首页  编辑  

在标题栏添加按钮

Tags: /超级猛料/VCL/Form,窗体/标题栏和边框/   Date Created:

]、。·ˉˇ¨〃々—~‖…’”〕〉》」』〗】∶!"'),.:;?]` 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.