Form - Colocando botao no caption

Top  Previous  Next

// Fonte completo de botãozinho no caption

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls, buttons;

 

type

  TForm1 = class(TForm)

    procedure FormResize(Sender: TObject);

  private

    TitleButton : TRect;

    procedure DrawTitleButton;

    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;

  end;

 

var

  Form1: TForm1;

 

const

  htTitleBtn = htSizeLast + 1;

 

implementation

 

{$R *.DFM}

 

procedure TForm1.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 TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);

begin

 inherited;

 if (Msg.HitTest = htTitleBtn) then

   ShowMessage('You pressed the new button');

end;

 

procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);

begin

 Inherited;

 DrawTitleButton;

end;

 

//Painting events

procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);

begin

 Inherited;

 DrawTitleButton;

end;

 

procedure TForm1.WMSetText(var Msg : TWMSetText);

begin

 Inherited;

 DrawTitleButton;

end;

 

procedure TForm1.DrawTitleButton;

var

  bmap : TBitmap;   // Bitmap to be drawn - 16 X 16 : 16 Colors

  XFrame , YFrame,  // X and Y size of Sizeable area of Frame}

  XTtlBit, YTtlBit: Integer;  // X and Y size of Bitmaps in caption

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);

 

  TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) + 20), YFrame + 2, XTtlBit - 2, YTtlBit - 4);

 

  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:\CHAVE.BMP');

    with TitleButton do

        Canvas.Draw(Left + 2, Top + 2, bmap);

  finally

    ReleaseDC(Self.Handle, Canvas.Handle);

    bmap.Free;

    Canvas.Handle := 0;

  end;

end;

 

procedure TForm1.FormResize(Sender: TObject);

begin

  Perform(WM_NCACTIVATE, Word(Active), 0);

end;

 

end.