Текущий архив: 2007.04.29;
Скачать: 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 вся ветка

Текущий архив: 2007.04.29;
Скачать: CL | DM;

Наверх

Память: 0.46 MB
Время: 0.049 c