Создаю меню в окне, но оно почему-то не появляется на форме... Подскажите пожалуйста что я не так делаю?
| Код |
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.
|
|