Author: Tomas Rutkauskas
I would like to know how to write in any direction on a canvas : to write
vertically or with any angle?
Answer:
Solve 1:
1 { ... }
2 var
3 LogRec: TLogFont;
4 OldFontHandle, NewFontHandle: hFont;
5 begin
6 with Canvas do
7 begin
8 Font := Self.Font;
9 {create a rotated font based on the font object Font}
10 GetObject(Font.Handle, SizeOf(LogRec), Addr(LogRec));
11 LogRec.lfEscapement := FAngle * 10;
12 LogRec.lfOutPrecision := OUT_DEFAULT_PRECIS;
13 NewFontHandle := CreateFontIndirect(LogRec);
14 {write text on a canvas}
15 TextOut(ARect.Left, ARect.Top, Text)
16 NewFontHandle := SelectObject(Canvas.Handle, OldFontHandle);
17 DeleteObject(NewFontHandle);
18 end;
19 end;
Solve 2:
Here's a procedure to draw rotated text. To call it, do something like:
20 { ... }
21 Form1.Canvas.Brush.Style := bsClear;
22 TextRotate(Form1.Canvas, 'Rotated Text', W, H, Angle);
23
24 Where W and H are the x, y position at which to draw the text, and Angle is 0 - 359.
25
26 procedure TForm1.TextRotate(LocalCanvas: TCanvas; Text: string; X: Integer;
27 Y: Integer; RotateAngle: Integer);
28 var
29 LogFont: TLogFont;
30 begin
31 {Get font information}
32 GetObject(LocalCanvas.Handle, SizeOf(TLogFont), @LogFont);
33 {The angle, in tenths of degrees, between the base line of a character and the
34 x-axis}
35 LogFont.lfEscapement := RotateAngle * 10;
36 LogFont.lfUnderline := 0;
37 LogFont.lfStrikeOut := 0;
38 LogFont.lfWidth := 6;
39 LogFont.lfHeight := 12;
40 LogFont.lfItalic := 0;
41 LogFont.lfQuality := PROOF_QUALITY;
42 LogFont.lfFaceName := 'Times New Roman';
43 LogFont.lfWeight := 400;
44 {Assign the new rotated font handle}
45 LocalCanvas.Font.Handle := CreateFontIndirect(LogFont);
46 {Print the text}
47 LocalCanvas.TextOut(X, Y, Text);
48 DeleteObject(LocalCanvas.Font.Handle);
49 end;
Solve 3:
You want to display rotated text? For that you need to use a TrueType font (bitmap
fonts cannot be rotated) and a little API to create a rotated font. TFont does not
directly support it.
The following example shows how to print rotated text. The same principle works on
other canvases.
50 procedure TForm1.Button3Click(Sender: TObject);
51 var
52 lf: TLogfont;
53 begin
54 with printer do
55 begin
56 begindoc;
57 canvas.font.Name := 'Arial';
58 canvas.font.Size := 24;
59 canvas.textout(100, 100, 'This is a normal text');
60 GetObject(canvas.font.handle, Sizeof(lf), @lf);
61 lf.lfescapement := 450;
62 lf.lforientation := 450;
63 Canvas.Font.handle := CreateFontIndirect(lf);
64 canvas.TextOut(100, 1500, 'This is a rotated text');
65 EndDoc;
66 end;
67 end;
Solve 4:
68
69 procedure TForm1.Button1Click(Sender: TObject);
70 var
71 LogRec: TLogFont;
72 OldFont, NewFont: HFont;
73 i, X, Y: LongInt;
74 begin
75 if pdPrinter.Execute then
76 begin
77 with Printer do
78 begin
79 GetObject(Canvas.Font.Handle, SizeOf(LogRec), @LogRec);
80 BeginDoc;
81 for i := 0 to 5 do
82 begin
83 LogRec.lfEscapement := (i * 60) * 10;
84 LogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;
85 LogRec.lfFaceName := 'Times New Roman';
86 NewFont := CreateFontIndirect(LogRec);
87 OldFont := SelectObject(Canvas.Handle, NewFont);
88 Canvas.TextOut(100, 100, 'Hello World!');
89 NewFont := SelectObject(Canvas.Font.Handle, OldFont);
90 DeleteObject(NewFont);
91 end;
92 EndDoc;
93 end;
94 end;
95 end;
96
97 end.
Solve 5:
98
99 function GetRotatedFont(Canvas: TCanvas; RotationAngle: integer): HFont;
100 var
101 LogFont: TLogFont;
102 begin
103 GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
104 with LogFont do
105 begin
106 if (RotationAngle <> lfEscapement) then
107 begin
108 if RotationAngle = 0 then
109 lfOutPrecision := OUT_DEFAULT_PRECIS
110 else
111 lfOutPrecision := OUT_TT_ONLY_PRECIS;
112 lfEscapement := RotationAngle;
113 lfOrientation := lfEscapement;
114 end;
115 end;
116 Result := CreateFontIndirect(LogFont);
117 end;
Solve 6:
118 { ... }
119 var
120 LogFont: TLogFont;
121 fHandle: HFont;
122 begin
123 try
124 Printer.BeginDoc;
125 {Create font}
126 ZeroMemory(@LogFont, SizeOf(LogFont));
127 LogFont.lfFaceName := 'Times New Roman';
128 LogFont.lfHeight := 48;
129 LogFont.lfWidth := 0; {Have font mapper choose}
130 LogFont.lfEscapement := 300; {Angle in 1/10ths of a degree}
131 LogFont.lfOrientation := 300; {Angle in 1/10ths of a degree}
132 LogFont.lfQuality := DEFAULT_QUALITY;
133 {Everything else as default}
134 LogFont.lfOutPrecision := OUT_DEFAULT_PRECIS;
135 LogFont.lfClipPrecision := CLIP_DEFAULT_PRECIS;
136 fHandle := CreateFontIndirect(LogFont);
137 {Select new font, print the text and delete font}
138 SelectObject(Printer.Canvas.Handle, fHandle);
139 Printer.Canvas.TextOut(100, 300, '30 degree text');
140 DeleteObject(fHandle);
141 finally
142 Printer.EndDoc;
143 end;
144 end;
Solve 7:
145 { ... }
146 var
147 FontName: string;
148 NewFont: Integer;
149 OldFont: Integer;
150 { ... }
151 with Printer.Canvas do
152 begin
153 FontName := Font.Name + #0;
154 NewFont := CreateFont(Font.Height - 1, 0, 900, 0, FW_NORMAL, 0, 0, 0,
155 DEFAULT_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, 4,
156 @fontname[1]);
157 OldFont := SelectObject(Handle, NewFont);
158 TextOut(X, Y, Text);
159 SelectObject(Handle, OldFont);
160 DeleteObject(NewFont);
161 end;
162 { ... }
The value '900' is tenths of degrees.
|
