// Diese Prozedur erlaubt auf dem ganzen Fenster Text auszugeben,
// also auch auf der Titelleiste. Außerdem kann der Text in einem
// bestimmten Winkel gedreht werden. Es dürfen nur TrueType Schriften
// verwendet werden
(z.B. 'MS Sans Serif' geht nicht).

// Getestet mit D4 unter Win98

... 
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;

 

Zugriffe seit 6.9.2001 auf Delphi-Ecke