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;
не дает результат...

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

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;

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