Карта сайтаСсылкиКонтакты

Как поместить кнопку в заголовок формы

PDF Печать
Статьи

Непосредственно такой функции вроде нет, но можно изловчиться. Нарисовать там кнопку вручную и обрабатывать команды нажатия мышки на Caption Bar.


{ ... }
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.FormResize(Sender: TObject);
begin
  Perform(WM_NCACTIVATE, Word(Active), 0);
end;

procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
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('Вы нажали на кнопку на заголовке окна');
end;

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
begin
  inherited;
  DrawCaptButton;
end;

procedure TForm1.WMSetText(var Msg: TWMSetText);
begin
  inherited;
  DrawCaptButton;
end;

end.

Автор: Зайцев Олег


 

Добавить комментарий


Защитный код
Обновить