Вертикальный TitleBar

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

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

type
   TForm1 = class(TForm)
     procedure FormResize(Sender: TObject);
     procedure FormPaint(Sender: TObject);
   private
     procedure VerticalTitleBar(Texto: string; Size: Integer);
   end;

 const
   MY_TITLE_TEXT = 'Vertical Text';
 var
   Form1: TForm1;

 implementation

 {$R *.DFM}

 procedure TForm1.VerticalTitleBar(TexTo: string; Size: Integer);
 var
   LogFont: TLogFont;
   tmpCanvas: TCanvas;
   tmpRect: TRect;
   x1, x2, y1, y2: integer;
 begin
   tmpCanvas        := TCanvas.Create;
   tmpCanvas.Handle := GetWindowDc(Handle);
   try
     GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
     with LogFont do
     begin
       lfEscapement   := 90 * 10;
       lfOrientation  := 90 * 10;
       lfOutPrecision := OUT_TT_ONLY_PRECIS;
       lfFaceName     := 'Arial';
       lfHeight       := Size;
       lfWeight       := FW_BOLD;
       lfQuality      := PROOF_QUALITY;
     end;
     with tmpCanvas do
     begin
       Font.Handle := CreateFontIndirect(LogFont);
       Font.Color  := clWhite;
       Brush.Color := clNavy;
     end;
     x1 := GetSystemMetrics(SM_CXEDGE) + GetSystemMetrics(SM_CXBORDER);
     x2 := 20;
     y1 := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYEDGE) +
           GetSystemMetrics(SM_CYBORDER) + 1;
     y2 := Height - GetSystemMetrics(SM_CYEDGE) - GetSystemMetrics(SM_CYBORDER);
     tmpRect := Rect(x1, y1, x2, y2);
     tmpCanvas.FillRect(tmpRect);
     DrawText(tmpCanvas.Handle, PChar(Texto), - 1, tmpRect, DT_BOTTOM or
       DT_SINGLELINE);
   finally
     tmpCanvas.Free;
   end;
 end;

 procedure TForm1.FormResize(Sender: TObject);
 begin
   VerticalTitleBar(MY_TITLE_TEXT, 12);
 end;

 procedure TForm1.FormPaint(Sender: TObject);
 begin
   VerticalTitleBar(MY_TITLE_TEXT, 12);
 end;

 end.

Перевод контента на русский язык:

Это проект Delphi, который создает вертикальную панель заголовка для формы. Код определяет пользовательский компонент TForm1 с двумя процедурами: VerticalTitleBar и двумя обработчиками событий: FormResize и FormPaint.

Процедура VerticalTitleBar принимает два параметра: строку (Texto) и целое число (Size). Она создает временный канвас, устанавливает шрифт Arial bold 12-ти пунктов, текстовый цвет на белый и фон на синий. Затем она рисует текст вертикально с помощью функции DrawText.

Процедура FormResize вызывает процедуру VerticalTitleBar с текстом заголовка "Vertical Text" и размером 12 при изменении размера формы.

Процедура FormPaint также вызывает процедуру VerticalTitleBar, что означает, что вертикальная панель заголовка будет рисоваться каждый раз, когда форма будет перерисована (например, при перемещении или минимальизации).

Вот некоторые предложения по улучшению:

1. Вместо создания временного канваса и шрифта в процедуре VerticalTitleBar, можно использовать свойство Canvas формы для рисования текста напрямую.
2. Процедура FormPaint может быть удалена, потому что вертикальная панель заголовка уже рисуется в процедуре FormResize при изменении размера формы.
3. Рассмотрите возможность сделать вертикальную панель заголовка регулируемой, добавив свойство к форме, которое позволяет пользователям изменять размер и/или цвет текста заголовка.

Вот обновленная версия кода:

type
  TForm1 = class(TForm)
    procedure FormResize(Sender: TObject);
  private
    procedure DrawVerticalTitleBar;
  end;

const
  MY_TITLE_TEXT = 'Vertical Text';

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormResize(Sender: TObject);
begin
  DrawVerticalTitleBar;
end;

procedure TForm1.DrawVerticalTitleBar;
var
  LogFont: TLogFont;
  x1, x2, y1, y2: integer;
begin
  with Canvas do
  begin
    Font.Name := 'Arial';
    Font.Style := [fsBold];
    Font.Size := 12;
    Font.Color := clWhite;
    Brush.Color := clNavy;

    x1 := GetSystemMetrics(SM_CXEDGE) + GetSystemMetrics(SM_CXBORDER);
    x2 := Width - x1;
    y1 := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYEDGE) + GetSystemMetrics(SM_CYBORDER);
    y2 := Height - GetSystemMetrics(SM_CYEDGE) - GetSystemMetrics(SM_CYBORDER);

    with Canvas do
    begin
      FillRect(Rect(x1, y1, x2, y2));
      DrawText(Handle, PChar(MY_TITLE_TEXT), -1, Rect(x1, y1, x2, y2), DT_BOTTOM or DT_SINGLELINE);
    end;
  end;
end.

Обратите внимание, что я удалил переменные tmpCanvas и tmpRect, а также заменял их на свойство Canvas формы. Я также удалил процедуру FormPaint и обновил процедуру DrawVerticalTitleBar для использования свойства Canvas напрямую.

В этой статье описывается создание вертикального TitleBar в делифете с помощью использования класса TCanvas и функции DrawText.

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

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

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