Cara Menambahkan Button Pada Title Bar Di Delphi

Secara normal hanya terdapat tiga tombol pada title bar, yaitu tombol maximize, minimize, dan close. Jika Anda menginginkan untuk menambahkan button pada title bar, jawabnya bisa. Untuk dapat menambahkan dan memfungsikan tombol tersebut ada beberapa message atau pesan yang perlu dilibatkan, yaitu:

• WM_NCPAINT adalah pesan yang dikirim untuk menggambar ulang title bar termasuk tombol tambahan.
• WM_NCACTIVATE adalah pesan yang dikirim saat nonclient area perlu diubah untuk mengindikasikan keadaan aktif dan nonaktif.
• WM_NCHITTEST adalah pesan yang dikirim saat cursor digerakkan (dipindah) atau tombol mouse ditekan.
• WM_NCLBUTTONDOWN adalah pesan yang dikirim saat pengguna menekan tombol kiri mouse.
• WM_NCLBUTTONUP adalah pesan yang dikirim saat pengguna melepaskan tombol kiri mouse.

Untuk menggambar tombol pada title bar Anda dapat menggunakan fungsi DrawButtonFace. Berikut adalah listing lengkapnya:

unit UMain;

interface

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

type
  TForm1 = class(TForm)
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    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
  xFrame:= GetSystemMetrics(SM_CXFRAME);
  yFrame:= GetSystemMetrics(SM_CYFRAME);
  xSize:= GetSystemMetrics(SM_CXSIZE);
  ySize:= GetSystemMetrics(SM_CYSIZE);

  CaptionBtn:= Bounds(Width - xFrame - 4*xSize + 2, yFrame + 2, xSize - 2, ySize - 4);
  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);
    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.FormResize(Sender: TObject);
begin
  Perform(WM_NCACTIVATE, Word(Active), 0);
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: TWMNCHitMessage);
begin
  inherited;
  if (Msg.HitTest = htCaptionBtn) then
    Application.MessageBox('You clicked the button', 'Message', MB_OK or MB_ICONASTERISK);
end;

end.