开箱即用的扁平无边框按钮

时间:2014-06-19 07:55:01

标签: delphi button devexpress delphi-7 vcl

我正在寻找配置平面无边框按钮的开箱即用方式。这样我就可以在调色板中添加一个按钮并在设计时配置它,而不需要运行时覆盖。 我可以使用DevExpress组件,但是我想避免使用LookAndFeel覆盖或为其创建自定义主题。

问题是某些控件允许编辑属性,但是会遗漏其他控件。

以下是我的尝试:

Component      TabStop    FocusRect     Text V.Align    Borderless    Color
----------------------------------------------------------------------------
TButton        V          V             V               -             -
TSpeedButton   V          V             V               -             -
TLabel         -          -             V               V             V
TPanel         V          -             V               V             V
TStaticText    V          -             -               V             V
TcxButton      V          V             V               -             V
TcxLabel       -          -             V               V             V
----------------------------------------------------------------------------
* Text V.Align - vertical text alignment to center
* Borderless - no borders in default/unfocused state
** Color - ability to set face color

另一种方法可能是通过一些OwnerDraw魔术来覆盖TButton类,并将该单元放在每个表单的第一位。使用条款?

您是否知道在设计时只允许使用标准Delphi 7和基本DevExpress组件创建/配置这样的平面按钮的任何替代方案?

编辑:为了解决那些可能认为这是一个糟糕问题的挫折者,因为它询问如何在不重新设计自行车的情况下使用现有工具做些什么。

  • 这不是车库项目。有六个开发人员和构建机器,这意味着安装包含自定义按钮的更新组件每次都是一个明显的麻烦。
  • 问题不在于寻找第三方组件。我问是否有一种已知的方法来配置现有控件以满足需要。每次需要热链接标签时,您都不会创建新控件吗?

P.S。目标操作系统是Windows XP及更高版本

1 个答案:

答案 0 :(得分:7)

下面是一个内插器类示例,它将TButton修改为BS_OWNERDRAW样式。正如您所指出的,它可以放在'stdctrls'之后使用的单元中。

type
  TButton = class(stdctrls.TButton)
  protected
    procedure SetButtonStyle(ADefault: Boolean); override;
    procedure CNCtlcolorbtn(var Message: TMessage); message CN_CTLCOLORBTN;
    procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  end;

...

procedure TButton.SetButtonStyle(ADefault: Boolean);
begin
  if HandleAllocated then
    Perform(BM_SETSTYLE, BS_OWNERDRAW, 1);
end;

procedure TButton.CNCtlcolorbtn(var Message: TMessage);
begin
  DWORD(Message.Result) := CreateSolidBrush($79FF);
end;

procedure TButton.CNDrawitem(var Message: TWMDrawItem);
var
  DC: HDC;
  SaveObj: HGDIOBJ;
  R: TRect;
begin
  R := ClientRect;
  DC := Message.DrawItemStruct.hDC;
  SaveObj := SelectObject(DC, Font.Handle);
  SetBkMode(DC, TRANSPARENT);
  DrawText(DC, PChar(Caption), -1, R, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  SelectObject(DC, SaveObj);
  Message.Result := 1;
end;

procedure TButton.WMPaint(var Message: TWMPaint);
var
  DC: HDC;
  R: TRect;
begin
  inherited;
  if GetFocus = Handle then begin
    DC := GetDC(Handle);
    SelectObject(DC, GetStockObject(DC_BRUSH));
    SetDCBrushColor(DC, $FF);
    R := ClientRect;
    InflateRect(R, -2, -2);
    FrameRect(DC, R, DC_BRUSH);
    ReleaseDC(Handle, DC);
  end;
end;

在W7上看起来像这样:

enter image description here