Манипуляции с заголовком формы

Code:

unit Main;

interface

uses

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

type

TForm1 = class(TForm)

   procedure FormResize(Sender: TObject);

private

   CaptionBtn : TRect;

   procedure DrawCaptButton;

   procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;

   procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;

   procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;

   procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;

   procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;

public

   { Public declarations }

end;

var

Form1: TForm1;

implementation

const

htCaptionBtn = htSizeLast + 1;

{$R *.DFM}

procedure TForm1.DrawCaptButton;

var

xFrame,  yFrame,  xSize,  ySize  : Integer;

R : TRect;

begin

//Dimensions of Sizeable Frame

xFrame := GetSystemMetrics(SM_CXFRAME);

yFrame := GetSystemMetrics(SM_CYFRAME);

//Dimensions of Caption Buttons

xSize  := GetSystemMetrics(SM_CXSIZE);

ySize  := GetSystemMetrics(SM_CYSIZE);

//Define the placement of the new caption button

CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2,

                      yFrame + 2, xSize - 2, ySize - 4);

//Get the handle to canvas using Form's device context

Canvas.Handle := GetWindowDC(Self.Handle);

Canvas.Font.Name := 'Symbol';

Canvas.Font.Color := clBlue;

Canvas.Font.Style := [fsBold];

Canvas.Pen.Color := clYellow;

Canvas.Brush.Color := clBtnFace;

try

   DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False);

   //Define a smaller drawing rectangle within the button

   R := Bounds(Width - xFrame - 4 * xSize + 2,

                      yFrame + 3, xSize - 6, ySize - 7);

   with CaptionBtn do

     Canvas.TextRect(R, R.Left + 2, R.Top - 1, 'W');

finally

   ReleaseDC(Self.Handle, Canvas.Handle);

   Canvas.Handle := 0;

end;

end;

procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);

begin

inherited;

DrawCaptButton;

end;

procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);

begin

inherited;

DrawCaptButton;

end;

procedure TForm1.WMSetText(var Msg : TWMSetText);

begin

inherited;

DrawCaptButton;

end;

procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);

begin

inherited;

with Msg do

   if PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top)) then

     Result := htCaptionBtn;

end;

procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);

begin

inherited;

if (Msg.HitTest = htCaptionBtn) then

   ShowMessage('You hit the button on the caption bar');

end;

procedure TForm1.FormResize(Sender: TObject);

begin

//Force a redraw of caption bar if form is resized

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

end;

end.