Rotierende Schriften auf Drucker

[Bernhard Roland]

Suche eine Lösung um Schriften auf den Drucker in einem vorgegebenen Winkel ausgeben zu können. Kann mit dem u.a. Programm zwar über Canvas Schriften auf dem Bildschirm (Form1.Canvas.TextOu....) im Winkel ausgeben, jedoch über den Printer.Canvas-Aufruf funktioniert die Sache nicht.
Wer kann mir helfen?

---------- Listing ----------
Uses Printers
.
.
var lf : TLogFont;
tf : TFont;
Angle : Integer;
DC : THandle;

Begin

Printer.BeginDoc;

Angle := 45;
Printer.Canvas.Font.Name:='Arial';
printer.Canvas.Font.Size:=20;
tf:=TFont.Create;
tf.Assign(Printer.Canvas.Font);
GetObject(tf.Handle,SizeOf(lf),Addr(Lf));
Lf.lfEscapement:=Angel*10;
Lf.lfOrientation:=Angel*10;
SetBKMode(Printer.Canvas.Handle,transparent);
tf.Handle:=CreateFontIndirect(lf);
Printer.Canvas.Font.Assign(tf);
tf.Free;

Printer.Canvas.TextOut(200,200,'Computer');

Printer.EndDoc;

End;

[Frank Zimmermann]

Ich habe da vielleicht eine Lösung, die Nullterminierten Strings sind für Delphi 1 (<font color=#FF0000>rot</font>) angepaßt,<br>
das Original ist auf <a href="http://home.t-online.de/home/thomas.schwobe/textm.htm">home.t-online.de/home/thomas.schwobe/textm.htm</a> zu finden.
<pre>
<b>procedure</b> Rotation(rCanvas: TCanvas; rX, rY: Integer; rText: <b>string</b>);
<b>var</b>
newfont, oldfont, fontheight, fontstyle, fontitalic, fontunderline, fontstrikeout: Integer;
fontname: <b>string</b>;
<font color=#FF0000>ntext, nFont: PChar;</font>
<b>begin</b>
<b>if</b> rText='' <b>then</b> Exit;
fontheight:=rCanvas.TextHeight('Wg');
<b>if</b> (fsBold <b>in</b> rCanvas.Font.Style) <b>then</b> fontstyle:=FW_BOLD <b>else</b> fontstyle:=FW_NORMAL;
<b>if</b> (fsItalic <b>in</b> rCanvas.Font.Style) <b>then</b> fontitalic:=1 <b>else</b> fontitalic:=0;
<b>if</b> (fsUnderline <b>in</b> rCanvas.Font.Style) <b>then</b> fontunderline:=1 <b>else</b> fontunderline:=0;
<b>if</b> (fsStrikeOut <b>in</b> rCanvas.Font.Style) <b>then</b> fontstrikeout:=1 <b>else</b> fontstrikeout:=0;
fontname:=rCanvas.Font.Name;
<font color=#FF0000>GetMem(nFont, Length(fontname)+1);
StrPCopy(nFont, fontname);
GetMem(nText, Length(rText)+1);
StrPCopy(nText, rText);</font>
newfont := CreateFont(fontheight, 0, 900, 0, fontstyle, fontitalic, fontunderline, fontstrikeout,
DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, PChar(<font color=#FF0000>nFont</font>));
oldfont := SelectObject(rCanvas.Handle, newfont);
TextOut(rCanvas.Handle, rX, rY, pChar(<font color=#FF0000>nText</font>), StrLen(nText));
SelectObject(rCanvas.Handle, oldfont);
DeleteObject(newfont);
<font color=#FF0000>FreeMem(nText, Length(rText)+1);
FreeMem(nFont, Length(fontname)+1);</font>
<b>end</b>;
</pre>

Viel Erfolg