Вниз
Скачать: CL | DM;

Собственная отрисовка PopupMenu   Найти похожие ветки 

← →
Бригадир   (2007-03-02 09:06) [0]

Создаю пункты меню с флагом MF_OWNERDRAW, чтобы можно было их перерисовывать в WM_DRAWITEM, что не соображу как сделать сбытие OnClick, подскажите пожалуйста.

private
   { Private declarations }
   procedure WMMeasureItem(var Msg: TWMMeasureItem); message WM_MEASUREITEM;
   procedure WMDrawItem(var Msg: TWMDrawItem); message WM_DRAWITEM;

var
 MyMenu: HMenu;

procedure TForm1.WMMeasureItem(var Msg:TWMMeasureItem);
begin
 with Msg.MeasureItemStruct^ do
 begin
   ItemWidth:=100;
   Itemheight:=18;
 end;
end;

procedure TForm1.WMDrawItem(var Msg: TWMDrawItem);
begin
 with Msg.DrawItemStruct^ do
 begin
   if ItemID = SC_MyMenuItem then
   begin
   if (itemState and ODS_SELECTED) <> 0 then
     SetTextColor(hDC, clRed)
   else
    SetTextColor(hDC, clGreen);
   end;
   TextOut(hDC, rcItem.Left + 2, rcItem.Top + 2, "Menu Item Caption", Length("Menu Item Caption"));
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 MyMenu:= CreatePopupMenu;
 AppendMenu(MyMenu, MF_OWNERDRAW, SC_MyMenuItem, "");
end;

procedure TForm1.FormClick(Sender: TObject);
begin
 TrackPopupMenu(MyMenu, TPM_LEFTALIGN, Mouse.CursorPos.X, Mouse.CursorPos.Y, 0, Handle, nil);
end;


← →
clickmaker ©   (2007-03-02 10:23) [1]

procedure WMCommand(var Msg: TWMCommand); message WM_COMMAND;



Страницы: 1 вся ветка

Скачать: CL | DM;



Память: 0.45 MB
Время: 0.027 c
15-1175833346
Steep
2007-04-06 08:22
2007.04.29
Build with RunTime Packages


2-1176202422
vegarulez
2007-04-10 14:53
2007.04.29
Подскажите как правильно задекларировать процедуру.


15-1175720351
Германн
2007-04-05 00:59
2007.04.29
Не долго музыка играла :(((


15-1175146451
webman
2007-03-29 09:34
2007.04.29
Игра для детей


2-1176116225
defiler
2007-04-09 14:57
2007.04.29
Windows AD




   Наверх