/
RTFFormatter.pas
73 lines (62 loc) · 1.54 KB
/
RTFFormatter.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
unit RTFFormatter;
{$mode delphi}
interface
uses
Classes, SysUtils, TokenTypes, FormatterBase;
type
TRTFFormatter = class(TFormatterBase)
private
function SetSpecial(const str: String): String;
public
procedure WriteFooter; override;
procedure WriteHeader; override;
procedure WriteToken(const Token: String; const TokenType: THigherTokenType); override;
end;
implementation
procedure TRTFFormatter.WriteToken(const Token: String; const TokenType: THigherTokenType);
var
escapedToken, FormatToken: String;
begin
escapedToken := SetSpecial(Token);
case TokenType of
htCRLF:
FormatToken := '\par' + escapedToken;
htDirective, htKeyWord:
FormatToken := '\b ' + escapedToken + '\b0 ';
htComment:
FormatToken := '\cf1\i ' + escapedToken + '\cf0\i0 ';
else
FormatToken := escapedToken;
end;
Write(FormatToken);
end;
function TRTFFormatter.SetSpecial(const str: String): String;
var
i: Integer;
begin
Result := '';
for i := 1 to Length(str) do
case str[i] of
'\', '{', '}': Result := Result + '\' + str[i];
else
Result := Result + str[i];
end;
end;
procedure TRTFFormatter.WriteFooter;
begin
WriteLn('');
WriteLn('\par}');
end;
procedure TRTFFormatter.WriteHeader;
begin
WriteLn('{\rtf1\ansi\ansicpg1253\deff0\deflang1032');
WriteLn('');
WriteLn('{\fonttbl');
WriteLn('{\f0\fcourier Courier New Greek;}');
WriteLn('}');
WriteLn('');
WriteLn('{\colortbl ;\red0\green0\blue128;}');
WriteLn('');
WriteLn('\pard\plain \li120 \fs20');
end;
end.