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

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

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
http://www.baltsoft.com/

DELPHI FAQ