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

Code:

...

private

   { Private declarations }

   procedure WMNCPAINT          (var msg: Tmessage); message WM_NCPAINT;

   procedure WMNCACTIVATE       (var msg: Tmessage); message WM_NCACTIVATE;

   procedure WMNCMOUSEDOWN      (var msg: Tmessage); message WM_NCLBUTTONDOWN;

   procedure WMNCMOUSEMOVE      (var Msg: TMessage); message WM_NCMOUSEMOVE;

   procedure WMMOUSEMOVE        (var Msg: TMessage); message WM_MOUSEMOVE;

   procedure WMLBUTTONUP        (var msg: Tmessage); message WM_LBUTTONUP;

   procedure WNCLBUTTONDBLCLICK (var msg: Tmessage); message WM_NCLBUTTONDBLCLK;

   procedure WMNCRBUTTONDOWN    (var msg: Tmessage); message WM_NCRBUTTONDOWN;

   procedure WMNCHITTEST        (var msg: Tmessage); message WM_NCHITTEST;

   procedure WMSYSCOMMAND       (var msg: Tmessage); message WM_SYSCOMMAND;

...

 var

...

Pressed         : Boolean;

FocusLost       : Boolean;

Rec             : TRect;

NovoMenuHandle  : THandle;

PT1             : TPoint;

FHintshow       : Boolean;

FHint           : THintWindow;

FHintText       : String;

FHintWidth      : Integer;

 ...

 //------------------------------------------------------------------------------

 procedure TFrmMainForm.WMSYSCOMMAND(var Msg: TMessage);

begin

if Msg.WParam=LongInt(NovoMenuHandle) then

   //*********************************************

   //Кнопка была нажата! Добавьте сюда Вашу функцию

   //*********************************************

inherited;

end;

//------------------------------------------------------------------------------

 procedure TFrmMainForm.WMNCHITTEST(var Msg: TMessage);

var

Tmp : Boolean;

begin

if Pressed then

begin

   Tmp:=FocusLost;

   PT1.X := Msg.LParamLo - FrmMainForm.Left;

   PT1.Y := Msg.LParamHi - FrmMainForm.Top ;

   if PTInRect(Rec, PT1) then

     FocusLost := False

   else

     FocusLost := True;

   if FocusLost <> Tmp then

     InvalidateRect(FrmMainForm.Handle, @Rec, True);

end;

inherited;

end;

//------------------------------------------------------------------------------

 procedure TFrmMainForm.WMLBUTTONUP(var Msg: TMessage);

var

Tmp : Boolean;

begin

ReleaseCapture;

Tmp     := Pressed;

Pressed := False;

if Tmp and PTInRect(Rec, PT1) then

begin

   InvalidateRect(FrmMainForm.Handle, @Rec, True);

   FHintShow := False;

   FHint.ReleaseHandle;

   //*********************************************

   //Кнопка была нажата! Добавьте сюда Вашу функцию

   //*********************************************

end

else

   inherited;

end;

//------------------------------------------------------------------------------

 procedure TFrmMainForm.WNCLBUTTONDBLCLICK(var Msg: TMessage);

begin

PT1.X := Msg.LParamLo - FrmMainForm.Left;

PT1.Y := Msg.LParamHi - FrmMainForm.Top ;

if not PTInRect(Rec, PT1) then

   inherited;

end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.WMNCRBUTTONDOWN(var Msg: TMessage);

begin

PT1.X := Msg.LParamLo - FrmMainForm.Left;

PT1.Y := Msg.LParamHi - FrmMainForm.Top ;

if not PTInRect(Rec, PT1) then

   inherited;

end;

//------------------------------------------------------------------------------

 procedure TFrmMainForm.WMNCMOUSEDOWN(var Msg: TMessage);

begin

PT1.X := Msg.LParamLo - FrmMainForm.Left;

PT1.Y := Msg.LParamHi - FrmMainForm.Top ;

FHintShow := False;

if PTInRect(Rec, PT1) then

begin

  Pressed   := True;

  FocusLost := False;

  InvalidateRect(FrmMainForm.Handle, @Rec, True);

  SetCapture(TWinControl(FrmMainForm).Handle);

end

else

begin

  FrmMainForm.Paint;

  inherited;

end;

end;

//------------------------------------------------------------------------------

 //That function Create a Hint

procedure TFrmMainForm.WMNCMOUSEMOVE(var Msg: TMessage);

begin

PT1.X := Msg.LParamLo - FrmMainForm.Left;

PT1.Y := Msg.LParamHi - FrmMainForm.Top ;

if PTInRect(Rec, PT1) then

begin

   FHintWidth  := FHint.Canvas.TextWidth(FHintText);

   if (FHintShow = False) and (Length(Trim(FHintText)) <> 0) then

     FHint.ActivateHint(

       Rect(

         Mouse.CursorPos.X,

         Mouse.CursorPos.Y + 20,

         Mouse.CursorPos.X + FHintWidth + 10,

         Mouse.CursorPos.Y + 35

         ),

       FHintText

     );

     FHintShow := True;

end

else

begin

   FHintShow := False;

   FHint.ReleaseHandle;

end;

end;

//------------------------------------------------------------------------------

 procedure TFrmMainForm.WMMOUSEMOVE(var Msg: TMessage);

begin

FHintShow := False;

FHint.ReleaseHandle;

end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.WMNCACTIVATE(var Msg: TMessage);

begin

InvalidateRect(FrmMainForm.Handle, @Rec, True);

inherited;

end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.WMNCPAINT(var Msg: TMessage);

begin

InvalidateRect(FrmMainForm.Handle, @Rec, True);

inherited;

end;

//------------------------------------------------------------------------------

 procedure TFrmMainForm.FormPaint(Sender:TObject);

var

Border3D_Y, Border_Thickness, Btn_Width,

Button_Width, Button_Height  : Integer;

MyCanvas                      : TCanvas;

begin

MyCanvas        := TCanvas.Create;

MyCanvas.Handle := GetWindowDC(FrmMainForm.Handle);

Border3D_Y      := GetSystemMetrics(SM_CYEDGE);

Border_Thickness:= GetSystemMetrics(SM_CYSIZEFRAME);

Button_Width    := GetSystemMetrics(SM_CXSIZE);

Button_Height   := GetSystemMetrics(SM_CYSIZE);

//Создаём квадратную кнопку, но если Вы захотите создать кнопку другого размера, то

//измените эту переменную на Вашу ширину.

Btn_Width  := Border3D_Y  + Border_Thickness + Button_Height - (2 * Border3D_Y) - 1;

Rec.Left   := FrmMainForm.Width - (3 * Button_Width + Btn_Width);

Rec.Right  := FrmMainForm.Width - (3 * Button_Width + 03);

Rec.Top    := Border3D_Y  + Border_Thickness - 1;

Rec.Bottom := Rec.Top     + Button_Height - (2 * Border3D_Y);

FillRect(MyCanvas.Handle,Rec,HBRUSH(COLOR_BTNFACE+1));

If not Pressed or Focuslost Then

   DrawEdge(MyCanvas.Handle, Rec, EDGE_RAISED, BF_SOFT or BF_RECT)

Else If Pressed and Not Focuslost Then

   DrawEdge(MyCanvas.Handle, Rec, EDGE_SUNKEN, BF_SOFT or BF_RECT);

//It draw a the application icon to the button. Easy to change.

DrawIconEX(MyCanvas.Handle, Rec.Left+4, Rec.Top+3, Application.Icon, 8, 8, 0, 0, DI_NORMAL);

MyCanvas.Free;

end;

 ...

 procedure TFrmMainForm.FormCreate(Sender: TObject);

 ...

 InsertMenu(GetSystemMenu(Handle,False), 4, MF_BYPOSITION+MF_STRING, NovoMenuHandle,pchar('TEXT OF THE MENU'));

Rec             := Rect(0,0,0,0);

FHintText       := 'Put the text of your Hint HERE';

FHint           := THintWindow.Create(Self);

FHint.Color     := clInfoBk;  //Вы можете изменить бэкграунд подсказки

 ...