PopupMenu

← →
Evgeny © (2002-01-22 07:45) [0]

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

// Переводим PopupMenu в режим OwnerDraw
procedure SetPopupMenu(Wnd : HWND);
var
Pt : TPoint;
I, Count : Integer;
lpmii : TMENUITEMINFO;
CCaption : array[0..255] of Char;
begin
PopMenu := GetSubMenu(hMn, 0);
SetMenuDefaultItem(PopMenu, 0, 1);

Count := GetMenuItemCount(PopMenu);
for I := 0 to Count - 1 do
begin
FillChar(lpmii, SizeOf(TMenuItemInfo), 0);
lpmii.cbSize := SizeOf(TMenuItemInfo);
lpmii.fMask := MIIM_DATA or MIIM_TYPE;
lpmii.dwTypeData := CCaption;
lpmii.cch := SizeOf(CCaption);
GetMenuItemInfo(PopMenu, I, True, lpmii);
lpmii.fType := lpmii.fType or MF_OWNERDRAW;
SetMenuItemInfo(PopMenu, I, True, lpmii);
end;

GetCursorPos(Pt);
TrackPopupMenu(PopMenu, TPM_LEFTALIGN or TPM_TOPALIGN or TPM_RIGHTBUTTON or TPM_LEFTBUTTON, pt.x, pt.y, 0, Wnd, NIL);
end;

procedure DrawMenuItem(Wnd : HWND; lpdis : PDRAWITEMSTRUCT);
var
LineTop : Integer;
LLeft : Integer;
Size : TSize;
St : String;
CCaption : array[0..255] of Char;
R : TRect;
begin
LLeft := 2 * (Round(LoWord(GetMenuCheckMarkDimensions) * 0.3)) + LoWord(GetMenuCheckMarkDimensions);
GetMenuString(PopMenu, lpdis.itemID, CCaption, Length(CCaption), MF_BYCOMMAND);
St := DelChars(CCaption, "&");
GetTextExtentPoint32(lpdis.hDC, PChar(St), Length(St), Size);

if CCaption = "" then
begin
with lpdis.rcItem do
begin
LineTop := (Top + Bottom) div 2 - 1;
MenuLine(lpdis.hDC, clBtnShadow, Left, LineTop, Right, LineTop);
MenuLine(lpdis.hDC, clBtnHighlight, Left, LineTop + 1, Right, LineTop + 1);
end;
end
else
begin
GetTextExtentPoint32(lpdis.hDC, "Ay", Length("Ay"), Size);
with lpdis.rcItem do
LineTop := (Bottom + Top - Size.cy) div 2;
R := lpdis.rcItem;
Inc(R.Left, LLeft);
R.Top := LineTop;
DrawText(lpdis.hDC, @St[1], Length(St), R, DT_EXPANDTABS or DT_LEFT or DT_SINGLELINE);
end;
end;

// Пытаемся отрисовать
WM_DRAWITEM :
begin
lpdis := PDRAWITEMSTRUCT(lParam);
if lpdis.CtlType = ODT_MENU then
begin
clrText := ColorToRGB(clMenuText);
clrBack := ColorToRGB(ColorBack);
if (lpdis.itemState = ODS_SELECTED) then
begin
clrText := ColorToRGB(clHighlightText);
clrBack := ColorToRGB(clHighlight);
end;
SetTextColor(lpdis.hDC, clrText);
SetBkColor(lpdis.hDC, clrBack);
TmpBr := CreateSolidBrush(ColorToRGB(ClrBack));
FillRect(lpdis.hDC, lpdis.rcItem, TmpBr);
DeleteObject(TmpBr);
DrawMenuItem(Wnd, PDRAWITEMSTRUCT(lParam));
end;
end;

← →
Evgeny © (2002-01-24 11:06) [1]

Может кто-нибудь сможет помочь?

PopupMenu Найти похожие ветки