Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

01.01.2007

Note: The formDeactivate never gets called so when the form isn't active, sometimes the FormPaint isn't called. If anything causes the form to be repainted while in inactive, it draws correctly.

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.

{ ... }
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: https://www.baltsoft.com/