unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus;type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);  private
    { Private declarations }
    IsGraphTicket: Boolean;
    CBBtnRect: TRect; // Caption Bar Button Rectangle
    CBBtnFont: TFont; // Caption Bar Button Font
    procedure SetRect();
    procedure DrawCaptionBtn(uEdge: UINT);
    // 当在标题栏上按下鼠标左按钮时进入该过程
    procedure WMNcLButtonDown(var m: TMessage);
      message WM_NCLBUTTONDOWN;
    // 当在标题栏上放开鼠标左按钮时进入该过程
    procedure WMNcLButtonUp(var m: TMessage);
      message WM_NCLBUTTONUP;
    // 当在标题栏上移动鼠标时进入该过程
    procedure WMNcMouseMove(var m: TMessage);
    //  message WM_NCMOUSEMOVE;
    // 当在标题栏上双击鼠标左铵钮时进入该过程
    procedure WMNcLButtonDBLClk
      (var m: TMessage);// message WM_NCLBUTTONDBLCLK;
    // 当在标题栏上按下鼠标右按钮时进入该过程
    procedure WMNcRButtonDown(var m: TMessage);
    //  message WM_NCRBUTTONDOWN;
    // 当画标题栏时进入该过程
    procedure WMNcPaint(var m: TMessage);
    //  message WM_NCPAINT;
    // 当标题栏在激活与非激活之间切换时进入该过程
    procedure WMNcActivate(var m: TMessage);
      message WM_NCACTIVATE;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation
  uses StrUtils;{$R *.DFM}procedure TForm1.SetRect();
var
  Width: Integer;
begin
  with CBBtnRect do
  begin
    if IsGraphTicket then
      Width := 100
    else
      Width := 110;
    left := Self.Width - Width - 57;    top := 6;
    right := left + Width;
    bottom := 20;
  end;
end;procedure TForm1.DrawCaptionBtn(uEdge: UINT);
var
  hCaptionDC: HDC; // 标题条Device Context
  hOldFont: HFONT; // 原来的字体
  r: TRect;
begin
  hCaptionDC := GetWindowDC(Self.Handle);
  // 注意不能用GetDC,那样的话,将得不到标题栏
  // 的设备上下文
  //画按钮的样子,如果uEdge=EDGE_RAIS,
  //则画出的样子为凸起;如果
  //uEdge=EDGE_SUNKEN,则画出的样子为凹下。
  DrawEdge(hCaptionDC, CBBtnRect, uEdge,
    BF_RECT or BF_MIDDLE or
    BF_SOFT);     //设置标题栏的设备上下文为透明状态
  SetBkMode(hCaptionDC, TRANSPARENT);     //设置标题栏设备上下文的字体
  hOldFont := SelectObject(hCaptionDC, CBBtnFont.Handle);     //画按钮
  if uEdge = EDGE_RAISED then
    if IsGraphTicket then
      DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, DT_CENTER)
    else
      DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, DT_CENTER)
  else
  begin
    r := CBBtnRect;
    OffsetRect(r, 1, 1);
    if IsGraphTicket then
      DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, DT_CENTER)
    else
      DrawText(hCaptionDC, '到了按钮', 8, CBBtnRect, DT_CENTER);
  end;     //还原为原来的字体
  SelectObject(hCaptionDC, hOldFont);
end;procedure TForm1.WMNcActivate(var m: TMessage);
begin
  inherited;
  DrawCaptionBtn(EDGE_RAISED);
end;
procedure TForm1.WMNcPaint(var m: TMessage);
begin
  inherited;
  DrawCaptionBtn(EDGE_RAISED);
end;
procedure TForm1.WMNcLButtonDBLClk(var m: TMessage);
var
  p: TPoint;
begin
  p.x := LOWORD(m.lParam) - Self.Left;
  p.y := HIWORD(m.lParam) - Self.Top;
  if not PtInRect(CBBtnRect, p) then // 如果不在按钮区域内
    inherited; // 执行默认的操作
end;procedure TForm1.WMNcMouseMove(var m: TMessage);
var
  p: TPoint;
begin
  p.x := LOWORD(m.lParam) - Self.Left;
  p.y := HIWORD(m.lParam) - Self.Top;
  if not PtInRect(CBBtnRect, p) then // 如果不在按钮区域
  begin
    DrawCaptionBtn(EDGE_RAISED);
    //Application.ShowHint := False;
  end
  else
  begin
    inherited; // 执行默认的操作
  end;
end;
procedure TForm1.WMNcLButtonDown(var m: TMessage);
var
  p: TPoint;
begin
  p.x := LOWORD(m.lParam) - Self.Left;
  p.y := HIWORD(m.lParam) - Self.Top;
  if PtInRect(CBBtnRect, p) then // 如果按在了按钮区域
  begin
    Self.BringToFront;
    DrawCaptionBtn(EDGE_SUNKEN);
  end
  else
    inherited; // 执行默认的操作
end;
procedure TForm1.WMNcLButtonUp(var m: TMessage);
var
  p: TPoint;
begin
  p.x := LOWORD(m.lParam) - Self.Left;
  p.y := HIWORD(m.lParam) - Self.Top;
  if PtInRect(CBBtnRect, p) then //如果在标题栏按钮区域释放鼠标
  begin
    IsGraphTicket := not IsGraphTicket;
    DrawCaptionBtn(EDGE_RAISED);
    //自己的OnClick事件写在这里
    ShowMessage('Here');
  end
  else
    inherited; // 执行默认的操作
end;
procedure TForm1.WMNcRButtonDown(var m: TMessage);
var
  p: TPoint;
begin
  p.x := LOWORD(m.lParam) - Self.Left;
  p.y := HIWORD(m.lParam) - Self.Top;
  if not PtInRect(CBBtnRect, p) then // 如果不在标题栏按钮区域
    inherited; // 执行默认的操作
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
     // 这个大小大家可以得用GetSystemMetrics函数来进行更精确的计算。这里
     // 只是用来示例
  SetRect();
     // 标题栏按钮字体。
  CBBtnFont := self.Font;
  {CBBtnFont := TFont.Create;
  with CBBtnFont do
  begin
    Name := '宋体';
    Size := 9;
    Color := clRed;
  end;//}
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  //CBBtnFont.Free;
end;procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
var
  t: TMessage;
  Form: TForm;
begin
  SetRect();
  Form := TForm.Create(nil);
  Form.Show;
  Form.Free;
end;end.