TMenuItem - CustomDraw

← →
Smok_er (2003-08-02 14:07) [0]

Уважаемые мастера!
Для использования CustomDraw необходимо у PopupMenu установить свойство OwnerDraw. Но проблема в том, что не все элементы хочется отрисовывать вручную. И получается некое подобие "каши". Т.е. места под надпись не вмещается и т.д и т.п.

Как можно это побороть? Желательный вариант - применять ownerdraw только для нужных пунктов меню.

Заранее большое спасибо!

← →
Романов Р.В. © (2003-08-02 22:49) [1]

Вызывать стандартный обработчик отрисовки меню

← →
Smok_er (2003-08-04 10:11) [2]

Каким образом?

← →
Романов Р.В. © (2003-08-04 16:10) [3]

TOpenMenuItem = class(TMenuItem);

procedure TForm1.cdsvcx1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
begin
// Вызов стандартной прорисовки
TMenuItem(Sender).OnAdvancedDrawItem := nil;
DrawMenuItem(TOpenMenuItem(Sender), ACanvas, ARect, State);
TMenuItem(Sender).OnAdvancedDrawItem := cdsvcx1AdvancedDrawItem;
end;

← →
Smok_er (2003-08-05 11:24) [4]

Спасибо, но не работает :(
Видимо я не так объяснил, что мне надо.

У меня большое popup-menu, в котором некоторые пункты мне надо отрисовать используя OwnerDraw. Если я устанавливаю свойство PopupMenu OwnerDraw, то ширина Item"a становится равной длине Caption"a, вследствие чего, к примеру, не влезает стрелка, если этот Item содержит Subitems.
Мало того, замечен баг в том, что если для некоторых итемов не указана процедура обработки, то автоматически подставляется не DEFAULT_CHARSET, а западноевропейский.

Может есть возможность с одного попап-меню вызвать другое?

← →
Zergling © (2003-08-05 12:11) [5]

>> становится равной длине Caption"a, вследствие чего,

PopupMenu.AutoHotKeys = amManual;

← →
Smok_er (2003-08-05 14:00) [6]

Честно говоря абсолютно не вижу связи, но меня так и стоит. А изменил значение этого свойства только для того, чтобы не отображался знак & (амперсенд).

← →
Zergling © (2003-08-05 14:04) [7]

>> не влезает стрелка,

При этом ведь и ширина всстанавливается

← →
Zergling © (2003-08-05 14:06) [8]

>> не влезает стрелка,

При этом ведь и ширина всстанавливается или стрелка рисуется твоя собственная?

← →
ggsoft © (2003-08-05 14:58) [9]

> то ширина Item"a становится равной длине Caption"a, вследствие
> чего, к примеру, не влезает стрелка,

TMenuItem.OnMeasureItem(...)

← →
Smok_er (2003-08-05 15:21) [10]

Zergling © (05.08.03 14:06)
> не влезает стрелка,

>При этом ведь и ширина всстанавливается или стрелка рисуется >твоя собственная?

Нет, не моя, но и не влезает.

ggsoft © (05.08.03 14:58)

>TMenuItem.OnMeasureItem(...)

Да, это отчасти решает проблему, но остаются траблы с неверной кодировкой :(

← →
ggsoft © (2003-08-05 15:50) [11]

> Да, это отчасти решает проблему,

Я думаю это должно полностью решить проблему с шириной MenuItem...

А вот насчет "неверноей кодировки", как это понимать? Свойства Font ведь у TMenuItem нет, значит отрисовываете своим шрифтом, видимо там и все...
А как у Вас реализовано OnDrawItem... или OnAdvancedDraw...?
Что, для каждого TMenuItem свой обработчик?

← →
Smok_er (2003-08-06 10:08) [12]

Сейчас я сделал так: для итемов, которые надо рисовать с использованием CustomDraw - один обработчик OnDrawItem, а для всех остальных - другой (для того, чтобы кодировка была русской). Также для этих итемов использую OnMeasureItem.

Это не совсем удобно :(

> При этом ведь и ширина всстанавливается или стрелка рисуется >твоя собственная?
> Нет, не моя, но и не влезает.

Странно. После установки PopupMenu.AutoHotKeys = amManual у меня и Caption нормальный и стрелка влазит, а если данное значение не установленно, то и Caption кривой и стрелка невлазит. Скорей всего это зависит от того чего и как рисуеш. Может кусок кода кинешь по этому поводу?

← →
Smok_er (2003-08-06 13:33) [14]

Да, конечно. Спасибо что согласился помочь!

Для проверки этого кода достаточно создать на форме popup menu, в дизайне подобавлять в него побольше итемов (желательно на русском, заодно для проверки кодировки). Один из итемов - miColor. В него и будем добавлять новые сабитемы.

// Добавление пунктов меню

procedure TfmMain.FillPopupMenu;
var
i: Integer;

procedure AddMenuItem(Color: TColor; Name: string);
var
MenuItem: TMenuItem;
begin
MenuItem := TMenuItem.Create(miColor);
MenuItem.Caption := Name;
MenuItem.Tag := Color;
MenuItem.OnDrawItem := OnDrawColorItem;
MenuItem.OnClick := OnClickColorItem;
miColor.Add(MenuItem);
end;
begin
AddMenuItem(clBlack, "Черный ");
AddMenuItem(clMaroon, "Коричневый ");
AddMenuItem(clGreen, "Зеленый ");
AddMenuItem(clOlive, "Оливковый ");
AddMenuItem(clNavy, "Фиолетовый ");
AddMenuItem(clRed, "Красный ");
AddMenuItem(clBlue, "Синий ");
AddMenuItem(clYellow, "Желтый ");
AddMenuItem(clWhite, "Белый ");
end;

// Обработчик
procedure TfmMain.OnDrawColorItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
var
R: TRect;
Color: TColor;
begin
Color := (Sender as TMenuItem).Tag;
R := ARect;
R.Left := R.Left + 3;
R.Top := R.Top + 3;
R.Right := R.Left + 20;
R.Bottom := R.Bottom - 3;
with ACanvas do
begin
if Selected then Brush.Color := clHighlight
else Brush.Color := clBtnFace;

FillRect(ARect);
Brush.Color := Color;
FillRect(R);

if Selected then Brush.Color := clHighlight
else Brush.Color := clBtnFace;

Font.Charset := DEFAULT_CHARSET; // Замечу, что если убрать эту строку, то на некоторых компах рисуется западноевропейским чарсетом
( ARect.Left + 30, ARect.Top + 2, (Sender as TMenuItem) Да, конечно. Спасибо что согласился помочь!

Для проверки этого кода достаточно создать на форме popup menu, в дизайне подобавлять в него побольше итемов (желательно на русском, заодно для проверки кодировки). Один из итемов - miColor. В него и будем добавлять новые сабитемы.

// Добавление пунктов меню

procedure TfmMain.FillPopupMenu;
var
i: Integer;

procedure AddMenuItem(Color: TColor; Name: string);
var
MenuItem: TMenuItem;
begin
MenuItem := TMenuItem.Create(miColor);
MenuItem.Caption := Name;
MenuItem.Tag := Color;
MenuItem.OnDrawItem := OnDrawColorItem;
MenuItem.OnClick := OnClickColorItem;
miColor.Add(MenuItem);
end;
begin
AddMenuItem(clBlack, "Черный ");
AddMenuItem(clMaroon, "Коричневый ");
AddMenuItem(clGreen, "Зеленый ");
AddMenuItem(clOlive, "Оливковый ");
AddMenuItem(clNavy, "Фиолетовый ");
AddMenuItem(clRed, "Красный ");
AddMenuItem(clBlue, "Синий ");
AddMenuItem(clYellow, "Желтый ");
AddMenuItem(clWhite, "Белый ");
end;

// Обработчик
procedure TfmMain.OnDrawColorItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
var
R: TRect;
Color: TColor;
begin
Color := (Sender as TMenuItem).Tag;
R := ARect;
R.Left := R.Left + 3;
R.Top := R.Top + 3;
R.Right := R.Left + 20;
R.Bottom := R.Bottom - 3;
with ACanvas do
begin
if Selected then Brush.Color := clHighlight
else Brush.Color := clBtnFace;

FillRect(ARect);
Brush.Color := Color;
FillRect(R);

if Selected then Brush.Color := clHighlight
else Brush.Color := clBtnFace;

Font.Charset := DEFAULT_CHARSET; // Замечу, что если убрать эту строку, то на некоторых компах рисуется западноевропейским чарсетом
TextOut(ARect.Left + 30, ARect.Top + 2, (Sender as TMenuItem).Caption);
end;
end;

← →
Smok_er (2003-08-06 13:34) [15]

Да, конечно. Спасибо что согласился помочь!

Для проверки этого кода достаточно создать на форме popup menu, в дизайне подобавлять в него побольше итемов (желательно на русском, заодно для проверки кодировки). Один из итемов - miColor. В него и будем добавлять новые сабитемы.

// Добавление пунктов меню procedure TfmMain.FillPopupMenu; var i: Integer; procedure AddMenuItem(Color: TColor; Name: string); var MenuItem: TMenuItem; begin MenuItem := TMenuItem.Create(miColor); MenuItem.Caption := Name; MenuItem.Tag := Color; MenuItem.OnDrawItem := OnDrawColorItem; MenuItem.OnClick := OnClickColorItem; miColor.Add(MenuItem); end; begin AddMenuItem(clBlack, "Черный "); AddMenuItem(clMaroon, "Коричневый "); AddMenuItem(clGreen, "Зеленый "); AddMenuItem(clOlive, "Оливковый "); AddMenuItem(clNavy, "Фиолетовый "); AddMenuItem(clRed, "Красный "); AddMenuItem(clBlue, "Синий "); AddMenuItem(clYellow, "Желтый "); AddMenuItem(clWhite, "Белый "); end; // Обработчик procedure TfmMain.OnDrawColorItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); var R: TRect; Color: TColor; begin Color := (Sender as TMenuItem).Tag; R := ARect; R.Left := R.Left + 3; R.Top := R.Top + 3; R.Right := R.Left + 20; R.Bottom := R.Bottom - 3; with ACanvas do begin if Selected then Brush.Color := clHighlight else Brush.Color := clBtnFace; FillRect(ARect); Brush.Color := Color; FillRect(R); if Selected then Brush.Color := clHighlight else Brush.Color := clBtnFace; Font.Charset := DEFAULT_CHARSET; // Замечу, что если убрать эту строку, то на некоторых компах рисуется западноевропейским чарсетом ( ARect.Left + 30, ARect.Top + 2, (Sender as TMenuItem) Да, конечно. Спасибо что согласился помочь! Для проверки этого кода достаточно создать на форме popup menu, в дизайне подобавлять в него побольше итемов (желательно на русском, заодно для проверки кодировки). Один из итемов - miColor. В него и будем добавлять новые сабитемы. // Добавление пунктов меню procedure TfmMain.FillPopupMenu; var i: Integer; procedure AddMenuItem(Color: TColor; Name: string); var MenuItem: TMenuItem; begin MenuItem := TMenuItem.Create(miColor); MenuItem.Caption := Name; MenuItem.Tag := Color; MenuItem.OnDrawItem := OnDrawColorItem; MenuItem.OnClick := OnClickColorItem; miColor.Add(MenuItem); end; begin AddMenuItem(clBlack, "Черный "); AddMenuItem(clMaroon, "Коричневый "); AddMenuItem(clGreen, "Зеленый "); AddMenuItem(clOlive, "Оливковый "); AddMenuItem(clNavy, "Фиолетовый "); AddMenuItem(clRed, "Красный "); AddMenuItem(clBlue, "Синий "); AddMenuItem(clYellow, "Желтый "); AddMenuItem(clWhite, "Белый "); end; // Обработчик procedure TfmMain.OnDrawColorItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); var R: TRect; Color: TColor; begin Color := (Sender as TMenuItem).Tag; R := ARect; R.Left := R.Left + 3; R.Top := R.Top + 3; R.Right := R.Left + 20; R.Bottom := R.Bottom - 3; with ACanvas do begin if Selected then Brush.Color := clHighlight else Brush.Color := clBtnFace; FillRect(ARect); Brush.Color := Color; FillRect(R); if Selected then Brush.Color := clHighlight else Brush.Color := clBtnFace; Font.Charset := DEFAULT_CHARSET; // Замечу, что если убрать эту строку, то на некоторых компах рисуется западноевропейским чарсетом TextOut(ARect.Left + 30, ARect.Top + 2, (Sender as TMenuItem).Caption); end; end;

← →
Smok_er (2003-08-06 14:21) [16]

Блин, форум глючит. 2 раза добавилось сообщение.

У меня твой код очень даже красиво выглядит. Ни каких проблем с показом стрелки и шрифтом, даже PopupMenu.AutoHotKeys = amManual не понадобился. Итог: получилась SubMenu для выбора цветов с цветными прямоугольниками. Вобщем у меня глюков не наблюдается. Создай свою тестовую минипрогу, чего конкретно не получается и что такое глючное я должен увидеть. Когда создаш прогу можешь кинуть мне на ящик (только без *.exe, *.dcu, *.~*)

← →
Smok_er (2003-08-07 10:52) [18]

Да нет, спасибо! Не хочу тебя напрягать.
В принципе решения этой проблемы есть - добавлять пробелы для расширения итемов. Основная задача этого поста - найти способ выборочного назначения свойства OwnerDraw определенным итемам. Такого способа нет, приходится плясать от того, что есть.

Всем огромнейшее спасибо!

TMenuItem - CustomDraw Найти похожие ветки