Author: Jonas Bilinkevicius
How to rotate the text in a StringGrid cell by 90°
Answer:
Solve 1:
1 uses
2 {...} Grids;
3
4 type
5 TForm1 = class(TForm)
6 StringGrid1: TStringGrid;
7 procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
8 Rect: TRect; State: TGridDrawState);
9 end;
10
11 {...}
12
13 implementation
14
15 {...}
16
17 // Display text vertically in StringGrid cells
18
19 procedure StringGridRotateTextOut(Grid: TStringGrid; ARow, ACol: Integer; Rect:
20 TRect;
21 Schriftart: string; Size: Integer; Color: TColor; Alignment: TAlignment);
22 var
23 lf: TLogFont;
24 tf: TFont;
25 begin
26 // if the font is to big, resize it
27 if (Size > Grid.ColWidths[ACol] div 2) then
28 Size := Grid.ColWidths[ACol] div 2;
29 with Grid.Canvas do
30 begin
31 // Replace the font
32 Font.Name := Schriftart;
33 Font.Size := Size;
34 Font.Color := Color;
35 tf := TFont.Create;
36 try
37 tf.Assign(Font);
38 GetObject(tf.Handle, SizeOf(lf), @lf);
39 lf.lfEscapement := 900;
40 lf.lfOrientation := 0;
41 tf.Handle := CreateFontIndirect(lf);
42 Font.Assign(tf);
43 finally
44 tf.Free;
45 end;
46 // fill the rectangle
47 FillRect(Rect);
48 // Align text and write it
49 if Alignment = taLeftJustify then
50 TextRect(Rect, Rect.Left + 2, Rect.Bottom - 2, Grid.Cells[ACol, ARow]);
51 if Alignment = taCenter then
52 TextRect(Rect, Rect.Left + Grid.ColWidths[ACol] div 2 - Size +
53 Size div 3, Rect.Bottom - 2, Grid.Cells[ACol, ARow]);
54 if Alignment = taRightJustify then
55 TextRect(Rect, Rect.Right - Size - Size div 2 - 2, Rect.Bottom -
56 2, Grid.Cells[ACol, ARow]);
57 end;
58 end;
Solve 2:
Display text vertically in StringGrid cells
59
60 procedure StringGridRotateTextOut2(Grid: TStringGrid; ARow, ACol: Integer; Rect:
61 TRect;
62 Schriftart: string; Size: Integer; Color: TColor; Alignment: TAlignment);
63 var
64 NewFont, OldFont: Integer;
65 FontStyle, FontItalic, FontUnderline, FontStrikeout: Integer;
66 begin
67 // if the font is to big, resize it
68 if (Size > Grid.ColWidths[ACol] div 2) then
69 Size := Grid.ColWidths[ACol] div 2;
70 with Grid.Canvas do
71 begin
72 // Set font
73 if (fsBold in Font.Style) then
74 FontStyle := FW_BOLD
75 else
76 FontStyle := FW_NORMAL;
77
78 if (fsItalic in Font.Style) then
79 FontItalic := 1
80 else
81 FontItalic := 0;
82
83 if (fsUnderline in Font.Style) then
84 FontUnderline := 1
85 else
86 FontUnderline := 0;
87
88 if (fsStrikeOut in Font.Style) then
89 FontStrikeout := 1
90 else
91 FontStrikeout := 0;
92
93 Font.Color := Color;
94
95 NewFont := CreateFont(Size, 0, 900, 0, FontStyle, FontItalic,
96 FontUnderline, FontStrikeout, DEFAULT_CHARSET,
97 OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
98 DEFAULT_PITCH, PChar(Schriftart));
99
100 OldFont := SelectObject(Handle, NewFont);
101 // fill the rectangle
102 FillRect(Rect);
103 // Write text depending on the alignment
104 if Alignment = taLeftJustify then
105 TextRect(Rect, Rect.Left + 2, Rect.Bottom - 2, Grid.Cells[ACol, ARow]);
106 if Alignment = taCenter then
107 TextRect(Rect, Rect.Left + Grid.ColWidths[ACol] div 2 - Size + Size div 3,
108 Rect.Bottom - 2, Grid.Cells[ACol, ARow]);
109 if Alignment = taRightJustify then
110 TextRect(Rect, Rect.Right - Size - Size div 2 - 2, Rect.Bottom - 2,
111 Grid.Cells[ACol, ARow]);
112
113 // Recreate reference to the old font
114 SelectObject(Handle, OldFont);
115 // Recreate reference to the new font
116 DeleteObject(NewFont);
117 end;
118 end;
119
120 // Call the method in OnDrawCell
121
122 procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol,
123 ARow: Integer; Rect: TRect; State: TGridDrawState);
124 begin
125 // In the second column: Rotate Text by 90° and left align the text
126 if ACol = 1 then
127 StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL',
128 12, clRed, taLeftJustify);
129
130 // In the third column: Center the text
131 if ACol = 2 then
132 StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clBlue,
133 taCenter);
134
135 // In all other columns third row: right align the text
136 if ACol > 2 then
137 StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clGreen,
138 taRightJustify);
139 end;
140
141 end.
|
