[Back to DELPHI SWAG index]  [Back to Main SWAG index]  [Original]

{+--------------------------------------------------------------------------+
 | Unit:   mwPasToRtf
 | Created:     09.97
 | Author:      Martin Waldenburg
 | Copyright    1997, all rights reserved.
 | Description: Pas to Rtf converter for syntax highlighting etc.
 | Version:     0.7 beta
 | Status:       FreeWare
 | DISCLAIMER:  This is provided as is, expressly without a warranty of any kind.
 |              You use it at your own risc.
 +--------------------------------------------------------------------------+}

unit mwPasToRtf;


interface

uses
  Windows,
  SysUtils,
  Messages,
  Classes,
  ComCtrls,
  Graphics,
  Dialogs,
  Registry;

type
  TTokenState = (tsAssembler, tsComment, tsCRLF, tsDirective, tsIdentifier,
                 tsKeyWord, tsNumber, tsSpace, tsString, tsSymbol, tsUnknown);

  TCommentState = (csAnsi, csBor, csNo, csSlashes);

type
  TPasConversion = class(TMemoryStream)
  private
    FDiffer: Boolean;
    FPreFixList, FPostFixList: array[tsAssembler..tsUnknown] of String;
    FComment: TCommentState;
    Prefix, TokenStr, Postfix: String;
    FBuffPos, TokenLen, FOutBuffSize, FStrBuffSize: Integer;
    FReadBuff, FOutBuff, FStrBuff, FStrBuffEnd, Run, RunStr, TokenPtr: PChar;
    FTokenState : TTokenState;
    FAssemblerFo: TFont;
    FCommentFo: TFont;
    FDirectiveFo: TFont;
    FIdentifierFo: TFont;
    FNumberFo: TFont;
    FKeyWordFo: TFont;
    FSpaceFo: TFont;
    FStringFo: TFont;
    FSymbolFo: TFont;
    function IsKeyWord(aToken: String):Boolean;
    function IsDirective(aToken: String):Boolean;
    function IsDiffKey(aToken: String):Boolean;
    procedure SetAssemblerFo(newValue: TFont);
    procedure SetCommentFo(newValue: TFont);
    procedure SetDirectiveFo(newValue: TFont);
    procedure SetIdentifierFo(newValue: TFont);
    procedure SetKeyWordFo(newValue: TFont);
    procedure SetNumberFo(newValue: TFont);
    procedure SetSpaceFo(newValue: TFont);
    procedure SetStringFo(newValue: TFont);
    procedure SetSymbolFo(newValue: TFont);
    procedure SetRTF;
    procedure WriteToBuffer(aString: String);
    procedure HandleAnsiC;
    procedure HandleBorC;
    procedure HandleCRLF;
    procedure HandleSlashesC;
    procedure HandleString;
    procedure ScanForRtf;
    procedure AllocStrBuff;
    procedure SetPreAndPosFix(aFont: TFont; aTokenState: TTokenState);
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure Init;
    procedure UseDelphiHighlighting(Ver: Integer);
    function ColorToRTF(aColor: TColor): String;
    function ConvertReadStream: Integer;
    function ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer):Integer;
    property AssemblerFo: TFont read FAssemblerFo write SetAssemblerFo;
    property CommentFo: TFont read FCommentFo write SetCommentFo;
    property DirectiveFo: TFont read FDirectiveFo write SetDirectiveFo;
    property IdentifierFo: TFont read FIdentifierFo write SetIdentifierFo;
    property KeyWordFo: TFont read FKeyWordFo write SetKeyWordFo;
    property NumberFo: TFont read FNumberFo write SetNumberFo;
    property SpaceFo: TFont read FSpaceFo write SetSpaceFo;
    property StringFo: TFont read FStringFo write SetStringFo;
    property SymbolFo: TFont read FSymbolFo write SetSymbolFo;
  published
  end;

const
  Keywords : array[0..98] of string =
            ('ABSOLUTE', 'ABSTRACT', 'AND', 'ARRAY', 'AS', 'ASM', 'ASSEMBLER',
             'AUTOMATED', 'BEGIN', 'CASE', 'CDECL', 'CLASS', 'CONST', 'CONSTRUCTOR',
             'DEFAULT', 'DESTRUCTOR', 'DISPID', 'DISPINTERFACE', 'DIV', 'DO',
             'DOWNTO', 'DYNAMIC', 'ELSE', 'END', 'EXCEPT', 'EXPORT', 'EXPORTS',
             'EXTERNAL', 'FAR', 'FILE', 'FINALIZATION', 'FINALLY', 'FOR', 'FORWARD',
             'FUNCTION', 'GOTO', 'IF', 'IMPLEMENTATION', 'IN', 'INDEX', 'INHERITED',
             'INITIALIZATION', 'INLINE', 'INTERFACE', 'IS', 'LABEL', 'LIBRARY',
             'MESSAGE', 'MOD', 'NAME', 'NEAR', 'NIL', 'NODEFAULT', 'NOT', 'OBJECT',
             'OF', 'OR', 'OUT', 'OVERRIDE', 'PACKED', 'PASCAL', 'PRIVATE', 'PROCEDURE',
             'PROGRAM', 'PROPERTY', 'PROTECTED', 'PUBLIC', 'PUBLISHED', 'RAISE',
             'READ', 'READONLY', 'RECORD', 'REGISTER', 'REPEAT', 'RESIDENT',
             'RESOURCESTRING', 'SAFECALL', 'SET', 'SHL', 'SHR', 'STDCALL', 'STORED',
             'STRING', 'STRINGRESOURCE', 'THEN', 'THREADVAR', 'TO', 'TRY', 'TYPE',
             'UNIT', 'UNTIL', 'USES', 'VAR', 'VIRTUAL', 'WHILE', 'WITH', 'WRITE',
             'WRITEONLY', 'XOR');

  Directives : array[0..10] of string =
              ('AUTOMATED', 'INDEX', 'NAME', 'NODEFAULT', 'READ', 'READONLY',
               'RESIDENT', 'STORED', 'STRINGRECOURCE', 'WRITE', 'WRITEONLY');

  DiffKeys: array[0..6] of string =
           ('END', 'FUNCTION', 'PRIVATE', 'PROCEDURE', 'PRODECTED', 'PUBLIC', 'PUBLISHED');


implementation

destructor TPasConversion.Destroy;
begin
  FAssemblerFo.Free;
  FCommentFo.Free;
  FDirectiveFo.Free;
  FIdentifierFo.Free;
  FKeyWordFo.Free;
  FNumberFo.Free;
  FSpaceFo.Free;
  FStringFo.Free;
  FSymbolFo.Free;
  ReAllocMem(FStrBuff, 0);
  inherited Destroy;
end;  { Destroy }

constructor TPasConversion.Create;
begin
  inherited Create;
  FAssemblerFo := TFont.Create;
  FCommentFo := TFont.Create;
  FDirectiveFo := TFont.Create;
  FIdentifierFo := TFont.Create;
  FKeyWordFo := TFont.Create;
  FNumberFo := TFont.Create;
  FSpaceFo := TFont.Create;
  FStringFo := TFont.Create;
  FSymbolFo := TFont.Create;
  Prefix:='';
  PostFix:='';
  FStrBuffSize:= 0;
  AllocStrBuff;
  Init;
  FDiffer:= False;
end;  { Create }

procedure TPasConversion.AllocStrBuff;
begin
  FStrBuffSize:= FStrBuffSize + 1024;
  ReAllocMem(FStrBuff, FStrBuffSize);
  FStrBuffEnd:= FStrBuff + 1023;
end;  { AllocStrBuff }

procedure TPasConversion.SetAssemblerFo(newValue: TFont);
begin
  FAssemblerFo.Assign(newValue);
  SetPreAndPosFix(newValue, tsAssembler);
end;  { SetAssemblerFo }

procedure TPasConversion.SetCommentFo(newValue: TFont);
begin
  FCommentFo.Assign(newValue);
  SetPreAndPosFix(newValue, tsComment);
end;  { SetCommentFo }

procedure TPasConversion.SetDirectiveFo(newValue: TFont);
begin
  FDirectiveFo.Assign(newValue);
  SetPreAndPosFix(newValue, tsDirective);
end;  { SetDirectiveFo }

procedure TPasConversion.SetIdentifierFo(newValue: TFont);
begin
  FIdentifierFo.Assign(newValue);
  SetPreAndPosFix(newValue, tsIdentifier);
end;  { SetIdentifierFo }

procedure TPasConversion.SetKeyWordFo(newValue: TFont);
begin
  FKeyWordFo.Assign(newValue);
  SetPreAndPosFix(newValue, tsKeyWord);
end;  { SetKeyWordFo }

procedure TPasConversion.SetNumberFo(newValue: TFont);
begin
  FNumberFo.Assign(newValue);
  SetPreAndPosFix(newValue, tsNumber);
end;  { SetNumberFo }

procedure TPasConversion.SetSpaceFo(newValue: TFont);
begin
  FSpaceFo.Assign(newValue);
  SetPreAndPosFix(newValue, tsSpace);
end;  { SetSpaceFo }

procedure TPasConversion.SetStringFo(newValue: TFont);
begin
  FStringFo.Assign(newValue);
  SetPreAndPosFix(newValue, tsString);
end;  { SetStringFo }

procedure TPasConversion.SetSymbolFo(newValue: TFont);
begin
  FSymbolFo.Assign(newValue);
  SetPreAndPosFix(newValue, tsSymbol);
end;  { SetSymbolFo }

function TPasConversion.ColorToRTF(aColor: TColor): String;
begin
  aColor:=ColorToRGB(aColor);
  Result:='\red'+IntToStr(GetRValue(aColor))+
          '\green'+IntToStr(GetGValue(aColor))+
          '\blue'+IntToStr(GetBValue(aColor))+';';
end; { ColorToRTF }

procedure TPasConversion.UseDelphiHighlighting(Ver: Integer);

  {Delphi Editor settings are a comma delimited list of seven
   values as follows:

   0 - Foreground color
   1 - Background color
   2 - font style
   3 - Foreground Default
   4 - Background Default
   6 - Unknown
   7 - Unknown

   Currently this routine only handles setting the Bold, Italic, Underline}

  procedure SetDelphiRTF(S: String; aTokenState: TTokenState);
  var
    Ed_List: TStringList;
    Font: TFont;
  Begin
    Font:=TFont.Create;
    Ed_List:=TStringList.Create;
    Try
      Ed_List.CommaText:=S;
      if pos('B',Ed_List[2])>0 then
        Font.Style:=Font.Style+[fsBold];
      if pos('I',Ed_List[2])>0 then
        Font.Style:=Font.Style+[fsItalic];
      if pos('U',Ed_List[2])>0 then
        Font.Style:=Font.Style+[fsUnderLine];
      SetPreAndPosFix(Font,aTokenState);
    finally
    Ed_List.Free;
    Font.Free;
    End;
  End;

const Delphi_Editor: array[0..10] of string=('Assembler','Comment','IGNORE',
           'IGNORE','Identifier','Reserved_Word','Number','Whitespace','String',
           'Symbol','Plain_Text');
var
  RegIni: TRegIniFile;
  Ed_Setting: String;
  i: Integer;
Begin
  if Ver=2 then
    RegIni:=TRegIniFile.Create('Software\Borland\Delphi\2.0')
  else if Ver=3 then
    RegIni:=TRegIniFile.Create('Software\Borland\Delphi\3.0')
  else
    Raise Exception.Create('Only syntax highlighting from Delphi 2 and 3 are supported');

  Try
    for i:=0 to 10 do
      if Delphi_Editor[i]<>'IGNORE' then
        Begin
        Ed_Setting:=RegIni.ReadString('HighLight',Delphi_Editor[i],'0,0,,0,0,0,0');
        SetDelphiRTF(Ed_Setting,TTokenState(i));
        End;
  finally
  RegIni.Free;
  End;
End;

procedure TPasConversion.SetPreAndPosFix(aFont: TFont; aTokenState: TTokenState);
begin
   { Here you need to set the Pre - and PostFix
     accordingly to the aFont value }
  FPreFixList[aTokenState]:= '';
  FPostFixList[aTokenState]:= '';
  if (fsBold in aFont.Style) then
    FPreFixList[aTokenState]:=FPreFixList[aTokenState]+'\b ';
  if (fsItalic in aFont.Style) then
    FPreFixList[aTokenState]:=FPreFixList[aTokenState]+'\i ';
  if (fsUnderline in aFont.Style) then
    FPreFixList[aTokenState]:=FPreFixList[aTokenState]+'\u ';

  if FPreFixList[aTokenState]<>'' then
    FPreFixList[aTokenState]:='{'+FPreFixList[aTokenState];

  if FPreFixList[aTokenState]<>'' then
    FPostFixList[aTokenState]:='}'
end;  { SetPreAndPosFix }

procedure TPasConversion.ScanForRtf;
var
  i: Integer;
begin
  RunStr:= FStrBuff;
  FStrBuffEnd:= FStrBuff + 1023;
  for i:=1 to TokenLen do
  begin
    Case TokenStr[i] of
      '\', '{', '}':
        begin
          RunStr^:= '\';
          inc(RunStr);
        end
    end;
    if RunStr >= FStrBuffEnd then AllocStrBuff;
    RunStr^:= TokenStr[i];
    inc(RunStr);
  end;
  RunStr^:= #0;
  TokenStr:= FStrBuff;
end;  { ScanForRtf }

procedure TPasConversion.HandleAnsiC;
begin
  while Run^ <> #0 do
  begin
    Case Run^ of
      #13:
        begin
          if TokenPtr <> Run then
          begin
            FTokenState:= tsComment;
            TokenLen:= Run - TokenPtr;
            SetString(TokenStr, TokenPtr, TokenLen);
            ScanForRtf;
            SetRTF;
            WriteToBuffer(Prefix + TokenStr + Postfix);
            TokenPtr:= Run;
          end;
          HandleCRLF;
          dec(Run);
        end;

      '*': if (Run +1 )^ = ')' then begin  inc(Run, 2); break; end;
    end;
    inc(Run);
  end;
  FTokenState:= tsComment;
  TokenLen:= Run - TokenPtr;
  SetString(TokenStr, TokenPtr, TokenLen);
  ScanForRtf;
  SetRTF;
  WriteToBuffer(Prefix + TokenStr + Postfix);
  TokenPtr:= Run;
  FComment:= csNo;
end;  { HandleAnsiC }

procedure TPasConversion.HandleBorC;
begin
  while Run^ <> #0 do
  begin
    Case Run^ of
      #13:
        begin
          if TokenPtr <> Run then
          begin
            FTokenState:= tsComment;
            TokenLen:= Run - TokenPtr;
            SetString(TokenStr, TokenPtr, TokenLen);
            ScanForRtf;
            SetRTF;
            WriteToBuffer(Prefix + TokenStr + Postfix);
            TokenPtr:= Run;
          end;
          HandleCRLF;
          dec(Run);
        end;

      '}': begin  inc(Run); break; end;

    end;
    inc(Run);
  end;
  FTokenState:= tsComment;
  TokenLen:= Run - TokenPtr;
  SetString(TokenStr, TokenPtr, TokenLen);
  ScanForRtf;
  SetRTF;
  WriteToBuffer(Prefix + TokenStr + Postfix);
  TokenPtr:= Run;
  FComment:= csNo;
end;  { HandleBorC }

procedure TPasConversion.HandleCRLF;
begin
  if Run^ = #0 then exit;
  inc(Run, 2);
  FTokenState:= tsCRLF;
  TokenLen:= Run - TokenPtr;
  SetString(TokenStr, TokenPtr, TokenLen);
  SetRTF;
  WriteToBuffer(Prefix + TokenStr + Postfix);
  TokenPtr:= Run;
  fComment:= csNo;
  FTokenState:= tsUnKnown;
  if Run^ = #13 then HandleCRLF;
  end;  { HandleCRLF }

procedure TPasConversion.HandleSlashesC;
begin
  FTokenState:= tsComment;
  while (Run^ <> #13) and (Run^ <> #0) do inc(Run);
  TokenLen:= Run - TokenPtr;
  SetString(TokenStr, TokenPtr, TokenLen);
  ScanForRtf;
  SetRTF;
  WriteToBuffer(Prefix + TokenStr + Postfix);
  TokenPtr:= Run;
  FComment:= csNo;
end;  { HandleSlashesC }

procedure TPasConversion.HandleString;
begin
  FTokenState:= tsSTring;
  FComment:= csNo;
  repeat
    Case Run^ of
      #0, #10, #13: raise exception.Create('Invalid string');
    end;
    inc(Run);
  until Run^ = #39;
          inc(Run);
          TokenLen:= Run - TokenPtr;
          SetString(TokenStr, TokenPtr, TokenLen);
          ScanForRtf;
          SetRTF;
          WriteToBuffer(Prefix + TokenStr + Postfix);
          TokenPtr:= Run;
end;  { HandleString }

function TPasConversion.IsKeyWord(aToken: String):Boolean;
var
  First, Last, I, Compare: Integer;
  Token: String;
begin
  First := 0;
  Last := 98;
  Result := False;
  Token:= UpperCase(aToken);
  while First <= Last do
  begin
    I := (First + Last) shr 1;
    Compare := CompareStr(Keywords[i],Token);
    if Compare = 0 then
      begin
        Result:=True;
        break;
      end
    else
    if Compare < 0  then First := I + 1 else Last := I - 1;
  end;
end;  { IsKeyWord }

function TPasConversion.IsDiffKey(aToken: String):Boolean;
var
  First, Last, I, Compare: Integer;
  Token: String;
begin
  First := 0;
  Last := 6;
  Result := False;
  Token:= UpperCase(aToken);
  while First <= Last do
  begin
    I := (First + Last) shr 1;
    Compare := CompareStr(DiffKeys[i],Token);
    if Compare = 0 then
      begin
        Result:=True;
        break;
      end
    else
    if Compare < 0  then First := I + 1 else Last := I - 1;
  end;
end;  { IsDiffKey }

function TPasConversion.IsDirective(aToken: String):Boolean;
var
  First, Last, I, Compare: Integer;
  Token: String;
begin
  First := 0;
  Last := 10;
  Result := False;
  Token:= UpperCase(aToken);
  if CompareStr('PROPERTY', Token) = 0 then FDiffer:= True;
  if IsDiffKey(Token) then FDiffer:= False;
  while First <= Last do
  begin
    I := (First + Last) shr 1;
    Compare := CompareStr(Directives[i],Token);
    if Compare = 0 then
      begin
        Result:= True;
        if FDiffer then
        begin
          Result:= False;
          if CompareStr('NAME', Token) = 0 then Result:= True;
          if CompareStr('RESIDENT', Token) = 0 then Result:= True;
          if CompareStr('STRINGRESOURCE', Token) = 0 then Result:= True;
        end;
        break;
      end
    else
    if Compare < 0  then First := I + 1 else Last := I - 1;
  end;
end;  { IsDirective }

procedure TPasConversion.SetRTF;
begin
  prefix:=FPreFixList[FTokenState];
  postfix:=FPostFixList[FTokenState];
  Case FTokenState of
    tsAssembler: FTokenState:= tsUnknown;

    tsComment: FTokenState:= tsUnknown;

    tsCRLF:
      begin
        PostFix:= '\par ';
        FTokenState:= tsUnknown;
        FComment:= csNo;
      end;

    tsDirective: FTokenState:= tsUnknown;

    tsIdentifier: FTokenState:= tsUnknown;

    tsNumber: FTokenState:= tsUnknown;

    tsKeyWord: FTokenState:= tsUnknown;

    tsSpace: FTokenState:= tsUnknown;

    tsString: FTokenState:= tsUnknown;

    tsSymbol: FTokenState:= tsUnknown;

  end;
end;  { SetRTF }

procedure TPasConversion.WriteToBuffer(aString: String);
var
  Count, Pos: Longint;
begin
  Count:= Length(aString);
  if (FBuffPos >= 0) and (Count >= 0) then
  begin
    Pos := FBuffPos + Count;
    if Pos > 0 then
    begin
      if Pos >= FOutBuffSize then
        begin
           Try
             FOutBuffSize:= FOutBuffSize + 16384;
             ReAllocMem(FOutBuff, FOutBuffSize);
           except
             raise exception.Create('conversions buffer to small');
           end;
        end;
        {System.Write(aString);}
      StrECopy((FOutBuff + FBuffPos), PChar(aString));
      FBuffPos:= FBuffPos + Count;
      FOutBuff[FBuffPos]:= #0;
    end;
  end;
end;  { WriteToBuffer }

function TPasConversion.ConvertReadStream: Integer;
begin
  FTokenState:= tsUnknown;
  FOutBuffSize:= size+3;
  ReAllocMem(FOutBuff, FOutBuffSize);
  FComment:= csNo;
  FBuffPos:= 0;
  FReadBuff:= Memory;
  {Write leading RTF}
  WriteToBuffer('{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS SansSerif;}{\f1\froman\fcharset2 Symbol;}{\f2\fmodern Courier New;}}'+#13+#10);
  WriteToBuffer('{\colortbl\red0\green0\blue0;}'+#13+#10);
  WriteToBuffer('\deflang1033\pard\plain\f2\fs20 ');

  Result:= Read(FReadBuff^, Size);
  FReadBuff[Result]:= #0;
  if Result > 0 then
  begin
  Run:= FReadBuff;
  TokenPtr:= Run;
  while Run^ <> #0 do
  begin
    Case Run^ of

      #13:
        begin
          FComment:= csNo;
          HandleCRLF;
        end;

      #1..#9, #11, #12, #14..#32:
        begin
          while Run^ in [#1..#9, #11, #12, #14..#32] do inc(Run);
              FTokenState:= tsSpace;
              TokenLen:= Run - TokenPtr;
              SetString(TokenStr, TokenPtr, TokenLen);
              SetRTF;
              WriteToBuffer(Prefix + TokenStr + Postfix);
              TokenPtr:= Run;
        end;

      'A'..'Z', 'a'..'z', '_':
        begin
          FTokenState:= tsIdentifier;
          inc(Run);
          while Run^ in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do inc(Run);
          TokenLen:= Run - TokenPtr;
          SetString(TokenStr, TokenPtr, TokenLen);
          if IsKeyWord(TokenStr) then
          begin
            if IsDirective(TokenStr) then FTokenState:= tsDirective
              else FTokenState:= tsKeyWord;
          end;
          SetRTF;
          WriteToBuffer(Prefix + TokenStr + Postfix);
          TokenPtr:= Run;
        end;

      '0'..'9':
        begin
          inc(Run);
          FTokenState:= tsNumber;
          while Run^ in ['0'..'9', '.', 'e', 'E'] do inc(Run);
          TokenLen:= Run - TokenPtr;
          SetString(TokenStr, TokenPtr, TokenLen);
          SetRTF;
          WriteToBuffer(Prefix + TokenStr + Postfix);
          TokenPtr:= Run;
        end;

      '{':
        begin
          FComment:= csBor;
          HandleBorC;
        end;
      
      '!','"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~' :
        begin
          FTokenState:= tsSymbol;
          while Run^ in ['!','"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~'] do
          begin
            Case Run^ of
              '/': if (Run + 1)^ = '/' then
                   begin
                     TokenLen:= Run - TokenPtr;
                     SetString(TokenStr, TokenPtr, TokenLen);
                     SetRTF;
                     WriteToBuffer(Prefix + TokenStr + Postfix);
                     TokenPtr:= Run;
                     FComment:= csSlashes;
                     HandleSlashesC;
                     break;
                   end;

              '(': if (Run + 1)^ = '*' then
                   begin
                     TokenLen:= Run - TokenPtr;
                     SetString(TokenStr, TokenPtr, TokenLen);
                     SetRTF;
                     WriteToBuffer(Prefix + TokenStr + Postfix);
                     TokenPtr:= Run;
                     FComment:= csAnsi;
                     HandleAnsiC;
                     break;
                   end;
            end;
            inc(Run);
          end;
          TokenLen:= Run - TokenPtr;
          SetString(TokenStr, TokenPtr, TokenLen);
          SetRTF;
          WriteToBuffer(Prefix + TokenStr + Postfix);
          TokenPtr:= Run;
        end;

      #39: HandleString;

      '#':
        begin
          FTokenState:= tsString;
          while Run^ in ['#', '0'..'9'] do inc(Run);
          TokenLen:= Run - TokenPtr;
          SetString(TokenStr, TokenPtr, TokenLen);
          SetRTF;
          WriteToBuffer(Prefix + TokenStr + Postfix);
          TokenPtr:= Run;
        end;

      '$':
        begin
          FTokenState:= tsNumber;
          while Run^ in ['$','0'..'9', 'A'..'F', 'a'..'f'] do inc(Run);
          TokenLen:= Run - TokenPtr;
          SetString(TokenStr, TokenPtr, TokenLen);
          SetRTF;
          WriteToBuffer(Prefix + TokenStr + Postfix);
          TokenPtr:= Run;
        end;

    else
      begin
        if Run^ <> #0 then
        begin
          inc(Run);
          TokenLen:= Run - TokenPtr;
          SetString(TokenStr, TokenPtr, TokenLen);
          SetRTF;
          WriteToBuffer(Prefix + TokenStr + Postfix);
          TokenPtr:= Run;
        end else break;
      end;
    end;
  end;


  WriteToBuffer(#13+#10+'\par }{'+#13+#10);
end;
  Clear;
  SetPointer(FOutBuff, fBuffPos-1) ;
end;  { ConvertReadStream }

function TPasConversion.ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize:
Integer): Integer;
begin
  {FBuffPos:= 0;
  FOutBuffSize:= BufSize;
  FOutBuff:= StrAlloc(FOutBuffSize);
  Run:= Buffer;
  while Run^ <> #0 do
  begin

  end;
  Result := Stream.Write(FOutBuff^, BufSize);
  StrDispose(FOutBuff);}
end;  { ConvertWriteStream }

procedure TPasConversion.Init;
begin
end;  { Initialize }

end.

[Back to DELPHI SWAG index]  [Back to Main SWAG index]  [Original]