VPF::Создание меню на API - Форум программистов

Dmitry_177

Дата 25.11.2006, 21:33 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

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

Код


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

Дата 25.11.2006, 23:33 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

сделал так с mINFO: MENUITEMINFO; в начале функции CreateMenuItem()

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

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

Dmitry_177

Дата 26.11.2006, 00:26 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

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

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

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

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

Это сообщение отредактировал(а) Dmitry_177 - 26.11.2006, 00:27

Voyager

Дата 26.11.2006, 00:49 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 532
Регистрация: 8.2.2005

Репутация: 4
Всего: 18

Вот легкий способ сделать меню:

Код


var
  hMenuMain, hMenuFile, hMenuHelp: HWND;

procedure WMCreate(hWnd: HWND);
begin
  hMenuMain:=CreateMenu;
  SetMenu(hWnd,hMenuMain);
  hMenuFile:=CreatePopupMenu;
  hMenuHelp:=CreatePopupMenu;

  AppendMenu(hMenuFile, MF_SEPARATOR, 0,'');
  AppendMenu(hMenuFile, MF_STRING or MF_ENABLED, 100,'E&xit');
  AppendMenu(hMenuMain,MF_ENABLED or MF_POPUP,hMenuFile,PChar('&File'));
  
  AppendMenu(hMenuHelp, MF_STRING or MF_ENABLED, 101,'&Help');
  AppendMenu(hMenuMain,MF_ENABLED or MF_POPUP,hMenuHelp,PChar('&Help'));

end;

Так можно обойтись без MENUITEMINFO, если не знаешь как с ним работать.

Это сообщение отредактировал(а) Voyager - 26.11.2006, 00:51

Dmitry_177

Дата 26.11.2006, 00:58 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 418
Регистрация: 22.9.2006

Репутация: нет
Всего: нет

Я разобрался как с MENUITEMINFO работать.. Просто не заметил сразу то что написал в предыдущем посте... Я так делаю меню чтобы потом самому прорисовывать его... Пока еще не пробовал с прорисовкой..

Voyager

Дата 26.11.2006, 22:54 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 532
Регистрация: 8.2.2005

Репутация: 4
Всего: 18

В дополнение к моему посту. А потом перерисовывать можно, для этого сначала делаем к примеру:

Код


ZeroMemory(@mii, sizeof(mii));
  mii.cbSize := SizeOf(MENUITEMINFO);
  mii.fMask :=  MIIM_TYPE or MIIM_DATA;
  mii.fType := MFT_OWNERDRAW;
  for i:=0 to Length(Datas)-1 do
    begin
      mii.dwItemData := Datas[i];
      SetMenuItemInfo(hMenuFile, i, true, mii);
    end;

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »