Form - Desenhando no caption

// Este exemplo demonstra como desenhar na barra de titulo

// Testado e aprovado pelo INMETRO

type

  TForm1 = class(TForm)

  private

    { Private declarations }

  public

    procedure DesenhaTitulo;

    procedure M_PintarForm(var M: TMessage);    message WM_NCPAINT;

    procedure M_TrocarCaption(var M: TMessage); message WM_SETTEXT;

    procedure M_Ativa(var M: TMessage);         message WM_NCACTIVATE;

  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.DesenhaTitulo;

var

  X, Y: Integer;

  R   : TRect;

  C   : TCanvas;

begin

  // Obtem a pos do desenho (frame + btn)

  X := GetSystemMetrics(SM_CXFRAME) + GetSystemMetrics(SM_CXSIZE) + 2;

  Y := GetSystemMetrics(SM_CYFRAME) + 1;

  R.Left := X;

  R.Top  := Y;

  // Obtem dimensoes do rect do desenho

  R.Right  := Width - 3 * GetSystemMetrics(SM_CXSIZE) - 2 * GetSystemMetrics(SM_CXFRAME);

  R.Bottom := GetSystemMetrics(SM_CYSIZE);

  // cria o canvas

  C := TCanvas.Create;

  C.Handle := GetWindowDC( Self.Handle );

  try

    C.Pen.Color := clYellow;

    C.Ellipse(R.Left + 60, R.Top + 3, R.Left + 70, R.Top + 13); // Desenha uma bolota

    // Fonte:

    C.Font.Name := 'Arial';

    C.Font.Color:= clAqua;

    if Active then

      C.Brush.Color := GetSysColor( COLOR_ACTIVECAPTION )

    else

      C.Brush.Color := GetSysColor( COLOR_INACTIVECAPTION );

    DrawText(C.Handle, PChar(Caption), -1, R, DT_LEFT);

  finally

    ReleaseDC(Self.Handle, C.Handle);

    C.Handle := 0;

  end;

end;

procedure TForm1.M_Ativa(var M: TMessage);

begin

  inherited;

  DesenhaTitulo;

end;

procedure TForm1.M_PintarForm(var M: TMessage);

begin

  inherited;

  DesenhaTitulo;

end;

procedure TForm1.M_TrocarCaption(var M: TMessage);

begin

  inherited;

  DesenhaTitulo;

end;