Paint formatted text on the title bar of a TForm (Views: 28)
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; |