| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Создание меню на API [D7, WinXP]

Dmitry_177 ©   (2006-11-25 21:33:00) 

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

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.


---

Dmitry_177   (2006-11-26 00:27:00) [1]

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

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

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

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

---

Dmitry_177   (2006-11-25 23:33:00) [2]

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

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

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

---

Dmitry_177   (2006-11-25 23:28:00) [3]

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

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

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

---

Чапаев   (2006-11-25 23:07:00) [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 22:22:00) [5]

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

---

Чапаев   (2006-11-25 22:04:00) [6]

> 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), а затем заполняй только ненулевые поля.

---

Чапаев   (2006-11-25 22:01:00) [7]

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

---

Наверх