mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-21 14:41:27 +02:00
107 lines
2.1 KiB
ObjectPascal
107 lines
2.1 KiB
ObjectPascal
{
|
|
$Id$
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
|
|
Free Pascal development team
|
|
|
|
This program demonstrates the RTF parser object.
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
Program testrtf;
|
|
|
|
uses rtfpars,classes;
|
|
|
|
type
|
|
TRTFDemo = class(TObject)
|
|
FFileName : string;
|
|
FParser : TRTFParser;
|
|
Procedure DoDestination;
|
|
procedure dospecial;
|
|
procedure doctrl;
|
|
Procedure Dowrite;
|
|
Procedure Start;
|
|
procedure handleerror ( s : string);
|
|
end;
|
|
|
|
Var
|
|
RTFDemo : TRTFDemo;
|
|
|
|
procedure TRTFDemo.DoDestination;
|
|
{
|
|
skip all special destinations.
|
|
}
|
|
begin
|
|
FParser.skipgroup;
|
|
end;
|
|
|
|
procedure TRTFDemo.dospecial;
|
|
{
|
|
Don't do anything special.
|
|
}
|
|
begin
|
|
if FParser.RTFMinor=rtfpar then
|
|
Writeln;
|
|
end;
|
|
|
|
|
|
procedure TRTFDemo.doctrl;
|
|
|
|
begin
|
|
case Fparser.rtfmajor of
|
|
rtfdestination : dodestination;
|
|
rtfspecialchar : dospecial;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure TRTFDemo.Dowrite;
|
|
|
|
begin
|
|
{ RTFmajor contains the character ASCII Code, we just dump it }
|
|
Write (chr(FParser.RTFMajor));
|
|
end;
|
|
|
|
procedure TRTFDemo.Start;
|
|
|
|
var Thestream : TFilestream;
|
|
|
|
begin
|
|
Thestream:=TFileStream.Create(FFileName,fmopenread);
|
|
FParser:=TRTFParser.Create(TheStream);
|
|
FParser.classcallbacks[rtfText]:=@dowrite;
|
|
FParser.classcallbacks[rtfcontrol]:=@doctrl;
|
|
FParser.onrtferror:=@handleerror;
|
|
FParser.StartReading;
|
|
Fparser.Free;
|
|
Thestream.free;
|
|
end;
|
|
|
|
procedure TRTFDemo.handleerror ( s : string);
|
|
|
|
begin
|
|
Writeln (stderr,s);
|
|
end;
|
|
|
|
VAr Name : String;
|
|
|
|
begin
|
|
RTFDemo:=TRTFDemo.Create;
|
|
If Paramstr(1)='' then
|
|
begin
|
|
Write ('Enter filename to process: ');
|
|
Readln (name);
|
|
end
|
|
else
|
|
Name:=Paramstr(1);
|
|
RTFDemo.FFileName:=Name;
|
|
RTFDemo.Start;
|
|
RTFDemo.Free;
|
|
end.
|