如何在标题栏上增加按钮?

Question

unit Unit1;interfaceuses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, Buttons, DdeMan, StdCtrls;type
 TTitleBtnForm = class(TForm)
    Button1: TButton;
   procedure FormResize(Sender: TObject);
 private
   TitleButton : TRect;
   procedure DrawTitleButton;
   {Paint-related messages}
   procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
   procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
   procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
   {Mouse down-related messages}
   procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
   procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
   function GetVerInfo : DWORD;
 end;var
 TitleBtnForm: TTitleBtnForm;const
 htTitleBtn = htSizeLast + 1;implementation
{$R *.DFM}procedure TTitleBtnForm.DrawTitleButton;
var
 bmap : TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}
 XFrame,  {X and Y size of Sizeable area of Frame}
 YFrame,
 XTtlBit, {X and Y size of Bitmaps in caption}
 YTtlBit  : Integer;
begin
 {Get size of form frame and bitmaps in title bar}
 XFrame  := GetSystemMetrics(SM_CXFRAME);
 YFrame  := GetSystemMetrics(SM_CYFRAME);
 XTtlBit := GetSystemMetrics(SM_CXSIZE);
 YTtlBit := GetSystemMetrics(SM_CYSIZE); {$IFNDEF WIN32}
   TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
                         YFrame - 1,
                         XTtlBit + 2,
                         YTtlBit + 2); {$ELSE}     {Delphi 2.0 positioning}
   if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
     TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
                           YFrame - 1,
                           XTtlBit + 2,
                           YTtlBit + 2)
   else
     TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,
                          XFrame + 2,
                          XTtlBit + 2,
                          YTtlBit + 2);
 {$ENDIF}
 Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
 try
   {Draw a button face on the TRect}
   DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
   bmap := TBitmap.Create;
   bmap.LoadFromFile('c:\windows\desktop\aaa.bmp');
   with TitleButton do
     {$IFNDEF WIN32}
       Canvas.Draw(Left + 2, Top + 2, bmap);
     {$ELSE}
       if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
         Canvas.Draw(Left + 2, Top + 2, bmap)
       else
         Canvas.StretchDraw(TitleButton, bmap);
     {$ENDIF} finally
   ReleaseDC(Self.Handle, Canvas.Handle);
   bmap.Free;
   Canvas.Handle := 0;
 end;
end;{Paint triggering events}
procedure TTitleBtnForm.WMNCActivate(var Msg : TWMNCActivate);
begin
 Inherited;
 DrawTitleButton;
end;procedure TTitleBtnForm.FormResize(Sender: TObject);
begin
 Perform(WM_NCACTIVATE, Word(Active), 0);
end;{Painting events}
procedure TTitleBtnForm.WMNCPaint(var Msg : TWMNCPaint);
begin
 Inherited;
 DrawTitleButton;
end;procedure TTitleBtnForm.WMSetText(var Msg : TWMSetText);
begin
 Inherited;
 DrawTitleButton;
end;{Mouse-related procedures}
procedure TTitleBtnForm.WMNCHitTest(var Msg : TWMNCHitTest);
begin
 Inherited;
 {Check to see if the mouse was clicked in the area of the button}
 with Msg do
   if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
     Result := htTitleBtn;
end;procedure TTitleBtnForm.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
 inherited;
 if (Msg.HitTest = htTitleBtn) then
   ShowMessage('You pressed the new button');
end;function TTitleBtnForm.GetVerInfo : DWORD;
var
verInfo : TOSVERSIONINFO;
begin
 result:=0;
 verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
 if GetVersionEx(verInfo) then
   Result := verInfo.dwPlatformID;
   {Returns:
     VER_PLATFORM_WIN32s             Win32s on Windows 3.1
     VER_PLATFORM_WIN32_WINDOWS        Win32 on Windows 95
     VER_PLATFORM_WIN32_NT           Windows NT }
end;end.