Текущий архив: 2007.04.15;
Скачать: CL | DM;

Вниз

Создание меню на API   Найти похожие ветки 

← →
Dmitry_177   (2006-11-25 21:33) [0]

Создаю меню в окне, но оно почему-то не появляется на форме... Подскажите пожалуйста что я не так делаю?

program TestAPIMenu;

uses
 Windows,
 Messages;

const
 WindowName = "TestAPIButton";

 mFile      = 100;
 mEdit      = 200;
 mHelp      = 300;
 sNew       = 101;
 sOpen      = 102;
 sOpenAs    = 103;
 sSave      = 104;
 sSaveAs    = 105;
 sClose     = 106;
 sExit      = 107;
 sUndo      = 201;
 sRedo      = 202;
 sCut       = 203;
 sCopy      = 204;
 sPaste     = 205;
 sDelete    = 206;
 sSelectAll = 207;
 sHelp      = 301;
 sAbout     = 302;

var
 WindowClass: TWndClass;
 hWindow: HWND;
 hMainMenu: HMENU;
 hSubMenuFile: HMENU;
 hSubMenuEdit: HMENU;
 hSubMenuHelp: HMENU;
 AMessage: TMsg;

function WindowProc(Window: HWnd; Message: Word; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
 Result := 0;
   case Message of
     WM_DESTROY: PostQuitMessage(0);
   else
     Result := DefWindowProc(Window, Message, wParam, lParam);
   end;
end;

function CreateMenuItem(hMenu, hSubMenu: HMENU; Caption: PChar; miimID: UINT; Separator: bool): boolean;
var
 mINFO: MENUITEMINFO;
begin
 with mINFO do
   begin
     cbSize := SizeOf(mINFO);
     if hSubMenu = 0 then
       fMask := MIIM_STATE or MIIM_TYPE or MIIM_ID
     else
       fMask := MIIM_STATE or MIIM_TYPE or MIIM_SUBMENU or MIIM_ID;
     if not Separator then
       fType := MFT_STRING
     else
       fType := MFT_SEPARATOR;
     fState := MFS_ENABLED;
     wID := miimID;
     hSubMenu := hSubMenu;
     dwItemData := 0;
     dwTypeData := Caption;
     cch := SizeOf(Caption);
   end;
 Result := InsertMenuItem(hMenu, 0, false, mINFO);
end;

begin
 hMainMenu := CreateMenu;

 hSubMenuFile := CreatePopupMenu;
 hSubMenuEdit := CreatePopupMenu;
 hSubMenuHelp := CreatePopupMenu;

 CreateMenuItem(hMainMenu, hSubMenuFile, "File", mFile, false);
 CreateMenuItem(hMainMenu, hSubMenuEdit, "Edit", mEdit, false);
 CreateMenuItem(hMainMenu, hSubMenuHelp, "Help", mHelp, false);

 CreateMenuItem(hSubMenuFile, 0, "New", sNew, false);
 CreateMenuItem(hSubMenuFile, 0, "Open", sOpen, false);
 CreateMenuItem(hSubMenuFile, 0, "Open As", sOpenAs, false);
 CreateMenuItem(hSubMenuFile, 0, "Save", sSave, false);
 CreateMenuItem(hSubMenuFile, 0, "Save As", sSaveAs, false);
 CreateMenuItem(hSubMenuFile, 0, "Close", sClose, false);
 CreateMenuItem(hSubMenuFile, 0, "Exit", sExit, false);

 CreateMenuItem(hSubMenuEdit, 0, "Undo", sUndo, false);
 CreateMenuItem(hSubMenuEdit, 0, "Redo", sRedo, false);
 CreateMenuItem(hSubMenuEdit, 0, "Cut", sCut, false);
 CreateMenuItem(hSubMenuEdit, 0, "Copy", sCopy, false);
 CreateMenuItem(hSubMenuEdit, 0, "Paste", sPaste, false);
 CreateMenuItem(hSubMenuEdit, 0, "Delete", sDelete, false);
 CreateMenuItem(hSubMenuEdit, 0, "Select All", sSelectAll, false);

 CreateMenuItem(hSubMenuHelp, 0, "Help", sHelp, false);
 CreateMenuItem(hSubMenuHelp, 0, "About", sAbout, false);

 with WindowClass do
   begin
     lpszClassName := WindowName;
     lpfnWndProc := @WindowProc;
     cbClsExtra := 0;
     cbWndExtra := 0;
     hInstance := 0;
     hCursor := LoadCursor (0, idc_Arrow);
     lpszMenuName := @hMainMenu;
     hbrBackground := COLOR_WINDOW;
   end;

 if RegisterClass(WindowClass) = 0 then Exit;

 hWindow := CreateWindow(WindowName, WindowName, WS_OVERLAPPEDWINDOW, cw_UseDefault, cw_UseDefault, 300, 200, 0, hMainMenu, HInstance, nil);

 ShowWindow(hWindow, SW_SHOWNORMAL);
 UpdateWindow(hWindow);

 while GetMessage(AMessage, 0, 0, 0) do
   begin
     TranslateMessage(AMessage);
     DispatchMessage(AMessage);
   end;
end.


---

← →
Чапаев ©   (2006-11-25 22:01) [1]

> lpszMenuName := @hMainMenu;
Неправильно, сюда нужно передавать имя меню в ресурсе. Здесь присвой nil, а меню прописывай только в CreateWindow() (там у тебя всё правильно).

---

← →
Чапаев ©   (2006-11-25 22:04) [2]

> with WindowClass do
>   begin
>     lpszClassName := WindowName;
>     lpfnWndProc := @WindowProc;
>     cbClsExtra := 0;
>     cbWndExtra := 0;
>     hInstance := 0;
>     hCursor := LoadCursor (0, idc_Arrow);
>     lpszMenuName := @hMainMenu;
>     hbrBackground := COLOR_WINDOW;
>   end;
Это тоже нехорошее решение. Сделай сначала FillChar(WindowClass, SizeOf(WindowClass), 0), а затем заполняй только ненулевые поля.

---

← →
Dmitry_177   (2006-11-25 22:22) [3]

Сделал, всеравно не появляется.

---

← →
Чапаев ©   (2006-11-25 23:07) [4]

Что-то ты с CreateMenuItem() мудришь...

Вот такое работает:
hMainMenu := CreateMenu;
hSubMenuFile := CreatePopupMenu;
AppendMenu(hMainMenu,MF_STRING or MF_POPUP,hSubMenuFile,"File");
AppendMenu(hSubMenuFile,MF_STRING,sNew,"New");

---

← →
Dmitry_177   (2006-11-25 23:28) [5]

в функции CreateMenuItem() все закоментировал, а вписал одну строку

AppendMenu(hMenu, MF_STRING or MF_POPUP, hSubMenu, Caption);

работает... Странно почему InsertMenuItem не работает...

---

← →
Dmitry_177   (2006-11-25 23:33) [6]

сделал так, как вы мне посоветовали с WindowClass, только с mINFO: MENUITEMINFO; в CreateMenuItem()

FillChar(mINFO, SizeOf(mINFO), 0);

И меню появилось, только оно не расскрывается...

---

← →
Dmitry_177   (2006-11-26 00:27) [7]

Заработало ))) Понял в чем дело было! Название второго параметра в функции поменял:

function CreateMenuItem(hMenu, hSMenu: HMENU; Caption: PChar; miimID: UINT; Separator: bool): boolean;

hSubMenu есть в структуре MENUITEMINFO, и было в функции hSubMenu := hSubMenu; непойми чего к непойми чему присваивалось...

Работает и без FillChar(mINFO, SizeOf(mINFO), 0); интересно желательно его делать или нет?

---

Страницы: 1 вся ветка

Текущий архив: 2007.04.15;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.099 c