1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:

unit Unit1; 

interface 

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  Buttons; 

type 
  TForm1 = class(TForm) 
    procedure FormResize(Sender: TObject); 
  private 
    { Private-Deklarationen } 
    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-Deklarationen } 
  end; 

var 
  Form1: TForm1; 

const 
  htCaptionBtn = htSizeLast + 1; 

implementation 

{$R *.DFM} 

procedure TForm1.DrawCaptButton; 
var 
  xFrame, 
  yFrame, 
  xSize, 
  ySize  : Integer; 
  R : TRect; 
begin 
  //Dimensions of Sizeable Frame 
  xFrame := GetSystemMetrics(SM_CXFRAME); 
  yFrame := GetSystemMetrics(SM_CYFRAME); 

  //Dimensions of Caption Buttons 
  xSize  := GetSystemMetrics(SM_CXSIZE); 
  ySize  := GetSystemMetrics(SM_CYSIZE); 

  //Define the placement of the new caption button 
  //next to the existing caption buttons 
  CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2, 
                       yFrame + 2, xSize - 2, ySize - 4); 

  //Get the handle to canvas using Form's device context 
  Canvas.Handle := GetWindowDC(Self.Handle); 

  Canvas.Font.Name := 'Symbol'; 
  Canvas.Font.Color := clBlue; 
  Canvas.Font.Style := [fsBold]; 
  Canvas.Pen.Color := clYellow; 
  Canvas.Brush.Color := clBtnFace; 

  try 
    DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False); 
    //Define a smaller drawing rectangle within the button 
    R := Bounds(Width - xFrame - 4 * xSize + 2, 
                       yFrame + 3, xSize - 6, ySize - 7); 
    with CaptionBtn do 
      Canvas.TextRect(R, R.Left + 2, R.Top - 1, 'W'); 
  finally 
    //Get rid of the device context and set the 
    //canvas handle to default 
    ReleaseDC(Self.Handle, Canvas.Handle); 
    Canvas.Handle := 0; 
  end; 
end; 

//This traps the default form painting 
procedure TForm1.WMNCPaint(var Msg : TWMNCPaint); 
begin 
  inherited; 
  DrawCaptButton; 
end; 

//This traps form activation 
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate); 
begin 
  inherited; 
  DrawCaptButton; 
end; 

//This traps any text being sent to the window 
procedure TForm1.WMSetText(var Msg : TWMSetText); 
begin 
  inherited; 
  DrawCaptButton; 
end; 

//This traps when the form's caption bar is hit with a mouse 
procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest); 
begin 
  inherited; 
  with Msg do 
    if PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top)) then 
      Result := htCaptionBtn; 
end; 

//Traps a left-click on the caption bar 
procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown); 
begin 
  inherited; 
  if (Msg.HitTest = htCaptionBtn) then 
    ShowMessage('You hit the button on the caption bar'); 
end; 

//Have to perform an NC_ACTIVATE when the form is resized 
//so that the caption bar and button are redrawn. This is 
//necessary because Win95/NT4+ draw all buttons relative to the 
//right side of a window. 
procedure TForm1.FormResize(Sender: TObject); 
begin 
  //Force a redraw of caption bar if form is resized 
  Perform(WM_NCACTIVATE, Word(Active), 0); 
end; 

end.