Вниз
Скачать: 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.059 c
2-1176103591
Sapos
2007-04-09 11:26
2007.04.29
Установка компонентов.


15-1175435176
isasa
2007-04-01 17:46
2007.04.29
Многопоточная задача канадских лесорубов.


15-1175480795
Slider007
2007-04-02 06:26
2007.04.29
С днем рождения ! 31 марта


15-1175517028
Desdechado
2007-04-02 16:30
2007.04.29
По следам 1 апреля


15-1175260410
Reaktor
2007-03-30 17:13
2007.04.29
Если свич воткнуть в свич




   Наверх