mwpastortf.pas

script language

  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: break; // 2000-5-1 Matthias Ackermann
    end;
    inc(Run);
  until Run^ = #39;
  if Run^ = #39 then inc(Run); // 2000-5-14 Willi Krenn, Matthias Ackermann
  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 := Low(Keywords);
  Last := High(Keywords);
  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;'+TokenColors+'}'+#13+#10);// added TokenColors 11/9/98 HDN
  WriteToBuffer('\deflang1033\pard\plain\f2'+FontSize);// added FontSize 11/13/98 HDN

  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);
          ScanForRtf;
          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 }

procedure TPasConversion.SetBgColor(aColor: TColor);// 11/11/98 HDN
begin
  FBgColor := aColor;
end;

procedure TPasConversion.Init;
begin
end;  { Initialize }

end.