Senkrechter Text in Delphi

Computer: Software & Programmierung Delphi & Pascal
#1

In Pascal konnte man mittels SetTextStyle(DefaultFont,VertDir,1) mit OutTextXY senkrechten Text ausgeben. Kann man das in Delphi auch mit TextOut und wenn ja wie?

#2

In Pascal konnte man mittels
SetTextStyle(DefaultFont,VertDir,1) mit OutTextXY senkrechten
Text ausgeben. Kann man das in Delphi auch mit TextOut und
wenn ja wie?

Ja, allerdings nicht ganz so einfach.
Für die Ausgabe von „aufrechten“ Buchstaben untereinander (statt nebeneinander) gibt es keine Routine, die muß mann selbst schreiben.

Man kann allerdings die Ausgaberichtung der Textes drehen. Dazu mußt du eine TLogFont-Struktur mit den Schriftattributen füllen. lfOrientation gibt die Drehrichtung in 10tel Grad an.

Mit CreateFontIndirect erzeugst du mit der LogFont-Variablen ein Font-Handle, welches du mit SelectObject in den Anzeigekontext auswählst (wenn du auf einem Canvas zeichnest ist DC = Canvas.Handle). Jede folgende Textausgabe (du solltest TextOut verwenden) nutzt dann diese gedrehte Schriftart. Nicht vergessen: Wenn die Schrift nicht mehr benötigt wird, mit SelectObject wieder die vorige Schriftart auswählen und die neu erstellte mit DeleteObject löschen ! Zu allen genannten Begriffen finden sich in der Online-Hilfe genaue Erklärungen.

Gruß
Jochen

#3

Folgene Prozedur leistet das Verlangte (UNIT „Graphics“ einbinden nicht vergessen!):

PROCEDURE TextRotOut(Canvas : TCanvas;
 x, y : INTEGER;
 Angle : INTEGER;
 FontName : TFontName;
 FontSize : INTEGER;
 FontStyle: TFontStyles;
 s : STRING);

CONST
 FONTWEIGHT:
 ARRAY[BOOLEAN] OF INTEGER
 = (FW\_NORMAL,
 FW\_BOLD);

VAR
 DC : HDC;
 HFont, HFontOld: INTEGER;

begin
 IF (Length(s)\>0) THEN
 begin
 DC := Canvas.Handle;

 SetBkMode(DC, Transparent);

 HFont := CreateFont(-FontSize, // height
 0, // width
 Angle\*10, // escapement
 0, // orientation
 FONTWEIGHT[fsBold IN FontStyle],
 Ord(fsItalic IN FontStyle),
 Ord(fsUnderline IN FontStyle),
 Ord(fsStrikeout IN FontStyle),
 1, // char set
 4, // output precision
 $10, // clip precision
 2, // quality
 4, // pitch and family
 PCHAR(FontName));

 HFontOld := SelectObject(DC, HFont);

 TextOut(DC, x, y, PCHAR(s), Length(s));

 SelectObject(DC, HFontOld);

 DeleteObject(HFont)
 end
end;
#4

Danke, genau danach habe ich gesucht (nt)
nt = no text