Paint formatted text on the title bar of a TForm

Problem/Question/Abstract:

How to paint formatted text on the title bar of a TForm

Answer:

This source code allows you to write text everywhere on the form and also on the title bar. You can even rotate the text at a certain angle. Just keep in mind, that the code below only works with Truetype fonts.

{ ... }
private
{Private declarations}

procedure Check(var aMsg: TMessage); message WM_ACTIVATE;
public
  {Public declarations}
end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure MyTextOut(form: TForm; txt: string; x, y, angle, fontsize: Integer;
  fontcolor: TColor;
  fontname: PChar; italic, underline: Boolean);
var
  H: HDC;
  l, myfont: Integer;
begin
  l := length(txt);
  H := GetWindowDC(Form.handle);
  SetTextColor(H, fontcolor);
  SetBkMode(H, Transparent);
  Myfont := CreateFont(fontsize, 0, angle * 10, 0, FW_SEMIBOLD, ord(italic),
    ord(underline), 0,
    DEFAULT_CHARSET, OUT_TT_PRECIS, $10, 2, 4, fontname);
  SelectObject(H, myfont);
  TextOut(H, x, y, pchar(txt), l);
  DeleteObject(myfont);
  ReleaseDC(Form.handle, H);
end;

{Paint text on title bar}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Caption := '';
end;

procedure DrawText;
begin
  MyTextout(Form1, 'This is italic', 30, 25, 0, 15, clYellow, 'Arial', true, false);
  MyTextout(Form1, 'This is underline', 125, 5, 0, 15, clYellow, 'Arial', false,
    true);
end;

procedure TForm1.Check(var aMsg: TMessage);
begin
  DrawText;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  DrawText;
end;