Главная страница
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.019 c
14-55803
cyborg
2003-07-01 00:46
2003.07.17
Осторожно, идиотские инструкции!


14-55714
Мазут Береговой
2003-07-01 19:03
2003.07.17
Притча от Мазута. Быль. 20 век.


1-55578
NIVA
2003-07-02 09:16
2003.07.17
Таблица в текстовом файле


3-55401
Ai
2003-06-23 15:46
2003.07.17
Как программно очистить базу?


3-55456
Kpax
2003-06-25 10:26
2003.07.17
TDBComboBox или?...