Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2007.04.15;
Скачать: [xml.tar.bz2];

Вниз

Создание меню на 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 вся ветка

Форум: "WinAPI";
Текущий архив: 2007.04.15;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.038 c
9-1146880328
Сценарист
2006-05-06 05:52
2007.04.15
Что случилось с CVS ?


1-1172004366
timself
2007-02-20 23:46
2007.04.15
Как перехватить начало перезагрузки?


2-1175013602
Comp
2007-03-27 20:40
2007.04.15
Как обработать сообщение WM_PAINT для Edit-а?


15-1174210474
Донской
2007-03-18 12:34
2007.04.15
IDE семерки


15-1172733217
Сало
2007-03-01 10:13
2007.04.15
Может кому понадобится...





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский