Delphi如何在窗体标题栏添加按钮

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.

转载于:https://www.cnblogs.com/martian6125/archive/2009/11/02/9631245.html