Adding a Custom Button to the Caption Bar with System Menu and Hint

Problem/Question/Abstract:

How to add a custom button to the caption bar with a System Menu and HINT!!!!

Answer:

That code can create a button to the caption bar, create a MenuItem in System menu and create a Hint to the button!
Just put the code above in your Unit and change the "FrmMainForm" to your Form name, and other small things like Text of Hint

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
    //*********************************************
    //The button was clicked! Put you function here
    //*********************************************
    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;
    //*********************************************
    //The button was clicked! Put you function here
    //*********************************************
  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);

  //It make a square button, but if you want a different button
  //just change that var to your width.
  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.Handle, 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;
//You can change the background color of the Hint