PC Plus SuperCD (UK) 2000 March/pcp161b.iso/handson/archive/Issue159/files/copydelp.exe/StreamIn/stin.pas

Pascal/Delphi Source File | 1999-08-23 | 5.9 KB | 181 lines

unit stin;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;

type
  charray = array[0..255] of char;

  TForm1 = class(TForm)
    LoadFileBtn: TButton;
    PlainTextRBtn: TCheckBox;
    RichEdit1: TRichEdit;
    procedure LoadFileBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PlainTextRBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ReadStream;
    procedure WriteRTFHeader( ms : TMemoryStream );
    procedure processStream( msin, msout : TMemoryStream );
    function KeyWord( token : string ) : boolean;
    procedure WriteToken( token: charray; msout : TMemoryStream );
  end;

var
  Form1: TForm1;


implementation

{$R *.DFM}

const
       INFILE = 'Stin.pas'; // the input file - this very unit.
       CR = #13;
       LF = #10;
       CRLF = #13#10;
       TERMINATOR : char = '}';
       SLASH : char = '\';
       PARCODE = '\par ';
       KWCODE = '\fs16\cf1\b ';  // bold blue for keywords
       PLAINCODE = '\plain\fs16\cf0 ';  // plain black for other text
       SPECIALCHARS = ['{','}','\'] ;
       ALPHANUMERIC =['a'..'z', 'A'..'Z', '_', '0'..'9']; // '_' is included
                                     // as it's valid in a Pascal identifier
  NUMKEYWORDS = 50;
  Keywords : array[0..NUMKEYWORDS] of string =
              ( 'and', 'array', 'as', 'begin', 'case', 'class', 'const',
              'constructor', 'destructor', 'div', 'do', 'downto', 'else',
              'end', 'except', 'file', 'finally', 'for', 'function', 'if',
              'implementation', 'in', 'inherited', 'interface', 'is', 'mod',
              'nil', 'not', 'object', 'of', 'on', 'or', 'private', 'procedure',
              'program', 'property', 'public', 'published', 'repeat', 'set',
              'string', 'then', 'to', 'try', 'type', 'unit', 'until', 'uses',
              'var', 'while', 'with');

function TForm1.KeyWord( token : string ) : boolean;
var
   isKW : boolean;
   i    : integer;
begin
   isKW := false;
   i := 0;
   while ((i <= NUMKEYWORDS) and (isKW = false )) do
   begin
   //!! Test is case-insensitive (OK for Pascal. Change this for C or Java)
      if lowercase(token) = KeyWords[i] then
         isKW := true
      else
         Inc(i);
   end;
   result := isKW;
end;

procedure TForm1.WriteRTFHeader( ms : TMemoryStream );
var
   header : charray;
   ctable : charray;
begin
   header := '{\rtf1\ansi\ansicpg1252\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}{\f1\froman\fcharset2 Symbol;}'+CRLF+'{\f2\fswiss MS Sans Serif;}{\f3\fswiss\fprq2 System;}}'+CRLF;
   ctable := '{\colortbl\red0\green0\blue0;\red0\green0\blue255;}'+CRLF+'\deflang2057\pard\plain\f0\fs16\cf0 ';
   try
      ms.WriteBuffer( header, length(header) );
      ms.WriteBuffer( ctable, length(ctable) );
   except
      on EWriteError do
         ShowMessage( 'Failed to write header and ctable to stream!' );
   end;
end;

procedure TForm1.WriteToken( token: charray; msout : TMemoryStream );
begin
   msout.WriteBuffer( KWCODE, length( KWCODE ) );
   msout.WriteBuffer( token, length( token ) );
   msout.WriteBuffer( PLAINCODE, length( PLAINCODE ) );
end;

procedure TForm1.processStream( msin, msout : TMemoryStream );
var
   i : integer;
   c : char;
   token : charray;
begin
Screen.Cursor := crHourglass;       // Show hourglass cursor
try
// ---- Read Chars from Input Stream until we are at the end of the Stream -----
   while msin.position < msin.size do     // iterate through input stream
   begin
      msin.ReadBuffer( c, sizeof(c) );    // read one char at a time
      token := '';
      i := 0;
// a) Look For a Token
      while (c in ALPHANUMERIC) do       // if char is alphanumeric, keep
      begin                              // reading subsequent chars and
        token[i] := c;                   // build a token from them
        INC(i);
        msin.ReadBuffer( c, sizeof(c) );
      end;
// b) If we found a token, see if it's a Keyword
      if token <> '' then                // if we've built a token, see
      begin                              // if it's a keyword and
         if KeyWord(token) then          // colour it if necessary
            WriteToken(token, msout)
         else
            msout.WriteBuffer( token, length( token ) );
      end;
// c) if c is has a special meaning in RTF format, precede it with a '\'
      if c in SPECIALCHARS then          // * deal with special RTF chars
          msout.WriteBuffer( SLASH, sizeof( SLASH ) )  // and precede
      else                               // them with a '\' char
// d) else if it's a Carriage Return, add an RTF paragraph code
      if c = CR then                     // * deal with CR - add \para
         msout.WriteBuffer( PARCODE, sizeof( PARCODE ) );
           msout.WriteBuffer( c, sizeof( c ) );
  end;
finally
  Screen.Cursor := crDefault;    // restore normal cusror
end;
end;

procedure TForm1.ReadStream;
var
   msin, msout : TMemoryStream;
begin
   msin := TMemoryStream.Create;
   msout := TMemoryStream.Create;
   msin.LoadFromFile(INFILE);
   msin.Position := 0;  // set pos to 0 prior to loading from stream
   msout.Position := 0;
   WriteRTFHeader( msout );
   processStream(msin, msout);
   msout.WriteBuffer(TERMINATOR, sizeof(TERMINATOR)); // terminate RTF buffer
   msout.Position := 0;
   RichEdit1.Lines.LoadFromStream(msout);
   msin.Free;
   msout.Free;
end;

procedure TForm1.LoadFileBtnClick(Sender: TObject);
begin
   ReadStream;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.Plaintext := false;
  PlainTextRBtn.Checked := RichEdit1.PlainText;
end;

procedure TForm1.PlainTextRBtnClick(Sender: TObject);
begin
   RichEdit1.Plaintext := PlainTextRBtn.Checked;
end;

end.