Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.07.17;
Скачать: CL | DM;

Вниз

SysColors   Найти похожие ветки 

 
Far   (2003-07-06 22:07) [0]

Уважаемые! Делаю PopUp-меню для настройки цветов. Но хотелось бы кроме их названий добавить в это меню еще и образцы этих цветов. Никак не могу решить эту задачу. Помогите!!!


 
Романов Р.В. ©   (2003-07-06 22:30) [1]

TMenuItem.OnDrawItem


 
Far   (2003-07-07 00:40) [2]

А можно подробнее. Потому что процедура:
procedure TForm1.ColorDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
var
R: TRect;
begin
R := ARect;
ACanvas.Brush.Color := clWhite;
ACanvas.FillRect(Rect(R.Left, R.Top, 16, 16));
end;
не дает результат...


 
Юрий Зотов ©   (2003-07-07 00:41) [3]

Не очень хороший, но все-таки пример.

type
TForm1 = class(TForm) // PopupMenu = PopupMenu1
PopupMenu1: TPopupMenu; // OwnerDraw = True
procedure FormCreate(Sender: TObject); // OnCreate
private
procedure AddMenuItem(const S: string);
procedure DrawMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
procedure MenuItemClick(Sender: TObject);
end;

procedure TForm1.AddMenuItem(const S: string);
var
ColorValue: TColor;
Item: TMenuItem;
begin
ColorValue := StringToColor(S);
if ColorValue < 0 then // Только системные цвета
begin
Item := TMenuItem.Create(Self);
with PopupMenu1.Items do
try
Item.Caption := S;
Item.Tag := ColorValue;
Item.OnDrawItem := DrawMenuItem;
Item.OnClick := MenuItemClick;
PopupMenu1.Items.Add(Item);
Item.Name := Format("MenuItem%u", [IndexOf(Item)])
except
Item.Free;
raise
end
end
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
GetColorValues(AddMenuItem)
end;

type
TRGB = packed record
case Boolean of
True: (R, G, B, P: Byte);
False: (RGB: LongInt)
end;

procedure TForm1.DrawMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
const
SelectedStyle: array[Boolean] of TFontStyles = ([], [fsBold, fsItalic]);
var
RGB: TRGB;
begin
with TMenuItem(Sender), ACanvas, Brush do
begin
Color := TColor(Tag);
RGB.RGB := ColorToRGB(Color);
with Font do
begin
Color := (255 - RGB.R) or (255 - RGB.G) shl 8 or (255 - RGB.B) shl 16;
Style := SelectedStyle[Selected]
end;
TextRect(ARect, 2, ARect.Top + 2, StripHotKey(Caption))
end
end;

procedure TForm1.MenuItemClick(Sender: TObject);
begin
ShowMessage(TMenuItem(Sender).Name)
end;



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

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

Наверх




Память: 0.47 MB
Время: 0.018 c
3-55449
alexander_ua
2003-06-23 18:30
2003.07.17
Paradox, Novell, Win 2000/XP


1-55500
DBDev
2003-07-02 17:37
2003.07.17
Коллеги, чем бы занять юзера на время окрытия базы???


3-55398
Andrey007
2003-06-23 13:32
2003.07.17
Как редактировать текст в DBMemo?


14-55731
NailMan
2003-07-01 18:13
2003.07.17
А как вы относитесь к идее распределенных вычислений?


1-55615
Sandman25
2003-07-02 17:31
2003.07.17
Переменная окружения