Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to write on a canvas with a rotated font Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
29-Aug-02
Category
Graphic
Language
Delphi 2.x
Views
145
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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.

			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC