在标题栏添加按钮

unit Unit1;
interface
uses
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.