HtFormatting.pas 5.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217
  1. {
  2. TIGCC IDE
  3. Copyright (C) 2004 Fréderic Bour
  4. Copyright (C) 2004 Sebastian Reichelt
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2, or (at your option)
  8. any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software Foundation,
  15. Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  16. }
  17. unit HtFormatting;
  18. interface
  19. uses Windows, Types, Classes, Graphics, Forms, Controls;
  20. // Show an hint window with formatted text
  21. type
  22. THtHintWindow = class(THintWindow)
  23. protected
  24. procedure Paint; override;
  25. public
  26. function CalcHintRect(MaxWidth: Integer; const AHint: string;
  27. AData: Pointer): TRect; override;
  28. end;
  29. // Draw text with a small HTML-like formatting
  30. // Tags: B (bold), I (italic), U (underline) or S (strike-out)
  31. //
  32. // You can also use <C:Color> for changing text color
  33. procedure DrawHtTextEx(const Text: string; out PlainText: string; Rect: TRect; Cnv: TCanvas; var Width, Height: Integer; NoColor: Boolean);
  34. procedure DrawHtText(const Text: string; Rect: TRect; Cnv: TCanvas; var Width: Integer; NoColor: Boolean);
  35. procedure DrawMultiLineHtTextEx(const Text: string; out PlainText: string; Rect: TRect; Cnv: TCanvas; var Width, Height: Integer; NoColor: Boolean);
  36. procedure DrawMultiLineHtText(const Text: string; Rect: TRect; Cnv: TCanvas; var Width: Integer; NoColor: Boolean);
  37. implementation
  38. uses StrUtils, MaskUtils, UtilsDos;
  39. procedure DrawHtTextEx(const Text: string; out PlainText: string; Rect: TRect; Cnv: TCanvas; var Width, Height: Integer; NoColor: Boolean);
  40. var
  41. i, l, p: Integer;
  42. S: string;
  43. X, BWidth: Integer;
  44. C: Char;
  45. OriginalColor: TColor;
  46. OriginalStyle: TFontStyles;
  47. Size: tagSIZE;
  48. begin
  49. OriginalColor := Cnv.Font.Color;
  50. OriginalStyle := Cnv.Font.Style;
  51. l := Length(Text);
  52. p := 0;
  53. X := Rect.Left;
  54. Height := 0;
  55. PlainText := '';
  56. BWidth := Cnv.TextWidth('<');
  57. while p < l do
  58. begin
  59. i := p + 1;
  60. p := PosEx('<', Text, i);
  61. if p = 0 then
  62. p := l + 1;
  63. // Draw Text
  64. S := Copy(Text, i, p - i);
  65. Cnv.TextRect(Rect, Rect.Left, Rect.Top, S);
  66. PlainText := PlainText + S;
  67. // Update Size
  68. Size := Cnv.TextExtent(S);
  69. Inc(Rect.Left, Size.cx);
  70. if Size.cy > Height then
  71. Height := Size.cy;
  72. if p <> l then
  73. begin
  74. C := UpCase(Text[p + 1]);
  75. if C <> 'C' then
  76. begin
  77. case C of
  78. 'B': Cnv.Font.Style := Cnv.Font.Style + [fsBold];
  79. 'U': Cnv.Font.Style := Cnv.Font.Style + [fsItalic];
  80. 'I': Cnv.Font.Style := Cnv.Font.Style + [fsUnderline];
  81. 'S': Cnv.Font.Style := Cnv.Font.Style + [fsStrikeOut];
  82. '/':
  83. if p + 1 < l then
  84. begin
  85. case UpCase(Text[p + 2]) of
  86. 'B': Cnv.Font.Style := Cnv.Font.Style - [fsBold];
  87. 'U': Cnv.Font.Style := Cnv.Font.Style - [fsItalic];
  88. 'I': Cnv.Font.Style := Cnv.Font.Style - [fsUnderline];
  89. 'S': Cnv.Font.Style := Cnv.Font.Style - [fsStrikeOut];
  90. end;
  91. end;
  92. '<':
  93. begin
  94. Cnv.TextRect(Rect, Rect.Left, Rect.Top, '<');
  95. Inc(Rect.Left, BWidth);
  96. end;
  97. end;
  98. p := PosEx('>', Text, p + 1);
  99. if p = 0 then
  100. p := l;
  101. end
  102. else
  103. begin
  104. Inc(P, 3);
  105. i := PosEx('>', Text, p);
  106. if i = 0 then
  107. p := l
  108. else
  109. begin
  110. S := Copy(Text, p, i - p);
  111. if S <> '' then
  112. begin
  113. if not (S[1] in ['0'..'9', '$']) then
  114. S := 'cl' + S;
  115. try
  116. if not NoColor then
  117. Cnv.Font.Color := StringToColor(S);
  118. except
  119. end;
  120. end;
  121. p := i;
  122. end;
  123. end;
  124. end
  125. else
  126. Break;
  127. end;
  128. Width := Rect.Left - X;
  129. Cnv.Font.Color := OriginalColor;
  130. Cnv.Font.Style := OriginalStyle;
  131. end;
  132. procedure DrawMultiLineHtTextEx(const Text: string; out PlainText: string; Rect: TRect; Cnv: TCanvas; var Width, Height: Integer; NoColor: Boolean);
  133. var
  134. Lst: TStringList;
  135. S: string;
  136. i, W, H: Integer;
  137. begin
  138. Lst := TStringList.Create;
  139. Lst.Text := Text;
  140. Height := 0;
  141. Width := 0;
  142. for i := 0 to Lst.Count - 1 do
  143. begin
  144. DrawHtTextEx(Lst[i], S, Rect, Cnv, W, H, NoColor);
  145. if W > Width then
  146. Width := W;
  147. Inc(Height, H);
  148. Inc(Rect.Top, H);
  149. Lst[i] := S;
  150. end;
  151. PlainText := Lst.Text;
  152. Lst.Free;
  153. end;
  154. procedure DrawHtText(const Text: string; Rect: TRect; Cnv: TCanvas; var Width: Integer; NoColor: Boolean);
  155. var
  156. S: string;
  157. H: Integer;
  158. begin
  159. DrawHtTextEx(Text, S, Rect, Cnv, Width, H, NoColor);
  160. end;
  161. procedure DrawMultiLineHtText(const Text: string; Rect: TRect; Cnv: TCanvas; var Width: Integer; NoColor: Boolean);
  162. var
  163. S: string;
  164. H: Integer;
  165. begin
  166. DrawMultiLineHtTextEx(Text, S, Rect, Cnv, Width, H, NoColor);
  167. end;
  168. { THtHintWindow }
  169. function THtHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string;
  170. AData: Pointer): TRect;
  171. var
  172. P: string;
  173. R: TRect;
  174. W, H: Integer;
  175. begin
  176. R := Rect(2, 2, 2, 2);
  177. Canvas.Font.Color := Screen.HintFont.Color;
  178. DrawMultiLineHtTextEx(AHint, P, R, Self.Canvas, W, H, False);
  179. Result := Rect(0, 0, W + 2, H + 2);
  180. end;
  181. procedure THtHintWindow.Paint;
  182. var
  183. R: TRect;
  184. W: Integer;
  185. begin
  186. R := ClientRect;
  187. Inc(R.Left, 2);
  188. Inc(R.Top, 2);
  189. Canvas.Font.Color := Screen.HintFont.Color;
  190. DrawMultiLineHtText(Caption, R, Self.Canvas, W, False);
  191. end;
  192. end.