|  | 
 
 发表于 2003-4-21 00:42:24
|
显示全部楼层 
| 我不加code不行吗? 
 unit RTFEncode;
 interface
 
 uses SysUtils, Classes, LexAnalysis;
 
 type
 
 TRTFSyntaxLightor = class(TSyntaxLightor)
 private
 function HexToDec(s : string) : string;
 function HexToRGB(s : string) : string;
 protected
 procedure WriteHead; override;
 procedure WriteFoot; override;
 procedure Encode(const s : string); override;
 procedure AddStyle(const s : string; StyleIndex : integer); override;
 end;
 implementation
 
 function TRTFSyntaxLightor.HexToDec(s : string) : string;
 begin
 Result := IntToStr(StrToInt('$' + s));
 end;
 
 function TRTFSyntaxLightor.HexToRGB(s : string) : string;
 var
 Red, Green, Blue : string;
 begin
 Red := HexToDec(Copy(s, 2, 2));
 Green := HexToDec(Copy(s, 4, 2));
 Blue := HexToDec(Copy(s, 6, 2));
 Result := '\red' + Red + '\green' + Green + '\blue' + Blue + ';';
 end;
 
 procedure TRTFSyntaxLightor.WriteHead;
 var
 Data : string;
 i : integer;
 begin
 Data := '{\rtf1\ansi\ansicpg936\deff0\deflang1033\deflangfe2052{\fonttbl{\f0\fmodern\fprq6\fcharset134 \''cb\''ce\''cc\''e5;}}';
 FDestStream.WriteBuffer(Data[ 1 ], Length(Data));
 Data :='{\colortbl ;';
 FDestStream.WriteBuffer(Data[ 1 ], Length(Data));
 for i := 0 to FSyntaxList.Count - 1 do begin
 Data := HexToRGB(FSyntaxList[ i ].Style);
 FDestStream.WriteBuffer(Data[ 1 ], Length(Data));
 end;
 Data := HexToRGB(FSyntaxList.DigitStyle) + '}';
 FDestStream.WriteBuffer(Data[ 1 ], Length(Data));
 Data := '\viewkind4\uc1\pard\cf0\lang2052\f0\fs18';
 FDestStream.WriteBuffer(Data[ 1 ], Length(Data));
 end;
 
 procedure TRTFSyntaxLightor.WriteFoot;
 var
 Data : string;
 begin
 Data := '}';
 FDestStream.WriteBuffer(Data[ 1 ], Length(Data));
 end;
 
 procedure TRTFSyntaxLightor.Encode(const s : string);
 var
 CurPos, LastPos, Len, SubLen : integer;
 Data : string;
 begin
 if s <> '' then begin
 Len := Length(s);
 LastPos := 1;
 while true do begin
 CurPos := LastPos;
 while (CurPos <= Len) and not (s[ CurPos ] in [ '\', '{', '}', cEnter, cNewLine, cTab ]) do inc(CurPos);
 SubLen := CurPos - LastPos;
 if SubLen > 0 then FDestStream.WriteBuffer(s[ LastPos ], SubLen);
 if CurPos > Len then exit;
 case s[ CurPos ] of
 '\' : Data := '\\';
 '{' : Data := '\{';
 '}' : Data := '\}';
 cNewLine : Data := '\par' + cEnter + cNewLine;
 cTab : Data := '\tab ';
 end;
 if s[ CurPos ] <> cEnter then FDestStream.WriteBuffer(Data[ 1 ], Length(Data));
 LastPos := CurPos + 1;
 end;
 end;
 end;
 
 procedure TRTFSyntaxLightor.AddStyle(const s : string; StyleIndex : integer);
 var
 Data : string;
 begin
 if s <> '' then begin
 Data := '\cf' + IntToStr(StyleIndex + 1) + ' ';
 FDestStream.WriteBuffer(Data[ 1 ], Length(Data));
 Encode(s);
 Data := '\cf0 ';
 FDestStream.WriteBuffer(Data[ 1 ], Length(Data));
 end;
 end;
 
 end.
 | 
 |