Как изменить шрифт в PopupMenu ?

← →
DmiSb (2005-02-08 08:51) [0]

Собственно вопрос. Демку (DemoMenuBitmap) я смотрел, там идет прорисовка при OwnerDraw одного пункта меню (причем не изменение шрифта, а рисование картинки). Изменить шрифт таким образом у меня что-то не выходит. Может кто подскажет, как это решается, или какую демку еще посмотреть ?

← →
Anatoly Podgoretsky © (2005-02-08 09:04) [1]

Решается это путем рисования пунктов меню на канве.

← →
SPeller © (2005-02-08 09:17) [2]

Тебе надо рисовать весь пункт полностью, с надписями, тогда и сможешь изменить шрифт.

← →
DmiSb (2005-02-08 09:19) [3]

Хм. Прошу прощения, я неправильно выразился. Насколько я понял, для KOLPopupMenu рисовать приходится в событии onDrawItem при включенном OwnerDraw пункта меню, а там нету канвы. Возможен вариант, создать канву, но я честно говоря тоже не знаю как это сделать. Подскажите, плз.
Зы. Такая штука для ВКЛ делается проще однако.

← →
ECM © (2005-02-08 11:19) [4]

[3] > Зы. Такая штука для ВКЛ делается проще однако
Кому как :) - мне проще рисовать сразу на DC ...
посмотри сюда ->
http://delphimaster.net/view/11-1095533289/

З.Ы. - поиск на этом форуме знает много интересного ...:)

← →
DmiSb (2005-02-08 11:55) [5]

Спасибо, попробую выкрутиться.

А хотелось быстро и на халяву, однако :)

Вот пример. Выдрал кусок из кода, думаю, разберешься.

function TJMCtrlMainForm.pmMainMeasureItem(Sender: PObj;
Idx: Integer): Integer;
begin
Result:= MakeLong(30, 170{+30*Ord(PMenu(Sender).Items[Idx].Parent = pmMain.Items[mJournals])});
end;

function TJMCtrlMainForm.pmMainDrawItem(Sender: PObj; DC: HDC;
const Rect: TRect; ItemIdx: Integer; DrawAction: TDrawAction;
ItemState: TDrawState): Boolean;
var R: Trect;
Brush: HBrush;
S: String;
tFont: HFont;
begin
R:= Rect;
S:= PMenu(Sender).ItemText[ItemIdx];

Brush:= CreateSolidBrush(Color2RGB(clMenu));

SetBkColor(DC, Color2RGB(clMenu));
if (odsSelected in ItemState) and (PMenu(Sender).Items[ItemIdx].Parent <> pmMain.Items[mJournals]) then begin
SetTextColor(DC, Color2RGB(clHighlightText));
SetBkColor(DC, Color2RGB(clHighlight));
Brush:= CreateSolidBrush(Color2RGB(clHighlight));
end;
FillRect(DC, R, Brush);

if PMenu(Sender).Items[ItemIdx].Parent = pmMain.Items[mJournals] then begin
SetTextColor(DC, Color2RGB(clRed));
if odsChecked in ItemState then DrawEdge(DC, R, EDGE_SUNKEN, BF_RECT);
if odsSelected in ItemState then DrawEdge(DC, R, EDGE_RAISED, BF_RECT);
end;
tFont:= SelectObject(DC, Form.Font.Handle);

Inc(R.Left, 5); Dec(R.Right, 5);
DrawText(DC, Pchar(GetStrToChar(S, #9)), -1, R, DT_SINGLELINE or DT_VCENTER);
if Pos(#9, S)>0 then DrawText(DC, Pchar(GetStrAfterChar(S, #9)), -1, R, DT_SINGLELINE or DT_VCENTER or DT_RIGHT);

SelectObject(DC, tFont);
DeleteObject(Brush);
Result:= True;
end;

function TMainForm.MainMenu1DrawItem(Sender: PObj; DC: HDC; const Rect: TRect; ItemIdx: Integer; DrawAction: TDrawAction; ItemState: TDrawState): Boolean; var Br: HBrush; S: String; R: TRect; ColorTxt: TColor; ColorBrush: TColor; begin R := Rect; if odsSelected in ItemState then begin ColorBrush := Color2RGB(clHighLight); if odsGrayed in ItemState then ColorTxt := Color2RGB(clGrayText) else ColorTxt := Color2RGB(clHighLightText); end else begin ColorBrush := Color2RGB(clMenu); if odsGrayed in ItemState then ColorTxt := Color2RGB(clGrayText) else ColorTxt := Color2RGB(clMenuText); end; Br := CreateSolidBrush(ColorBrush); Inc(R.Left,18); FillRect(DC,R,Br); Inc(R.Left,2); SetBkMode(DC,TRANSPARENT); if (odsGrayed in ItemState) then begin ImageList2.Draw(PMenu(Sender).Items[ItemIdx].Tag ,DC,Rect.Left,Rect.Top); end else begin ImageList1.Draw(PMenu(Sender).Items[ItemIdx].Tag ,DC,Rect.Left,Rect.Top); end; S := PMenu(Sender).ItemText[ItemIdx]; if (odsGrayed in ItemState) and (not (odsSelected in ItemState)) then begin Inc(R.Left); Inc(R.Top); SetTextColor(DC,Color2RGB(clHighLightText)); DrawText(DC,@S[1],Length(S),R,DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS); Dec(R.Left); Dec(R.Top); end; SetTextColor(DC,ColorTxt); DrawText(DC,@S[1],Length(S),R,DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS); DeleteObject(Br); Result := TRUE; end;

Как изменить шрифт в PopupMenu ? Найти похожие ветки