...
private
procedure Abfrage(var aMsg: TMessage); message WM_ACTIVATE;
public
{ Public-Deklarationen}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure SpeziTextOut(Form: TForm; txt: string; x, y, winkel, fontsize:
Integer; fontfarbe: TColor; fontname: PChar; kursiv, unterstrich: boolean);
var H: HDC;
l, myfont: integer;
begin
l := length(txt);
H := GetWindowDC(Form.handle);
settextcolor(H, fontfarbe);
SetBkMode(H, TRANSPARENT);
Myfont := CreateFont(-muldiv(fontsize, getdevicecaps(H, logpixelsy), 72), 0,
winkel * 10, 0, FW_SEMIBOLD, ord(kursiv), ord(unterstrich), 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;
// Es wird Text auf der Titelleiste ausgegeben
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Caption := '';
end;
procedure schreibtext;
begin
SpeziTextout(Form1, 'Das ist kursiv',
30, 5, 0, 8, clyellow, 'Arial', true, false);
SpeziTextout(Form1, 'Das ist unterstrichen',
125, 5, 0, 8, clyellow, 'Arial', false, true);
end;
procedure TForm1.Abfrage(var aMsg: TMessage);
begin
schreibtext;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
schreibtext;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
schreibtext;
end;