Как изменить шрифт и выравнивание в заголовке формы?

Delphi , Программа и Интерфейс , Заголовок формы

Как изменить шрифт и выравнивание в заголовке формы?

Примечание: formDeactivate не вызовится пока форма не станет активной,иногда FormPaint не вызывается. Если форма была не активто, то при активации перерисуется.

Code:

unit Unit1;

         

        interface

         

        uses

        Windows,  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

         

        type

        TForm1 =  class(TForm)

            procedure FormPaint(Sender:  TObject);

            procedure FormResize(Sender:  TObject);

            procedure FormDeactivate(Sender:  TObject);

            procedure FormActivate(Sender:  TObject);

        private

        public

            { Public declarations  }

        end;

         

        var

        Form1:  TForm1;

         

        implementation

         

        {$R  *.DFM}

         

        procedure TForm1.FormPaint(Sender:  TObject);

        var

        LabelHeight, LabelWidth, LabelTop: Integer;

        caption_height, border3d_y, button_width,  border_thickness: Integer;

        MyCanvas: TCanvas;

        CaptionBarRect: TRect;

        begin

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

        MyCanvas  := TCanvas.Create;

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

        border3d_y := GetSystemMetrics(SM_CYEDGE);

        button_width := GetSystemMetrics(SM_CXSIZE);

        border_thickness :=  GetSystemMetrics(SM_CYSIZEFRAME);

        caption_height :=  GetSystemMetrics(SM_CYCAPTION);

        LabelWidth :=  Form1.Canvas.TextWidth(Form1.Caption);

        LabelHeight :=  Form1.Canvas.TextHeight(Form1.Caption);

        LabelTop  := LabelHeight - (caption_height div 2);

        CaptionBarRect.Left := border_thickness + border3d_y +  button_width;

        CaptionBarRect.Right := Form1.Width - (border_thickness +  border3d_y) 

                       - (button_width * 4);

        CaptionBarRect.Top := border_thickness +  border3d_y;

        CaptionBarRect.Bottom := caption_height;

        if Form1.Active then

            MyCanvas.Brush.Color := clActiveCaption

        else

            MyCanvas.Brush.Color := clInActiveCaption;

        MyCanvas.Brush.Style := bsSolid;

        MyCanvas.FillRect(CaptionBarRect);

        MyCanvas.Brush.Style := bsClear;

        MyCanvas.Font.Color := clCaptionText;

        MyCanvas.Font.Name := 'MS Sans Serif';

        MyCanvas.Font.Style := MyCanvas.Font.Style +  [fsBold];

        DrawText(MyCanvas.Handle, PChar(' ' + Form1.Caption), Length(Form1.Caption) + 1,

            CaptionBarRect, DT_CENTER or DT_SINGLELINE or DT_VCENTER);

        MyCanvas.Free;

        end;

         

        procedure TForm1.FormResize(Sender:  TObject);

        begin

        Form1.Paint;

        end;

         

        procedure TForm1.FormDeactivate(Sender:  TObject);

        begin

        Form1.Paint;

        end;

         

        procedure TForm1.FormActivate(Sender:  TObject);

        begin

        Form1.Paint;

        end;

         

        end.

Code:

{ ...  }

        type

        TForm1 =  class(TForm)

        private

            procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;

        public

        end;

         

        var

        Form1:  TForm1;

         

        implementation

         

        {$R  *.dfm}

         

        procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);

        var

        ACanvas:  TCanvas;

        begin

        inherited;

        ACanvas  := TCanvas.Create;

        try

            ACanvas.Handle := GetWindowDC(Form1.Handle);

            with ACanvas do

            begin

              Brush.Color := clActiveCaption;

              Font.Name := 'Tahoma';

              Font.Size := 8;

              Font.Color := clred;

              Font.Style := [fsItalic, fsBold];

              TextOut(GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER),

                Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height)) / 2) + 1,

                  ' Some Text');

            end;

        finally

            ReleaseDC(Form1.Handle, ACanvas.Handle);

            ACanvas.Free;

        end;

        end;

Взято с Delphi Knowledge Base: http://www.baltsoft.com/

Переопределить шрифт и выравнивание в заголовке формы Delphi можно с помощью обработчика сообщения WMNCPaint.

Вот пример кода:

type
  TForm1 = class(TForm)
    private
      procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
  public
  end;

var
  Form1: TForm1;

implementation

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
  ACanvas: TCanvas;
begin
  inherited;
  ACanvas := TCanvas.Create;
  try
    ACanvas.Handle := GetWindowDC(Form1.Handle);
    with ACanvas do
    begin
      Brush.Color := clRed; // Изменить цвет шрифта на красный
      Font.Name := 'Tahoma'; // Установить имя шрифта в Tahoma
      Font.Size := 8; // Установить размер шрифта в 8
      Font.Style := [fsItalic, fsBold]; // Установить стиль шрифта в итал. и жир.
      TextOut(GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER),
              Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height)) / 2) + 1,
              'Some Text'); // Нарисовать текст в заголовке
    end;
  finally
    ReleaseDC(Form1.Handle, ACanvas.Handle);
    ACanvas.Free;
  end;
end;

В этом примере мы используем обработчик сообщения WMNCPaint для рисования заголовка. Мы устанавливаем имя шрифта в 'Tahoma', размер шрифта в 8, цвет шрифта в красный и стиль шрифта в итал. и жир. Затем мы нарисуем текст "Some Text" в заголовке.

Чтобы изменить выравнивание текста, можно использовать функцию TextOut с различными координатами по горизонтали и вертикали. Например, чтобы центрировать текст горизонтально, можно рассчитать координату x следующим образом:

x := (GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER)) - (Length(Text) * Font.Width) / 2;

А чтобы центрировать текст вертикально, можно рассчитать координату y следующим образом:

y := Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height)) / 2);

Затем передайте эти координаты в функцию TextOut:

TextOut(x, y, PChar('Some Text'));

Обратите внимание, что вам нужно рассчитать координаты x и y в зависимости от размера вашего текста. Формулы выше только примеры и могут не работать для всех случаев.

Как изменить шрифт и выравнивание в заголовке формы можно сделать за помощью процедуры FormPaint, где можно задать нужный шрифт и параметры выравнивания.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.

:: Главная :: Заголовок формы ::

Время компиляции файла: 2024-08-19 13:29:56
2024-11-21 11:50:34/0.0059170722961426/1