标题栏按钮的问题

Question

BusinessSkinForm皮肤做的界面，如何给标题栏加入一个自定义的按钮呢

Answer 1

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Buttons;type
  TForm1 = class(TForm)
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    CaptionBtn: TRect   ;
    Procedure DrawCaptButton;
    Procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPaint;
    Procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCActivate;
    Procedure WMSetText(var Msg: TWMSetText);   message WM_SetText;
    Procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest;
    Procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown); message WM_NCLButtonDown;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}{ TForm1 }const
HtCaptionBtn = HtSizeLast + 1;
Procedure TForm1.DrawCaptButton;
var
  xFrame, yFrame, xSize, ySize: Integer;
  R: TRect;
begin
  xFrame := GetSystemMetrics(SM_CXFRAME);
  yFrame := GetSystemMetrics(SM_CYFRAME);
  xSize  := GetSystemMetrics(SM_CXSIZE);
  ySize  := GetSystemMetrics(SM_CYSIZE);  //按钮属性调整
  CaptionBtn := Bounds(Width-xFrame-5*xSize+2, yFrame+2, xSize+13, ySize-4);
  Canvas.Handle := GetWindowDC(self.Handle);
  Canvas.Font.Name := '宋体';
  Canvas.Font.Color:= clBlack;
  Canvas.Pen.Color := clYellow;
  Canvas.Brush.Color := clBtnFace;  try
    DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False);
    R:= Bounds(Width-xFrame-5*xSize+3, yFrame+3, xSize+10, ySize-7);
  With CaptionBtn Do
    Canvas.TextRect(R, R.Left, R.Top, 'New');
  finally
    ReleaseDC(self.Handle, Canvas.Handle);
    Canvas.Handle:= 0;
  end;
end;
Procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
begin
  inherited;
  DrawCaptButton;
end;Procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  inherited;
  With Msg Do
    if PtInRect(CaptionBtn, Point(xPos-Left, yPos-Top)) then
      Result := HtCaptionBtn;
end;
Procedure TForm1.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
  inherited;
  if (Msg.HitTest = HtCaptionBtn) then
    ShowMessage('添加您要执行的代码');
end;Procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
begin
  inherited;
  DrawCaptButton;
end;Procedure TForm1.WMSetText(var Msg: TWMSetText);
begin
  inherited;
  DrawCaptButton;
end;procedure TForm1.FormResize(Sender: TObject);
begin
  Perform(WM_NCActivate, Word(Active), 0);
end;
end.