Word 2010 中的“选项”对话框通过一组白色“切换”按钮实现类别选择器，这些按钮在单击（选择）时变为橙色。
如何在 Delphi 中重新实现这种行为？需要符合当前的 Windows 主题（即必须可以将按钮颜色指定为 clWindow，而不是 clWhite）。
编辑：澄清一下-我只有左侧的类别选择器有问题。其他一切都相当简单。
问问题
1879 次
4 回答
8
您可以使用 TButtonGroup组件。
到目前为止，使用 VCL 样式是最简单的解决方案，但正如您所说，在 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
那里有一个 Panel 容器托管 TButtonGroup，它不是必需的，只是为了视觉改进而添加。
如果您想在运行时更改选择的颜色，那么我建议使用efg 的 Hue/Saturation 方法来更改图像的色调，这样颜色面板会保留但颜色会改变。
要获得对 VCL 样式的支持，只需将 ButtonGroup1DrawButton 事件从 TButtonGroup 组件中分离出来，这样默认的 DrawButton 事件就可以启动，从而增加对它的支持。
于 2013-05-27T14:21:30.583 回答
8
您可以使用样式设置为 lbOwnerDrawFixed（如果间距的大小不重要）或 lbOwnerDrawVariable（如果是）的 TListBox。
然后，您可以相应地处理 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”看起来更接近但不能保证在那里）
于 2013-05-27T14:42:47.520 回答
4
我们为此外观使用TMS Control 的Advanced Poly Pager 。我强烈推荐它。这是一组非常强大且灵活的控件。具体来说，我们TAdvPolyList用于 Office 风格的对话框，并对配色方案进行了一些自定义调整。（请注意，这与它们TAdvOfficePager看起来不太一样好。不要意外地将两者混为一谈！）
它允许您：
- 左侧有一个类别选择器
- 是一个页面控件，所以很容易把你的控件放在右边的页面上（和普通的页面控件一样）
- 显示选项卡和页面之间的视觉链接，这是您提供的 Word 屏幕截图所没有的（Word 之间有障碍；此控件没有。它是一个更好、更直观且链接良好的 UI 设计。）
- 如果你愿意，肯定会允许你使用像 clWindow 这样的颜色常量，尽管任何东西都会
- 左侧面板中有各种各样的项目，包括图像、带有图像的文本、链接等。您的 Word 屏幕截图有细微的灰色分隔线分隔一些元素；我相信您也可以使用此控件执行此操作，而可靠地使用海报给出的其他一些答案会更棘手，例如自定义绘画 TListBox。
- 看起来很棒！
他们网站上的图像并没有真正完美地展示如何模仿 Office 外观，但是从这两个屏幕截图（他们网站上的高分辨率）中，您应该能够看到您可以实现的目标：
和
我们的菜单看起来类似于第二个屏幕截图，但带有简单的文本项（没有复杂的复选框和图像等 - 我认为他们放在那里只是为了证明你可以）并使用更像你的配色方案，另外我们添加了蓝色每个页面的标题。
我们几年前买了它，从未后悔过。强烈推荐。
于 2013-05-27T15:50:05.873 回答
-1
我原以为您可以使用两件事：右侧部分的页面控件。对于左侧的部分，我认为您有几个选项，主要可能是使用 1 列和速度按钮的 GridLayout。
不是特别难，就是有点乱。您可能可以使用框架来包含按钮部分。
唯一困难的一点是分隔条，但也许您可以通过对其进行子类化并具有特定属性来做到这一点。
问候，
一个
于 2013-05-27T12:53:17.740 回答