编写Flat风格的Button Delphi标准的组件中的Button组件都是3D风格的组件，即使像SpeedButton组件具有Flat属性，但是确没有了Border。因此我们需要一个简单功能的Flat风格组件又不想使用第三方组件，该怎么办呢？通过阅读delphi源代码和反复尝试，我们发现组件的风格主要通过重载 procedure CreateParams(var Params: TCreateParams); override;方法来实现，这也是delphi组件和windows标准组件结合的位置。我们看一下源代码： procedure TButton.CreateParams(var Params: TCreateParams); const ButtonStyles: array[Boolean] of DWORD = (BS_PUSHBUTTON, BS_DEFPUSHBUTTON); begin inherited CreateParams(Params); //继承祖先的方法 CreateSubClass(Params, 'BUTTON'); //创建windows组件button类 Params.Style := Params.Style or ButtonStyles[FDefault]; //设置button类型 end; 我们继续跟踪发现ButtonStyles控制了他的border外观，同时由FDefault来确定。我们继续跟踪，就来到了Windows单元，组件风格的秘密就全在这里了。我们来看看： BS_PUSHBUTTON, BS_DEFPUSHBUTTON 通过字面意思不难理解，BS_FLAT就是我们要找的。好了，接下来我们实现它就OK了。 代码及测试代码实现如下： unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Buttons, StdCtrls, Themes; type TFlatButton = class(TButtonControl) private FCancel: Boolean; FDefault: Boolean; FActive: Boolean; FModalResult: TModalResult; procedure SetDefault(const Value: Boolean); procedure CNCtlColorBtn(var Message: TWMCtlColorBtn); message CN_CTLCOLORBTN; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; protected procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; public constructor Create(AOwner: TComponent); override; procedure Click; override; function UseRightToLeftAlignment: Boolean; override; published property Action; property Anchors; property BiDiMode; property Cancel: Boolean read FCancel write FCancel default False; property Caption; property Constraints; property Default: Boolean read FDefault write SetDefault default False; property DragCursor; property DragKind; property DragMode; property Enabled; property Font; property ModalResult: TModalResult read FModalResult write FModalResult default 0; property ParentBiDiMode; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop default True; property Visible; property WordWrap; property OnClick; property OnContextPopup; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDock; property OnStartDrag; end; TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public procedure MyClick(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} { TFlatButton } procedure TFlatButton.Click; var Form: TCustomForm; begin Form := GetParentForm(Self); if Form <> nil then Form.ModalResult := ModalResult; inherited Click; end; procedure TFlatButton.CNCtlColorBtn(var Message: TWMCtlColorBtn); begin with ThemeServices do if ThemesEnabled then begin DrawParentBackground(Handle, Message.ChildDC, nil, False); { Return an empty brush to prevent Windows from overpainting we just have created. } Message.Result := GetStockObject(NULL_BRUSH); end else inherited; end; constructor TFlatButton.Create(AOwner: TComponent); begin inherited Create(AOwner); Width := 75; Height := 25; TabStop := True; end; procedure TFlatButton.CreateParams(var Params: TCreateParams); const ButtonStyles: array[Boolean] of DWORD = (BS_FLAT, BS_DEFPUSHBUTTON); begin inherited CreateParams(Params); CreateSubClass(Params, 'BUTTON'); Params.Style := Params.Style or BS_FLAT;//ButtonStyles[FDefault]; end; procedure TFlatButton.CreateWnd; begin inherited CreateWnd; FActive := FDefault; end; procedure TFlatButton.SetDefault(const Value: Boolean); begin FDefault := Value; end; function TFlatButton.UseRightToLeftAlignment: Boolean; begin Result := False; end; procedure TFlatButton.WMEraseBkgnd(var Message: TWMEraseBkgnd); begin if ThemeServices.ThemesEnabled then Message.Result := 1 else DefaultHandler(Message); end; procedure TForm1.Button1Click(Sender: TObject); var button: TFlatButton; begin button := TFlatButton.Create(self); button.Parent := self; button.Caption := '&OK'; button.SetBounds(10, 10, 75, 25); button.OnClick := myClick; end; procedure TForm1.MyClick(Sender: TObject); begin showmessage('you clicked me!'); end; end.
