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

Тема в разделе "Delphi", создана пользователем WinHack, 24 ноя 2016.

  1. WinHack
    По умолчанию, свойство Caption формы выводит текст в заголовке формы рядом с системным меню. Если Вы хотите добавить свой собственный текст в заголовок формы, не трогая ее свойство Caption, нужно работать с сообщением Windows WM_NCPAINT.

    add-custom-text-in-caption.png
    Сообщение WM_NCPAINT посылается окну, когда ему необходимо перерисовывать рамку. Приложение может перехватить это сообщение и прорисовать собственные данные.

    Обратите внимание, что Вам нужно перехватывать также сообщение WM_NCACTIVATE. Это сообщение посылается окну, когда оно активируется или деактивируется. Без обработки сообщения WM_NCACTIVATE текст пользователя из заголовка исчезнет, когда форма потеряет фокус.

    Код:
    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics,
      Controls, Forms, Dialogs;
    
    type
      TForm1 = class(TForm)
      private
        { Private declarations }
        procedure WMNCPaint(
            var Msg: TWMNCPaint); message WM_NCPAINT;
        procedure WMNCActivate(
            var Msg: TWMNCActivate); message WM_ACTIVATE;
        procedure DrawCaption;
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    { TForm1 }
    
    procedure TForm1.DrawCaption;
    const
      sText = 'Текст в заголовке';
    var
      canvas: TCanvas;
    begin
      canvas:= TCanvas.Create;
      try
        canvas.Handle:= GetWindowDC(Self.Handle);
        with canvas do
        begin
          Brush.Style:= bsClear;
          Font.Color:= clYellow;
          TextOut(
            { Отступ справа }
            Self.Width - 150,
            { Отступ сверху }
            10,
            { Собственно, текст }
             sText);
        end;
      finally
        ReleaseDC(Self.Handle, canvas.Handle);
        canvas.Free;
      end;
    end;
    
    procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
    begin
      inherited;
      DrawCaption;
    end;
    
    procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
    begin
      inherited;
      DrawCaption;
    end;
    
    end.