Диалоговое окно "Параметры" в Word 2010 реализует селектор категорий через набор белых кнопок "переключение", которые становятся оранжевыми при нажатии (выбрано).
Как можно повторить такое поведение в Delphi? Требуется соответствие текущей теме Windows (т.е. Должно быть возможно указать цвет кнопки как clWindow, а не clWhite).
EDIT: уточнить. У меня проблемы с селектором категорий слева. Все остальное довольно просто.
Вы можете использовать компонент TButtonGroup.
Использование VCL Styles на сегодняшний день является самым простым решением, но, как вы сказали, использование стилей в XE2 довольно неудобно, по-моему, эта функция действительно стала жизнеспособной в XE3.
В соответствии с вашим запросом использовать методы рисования по умолчанию, я отправляю свое решение,
исходный код проекта здесь.
Для этого проекта требуется изображение, изображение будет заархивировано вместе с проектом.
Скомпилирован и протестирован в XE4.
type
TButtonGroup = class(Vcl.ButtonGroup.TButtonGroup)
protected
procedure Paint; override;
end;
TForm1 = class(TForm)
ButtonGroup1: TButtonGroup;
Panel1: TPanel;
procedure ButtonGroup1DrawButton(Sender: TObject; Index: Integer;
Canvas: TCanvas; Rect: TRect; State: TButtonDrawState);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MBitmap : TBitmap;
implementation
{$R *.dfm}
procedure TButtonGroup.Paint;
var
R : TRect;
begin
inherited;
R := GetClientRect;
R.Top := Self.Items.Count * Self.ButtonHeight;
{Remove the clBtnFace background default Painting}
Self.Canvas.FillRect(R);
end;
procedure TForm1.ButtonGroup1DrawButton(Sender: TObject; Index: Integer;
Canvas: TCanvas; Rect: TRect; State: TButtonDrawState);
var
TextLeft, TextTop: Integer;
RectHeight: Integer;
ImgTop: Integer;
Text : String;
TextOffset: Integer;
ButtonItem: TGrpButtonItem;
InsertIndication: TRect;
DrawSkipLine : TRect;
TextRect: TRect;
OrgRect: TRect;
begin
//OrgRect := Rect; //icon
Canvas.Font := TButtonGroup(Sender).Font;
if bdsSelected in State then begin
Canvas.CopyRect(Rect,MBitmap.Canvas,
System.Classes.Rect(0, 0, MBitmap.Width, MBitmap.Height));
Canvas.Brush.Color := RGB(255,228,138);
end
else if bdsHot in State then
begin
Canvas.Brush.Color := RGB(194,221,244);
Canvas.Font.Color := clBlack;
end
else
Canvas.Brush.color := clWhite;
if not (bdsSelected in State)
then
Canvas.FillRect(Rect);
InflateRect(Rect, -2, -1);
{ Compute the text location }
TextLeft := Rect.Left + 4;
RectHeight := Rect.Bottom - Rect.Top;
TextTop := Rect.Top + (RectHeight - Canvas.TextHeight('Wg')) div 2; { Do not localize }
if TextTop < Rect.Top then
TextTop := Rect.Top;
if bdsDown in State then
begin
Inc(TextTop);
Inc(TextLeft);
end;
ButtonItem := TButtonGroup(Sender).Items.Items[Index];
TextOffset := 0;
{ Draw the icon - if you need to display icons}
// if (FImages <> nil) and (ButtonItem.ImageIndex > -1) and
// (ButtonItem.ImageIndex < FImages.Count) then
// begin
// ImgTop := Rect.Top + (RectHeight - FImages.Height) div 2;
// if ImgTop < Rect.Top then
// ImgTop := Rect.Top;
// if bdsDown in State then
// Inc(ImgTop);
// FImages.Draw(Canvas, TextLeft - 1, ImgTop, ButtonItem.ImageIndex);
// TextOffset := FImages.Width + 1;
// end;
{ Show insert indications }
if [bdsInsertLeft, bdsInsertTop, bdsInsertRight, bdsInsertBottom] * State <> [] then
begin
Canvas.Brush.Color := clSkyBlue;
InsertIndication := Rect;
if bdsInsertLeft in State then
begin
Dec(InsertIndication.Left, 2);
InsertIndication.Right := InsertIndication.Left + 2;
end
else if bdsInsertTop in State then
begin
Dec(InsertIndication.Top);
InsertIndication.Bottom := InsertIndication.Top + 2;
end
else if bdsInsertRight in State then
begin
Inc(InsertIndication.Right, 2);
InsertIndication.Left := InsertIndication.Right - 2;
end
else if bdsInsertBottom in State then
begin
Inc(InsertIndication.Bottom);
InsertIndication.Top := InsertIndication.Bottom - 2;
end;
Canvas.FillRect(InsertIndication);
//Canvas.Brush.Color := FillColor;
end;
if gboShowCaptions in TButtonGroup(Sender).ButtonOptions then
begin
{ Avoid clipping the image }
Inc(TextLeft, TextOffset);
TextRect.Left := TextLeft;
TextRect.Right := Rect.Right - 1;
TextRect.Top := TextTop;
TextRect.Bottom := Rect.Bottom -1;
Text := ButtonItem.Caption;
Canvas.TextRect(TextRect, Text, [tfEndEllipsis]);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MBitmap := TBitmap.Create;
try
MBitmap.LoadFromFile('bg.bmp');
except
on E : Exception do
ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
MBitmap.Free;
end;
DFM:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 398
ClientWidth = 287
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
StyleElements = []
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
AlignWithMargins = True
Left = 5
Top = 5
Width = 137
Height = 388
Margins.Left = 5
Margins.Top = 5
Margins.Right = 5
Margins.Bottom = 5
Align = alLeft
BevelKind = bkFlat
BevelOuter = bvNone
Color = clWhite
ParentBackground = False
TabOrder = 0
StyleElements = [seFont]
object ButtonGroup1: TButtonGroup
AlignWithMargins = True
Left = 4
Top = 4
Width = 125
Height = 378
Margins.Left = 4
Margins.Top = 4
Margins.Right = 4
Margins.Bottom = 2
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
BorderStyle = bsNone
ButtonOptions = [gboFullSize, gboGroupStyle, gboShowCaptions]
DoubleBuffered = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Segoe UI'
Font.Style = []
Items = <
item
Caption = 'General'
end
item
Caption = 'Display'
end
item
Caption = 'Proofing'
end
item
Caption = 'Save'
end
item
Caption = 'Language'
end
item
Caption = 'Advanced'
end>
ParentDoubleBuffered = False
TabOrder = 0
OnDrawButton = ButtonGroup1DrawButton
end
end
end
В контейнере есть контейнер, в котором размещается TButtonGroup, он не нужен, просто добавляется для визуального улучшения.
Если вы хотите изменить цвет выделения во время выполнения, я предлагаю использовать efg Hue/Saturation для изменения оттенка изображение, таким образом, цветная панель останется, но цвет изменится.
Чтобы получить поддержку VCL Styles, просто отсоедините событие ButtonGroup1DrawButton от компонента TButtonGroup, таким образом, событие DrawButton по умолчанию может ударить, в котором добавлена поддержка для этого.
Вы можете использовать TListBox со стилем, установленным в lbOwnerDrawFixed (если размер интервала не важен) или lbOwnerDrawVariable, если он есть.
Затем вы можете обрабатывать OnDrawItem и OnMeasureItem соответственно.
Использование clWindow не будет проблемой, однако AFAIK оранжевый цвет не является частью темы Windows, но вы можете получить что-то, что будет соответствовать теме, начиная с clHighlight, а затем применяя изменение оттенка, затем сдвиг яркости для затенения.
Если ваш оттенок будет постоянным, он автоматически адаптируется к цветам тем.
Пример кода (без HueShift для апельсина): отпустите TListBox, установите lbOwnerDrawFixed, отрегулируйте ItemHeight до 28, установите шрифт в "Segoe UI" и используйте следующий OnDrawItem
var
canvas : TCanvas;
txt : String;
begin
canvas:=ListBox1.Canvas;
canvas.Brush.Style:=bsSolid;
canvas.Brush.Color:=clWindow;
canvas.FillRect(Rect);
InflateRect(Rect, -2, -2);
if odSelected in State then begin
canvas.Pen.Color:=RGB(194, 118, 43);
canvas.Brush.Color:=RGB(255, 228, 138);
canvas.RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, 6, 6);
canvas.Pen.Color:=RGB(246, 200, 103);
canvas.RoundRect(Rect.Left+1, Rect.Top+1, Rect.Right-1, Rect.Bottom-1, 6, 6);
end;
canvas.Font.Color:=clWindowText;
canvas.Brush.Style:=bsClear;
txt:=ListBox1.Items[Index];
Rect.Left:=Rect.Left+10;
canvas.TextRect(Rect, txt, [tfLeft, tfSingleLine, tfVerticalCenter]);
end;
Если у вас будет несколько таких компонентов, конечно, предпочтительнее просто подкласс TListBox, и если вы хотите сглаживание для RoundRect, то можно использовать GR32 или GDI +.
Обратите внимание, что для обратной совместимости с XP шрифт "Segoe UI" должен быть установлен динамически, поскольку он недоступен в XP (в XP "Arial" является хорошим резервом, "Tahoma" выглядит ближе, но не гарантируется есть)
Мы используем TMS Control Advanced Poly Pager для этого вида. Я очень рекомендую. Это очень мощный и гибкий набор элементов управления. В частности, мы используем TAdvPolyList для наших диалоговых окон в стиле Office с некоторой настраиваемой настройкой цветовой схемы. (Обратите внимание, что это отличается от их TAdvOfficePager, который выглядит не так хорошо. Не производите смешение двух!)
Он позволяет:
Изображения на их сайте на самом деле не показывают, как имитировать внешний вид Office, но из этих двух скриншотов (high-res на их сайте) вы сможете увидеть то, что вы можете достичь:
и
Наши меню выглядят похожими на второй скриншот, но с простыми текстовыми элементами (ничего сложного, как флажки и изображения и т.д.), я думаю, что они поставили их там, чтобы продемонстрировать, что вы можете) и использует цветовую схему, более похожую на вашу, плюс мы добавили синие заголовки на каждую страницу.
Мы купили его пару лет назад и никогда не сожалели об этом. Очень рекомендуется.
Я бы подумал, что вы можете использовать две вещи: управление страницей для части справа. Для части слева я думаю, что у вас есть несколько вариантов, главным из которых, вероятно, является GridLayout, использующая 1 колонку и кнопки скорости.
Не слишком сложно, но немного грязно. Возможно, вы можете сделать с фреймом, чтобы содержать часть кнопок.
Единственный трудный бит - это разделительные столбцы, но, возможно, вы могли бы сделать это путем подклассификации и наличия определенных свойств.
Привет,
А