аналог mainmenu

← →
barakuda © (2007-09-07 21:42) [0]

Здравствуйте мастера,

Может кто встречал аналог mainmenu? но чтобы путктам можно было большие иконки присваивать например 32х32

заранее спасибо...

← →
Dib@zol © (2007-09-07 21:48) [1]

Можно было бы написать самому... Но если лень - поищи на torry.

← →
Dib@zol © (2007-09-07 22:25) [2]

Хм. Попробовал задать менюшку как перерисовываемую прогой. Но пчм то высота в 42 пикселя задаваться не хочет :(

program Test;

{$Warnings off}
{$Hints off}

uses
Windows, Messages;

const
WW = 300;
WH = 170;
CN = "TEST_WND";
WN = "Source";

var
M : MSG;
W : HWND;
HM : HMENU;
WC : WNDCLASS;
WXPos, WYPos : Word;

function GetWindowTextStr(W:HWND):string;
var
lpTemp : PChar;
i : byte;
begin
i:=GetWindowTextLength(W)+1; GetMem(lpTemp, i);
SendMessage(W, WM_GETTEXT, i, LongInt(lpTemp));
result:=lpTemp;
end;

function WindowProc(hWnd: HWND; Msg, WParam, LParam: LongInt): LongInt; stdcall;
var
mi : MENUITEMINFO;
ms : PMEASUREITEMSTRUCT;
md : PDRAWITEMSTRUCT;
begin
Result:=0;
case Msg of
WM_CREATE:
begin
HM:=CreateMenu;

with mi do begin
cbSize:=SIZEOF(MENUITEMINFO);
fMask:=MIIM_STATE or MIIM_ID or MIIM_TYPE;
fType:=MFT_STRING or MFT_OWNERDRAW;
fState:=MFS_CHECKED;
wID:=1;
hSubMenu:=0;
hbmpChecked:=0;
hbmpUnchecked:=0;
dwItemData:=0;
dwTypeData:="Файл";
cch:=4;
end;

InsertMenuItem(HM, 1, true, mi);
AppendMenu(HM, MF_BYPOSITION, 2, "Справка");
SetMenu(hWnd, HM);
end;

WM_MEASUREITEM:
begin
ms:=pointer(lParam);
ms.itemWidth:=42;
ms.itemHeight:=42;
result:=longInt(true);
end;

WM_DRAWITEM:
begin
md:=pointer(LParam);
Rectangle(md.hDC, md.rcItem.Left, md.rcItem.Top, md.rcItem.Right, md.rcItem.Bottom);
end;

WM_CLOSE:
begin
DestroyMenu(HM);
DestroyWindow(hWnd);
end;

WM_DESTROY: PostQuitMessage(0);

else Result:=DefWindowProc(hWnd, Msg, WParam, LParam);
end;
end;

begin
WXPos:=round((GetSystemMetrics(SM_CXSCREEN)-WW)/2);
WYPos:=round((GetSystemMetrics(SM_CYSCREEN)-WH)/2);

With WC do begin
Style := CS_HREDRAW or CS_VREDRAW;
lpfnWndProc := @WindowProc;
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := sysInit.HInstance;
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := GetSysColorBrush(COLOR_BTNFACE);
lpszClassName := CN;
end;
RegisterClass(WC);
W := CreateWindowEx(0, CN, WN, WS_VISIBLE or WS_SYSMENU,
WXPos, WYPos, WW, WH, 0, 0, HInstance, nil);
ShowWindow(W, SW_SHOWNORMAL);
UpdateWindow(W);

while GetMessage(M, 0, 0, 0) do begin
TranslateMessage(M);
DispatchMessage(M);
end;
Halt(M.wParam);
end.

аналог mainmenu Найти похожие ветки