Главная страница
    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.039 c
2-1174362365
Jump
2007-03-20 06:46
2007.04.15
Приоритет разблокирования


15-1174386860
Игорь М.
2007-03-20 13:34
2007.04.15
Разрешённые сайты для посещения...


2-1174933475
Гость3000
2007-03-26 22:24
2007.04.15
Эксель грузиться на свой лад


15-1173820936
ДжекиМайер
2007-03-14 00:22
2007.04.15
Нужна помощь написании модуля exception


15-1174256394
Alexander Panov
2007-03-19 01:19
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
Английский Французский Немецкий Итальянский Португальский Русский Испанский