← Back to branch summary

~ubuntu-branches/ubuntu/lucid/fpc/lucid-proposed

« back to all changes in this revision

Viewing changes to fpcsrc/packages/fcl-base/tests/testrtf.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-10-09 23:29:00 UTC
  • mfrom: (4.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20081009232900-553f61m37jkp6upv
Tags: 2.2.2-4
http://bugs.debian.org/498882
[ Torsten Werner ]
* Update ABI version in fpc-depends automatically.
* Remove empty directories from binary package fpc-source.

[ Mazen Neifer ]
* Removed leading path when calling update-alternatives to remove a Linitian
  error.
* Fixed clean target.
* Improved description of packages. (Closes: #498882)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/fcl-base/tests/testrtf.pp
1
 
{
2
 
    This file is part of the Free Pascal run time library.
3
 
    Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
4
 
    Free Pascal development team
5
 
 
6
 
    This program demonstrates the RTF parser object.
7
 
 
8
 
    See the file COPYING.FPC, included in this distribution,
9
 
    for details about the copyright.
10
 
 
11
 
    This program is distributed in the hope that it will be useful,
12
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
13
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
 
 
15
 
 **********************************************************************}
16
 
Program testrtf;
17
 
 
18
 
{$mode objfpc}{$h+}
19
 
 
20
 
uses rtfpars,classes;
21
 
 
22
 
type
23
 
  TRTFDemo = class(TObject)
24
 
    FFileName : string;
25
 
    FParser : TRTFParser;
26
 
    Procedure DoDestination;
27
 
    procedure dospecial;
28
 
    procedure doctrl;
29
 
    Procedure Dowrite;
30
 
    Procedure Start;
31
 
    procedure handleerror ( s : shortstring);
32
 
  end;
33
 
 
34
 
Var
35
 
  RTFDemo : TRTFDemo;
36
 
 
37
 
procedure TRTFDemo.DoDestination;
38
 
{
39
 
  skip all special destinations.
40
 
}
41
 
begin
42
 
  FParser.skipgroup;
43
 
end;
44
 
 
45
 
procedure TRTFDemo.dospecial;
46
 
{
47
 
  Don't do anything special.
48
 
}
49
 
begin
50
 
  if FParser.RTFMinor=rtfpar then
51
 
    Writeln;
52
 
end;
53
 
 
54
 
 
55
 
procedure TRTFDemo.doctrl;
56
 
 
57
 
begin
58
 
  case Fparser.rtfmajor of
59
 
    rtfdestination         : dodestination;
60
 
    rtfspecialchar         : dospecial;
61
 
    end;
62
 
end;
63
 
 
64
 
 
65
 
Procedure TRTFDemo.Dowrite;
66
 
 
67
 
begin
68
 
  { RTFmajor contains the character ASCII Code, we just dump it }
69
 
  Write (chr(FParser.RTFMajor));
70
 
end;
71
 
 
72
 
procedure TRTFDemo.Start;
73
 
 
74
 
var Thestream : TFilestream;
75
 
 
76
 
begin
77
 
  Thestream:=TFileStream.Create(FFileName,fmopenread);
78
 
  FParser:=TRTFParser.Create(TheStream);
79
 
  FParser.classcallbacks[rtfText]:=@dowrite;
80
 
  FParser.classcallbacks[rtfcontrol]:=@doctrl;
81
 
  FParser.onrtferror:=@handleerror;
82
 
  FParser.StartReading;
83
 
  Fparser.Free;
84
 
  Thestream.free;
85
 
end;
86
 
 
87
 
procedure TRTFDemo.handleerror ( s : shortstring);
88
 
 
89
 
begin
90
 
  Writeln (stderr,s);
91
 
end;
92
 
 
93
 
VAr Name : String;
94
 
 
95
 
begin
96
 
  RTFDemo:=TRTFDemo.Create;
97
 
  If Paramstr(1)='' then
98
 
    begin
99
 
    Write ('Enter filename to process: ');
100
 
    Readln (name);
101
 
    end
102
 
  else
103
 
    Name:=Paramstr(1);
104
 
  RTFDemo.FFileName:=Name;
105
 
  RTFDemo.Start;
106
 
  RTFDemo.Free;
107
 
end.