* Ported a RTF Reporting Engine for tiOPF and fpGUI. It's still missing Image support, but other than that, it's working nicely. A demo will be added soon.

5 files changed, 4660 insertions, 24 deletions

diff --git a/extras/tiopf/gui/tiRtfReport.pas b/extras/tiopf/gui/tiRtfReport.pas
new file mode 100644
index 00000000..5d8d9c53
--- /dev/null
+++ b/extras/tiopf/gui/tiRtfReport.pas
@@ -0,0 +1,4632 @@
+{
+
+Revision history:
+
+  05-07-2005: First release by Marius Ellen (mariusellen@home.nl)
+  2007-04-18: Ported to Free Pascal and fpGUI by Graeme Geldenhuys (graemeg@gmail.com)
+
+Purpose:
+  Create reports with Rtf documents with access to dataset and framework objects. 
+
+ToDo:
+  Better exception handling. (saw some unexpected errors while parsing)
+    corrupting the resulting rtf.
+  Show errors when trying to past eof in a tiPerObjList (its now ignored)
+  Suppress null dates (0 date are displayed as xx-xx-1899)
+
+  And if anybody got ideas for this section, please email them!
+}
+
+unit tiRtfReport;
+
+{$mode objfpc}{$H+}
+{.$I tiDefines.inc}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, TypInfo{, Jpeg},
+  Db, Variants, tiObject, gfxbase;
+
+type
+  TtiRtfParser = class;
+  TRtfArgument = class;
+  TRtfException = class(Exception);
+
+  TRtfClass =(RtfNothing, RtfUnknown, RtfGroup, RtfText, RtfControl,
+    RtfExpression, RtfBranche, RtfParseBegin, RtfParseEnd, RtfEOF);
+
+  TRtfToken =(etNothing, etComma, etFunction, etProcedure, etParenthesis,
+    etADD, etSUB, etMUL, etDIV, etEQ, etNE, etGE, etLE, etGT, etLT, etNot,
+    etAnd, etOr, etAssign, etFieldName, etVariable, etDataset, etLitString,
+    etLitInt, etLitFloat, etLitDate, etLitFalse, etLitTrue);
+  TRtfTokenSet = set of TRtfToken;
+
+  TRtfPictureOption =(poMetafile, poBinary);
+  TRtfPictureOptions = set of TRtfPictureOption;
+  TRtfPictureBorder =(brNone, brSingle, brDouble, brThick, brShadow, brDot, brHair);
+
+  TColor = TfpgColor;
+  TPicture = TMemoryStream;  // fake it until we can implement image support
+
+
+  TRtfPictureAttr = class(TObject)
+  private
+    FWidth: integer;
+    FHeigth: integer;
+    FScaleX: integer;
+    FScaleY: integer;
+    FWidthmm: Double;
+    FHeigthmm: Double;
+    FBorderWidth: integer;
+    FBorderColor: TColor;
+    FProportional: boolean;
+    FBorderType: TRtfPictureBorder;
+    procedure SetScaleX(Value: integer);
+    procedure SetScaleY(Value: integer);
+  public
+    constructor Create(AWidth, AHeigth: word);
+    //Width and height are in pixels
+    property Width: integer read FWidth;
+    property Heigth: integer read FHeigth;
+    //Widthmm and heightmm are in milimeters
+    property Widthmm: Double read FWidthmm;
+    property Heigthmm: Double read FHeigthmm;
+    //Scale from 1 to 100
+    property ScaleX: integer read FScaleX write SetScaleX;
+    property ScaleY: integer read FScaleY write SetScaleY;
+    property BorderColor: TColor read FBorderColor write FBorderColor;
+    property BorderWidth: integer read FBorderWidth write FBorderWidth; //in points
+    property BorderType: TRtfPictureBorder read FBorderType write FBorderType;
+    property Proportional: boolean read FProportional write FProportional;
+  end;
+
+
+  TRtfPicturePath = procedure(var AFilename: string)of object;
+  TRtfFunctionExecute = procedure(AArgument: TRtfArgument)of object;
+  TRtfOnPictureAttr = procedure(APictureAttr: TRtfPictureAttr)of object;
+  TRtfArgumentEvent = procedure(APrevItem, AArgument, ANextItem: TRtfArgument)of object;
+  TRtfOnCreateDataset = procedure(ADatabase, AAlias, ASql: string; AArgument: TRtfArgument)of object;
+
+
+  //Basic Rtf control word
+  TRtfItem = class(TList)
+  private
+    FNext: TRtfItem;
+    FPrev: TRtfItem;
+    FParent: TRtfItem;
+    FRtfMajor: integer;
+    FRtfMinor: integer;
+    FRtfClass: TRtfClass;
+    FRtfTextBuf: string;
+    function GetItem(Index: integer): TRtfItem;
+    function CheckItem(AClass: TRtfClass; Major: integer): boolean;
+  protected
+    procedure Notify(Ptr: pointer; Action: TListNotification); override;
+  public
+    procedure Assign(ASource: TRtfItem); virtual;
+    property Next: TRtfItem read FNext;
+    property Prev: TRtfItem read FPrev;
+    property Parent: TRtfItem read FParent;
+    //Weak names, but it keeps the RawRtfParser simple
+    property RtfClass: TRtfClass read FRtfClass write FRtfClass;
+    property RtfMajor: integer read FRtfMajor write FRtfMajor;
+    property RtfMinor: integer read FRtfMinor write FRtfMinor;
+    property RtfTextBuf: string read FRtfTextBuf write FRtfTextBuf;
+    property Items[Index: integer]: TRtfItem read GetItem; default;
+  end;
+
+
+  //Old style Double linked list (but still usefull)
+  TRtfItemList = class(TObject)
+  private
+    FHead: TRtfItem;
+    FTail: TRtfItem;
+    FCount: integer;
+  protected
+    procedure dlRemove(AItem: TRtfItem; DisposeIt: boolean);
+  public
+    constructor Create; virtual;
+    destructor Destroy; override;
+
+    procedure Clear;
+    function Add(AItem: TRtfItem): TRtfItem;
+    procedure SaveToStream(AStream: TStream; AColors: string);
+    procedure Insert(AItem: TRtfItem); {-Insert element at start of list}
+    procedure Delete(AItem: TRtfItem); {-Delete existing element in list, disposing of its contents}
+    procedure Extract(AItem: TRtfItem); {-Extract existing element from list without disposing of it}
+    procedure PlaceAfter(AItem, AAfter: TRtfItem); {-Place element P into list _after_ existing element L}
+    procedure PlaceBefore(AItem, ABefore: TRtfItem); {-Place element P into list _before_ existing element L}
+
+    property Head: TRtfItem read FHead; {-Return TRtfItem to head of list}
+    property Tail: TRtfItem read FTail; {-Return TRtfItem to tail of list}
+    property Count: integer read FCount;
+  end;
+
+
+  //Variable definition
+  TRtfVariable = class(TObject)
+  private
+    FName: string;
+    FValue: variant;
+    FToken: TRtfToken;
+  public
+    property Name: string read FName write FName;
+    property Value: variant read FValue write FValue;
+    property Token: TRtfToken read FToken write FToken;
+  end;
+
+
+  TRtfVariableList = class(TObjectList)
+  private
+    function GetItem(Index: integer): TRtfVariable;
+  public
+    destructor Destroy; override;
+    function Find(AName: string): TRtfVariable;
+    function Add(AName: string; AValue: variant; AToken: TRtfToken): TRtfVariable;
+    property Items[Index: integer]: TRtfVariable read GetItem; default;
+  end;
+
+
+  //Function definition
+  TRtfFunction = class(TObject)
+  private
+    FMin: smallint;
+    FMax: smallint;
+    FName: string;
+    FToken: TRtfToken;
+    FOnExecute: TRtfFunctionExecute;
+  public
+    property Name: string read FName write FName; //Function name
+    property Min: smallint read FMin write FMin; //Function minimal parameters
+    property Max: smallint read FMax write FMax; //Function maximal parameters
+    property Token: TRtfToken read FToken write FToken; //Function type (=weak name)
+    property OnExecute: TRtfFunctionExecute read FOnExecute write FOnExecute;
+  end;
+
+
+  TRtfFunctionList = class(TObjectList)
+  private
+    function GetItem(Index: integer): TRtfFunction;
+  public
+    function Find(AName: string): TRtfFunction;
+    function Add(ATokenType: TRtfToken; AName: string; AMin, AMax: smallint; AOnexecute: TRtfFunctionExecute): TRtfFunction;
+    property Items[Index: integer]: TRtfFunction read GetItem; default;
+  end;
+
+
+  //Dataset defintion (Simply a wrap around the TDataset compatible and framework objects)
+  TRtfDataset = class(TObjectList)
+  private
+    FName: string;
+    FDataset: TObject;
+    FParent: TRtfDataset;
+    FTableIndex: integer;
+    FFreeDataset: boolean;
+    function GetItem(Index: integer): TRtfDataset;
+    function ResolveNestedFields(ATable: TRtfDataset; AName: string; var AFieldName: string): TRtfDataset;
+  protected
+    procedure Notify(Ptr: pointer; Action: TListNotification); override;
+  public
+    destructor Destroy; override;
+    function Find(AName: string): TRtfDataset; overload;
+    function Find(AName: string; var AFieldName: string): TRtfDataset; overload;
+    function Add(ADataset: TObject; AName: string; AFreeDataset: boolean = false): TRtfDataset;
+    property Items[Index: integer]: TRtfDataset read GetItem; default;
+
+    procedure Open;
+    procedure Next;
+    procedure Prior;
+    procedure First;
+    procedure Last;
+    function Eof: boolean;
+    function Bof: boolean;
+    function IsEmpty: boolean;
+    function RecordCount: integer;
+
+    property Parent: TRtfDataset read FParent;
+    property Name: string read FName write FName; //TableName
+    property FreeDataset: boolean read FFreeDataset;
+    property Dataset: TObject read FDataset write FDataset;
+    property TableIndex: integer read FTableIndex write FTableIndex; //Record index
+  end;
+
+
+  //Argument definition (For evaluating of expressions)
+  TRtfArgument = class(TObjectList)
+  private
+    FValue: variant;
+    FParent: TRtfArgument;
+    FToken: TRtfToken;
+    FParam: integer;
+    FParser: TtiRtfParser;
+    procedure ResolveVariable;
+    procedure EvaluateExpression;
+    function GetItem(Index: integer): TRtfArgument;
+    function Add(AArgument: TRtfArgument): TRtfArgument; overload;
+    function Add(AValue: variant; ATokenType: TRtfToken): TRtfArgument; overload;
+    procedure Walk(ATokenset: TRtfTokenSet; AExecproc: TRtfArgumentEvent);
+    procedure EvaluateAssign(APrevItem, AArgument, ANextItem: TRtfArgument);
+    procedure EvaluateComparison(APrevItem, AArgument, ANextItem: TRtfArgument);
+    procedure EvaluateUnaryBinary(APrevItem, AArgument, ANextItem: TRtfArgument);
+  protected
+    procedure Notify(Ptr: pointer; Action: TListNotification); override;
+    //Dataset stuff
+    procedure ResolveFieldName;
+    function GetPicture(APicture: TPicture): string;
+    procedure GetGraphicsValue(ADataset: TRtfDataset; AFieldName: string);
+    procedure ResolveFieldValue(ADataset: TRtfDataset; AFieldName: string);
+    procedure GetPictureData(ABuffer: pointer; ALength: cardinal; var Result: string);
+  public
+    constructor Create(AParser: TtiRtfParser); overload;
+    procedure Evaluate;
+    function Check(AParam: integer; ATokens: TRtfTokenSet): boolean; overload;
+    function Check(ATokens: array of TRtfTokenSet): boolean; overload;
+    procedure ParseExpression(AExpression: string); virtual;
+
+    property Parser: TtiRtfParser read FParser;
+    property Parent: TRtfArgument read FParent; //Parent argument list
+    property Value: variant read FValue write FValue; //Argument value
+    property Param: integer read FParam write FParam; //Just for Scan(Dataset)
+    property Token: TRtfToken read FToken write FToken; //Argument type
+    property Items[Index: integer]: TRtfArgument read GetItem; default;
+  end;
+
+
+  //Color definition
+  TRtfColor = class(TObject)
+  private
+    FBlue: integer;
+    FRed: integer;
+    FGreen: integer;
+    function GetAsString: string;
+  public
+    property Red: integer read FRed write FRed;
+    property Green: integer read FGreen write FGreen;
+    property Blue: integer read FBlue write FBlue;
+    property AsString: string read GetAsString;
+  end;
+
+
+  TRtfColorList = class(TObjectlist)
+  private
+    function GetItem(Index: integer): TRtfColor;
+    function GetAsString: string;
+  public
+    property AsString: string read GetAsString;
+    procedure Clear; override;
+    function UseColor(AColor: TColor): integer; overload;
+    function Add(ARed, AGreen, ABlue: integer): integer;
+    function Find(ARed, AGreen, ABlue: integer): integer;
+    function UseColor(ARed, AGreen, ABlue: integer): integer; overload;
+    property Items[Index: integer]: TRtfColor read GetItem; default;
+  end;
+
+
+  //Parser definition
+  TtiRtfParser = class(TObject)
+  private
+    FBoolTrue: string;
+    FBoolFalse: string;
+    FHlpItems: TRtfItem;
+    TmpItems: TObjectlist;
+    FDatasets: TRtfDataset;
+    FRtfItems: TRtfItemList;
+    FErrorBackColor: TColor;
+    FErrorForeColor: TColor;
+    FRawItems: TRtfItemList;
+    FColorList: TRtfColorList;
+    FFunctions: TRtfFunctionList;
+    FVariables: TRtfVariableList;
+    FOnPicturePath: TRtfPicturePath;
+    FOnPictureAttr: TRtfOnPictureAttr;
+    FOnEvalutate: TRtfFunctionExecute;
+    FPictureOptions: TRtfPictureOptions;
+    FOnCreateDataset: TRtfOnCreateDataset;
+    procedure PreParse;
+    procedure Parse(AItems: TRtfItem);
+    procedure ParseExpression(AItem: TRtfItem);
+    function AddToRtfItems(AItem: TRtfItem): TRtfItem;
+    function SkipParagraph(AItem: TRtfItem): TRtfItem;
+    procedure UdfDateTimeTo(AArgument: TRtfArgument; AFormat: string);
+  protected
+    procedure AddFunctions; virtual;
+    procedure UdfDummy(AArgument: TRtfArgument);
+
+    //routines for date time
+    procedure UdfNow(AArgument: TRtfArgument);
+    procedure UdfDate(AArgument: TRtfArgument);
+    procedure UdfTime(AArgument: TRtfArgument);
+    procedure UdfYear(AArgument: TRtfArgument);
+    procedure UdfMonth(AArgument: TRtfArgument);
+    procedure UdfDay(AArgument: TRtfArgument);
+    procedure UdfShortDayName(AArgument: TRtfArgument);
+    procedure UdfShortMonthName(AArgument: TRtfArgument);
+    procedure UdfLongDayName(AArgument: TRtfArgument);
+    procedure UdfLongMonthName(AArgument: TRtfArgument);
+    procedure UdfSYear(AArgument: TRtfArgument);
+    procedure UdfSMonth(AArgument: TRtfArgument);
+    procedure UdfSDay(AArgument: TRtfArgument);
+    procedure UdfStod(AArgument: TRtfArgument);
+    procedure UdfDtos(AArgument: TRtfArgument);
+    procedure UdfDateToStr(AArgument: TRtfArgument);
+    procedure UdfTimeToStr(AArgument: TRtfArgument);
+    procedure UdfDateTimeToStr(AArgument: TRtfArgument);
+    procedure UdfStrToDate(AArgument: TRtfArgument);
+    procedure UdfStrToTime(AArgument: TRtfArgument);
+    procedure UdfStrToDateTime(AArgument: TRtfArgument);
+
+    //routines for strings, int, float etc.
+    procedure UdfInt(AArgument: TRtfArgument);
+    procedure UdfStr(AArgument: TRtfArgument);
+    procedure UdfVal(AArgument: TRtfArgument);
+    procedure UdfChr(AArgument: TRtfArgument);
+    procedure UdfNul(AArgument: TRtfArgument);
+    procedure UdfFrac(AArgument: TRtfArgument);
+    procedure UdfEmpty(AArgument: TRtfArgument);
+    procedure UdfPadr(AArgument: TRtfArgument);
+    procedure UdfPadl(AArgument: TRtfArgument);
+    procedure UdfLower(AArgument: TRtfArgument);
+    procedure UdfUpper(AArgument: TRtfArgument);
+    procedure UdfTrunc(AArgument: TRtfArgument);
+    procedure UdfRound(AArgument: TRtfArgument);
+    procedure UdfTrim(AArgument: TRtfArgument);
+    procedure UdfPower(AArgument: TRtfArgument);
+    procedure UdfIntPower(AArgument: TRtfArgument);
+    procedure UdfTrimLeft(AArgument: TRtfArgument);
+    procedure UdfTrimRight(AArgument: TRtfArgument);
+    procedure UdfSubStr(AArgument: TRtfArgument);
+    procedure UdfIntToStr(AArgument: TRtfArgument);
+    procedure UdfStrToInt(AArgument: TRtfArgument);
+    procedure UdfFloatToStr(AArgument: TRtfArgument);
+    procedure UdfStrToFloat(AArgument: TRtfArgument);
+    procedure UdfFormatFloat(AArgument: TRtfArgument);
+    procedure UdfFBool(AArgument: TRtfArgument);
+
+    //routines for conditinals
+    procedure UdfIf(AArgument: TRtfArgument);
+    procedure UdfIif(AArgument: TRtfArgument);
+
+    //routines for datasets
+    procedure UdfDataset(AArgument: TRtfArgument);
+    procedure UdfScan(AArgument: TRtfArgument);
+    procedure UdfBof(AArgument: TRtfArgument);
+    procedure UdfEof(AArgument: TRtfArgument);
+    procedure UdfNext(AArgument: TRtfArgument);
+    procedure UdfPrior(AArgument: TRtfArgument);
+    procedure UdfFirst(AArgument: TRtfArgument);
+    procedure UdfLast(AArgument: TRtfArgument);
+    procedure UdfOpen(AArgument: TRtfArgument);
+    procedure UdfIsEmpty(AArgument: TRtfArgument);
+    procedure UdfRecordCount(AArgument: TRtfArgument);
+
+    //misch routines
+    procedure UdfPicture(AArgument: TRtfArgument);
+    procedure UdfDbPicture(AArgument: TRtfArgument);
+  public
+    constructor Create; virtual;
+    destructor Destroy; override;
+
+    procedure Clear;
+    procedure Execute; virtual;
+
+    procedure LoadFromFile(AFilename: string);
+    procedure LoadFromString(AString: string);
+    procedure LoadFromStream(AStream: TMemoryStream);
+    procedure LoadFromBuffer(ABuffer: pchar; ASize: integer);
+
+    function SaveToString: string;
+    procedure SaveToFile(AFileName: string);
+    procedure SaveToStream(AStream: TMemoryStream);
+
+    function AddVariable(AName: string; AValue: variant; AToken: TRtfToken): TRtfVariable;
+    function AddDataset(ATable: TObject; AName: string; AFreeDataset: boolean = false): TRtfDataset;
+    function AddFunction(AName: string; ATokenType: TRtfToken; AMin, AMax: smallint; AOnexecute: TRtfFunctionExecute): TRtfFunction;
+
+
+    //these should all be hidden in component style
+    property RawItems: TRtfItemList read FRawItems;
+    property HlpItems: TRtfItem read FHlpItems;
+    property RtfItems: TRtfItemList read FRtfItems;
+    property Datasets: TRtfDataset read FDatasets;
+    property Functions: TRtfFunctionList read FFunctions;
+    property Variables: TRtfVariableList read FVariables;
+    property ColorList: TRtfColorList read FColorList;
+    property OnEvalutate: TRtfFunctionExecute read FOnEvalutate write FOnEvalutate; //For debug only
+  published
+    property BoolTrue: string read FBoolTrue write FBoolTrue;
+    property BoolFalse: string read FBoolFalse write FBoolFalse;
+    property ErrorForeColor: TColor read FErrorForeColor write FErrorForeColor default clRed;
+    property ErrorBackColor: TColor read FErrorBackColor write FErrorBackColor default clYellow;
+    property PictureOptions: TRtfPictureOptions read FPictureOptions write FPictureOptions default[poMetafile, poBinary];
+
+    property OnPicturePath: TRtfPicturePath read FOnPicturePath write FOnPicturePath;
+    property OnPictureAttr: TRtfOnPictureAttr read FOnPictureAttr write FOnPictureAttr;
+    property OnCreateDataset: TRtfOnCreateDataset read FOnCreateDataset write FOnCreateDataset;
+  end;
+
+implementation
+
+uses
+  math        // IntPower() function
+  ,fpgfx      // fpgApplication.HandleExeception()
+  ;
+
+resourcestring
+  rsNotImplemented = 'Not implemented';
+  rsInvalidDateConstant = 'Invalid date constant';
+  rsInvalidTimeConstant = 'Invalid time constant';
+  rsInvalidDateSeparator = 'Invalid date separator';
+  rsInvalidTimeSeparator = 'Invalid time separator';
+  rsInvalidDateTimeConstant = 'Invalid date/time constant';
+  rsInvalidExpressionCharacter = 'Invalid expression character "%s"';
+  rsUnterminatedStringConstant = 'Unterminated string constant';
+  rsToManyClosingParenthesis = 'Unexpected parenthesis';
+  rsExpectedClosingParenthesis = 'Missing closing parenthesis';
+  rsUnexpectedParameterType = 'Unexpected parameter type';
+
+type
+  TRtfKey = record
+    RtfKMajor: integer;
+    RtfKMinor: integer;
+    RtfKStr: string;
+  end;
+
+
+  TRawRtfParser = class(TObject)
+  private
+    APtr, AEnd: pchar;
+    APushedChar: char;
+    FRtfMajor: integer;
+    FRtfMinor: integer;
+    FRtfTextBuf: string;
+    AParseItem: TRtfItem;
+    FRtfClass: TRtfClass;
+    FColorTable: TRtfItem;
+    RawItems: TRtfItemList;
+    procedure RtfHook;
+    procedure GetRtfToken;
+    function GetRtfChar: char;
+  protected
+    property RtfClass: TRtfClass read FRtfClass;
+    property RtfMajor: integer read FRtfMajor;
+    property RtfMinor: integer read FRtfMinor;
+    property RtfTextBuf: string read FRtfTextBuf;
+  public
+    procedure Execute(ARawItems: TRtfItemList; ARtfPtr: pchar; ARtfSize: integer);
+
+    property ColorTable: TRtfItem read FColorTable;
+  end;
+
+
+
+const
+  {@indent off}
+  //Control class major numbers
+  //RtfVersion            = 01;
+  //RtfDefFont            = 02;
+  //RtfCharSet            = 03;
+  RtfDestination        = 04;
+  //RtfFontFamily         = 05;
+  //RtfColorName          = 06;
+  RtfSpecialChar        = 07;
+  //RtfStyleAttr          = 08;
+  //RtfDocAttr            = 09;
+  //RtfSectAttr           = 10;
+  //RtfTblAttr            = 11;
+  RtfParAttr            = 12;
+  //RtfCharAttr           = 13;
+  //RtfPictAttr           = 14;
+  //RtfNeXTGrAttr         = 15;
+  //RtfFieldAttr          = 16;
+  //RtfTOCAttr            = 17;
+  //RtfPosAttr            = 18;
+
+  //RtfExpression major numbers
+  RtfNormalExpression   = 1;
+  RtfIfExpression       = 2;
+  RtfThenExpression     = 3;
+  RtfElseExpression     = 4;
+  RtfEndifExpression    = 5;
+  RtfScan               = 6;
+  RtfScanEntry          = 7;
+  RtfScanFooter         = 8;
+  RtfScanEnd            = 9;
+
+  //Group class major numbers
+  RtfBeginGroup         = 01;
+  RtfEndGroup           = 02;
+
+  //Control class minor numbers
+  {RtfAnsiCharSet = 0;
+  RtfMacCharSet = 1;
+  RtfPcCharSet = 2;
+  RtfPcaCharSet = 3;}
+
+
+  //Destination attributes minor numbers
+  {RtfPict = 0;
+  RtfNeXTGraphic = 1;
+  RtfFootnote = 2;
+  RtfHeader = 3;
+  RtfHeaderLeft = 4;
+  RtfHeaderRight = 5;
+  RtfHeaderFirst = 6;
+  RtfFooter = 7;
+  RtfFooterLeft = 8;
+  RtfFooterRight = 9;
+  RtfFooterFirst = 10;
+  RtfFNSep = 11;
+  RtfFNContSep = 12;
+  RtfFNContNotice = 13;}
+  RtfInfo = 14;
+  RtfStyleSheet = 15;
+  RtfFontTbl = 16;
+  RtfColorTbl = 17;
+  RtfField = 18;
+  {RtfFieldInst = 19;
+  RtfFieldResult = 20;
+  RtfIndex = 21;
+  RtfIndexBold = 22;
+  RtfIndexItalic = 23;
+  RtfIndexText = 24;
+  RtfIndexRange = 25;
+  RtfTOC = 26;
+  RtfBookmarkStart = 27;
+  RtfBookmarkEnd = 28;
+  RtfITitle = 29;
+  RtfISubject = 30;
+  RtfIAuthor = 31;
+  RtfIOperator = 32;
+  RtfIKeywords = 33;
+  RtfIComment = 34;
+  RtfIVersion = 35;
+  RtfIDoccomm = 36;}
+
+  //Fonts minor numbers
+  {RtfFFNil = 0;
+  RtfFFRoman = 1;
+  RtfFFSwiss = 2;
+  RtfFFModern = 3;
+  RtfFFScript = 4;
+  RtfFFDecor = 5;
+  RtfFFTech = 6;}
+
+  //Color attributes minor numbers
+  {RtfRed = 0;
+  RtfGreen = 1;
+  RtfBlue = 2;}
+
+  //Style attributes minor numbers
+  {RtfBasedOn = 0;
+  RtfNext = 1;}
+
+  //Special characters minor numbers
+  {RtfCurHeadPage = 0;
+  RtfCurFNote = 1;
+  RtfCurHeadPict = 2;
+  RtfCurHeadDate = 3;
+  RtfCurHeadTime = 4;}
+  RtfFormula = 5;
+  RtfNoBrkSpace = 6;
+  RtfNoReqHyphen = 7;
+  RtfNoBrkHyphen = 8;
+  {RtfPage = 9;
+  RtfLine = 10;}
+  RtfPar = 11;
+  {RtfSect = 12;}
+  RtfTab = 13;
+  {RtfCell = 14;
+  RtfRow = 15;
+  RtfCurAnnot = 16;
+  RtfAnnotation = 17;
+  RtfAnnotID = 18;
+  RtfCurAnnotRef = 19;
+  RtfFNoteSep = 20;
+  RtfFNoteCont = 21;
+  RtfColumn = 22;}
+  RtfOptDest = 23;
+  {RtfIIntVersion = 24;
+  RtfICreateTime = 25;
+  RtfIRevisionTime = 26;
+  RtfIPrintTime = 27;
+  RtfIBackupTime = 28;
+  RtfIEditTime = 29;
+  RtfIYear = 30;
+  RtfIMonth = 31;
+  RtfIDay = 32;
+  RtfIHour = 33;
+  RtfIMinute = 34;
+  RtfINPages = 35;
+  RtfINWords = 36;
+  RtfINChars = 37;
+  RtfIIntID = 38;}
+  RtflQuote = 39;
+  RtfrQuote = 40;
+  RtflDblQuote = 41;
+  RtfrDblQuote = 42;
+
+
+  //Document atributes minor numbers
+  {RtfPaperWidth = 0;
+  RtfPaperHeight = 1;
+  RtfLeftMargin = 2;
+  RtfRightMargin = 3;
+  RtfTopMargin = 4;
+  RtfBottomMargin = 5;
+  RtfFacingPage = 6;
+  RtfGutterWid = 7;
+  RtfDefTab = 8;
+  RtfWidowCtrl = 9;
+  RtfHyphHotZone = 10;
+  RtfFNoteEndSect = 11;
+  RtfFNoteEndDoc = 12;
+  RtfFNoteText = 13;
+  RtfFNoteBottom = 14;
+  RtfFNoteStart = 15;
+  RtfFNoteRestart = 16;
+  RtfPageStart = 17;
+  RtfLineStart = 18;
+  RtfLandscape = 19;
+  RtfFracWidth = 20;
+  RtfNextFile = 21;
+  RtfTemplate = 22;
+  RtfMakeBackup = 23;
+  RtfRtfDefault = 24;
+  RtfRevisions = 25;
+  RtfMirrorMargin = 26;
+  RtfRevDisplay = 27;
+  RtfRevBar = 28;}
+
+  //Sector attributes minor numbers
+  {RtfSectDef = 0;
+  RtfNoBreak = 1;
+  RtfColBreak = 2;
+  RtfPageBreak = 3;
+  RtfEvenBreak = 4;
+  RtfOddBreak = 5;
+  RtfPageStarts = 6;
+  RtfPageCont = 7;
+  RtfPageRestart = 8;
+  RtfPageDecimal = 9;
+  RtfPageURoman = 10;
+  RtfPageLRoman = 11;
+  RtfPageULetter = 12;
+  RtfPageLLetter = 13;
+  RtfPageNumLeft = 14;
+  RtfPageNumTop = 15;
+  RtfHeaderY = 16;
+  RtfFooterY = 17;
+  RtfLineModulus = 18;
+  RtfLineDist = 19;
+  RtfLineStarts = 20;
+  RtfLineRestart = 21;
+  RtfLineRestartPg = 22;
+  RtfLineCont = 23;
+  RtfTopVAlign = 24;
+  RtfBottomVAlign = 25;
+  RtfCenterVAlign = 26;
+  RtfJustVAlign = 27;
+  RtfColumns = 28;
+  RtfColumnSpace = 29;
+  RtfColumnLine = 30;
+  RtfENoteHere = 31;
+  RtfTitleSpecial = 32;}
+
+  //Table attributes minor numbers
+  {RtfCellBordBottom = 0;
+  RtfCellBordTop = 1;
+  RtfCellBordLeft = 2;
+  RtfCellBordRight = 3;
+  RtfRowDef = 4;
+  RtfRowLeft = 5;
+  RtfRowRight = 6;
+  RtfRowCenter = 7;
+  RtfRowGapH = 8;
+  RtfRowHt = 9;
+  RtfRowLeftEdge = 10;
+  RtfCellPos = 11;
+  RtfMergeRngFirst = 12;
+  RtfMergePrevious = 13;}
+
+  //Paragrapgh attributes minor numbers
+  RtfParDef = 0;
+  {RtfStyleNum = 1;
+  RtfQuadLeft = 2;
+  RtfQuadRight = 3;
+  RtfQuadJust = 4;
+  RtfQuadCenter = 5;
+  RtfFirstIndent = 6;
+  RtfLeftIndent = 7;
+  RtfRightIndent = 8;
+  RtfSpaceBefore = 9;
+  RtfSpaceAfter = 10;
+  RtfSpaceBetween = 11;
+  RtfInTable = 12;
+  RtfKeep = 13;
+  RtfKeepNext = 14;
+  RtfSideBySide = 15;
+  RtfPBBefore = 16;
+  RtfNoLineNum = 17;
+  RtfTabPos = 18;
+  RtfTabRight = 19;
+  RtfTabCenter = 20;
+  RtfTabDecimal = 21;
+  RtfTabBar = 22;
+  RtfBorderTop = 23;
+  RtfBorderBottom = 24;
+  RtfBorderLeft = 25;
+  RtfBorderRight = 26;
+  RtfBorderBox = 27;
+  RtfBorderBar = 28;
+  RtfBorderBetween = 29;
+  RtfBorderSingle = 30;
+  RtfBorderThick = 31;
+  RtfBorderShadow = 32;
+  RtfBorderDouble = 33;
+  RtfBorderDot = 34;
+  RtfBorderHair = 35;
+  RtfBorderSpace = 36;
+  RtfLeaderDot = 37;
+  RtfLeaderHyphen = 38;
+  RtfLeaderUnder = 39;
+  RtfLeaderThick = 40;}
+
+  //Character attributes minor numbers
+  {RtfPlain = 0;
+  RtfBold = 1;
+  RtfItalic = 2;
+  RtfStrikeThru = 3;
+  RtfOutline = 4;
+  RtfShadow = 5;
+  RtfSmallCaps = 6;
+  RtfAllCaps = 7;
+  RtfInvisible = 8;
+  RtfFontNum = 9;
+  RtfFontSize = 10;
+  RtfExpand = 11;
+  RtfUnderline = 12;
+  RtfWUnderline = 13;
+  RtfDUnderline = 14;
+  RtfDbUnderline = 15;
+  RtfNoUnderline = 16;
+  RtfSuperScript = 17;
+  RtfSubScript = 18;
+  RtfRevised = 19;
+  RtfForeColor = 20;
+  RtfBackColor = 21;
+  RtfGray = 22; }
+
+  //Picture attributes minor numbers
+  {RtfMacQD = 0;
+  RtfWinMetafile = 1;
+  RtfWinBitmap = 2;
+  RtfPicWid = 3;
+  RtfPicHt = 4;
+  RtfPicGoalWid = 5;
+  RtfPicGoalHt = 6;
+  RtfPicScaleX = 7;
+  RtfPicScaleY = 8;
+  RtfPicScaled = 9;
+  RtfPicCropTop = 10;
+  RtfPicCropBottom = 11;
+  RtfPicCropLeft = 12;
+  RtfPicCropRight = 13;
+  RtfPixelBits = 14;
+  RtfBitmapPlanes = 15;
+  RtfBitmapWid = 16;
+  RtfPicBinary = 17;}
+
+  //
+  {RtfNeXTGWidth = 0;
+  RtfNeXTGHeight = 1;}
+
+  //Field attributes minor numbers
+  {RtfFieldDirty = 0;
+  RtfFieldEdited = 1;
+  RtfFieldLocked = 2;
+  RtfFieldPrivate = 3;}
+
+  //Toc attributes minor numbers
+  {RtfTOCType = 0;
+  RtfTOCLevel = 1;}
+
+  //Position attributes minor numbers
+  {RtfPosX = 0;
+  RtfPosXCenter = 1;
+  RtfPosXInside = 2;
+  RtfPosXLeft = 3;
+  RtfPosXOutSide = 4;
+  RtfPosXRight = 5;
+  RtfPosY = 6;
+  RtfPosYInline = 7;
+  RtfPosYTop = 8;
+  RtfPosYCenter = 9;
+  RtfPosYBottom = 10;
+  RtfAbsWid = 11;
+  RtfTextDist = 12;
+  RtfRPosMargV = 13;
+  RtfRPosPageV = 14;
+  RtfRPosMargH = 15;
+  RtfRPosPageH = 16;
+  RtfRPosColH = 17;}
+
+const
+  //A reduced set of control words
+  RtfKey: array[0..15]of TRtfKey =
+  (
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfParDef;         RtfKStr: '\pard'         ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfPar;            RtfKStr: '\par'          ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfTab;            RtfKStr: '\tab'          ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtflQuote;         RtfKStr: '\lquote'       ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfrQuote;         RtfKStr: '\rquote'       ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtflQuote;         RtfKStr: '\'+Chr(39)+'91'),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfrQuote;         RtfKStr: '\'+Chr(39)+'92'),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtflDblQuote;      RtfKStr: '\ldblquote'    ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfrDblQuote;      RtfKStr: '\rdblquote'    ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtflDblQuote;      RtfKStr: '\'+Chr(39)+'93'),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfrDblQuote;      RtfKStr: '\'+Chr(39)+'94'),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfInfo;           RtfKStr: '\info'         ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfStyleSheet;     RtfKStr: '\stylesheet'   ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfFontTbl;        RtfKStr: '\fonttbl'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfColorTbl;       RtfKStr: '\colortbl'     ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfField;          RtfKStr: '\field'        )
+  );
+
+  {  You could also add the following (but i don't need all that):
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurHeadPict;    RtfKStr: '\chpict'       ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurHeadDate;    RtfKStr: '\chdate'       ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurHeadTime;    RtfKStr: '\chtime'       ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurHeadPage;    RtfKStr: '\chpgn'        ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurFNote;       RtfKStr: '\chftn'        ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCurAnnotRef;    RtfKStr: '\chatn'        ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfFNoteSep;       RtfKStr: '\chftnsep'     ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfFNoteCont;      RtfKStr: '\chftnsepc'    ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfCell;           RtfKStr: '\cell'         ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfRow;            RtfKStr: '\row'          ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfSect;           RtfKStr: '\sect'         ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfPage;           RtfKStr: '\page'         ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfColumn;         RtfKStr: '\column'       ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfLine;           RtfKStr: '\line'         ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIIntVersion;    RtfKStr: '\vern'         ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfICreateTime;    RtfKStr: '\creatim'      ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIRevisionTime;  RtfKStr: '\revtim'       ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIPrintTime;     RtfKStr: '\printim'      ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIBackupTime;    RtfKStr: '\buptim'       ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIEditTime;      RtfKStr: '\edmins'       ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIYear;          RtfKStr: '\yr'           ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIMonth;         RtfKStr: '\mo'           ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIDay;           RtfKStr: '\dy'           ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIHour;          RtfKStr: '\hr'           ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIMinute;        RtfKStr: '\min'          ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfINPages;        RtfKStr: '\nofpages'     ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfINWords;        RtfKStr: '\nofwords'     ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfINChars;        RtfKStr: '\nofchars'     ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfIIntID;         RtfKStr: '\id'           ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfPict;           RtfKStr: '\pict'         ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfNeXTGraphic;    RtfKStr: '\nextgraphic'  ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfFootnote;       RtfKStr: '\footnote'     ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfHeader;         RtfKStr: '\header'       ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfHeaderLeft;     RtfKStr: '\headerl'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfHeaderRight;    RtfKStr: '\headerr'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfHeaderFirst;    RtfKStr: '\headerf'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfFooter;         RtfKStr: '\footer'       ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfFooterLeft;     RtfKStr: '\footerl'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfFooterRight;    RtfKStr: '\footerr'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfFooterFirst;    RtfKStr: '\footerf'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfFNSep;          RtfKStr: '\ftnsep'       ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfFNContSep;      RtfKStr: '\ftnsepc'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfFNContNotice;   RtfKStr: '\ftncn'        ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfAnnotation;     RtfKStr: '\annotation'   ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfAnnotID;        RtfKStr: '\atnid'        ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfFieldInst;      RtfKStr: '\fldinst'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfFieldResult;    RtfKStr: '\fldrslt'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfIndex;          RtfKStr: '\xe'           ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfIndexBold;      RtfKStr: '\bxe'          ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfIndexItalic;    RtfKStr: '\ixe'          ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfIndexText;      RtfKStr: '\txe'          ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfIndexRange;     RtfKStr: '\rxe'          ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfTOC;            RtfKStr: '\tc'           ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfBookmarkStart;  RtfKStr: '\bkmkstart'    ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfBookmarkEnd;    RtfKStr: '\bkmkend'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfITitle;         RtfKStr: '\title'        ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfISubject;       RtfKStr: '\subject'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfIAuthor;        RtfKStr: '\author'       ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfIOperator;      RtfKStr: '\operator'     ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfIKeywords;      RtfKStr: '\keywords'     ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfIComment;       RtfKStr: '\comment'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfIVersion;       RtfKStr: '\version'      ),
+    (RtfKMajor: RtfDestination; RtfKMinor: RtfIDoccomm;       RtfKStr: '\doccomm'      ),
+    (RtfKMajor: RtfVersion;     RtfKMinor: - 1;               RtfKStr: '\rtf'          ),
+    (RtfKMajor: RtfDefFont;     RtfKMinor: - 1;               RtfKStr: '\deff'         ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfStyleNum;       RtfKStr: '\s'            ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfQuadLeft;       RtfKStr: '\ql'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfQuadRight;      RtfKStr: '\qr'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfQuadJust;       RtfKStr: '\qj'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfQuadCenter;     RtfKStr: '\qc'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfFirstIndent;    RtfKStr: '\fi'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfLeftIndent;     RtfKStr: '\li'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfRightIndent;    RtfKStr: '\ri'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfSpaceBefore;    RtfKStr: '\sb'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfSpaceAfter;     RtfKStr: '\sa'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfSpaceBetween;   RtfKStr: '\sl'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfInTable;        RtfKStr: '\intbl'        ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfKeep;           RtfKStr: '\keep'         ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfKeepNext;       RtfKStr: '\keepn'        ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfSideBySide;     RtfKStr: '\sbys'         ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfPBBefore;       RtfKStr: '\pagebb'       ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfNoLineNum;      RtfKStr: '\noline'       ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfTabPos;         RtfKStr: '\tx'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfTabRight;       RtfKStr: '\tqr'          ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfTabCenter;      RtfKStr: '\tqc'          ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfTabDecimal;     RtfKStr: '\tqdec'        ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfTabBar;         RtfKStr: '\tb'           ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderTop;      RtfKStr: '\brdrt'        ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderBottom;   RtfKStr: '\brdrb'        ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderLeft;     RtfKStr: '\brdrl'        ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderRight;    RtfKStr: '\brdrr'        ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderBar;      RtfKStr: '\bar'          ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderBox;      RtfKStr: '\box'          ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderBetween;  RtfKStr: '\brdrbtw'      ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderSingle;   RtfKStr: '\brdrs'        ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderThick;    RtfKStr: '\brdrth'       ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderShadow;   RtfKStr: '\brdrsh'       ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderDouble;   RtfKStr: '\brdrdb'       ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderDot;      RtfKStr: '\brdrdot'      ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderHair;     RtfKStr: '\brdrhair'     ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfLeaderDot;      RtfKStr: '\tldot'        ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfLeaderHyphen;   RtfKStr: '\tlhyph'       ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfLeaderUnder;    RtfKStr: '\tlul'         ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfLeaderThick;    RtfKStr: '\tlth'         ),
+    (RtfKMajor: RtfParAttr;     RtfKMinor: RtfBorderSpace;    RtfKStr: '\brsp'         ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfCellBordBottom; RtfKStr: '\clbrdrb'      ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfCellBordTop;    RtfKStr: '\clbrdrt'      ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfCellBordLeft;   RtfKStr: '\clbrdrl'      ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfCellBordRight;  RtfKStr: '\clbrdrr'      ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfRowDef;         RtfKStr: '\trowd'        ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfRowLeft;        RtfKStr: '\trql'         ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfRowRight;       RtfKStr: '\trqr'         ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfRowCenter;      RtfKStr: '\trqc'         ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfRowGapH;        RtfKStr: '\trgaph'       ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfRowHt;          RtfKStr: '\trrh'         ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfRowLeftEdge;    RtfKStr: '\trleft'       ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfCellPos;        RtfKStr: '\cellx'        ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfMergeRngFirst;  RtfKStr: '\clmgf'        ),
+    (RtfKMajor: RtfTblAttr;     RtfKMinor: RtfMergePrevious;  RtfKStr: '\clmrg'        ),
+    (RtfKMajor: RtfTOCAttr;     RtfKMinor: RtfTOCType;        RtfKStr: '\tcf'          ),
+    (RtfKMajor: RtfTOCAttr;     RtfKMinor: RtfTOCLevel;       RtfKStr: '\tcl'          ),
+    (RtfKMajor: RtfFontFamily;  RtfKMinor: RtfFFNil;          RtfKStr: '\fnil'         ),
+    (RtfKMajor: RtfFontFamily;  RtfKMinor: RtfFFRoman;        RtfKStr: '\froman'       ),
+    (RtfKMajor: RtfFontFamily;  RtfKMinor: RtfFFSwiss;        RtfKStr: '\fswiss'       ),
+    (RtfKMajor: RtfFontFamily;  RtfKMinor: RtfFFModern;       RtfKStr: '\fmodern'      ),
+    (RtfKMajor: RtfFontFamily;  RtfKMinor: RtfFFScript;       RtfKStr: '\fscript'      ),
+    (RtfKMajor: RtfFontFamily;  RtfKMinor: RtfFFDecor;        RtfKStr: '\fdecor'       ),
+    (RtfKMajor: RtfFontFamily;  RtfKMinor: RtfFFTech;         RtfKStr: '\ftech'        ),
+    (RtfKMajor: RtfCharSet;     RtfKMinor: RtfMacCharSet;     RtfKStr: '\mac'          ),
+    (RtfKMajor: RtfCharSet;     RtfKMinor: RtfAnsiCharSet;    RtfKStr: '\ansi'         ),
+    (RtfKMajor: RtfCharSet;     RtfKMinor: RtfPcCharSet;      RtfKStr: '\pc'           ),
+    (RtfKMajor: RtfCharSet;     RtfKMinor: RtfPcaCharSet;     RtfKStr: '\pca'          ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfPlain;          RtfKStr: '\plain'        ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfBold;           RtfKStr: '\b'            ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfItalic;         RtfKStr: '\i'            ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfStrikeThru;     RtfKStr: '\strike'       ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfOutline;        RtfKStr: '\outl'         ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfShadow;         RtfKStr: '\shad'         ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfSmallCaps;      RtfKStr: '\scaps'        ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfAllCaps;        RtfKStr: '\caps'         ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfInvisible;      RtfKStr: '\v'            ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfFontNum;        RtfKStr: '\f'            ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfFontSize;       RtfKStr: '\fs'           ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfExpand;         RtfKStr: '\expnd'        ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfUnderline;      RtfKStr: '\ul'           ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfWUnderline;     RtfKStr: '\ulw'          ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfDUnderline;     RtfKStr: '\uld'          ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfDbUnderline;    RtfKStr: '\uldb'         ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfNoUnderline;    RtfKStr: '\ulnone'       ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfSuperScript;    RtfKStr: '\up'           ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfSubScript;      RtfKStr: '\dn'           ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfRevised;        RtfKStr: '\revised'      ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfForeColor;      RtfKStr: '\cf'           ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfBackColor;      RtfKStr: '\cb'           ),
+    (RtfKMajor: RtfCharAttr;    RtfKMinor: RtfGray;           RtfKStr: '\gray'         ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfFormula;        RtfKStr: '\|'            ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfNoBrkSpace;     RtfKStr: '\~'            ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfNoReqHyphen;    RtfKStr: '\-'            ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfNoBrkHyphen;    RtfKStr: '\_'            ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfOptDest;        RtfKStr: '\*'            ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfPar;            RtfKstr: #10             ),
+    (RtfKMajor: RtfSpecialChar; RtfKMinor: RtfPar;            RtfKstr: #13             ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfPosX;           RtfKStr: '\posx'         ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfPosXCenter;     RtfKStr: '\posxc'        ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfPosXInside;     RtfKStr: '\posxi'        ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfPosXLeft;       RtfKStr: '\posxl'        ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfPosXOutSide;    RtfKStr: '\posxo'        ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfPosXRight;      RtfKStr: '\posxr'        ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfPosY;           RtfKStr: '\posy'         ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfPosYInline;     RtfKStr: '\posyil'       ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfPosYTop;        RtfKStr: '\posyt'        ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfPosYCenter;     RtfKStr: '\posyc'        ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfPosYBottom;     RtfKStr: '\posyb'        ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfAbsWid;         RtfKStr: '\absw'         ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfTextDist;       RtfKStr: '\dxfrtext'     ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfRPosMargV;      RtfKStr: '\pvmrg'        ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfRPosPageV;      RtfKStr: '\pvpg'         ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfRPosMargH;      RtfKStr: '\phmrg'        ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfRPosPageH;      RtfKStr: '\phpg'         ),
+    (RtfKMajor: RtfPosAttr;     RtfKMinor: RtfRPosColH;       RtfKStr: '\phcol'        ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfSectDef;        RtfKStr: '\sectd'        ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfNoBreak;        RtfKStr: '\sbknone'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfColBreak;       RtfKStr: '\sbkcol'       ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfPageBreak;      RtfKStr: '\sbkpage'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfEvenBreak;      RtfKStr: '\sbkeven'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfOddBreak;       RtfKStr: '\sbkodd'       ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfPageCont;       RtfKStr: '\pgncont'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfPageStarts;     RtfKStr: '\pgnstarts'    ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfPageRestart;    RtfKStr: '\pgnrestart'   ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfPageDecimal;    RtfKStr: '\pgndec'       ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfPageURoman;     RtfKStr: '\pgnucrm'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfPageLRoman;     RtfKStr: '\pgnlcrm'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfPageULetter;    RtfKStr: '\pgnucltr'     ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfPageLLetter;    RtfKStr: '\pgnlcltr'     ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfPageNumLeft;    RtfKStr: '\pgnx'         ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfPageNumTop;     RtfKStr: '\pgny'         ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfHeaderY;        RtfKStr: '\headery'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfFooterY;        RtfKStr: '\footery'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfLineModulus;    RtfKStr: '\linemod'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfLineDist;       RtfKStr: '\linex'        ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfLineStarts;     RtfKStr: '\linestarts'   ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfLineRestart;    RtfKStr: '\linerestart'  ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfLineRestartPg;  RtfKStr: '\lineppage'    ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfLineCont;       RtfKStr: '\linecont'     ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfTopVAlign;      RtfKStr: '\vertalt'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfBottomVAlign;   RtfKStr: '\vertal'       ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfCenterVAlign;   RtfKStr: '\vertalc'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfJustVAlign;     RtfKStr: '\vertalj'      ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfColumns;        RtfKStr: '\cols'         ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfColumnSpace;    RtfKStr: '\colsx'        ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfColumnLine;     RtfKStr: '\linebetcol'   ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfENoteHere;      RtfKStr: '\endnhere'     ),
+    (RtfKMajor: RtfSectAttr;    RtfKMinor: RtfTitleSpecial;   RtfKStr: '\titlepg'      )
+    (RtfKMajor: RtfFieldAttr;   RtfKMinor: RtfFieldDirty;     RtfKStr: '\flddirty'     ),
+    (RtfKMajor: RtfFieldAttr;   RtfKMinor: RtfFieldEdited;    RtfKStr: '\fldedit'      ),
+    (RtfKMajor: RtfFieldAttr;   RtfKMinor: RtfFieldLocked;    RtfKStr: '\fldlock'      ),
+    (RtfKMajor: RtfFieldAttr;   RtfKMinor: RtfFieldPrivate;   RtfKStr: '\fldpriv'      ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfPaperWidth;     RtfKStr: '\paperw'       ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfPaperHeight;    RtfKStr: '\paperh'       ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfLeftMargin;     RtfKStr: '\margl'        ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfRightMargin;    RtfKStr: '\margr'        ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfTopMargin;      RtfKStr: '\margt'        ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfBottomMargin;   RtfKStr: '\margb'        ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfFacingPage;     RtfKStr: '\facingp'      ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfGutterWid;      RtfKStr: '\gutter'       ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfDefTab;         RtfKStr: '\deftab'       ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfWidowCtrl;      RtfKStr: '\widowctrl'    ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfHyphHotZone;    RtfKStr: '\hyphhotz'     ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfFNoteEndSect;   RtfKStr: '\endnotes'     ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfFNoteEndDoc;    RtfKStr: '\enddoc'       ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfFNoteBottom;    RtfKStr: '\ftnbj'        ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfFNoteText;      RtfKStr: '\ftntj'        ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfFNoteStart;     RtfKStr: '\ftnstart'     ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfFNoteRestart;   RtfKStr: '\ftnrestart'   ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfPageStart;      RtfKStr: '\pgnstart'     ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfLineStart;      RtfKStr: '\linestart'    ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfLandscape;      RtfKStr: '\landscape'    ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfFracWidth;      RtfKStr: '\fracwidth'    ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfNextFile;       RtfKStr: '\nextfile'     ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfTemplate;       RtfKStr: '\template'     ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfMakeBackup;     RtfKStr: '\makeback'     ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfRtfDefault;     RtfKStr: '\defformat'    ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfRevisions;      RtfKStr: '\revisions'    ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfMirrorMargin;   RtfKStr: '\margmirror'   ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfRevDisplay;     RtfKStr: '\revprop'      ),
+    (RtfKMajor: RtfDocAttr;     RtfKMinor: RtfRevBar;         RtfKStr: '\revbar'       ),
+    (RtfKMajor: RtfStyleAttr;   RtfKMinor: RtfBasedOn;        RtfKStr: '\sbasedon'     ),
+    (RtfKMajor: RtfStyleAttr;   RtfKMinor: RtfNext;           RtfKStr: '\snext'        ),
+    (RtfKMajor: RtfColorName;   RtfKMinor: RtfRed;            RtfKStr: '\red'          ),
+    (RtfKMajor: RtfColorName;   RtfKMinor: RtfGreen;          RtfKStr: '\green'        ),
+    (RtfKMajor: RtfColorName;   RtfKMinor: RtfBlue;           RtfKStr: '\blue'         ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfMacQD;          RtfKStr: '\macpict'      ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfWinMetafile;    RtfKStr: '\wmetafile'    ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfWinBitmap;      RtfKStr: '\wbitmap'      ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicWid;         RtfKStr: '\picw'         ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicHt;          RtfKStr: '\pich'         ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicGoalWid;     RtfKStr: '\picwgoal'     ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicGoalWid;     RtfKStr: '\picwGoal'     ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicGoalHt;      RtfKStr: '\pichgoal'     ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicGoalHt;      RtfKStr: '\pichGoal'     ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicScaleX;      RtfKStr: '\picscalex'    ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicScaleY;      RtfKStr: '\picscaley'    ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicScaled;      RtfKStr: '\picscaled'    ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicCropTop;     RtfKStr: '\piccropt'     ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicCropBottom;  RtfKStr: '\piccropb'     ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicCropLeft;    RtfKStr: '\piccropl'     ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicCropRight;   RtfKStr: '\piccropr'     ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPixelBits;      RtfKStr: '\wbmbitspixel' ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfBitmapPlanes;   RtfKStr: '\wbmplanes'    ),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfBitmapWid;      RtfKStr: '\wbmwidthbytes'),
+    (RtfKMajor: RtfPictAttr;    RtfKMinor: RtfPicBinary;      RtfKStr: '\bin'          ),
+    (RtfKMajor: RtfNeXTGrAttr;  RtfKMinor: RtfNeXTGWidth;     RtfKStr: '\width'        ),
+    (RtfKMajor: RtfNeXTGrAttr;  RtfKMinor: RtfNeXTGHeight;    RtfKStr: '\height'       ),
+    }
+  {@indent on}
+
+const
+  TRtfAnyType: TRtfTokenSet =[etDataset..etLitTrue];
+
+function ExtractFieldName(const Fields: string; var Pos: integer): string;
+var i: integer;
+begin
+  i := Pos;
+  while(i <= Length(Fields))and(Fields[i] <> '.')do Inc(i);
+  Result := Trim(Copy(Fields, Pos, i - Pos));
+  if(i <= Length(Fields))and(Fields[i] = '.')
+  then Inc(i);
+  Pos := i;
+end;
+
+function Pwr(const Base, Exponent: Double): Double;
+begin
+  if Exponent = 0.0 then
+    Result := 1.0 { n**0 = 1 }
+  else if(Base = 0.0)and(Exponent > 0.0) then
+    Result := 0.0 { 0**n = 0, n > 0 }
+  else if (Frac(Exponent) = 0.0) and (Abs(Exponent) <= MaxInt) then
+    Result := IntPower(Base, integer(Trunc(Exponent)))
+  else
+    Result := Exp(Exponent * Ln(Base))
+end;
+
+{ TRtfPictureAttr }
+
+constructor TRtfPictureAttr.Create(AWidth, AHeigth: word);
+begin
+  inherited Create;
+  FScaleX := 100;
+  FScaleY := 100;
+  FWidth := AWidth;
+  FHeigth := AHeigth;
+  FWidthmm := AWidth * 0.264596930676;
+  FHeigthmm := AHeigth * 0.264596930676;
+
+  FBorderWidth := 0;
+  FBorderType := brNone;
+  FBorderColor := clBlack;
+  FProportional := true;
+end;
+
+procedure TRtfPictureAttr.SetScaleX(Value: integer);
+var
+  AScale: Double;
+begin
+  if Value < 1 then
+    Value := 1
+  else if Value > 100 then
+    Value := 100;
+  AScale := Double(Value) / FScaleX;
+  FScaleX := Value;
+  FWidth := Round(FWidth * AScale);
+  FWidthmm := FWidthmm * AScale;
+  if FProportional then
+  begin
+    FScaleY := Round(FScaleY * AScale);
+    FHeigth := Round(FHeigth * AScale);
+    FHeigthmm := FHeigthmm * AScale;
+  end;
+end;
+
+procedure TRtfPictureAttr.SetScaleY(Value: integer);
+var
+  AScale: Double;
+begin
+  if Value < 1 then
+    Value := 1
+  else if Value > 100 then
+    Value := 100;
+  AScale := Double(Value) / FScaleY;
+  FScaleY := Value;
+  FHeigth := Round(FHeigth * AScale);
+  FHeigthmm := FHeigthmm * AScale;
+  if FProportional then
+  begin
+    FScaleX := Round(FScaleX * AScale);
+    FWidth := Round(FWidth * AScale);
+    FWidthmm := FWidthmm * AScale;
+  end;
+end;
+
+
+{ TRtfItem }
+
+procedure TRtfItem.Assign(ASource: TRtfItem);
+begin
+  RtfClass := ASource.RtfClass;
+  RtfMajor := ASource.RtfMajor;
+  RtfMinor := ASource.RtfMinor;
+  RtfTextBuf := ASource.RtfTextBuf;
+end;
+
+function TRtfItem.CheckItem(AClass: TRtfClass; Major: integer): boolean;
+begin
+  Result :=(RtfClass = AClass)and(RtfMajor = Major);
+end;
+
+function TRtfItem.GetItem(Index: integer): TRtfItem;
+begin
+  Result := TRtfItem(inherited Items[Index]);
+end;
+
+procedure TRtfItem.Notify(Ptr: pointer; Action: TListNotification);
+begin
+  inherited;
+  case Action of
+    lnAdded: TRtfItem(Ptr).FParent := Self;
+    lnExtracted: TRtfItem(Ptr).FParent := nil;
+  end;
+end;
+
+{ TRtfItemList }
+
+constructor TRtfItemList.Create;
+//Initialize an empty list
+begin
+  inherited Create;
+end;
+
+destructor TRtfItemList.Destroy;
+{-Destroy a list}
+var n: TRtfItem;
+  p: TRtfItem;
+begin
+  n := FTail;
+  while n <> nil do begin
+    {Get TRtfItem to previous node}
+    p := n.FPrev;
+    {Deallocate and destroy this node}
+    n.Free;
+    {Do the previous node}
+    n := p;
+  end;
+  FTail := nil;
+  FHead := nil;
+  FCount := 0;
+  inherited Destroy;
+end;
+
+function TRtfItemList.Add(AItem: TRtfItem): TRtfItem;
+{-Add element to end of list}
+begin
+  Result := AItem;
+  {Exit for bad input}
+  if AItem = nil
+  then Exit;
+  AItem.FPrev := FTail;
+  AItem.FNext := nil;
+  if FHead = nil then begin
+    {Special case for first node}
+    FHead := AItem;
+    FTail := AItem;
+  end else begin
+    {Add at end of existing list}
+    FTail.FNext := AItem;
+    FTail := AItem;
+  end;
+  Inc(FCount);
+end;
+
+procedure TRtfItemList.Insert(AItem: TRtfItem);
+{-Insert element at start of list}
+begin
+  {Exit for bad input}
+  if AItem = nil
+  then Exit;
+  AItem.FPrev := nil;
+  AItem.FNext := FHead;
+  if FHead = nil
+  then FTail := AItem {Special case for first node}
+  else FHead.FPrev := AItem; {Add at start of existing list}
+  FHead := AItem;
+  Inc(FCount);
+end;
+
+procedure TRtfItemList.PlaceAfter(AItem: TRtfItem; AAfter: TRtfItem);
+{-Place element P into list _after_ existing element L}
+begin
+  {Exit for bad input}
+  if(AItem = nil)or(AItem = AAfter)
+  then Exit;
+  if AAfter = nil
+  then Insert(AItem)
+  else if AAfter = FTail
+  then Add(AItem)
+  else begin
+    AItem.FPrev := AAfter;
+    AItem.FNext := AAfter.FNext;
+    AAfter.FNext.FPrev := AItem;
+    AAfter.FNext := AItem;
+    Inc(FCount);
+  end;
+end;
+
+procedure TRtfItemList.PlaceBefore(AItem, ABefore: TRtfItem);
+{-Place element P into list _before_ existing element L}
+begin
+  {Exit for bad input}
+  if(AItem = nil)or(AItem = ABefore)
+  then Exit;
+  if(ABefore = nil)or(ABefore = Head)
+  then Insert(AItem) {Place the new element at the start of the list}
+  else begin
+    {Patch in the new element}
+    AItem.FNext := ABefore;
+    AItem.FPrev := ABefore.FPrev;
+    ABefore.FPrev.FNext := AItem;
+    ABefore.FPrev := AItem;
+    Inc(FCount);
+  end;
+end;
+
+procedure TRtfItemList.dlRemove(AItem: TRtfItem; DisposeIt: boolean);
+{-Delete existing node from list, optionally disposing of it}
+var This: TRtfItem;
+begin
+  {Exit for bad input}
+  if(AItem = nil)or(FCount = 0)
+  then Exit;
+
+  This := AItem;
+  with This do begin
+    {Fix pointers of surrounding nodes}
+    if FNext <> nil
+    then FNext.FPrev := FPrev;
+    if FPrev <> nil
+    then FPrev.FNext := FNext;
+  end;
+
+  {Fix head and tail of list}
+  if FTail = This
+  then FTail := FTail.FPrev;
+  if FHead = This
+  then FHead := FHead.FNext;
+
+  Dec(FCount);
+  if DisposeIt
+  then This.Free;
+end;
+
+procedure TRtfItemList.Extract(AItem: TRtfItem);
+{-Extract existing element from list without disposing of it}
+begin
+  dlRemove(AItem, false);
+end;
+
+procedure TRtfItemList.Delete(AItem: TRtfItem);
+{-Delete an existing node, disposing of its contents}
+begin
+  dlRemove(AItem, true);
+end;
+
+procedure TRtfItemList.Clear;
+begin
+  while Assigned(FHead)do begin
+    dlRemove(FHead, true);
+  end;
+end;
+
+procedure TRtfItemList.SaveToStream(AStream: TStream; AColors: string);
+var AItem: TRtfItem;
+  ALine: string;
+begin
+  AItem := Head;
+  while Assigned(AItem)do begin
+    if AItem.CheckItem(RtfControl, RtfDestination)and(AItem.RtfMinor = RtfColorTbl)
+    then ALine := Format('\colortbl;%s}',[AColors])
+    else ALine := AItem.RtfTextBuf;
+    if ALine <> ''
+    then AStream.Write(ALine[1], Length(ALine));
+    AItem := AItem.Next;
+  end;
+end;
+
+{ TRawRtfParser }
+
+procedure TRawRtfParser.RtfHook;
+//Build a tree from the rtf-code tokens
+var AItem: TRtfItem;
+
+
+  function NewItem(AText: string): TRtfItem;
+  begin
+    Result := TRtfItem.Create;
+    Result.RtfClass := RtfClass;
+    Result.RtfMajor := RtfMajor;
+    Result.RtfMinor := RtfMinor;
+    Result.RtfTextBuf := AText;
+  end;
+begin
+  case RtfClass of
+    RtfParseBegin: begin
+      if Assigned(AParseItem) then begin
+        //Then close it
+        AParseItem := nil;
+        AItem := RawItems.Add(NewItem(''));
+        AItem.RtfClass := RtfParseEnd;
+      end else begin
+        //Otherwise open an item
+        AParseItem := RawItems.Add(NewItem(''));
+        AParseItem.RtfClass := RtfParseBegin;
+      end;
+    end;
+    RtfControl: begin
+      if(RtfMajor = RtfDestination)and(RtfMinor = RtfColorTbl)
+      then FColorTable := RawItems.Add(NewItem(RtfTextBuf))
+      else RawItems.Add(NewItem(RtfTextBuf));
+    end;
+    RtfText: begin
+      if RawItems.Tail.RtfClass = RtfClass
+      then RawItems.Tail.RtfTextBuf := RawItems.Tail.RtfTextBuf + RtfTextBuf
+      else RawItems.Add(NewItem(RtfTextBuf));
+    end;
+    RtfGroup, RtfUnknown: begin
+      if RawItems.Tail.RtfClass in[RtfGroup, RtfUnknown]
+      then RawItems.Tail.RtfTextBuf := RawItems.Tail.RtfTextBuf + RtfTextBuf
+      else RawItems.Add(NewItem(RtfTextBuf));
+      RawItems.Tail.RtfClass := RtfUnknown; //Dont use these for compares
+    end;
+  end;
+end;
+
+function TRawRtfParser.GetRtfChar: char;
+begin
+  if APtr >= AEnd
+  then Result := #0
+  else begin
+    Result := APtr^;
+    Inc(APtr);
+  end;
+end;
+
+procedure TRawRtfParser.GetRtfToken;
+var c: char;
+  i, ALevel: integer;
+begin
+  FRtfTextBuf := ''; //not really needed
+
+  //Get first character, which may be a pushback from previous token
+  if APushedChar <> #0 then begin
+    c := APushedChar;
+    APushedChar := #0;
+  end
+  else c := GetRtfChar;
+
+
+  case c of
+    #0: begin
+      FRtfClass := RtfEof;
+      FRtfTextBuf := '';
+    end;
+    #8: begin //effectively a \tab control symbol
+      FRtfClass := RtfControl;
+      FRtfMajor := RtfSpecialChar;
+      FRtfMinor := RtfTab;
+      FRtfTextBuf := c;
+      c := #0;
+    end;
+    '{': begin
+      FRtfClass := RtfGroup;
+      FRtfMajor := RtfBeginGroup;
+      FRtfTextBuf := c;
+      c := #0;
+    end;
+    '}': begin
+      FRtfClass := RtfGroup;
+      FRtfMajor := RtfEndGroup;
+      FRtfTextBuf := c;
+      c := #0;
+    end;
+    '\': begin //We have the backslash, advance to next character
+      FRtfTextBuf := c;
+      c := GetRtfChar;
+      case c of
+        chr(39): begin //Hex encoded text char, e.g., \'d5, \'d3
+          FRtfClass := RtfUnknown;
+          FRtfTextBuf := FRtfTextBuf + c;
+          c := GetRtfChar;
+          if c <> #0 then begin
+            FRtfTextBuf := FRtfTextBuf + c;
+            c := GetRtfChar;
+            if c <> #0 then begin
+              FRtfClass := RtfText;
+              FRtfTextBuf := FRtfTextBuf + c;
+              //It can still be a special character..
+              for i := Low(Rtfkey)to High(Rtfkey)do begin
+                if FRtfTextBuf = Rtfkey[i].RtfKStr then begin
+                  FRtfClass := RtfControl;
+                  FRtfMajor := Rtfkey[i].RtfKMajor;
+                  FRtfMinor := Rtfkey[i].RtfKMinor;
+                  break;
+                end;
+              end;
+              c := #0;
+            end;
+          end;
+        end;
+        ':', '{', '}', ';', '\': begin //special escaped text char, e.g., \, \;
+          FRtfTextBuf := FRtfTextBuf + c;
+          //"\" Marks the start and end of an expression with the RtfParseBegin
+          //RtfClass. They will later be removed and replaced by RtfExpression
+          //Items between the opening and closing \ will be the expression text
+          if c = '\'
+          then FRtfClass := RtfParseBegin
+          else FRtfClass := RtfText;
+          c := #0;
+        end;
+        '|': begin
+          FRtfTextBuf := FRtfTextBuf + c;
+          FRtfClass := RtfControl;
+          FRtfMajor := RtfSpecialChar;
+          FRtfMinor := RtfFormula;
+          c := #0;
+        end;
+        '~': begin
+          FRtfTextBuf := FRtfTextBuf + c;
+          FRtfClass := RtfControl;
+          FRtfMajor := RtfSpecialChar;
+          FRtfMinor := RtfNoBrkSpace;
+          c := #0;
+        end;
+        '-': begin
+          FRtfTextBuf := FRtfTextBuf + c;
+          FRtfClass := RtfControl;
+          FRtfMajor := RtfSpecialChar;
+          FRtfMinor := RtfNoReqHyphen;
+          c := #0;
+        end;
+        '_': begin
+          FRtfTextBuf := FRtfTextBuf + c;
+          FRtfClass := RtfControl;
+          FRtfMajor := RtfSpecialChar;
+          FRtfMinor := RtfNoBrkHyphen;
+          c := #0;
+        end;
+        '*': begin
+          FRtfTextBuf := FRtfTextBuf + c;
+          FRtfClass := RtfControl;
+          FRtfMajor := RtfSpecialChar;
+          FRtfMinor := RtfOptDest;
+          c := #0;
+        end;
+        #13, #10: begin
+          FRtfTextBuf := FRtfTextBuf + c;
+          FRtfClass := RtfControl;
+          FRtfMajor := RtfSpecialChar;
+          FRtfMinor := RtfPar;
+          c := #0;
+        end;
+        else begin //Wasn't anything special, continue with control word
+
+          while(c in['A'..'Z', 'a'..'z'])do begin
+            FRtfTextBuf := FRtfTextBuf + c;
+            c := GetRtfChar;
+          end;
+
+          //Find the control word in the key array
+          FRtfClass := RtfUnknown;
+          for i := Low(Rtfkey)to High(Rtfkey)do begin
+            if FRtfTextBuf = Rtfkey[i].RtfKStr then begin
+              FRtfClass := RtfControl;
+              FRtfMajor := Rtfkey[i].RtfKMajor;
+              FRtfMinor := Rtfkey[i].RtfKMinor;
+              break;
+            end;
+          end;
+
+          //Parse the word parameter negative sign
+          if c = '-' then begin
+            FRtfTextBuf := FRtfTextBuf + c;
+            c := GetRtfChar;
+          end;
+          //Parse the word parameter number
+          while(c in['0'..'9'])do begin
+            FRtfTextBuf := FRtfTextBuf + c;
+            c := GetRtfChar;
+          end;
+
+          //Append control symbol delimiter (i need it for writing)
+          if c = ' ' then begin
+            FRtfTextBuf := FRtfTextBuf + c;
+            c := GetRtfChar;
+          end;
+
+          //Crap1: Fix for {\field{\*\fldinst SYMBOL 32 \\f "Symbol" \\s 12}{\fldrslt\...
+          //RTF text gets corrupted by this parser (notice the Double backslash!)
+          //Crap2:Also INFO since it can contain the first line from rtf as docinfo.
+          if(FRtfClass = RtfControl)and(FRtfMajor = RtfDestination) then begin
+            if FRtfMinor in[RtfField, RtfInfo, RtfStyleSheet, RtfFontTbl, RtfColorTbl] then begin
+              //Just include the whole field Group to the TextBuf (who cares..?)
+              ALevel := 1; //All these items have a "group open" before them
+              while c <> #0 do begin
+                FRtfTextBuf := FRtfTextBuf + c;
+                case c of
+                  '{': Inc(ALevel);
+                  '}': Dec(ALevel);
+                end;
+                c := GetRtfChar;
+                if ALevel = 0
+                then break;
+              end;
+              FRtfClass := RtfControl;
+            end;
+          end;
+        end;
+      end;
+    end;
+    else
+    begin
+      //literal text char. This will give one character per call (which is slow)
+      FRtfTextBuf := c;
+      FRtfClass := RtfText;
+
+      c := GetRtfChar;
+      while not(c in[#0, #8, '\', '{', '}']) do
+      begin
+        FRtfTextBuf := FRtfTextBuf + c;
+        c := GetRtfChar;
+      end;
+    end;
+  end;
+
+  //Push character back if we read one to much
+  if c <> #0 then
+    APushedChar := c;
+end;
+
+procedure TRawRtfParser.Execute(ARawItems: TRtfItemList; ARtfPtr: pchar; ARtfSize: integer);
+var AItem: TRtfItem;
+begin
+  APtr := ARtfPtr;
+  APushedChar := #0;
+  RawItems := ARawItems;
+  FRtfClass := RtfNothing;
+  AEnd := APtr + ARtfSize;
+
+  //Dummy item so tail of list is always assigned
+  AItem := TRtfItem.Create;
+  AItem.RtfClass := RtfText;
+  ARawItems.Add(AItem);
+
+  while true do
+  begin
+    GetRtfToken;
+    if RtfClass = RtfEOF then
+      break;
+    RtfHook;
+  end;
+end;
+
+{ TRtfVariableList }
+
+function TRtfVariableList.Add(AName: string; AValue: variant; AToken: TRtfToken): TRtfVariable;
+begin
+  Result := Find(AName);
+  if Assigned(Result) then
+    raise TRtfException.CreateFmt('Variable %s already exists',[AName]);
+  Result := TRtfVariable.Create;
+  inherited Add(Result);
+  Result.Name := AName;
+  Result.Value := AValue;
+  Result.Token := AToken;
+end;
+
+destructor TRtfVariableList.Destroy;
+begin
+  inherited;
+end;
+
+function TRtfVariableList.Find(AName: string): TRtfVariable;
+var i: integer;
+begin
+  for i := 0 to Count - 1 do begin
+    Result := Items[i];
+    if SameText(Result.Name, AName)
+    then exit;
+  end;
+  Result := nil;
+end;
+
+function TRtfVariableList.GetItem(Index: integer): TRtfVariable;
+begin
+  Result := TRtfVariable(inherited Items[Index]);
+end;
+
+{ TRtfFunctionList }
+
+function TRtfFunctionList.GetItem(Index: integer): TRtfFunction;
+begin
+  Result := TRtfFunction(inherited Items[Index]);
+end;
+
+function TRtfFunctionList.Add(ATokenType: TRtfToken; AName: string; AMin, AMax: smallint; AOnexecute: TRtfFunctionExecute): TRtfFunction;
+//Add a new function or even an additional token to the function list
+begin
+  Result := Find(AName);
+  if Assigned(Result)
+  then raise TRtfException.CreateFmt('Function already exists',[AName]);
+
+  Result := TRtfFunction.Create;
+  Result.Name := AName;
+  Result.Min := AMin;
+  Result.Max := AMax;
+  Result.Token := ATokenType;
+  Result.Onexecute := AOnexecute;
+  inherited Add(Result);
+end;
+
+function TRtfFunctionList.Find(AName: string): TRtfFunction;
+var i: integer;
+begin
+  for i := 0 to Count - 1 do begin
+    Result := Items[i];
+    if SameText(Result.Name, AName)
+    then exit;
+  end;
+  Result := nil;
+end;
+
+{ TRtfDataset }
+
+procedure TRtfDataset.Notify(Ptr: pointer; Action: TListNotification);
+begin
+  inherited;
+  case Action of
+    lnAdded: TRtfDataset(Ptr).FParent := Self;
+    lnExtracted: TRtfDataset(Ptr).FParent := nil;
+  end;
+end;
+
+function TRtfDataset.Bof: boolean;
+begin
+  if Dataset is TDataset then begin
+    with Dataset as TDataset do begin
+      Result := Bof;
+    end
+  end
+  else if Dataset is TtiObjectList then
+    Result := TableIndex = 0
+  else if Dataset is TtiObject then
+    Result := false
+  else
+    raise TRtfException.Create(rsNotImplemented);
+end;
+
+function TRtfDataset.Eof: boolean;
+begin
+  if Dataset is TDataset then begin
+    with Dataset as TDataset do begin
+      Result := Eof;
+    end
+  end
+  else if Dataset is TtiObjectList then
+    Result :=(TableIndex >= RecordCount)or(TableIndex < 0)
+  else if Dataset is TtiObject then
+    Result := false
+  else
+    Result := false;
+end;
+
+function TRtfDataset.Find(AName: string): TRtfDataset;
+var i: integer;
+begin
+  for i := 0 to Count - 1 do begin
+    Result := Items[i];
+    if SameText(Result.Name, AName)
+    then exit;
+  end;
+  Result := nil;
+end;
+
+function TRtfDataset.Add(ADataset: TObject; AName: string; AFreeDataset: boolean = false): TRtfDataset;
+begin
+  Result := Find(AName);
+  if Assigned(Result) then
+    raise TRtfException.CreateFmt('Dataset already exists',[AName]);
+
+  Result := TRtfDataset.Create;
+  Result.Dataset := ADataset;
+  Result.Name := AName;
+  Result.FFreeDataset := AFreeDataset;
+  inherited Add(Result);
+end;
+
+function TRtfDataset.ResolveNestedFields(ATable: TRtfDataset; AName: string; var AFieldName: string): TRtfDataset;
+//Advance to field level (skipping nested dataset objects)
+var ATableName: string;
+  APropInfo: PPropInfo;
+  ASubTable: TRtfDataset;
+  AIndex, i: integer;
+  AObject: TObject;
+begin
+  AIndex := 1;
+  Result := ATable;
+  AFieldName := AName;
+  while AIndex < Length(AName)do begin
+
+    //Check object dataset and eof state
+    AObject := nil; 
+    if Result.Dataset is TDataset
+    then exit; //A TDataset is never nested
+    if Result.Dataset is TtiObjectList then begin
+      //Get the right record from the array
+      if Result.TableIndex <(Result.Dataset as TtiObjectList).Count
+      then AObject :=(Result.Dataset as TtiObjectList)[Result.TableIndex]
+      else exit; //Trying beyond eof (or empty table) big problem; nah?
+    end else if Result.Dataset is TtiObject
+    then AObject := Result.Dataset
+    else raise TRtfException.Create('Unknown object');
+
+    //If the next field is a class then advance
+    ASubTable := nil;
+    ATableName := ExtractFieldName(AName, AIndex);
+    APropInfo := GetPropInfo(AObject, ATableName);
+    if not Assigned(APropInfo)or(APropInfo^.PropType^.Kind <> tkClass)
+    then exit; //As long as it's an object continue parsing..
+
+    //Advance fieldname and find nested table
+    AFieldName := Copy(AName, AIndex, Maxint);
+    for i := 0 to Result.Count - 1 do begin
+      if SameText(Result[i].Name, ATableName) then begin
+        ASubTable := Result[i];
+        break;
+      end;
+    end;
+
+    //Add the nested table (for administration of the TableIndex)
+    if not Assigned(ASubTable) then begin
+      APropInfo := GetPropInfo(AObject, ATableName);
+      if not Assigned(APropInfo)
+      then raise TRtfException.CreateFmt('property %s not found',[ATableName]);
+      if APropInfo^.PropType^.Kind = tkClass
+      then AObject := GetObjectProp(AObject, APropInfo)
+      else exit; //Just a plain property field (returned via AFieldName)
+      ASubTable := Result.Add(AObject, ATableName);
+    end;
+
+    //Advance to a deeper table level
+    Result := ASubTable;
+  end;
+end;
+
+function TRtfDataset.Find(AName: string; var AFieldName: string): TRtfDataset;
+//Find the requested dataset
+var ATableName: string;
+  AIndex, i: integer;
+begin
+  //MainTable must be in the list of tables
+  //Otherwise no point of reference.
+  AIndex := 1;
+  Result := nil;
+  ATableName := ExtractFieldName(AName, AIndex);
+  AFieldName := Copy(AName, AIndex, Maxint);
+  for i := 0 to Count - 1 do begin
+    if SameText(Items[i].Name, ATableName) then begin
+      Result := Items[i];
+      break;
+    end;
+  end;
+  if not Assigned(Result)or not Assigned(Result.Dataset)
+  then raise TRtfException.CreateFmt('Unable to resolve %s',[ATableName]);
+  Result := ResolveNestedFields(Result, AFieldName, AFieldName);
+end;
+
+procedure TRtfDataset.Open;
+begin
+  Clear; //Clear nested tables
+  if Dataset is TDataset then begin
+    with Dataset as TDataset do begin
+      if not Active
+      then Open;
+    end
+  end;
+  First;
+end;
+
+procedure TRtfDataset.First;
+begin
+  Clear; //Clear nested tables
+  if Dataset is TDataset then
+  begin
+    with Dataset as TDataset do
+    begin
+      First;
+    end
+  end
+  else if Dataset is TtiObjectList then
+  begin
+    TableIndex := 0;
+  end;
+end;
+
+function TRtfDataset.GetItem(Index: integer): TRtfDataset;
+begin
+  Result := TRtfDataset(inherited Items[Index]);
+end;
+
+function TRtfDataset.IsEmpty: boolean;
+begin
+  if Dataset is TDataset then
+  begin
+    with Dataset as TDataset do
+    begin
+      Result := IsEmpty;
+    end
+  end
+  else if Dataset is TtiObjectList then
+    Result := RecordCount = 0
+  else if Dataset is TtiObject then
+    Result := false
+  else
+    raise TRtfException.Create(rsNotImplemented);
+end;
+
+procedure TRtfDataset.Last;
+begin
+  Clear; //Clear nested tables
+  if Dataset is TDataset then begin
+    with Dataset as TDataset do begin
+      Last;
+    end
+  end else if Dataset is TtiObjectList then begin
+    TableIndex := RecordCount - 1;
+  end;
+end;
+
+procedure TRtfDataset.Next;
+begin
+  Clear; //Clear nested tables
+  if Dataset is TDataset then begin
+    with Dataset as TDataset do begin
+      Next;
+    end
+  end else if Dataset is TtiObjectList then begin
+    if not Eof then begin
+      TableIndex := TableIndex + 1;
+    end;
+  end;
+end;
+
+procedure TRtfDataset.Prior;
+begin
+  Clear; //Clear nested tables
+  if Dataset is TDataset then begin
+    with Dataset as TDataset do begin
+      Prior;
+    end
+  end else if Dataset is TtiObjectList then begin
+    if not Bof then begin
+      TableIndex := TableIndex - 1;
+    end;
+  end;
+end;
+
+function TRtfDataset.RecordCount: integer;
+//This can give problems with Sql..
+begin
+  if Dataset is TDataset
+  then Result :=(Dataset as TDataset).RecordCount
+  else if Dataset is TtiObjectList
+  then Result :=(Dataset as TtiObjectList).Count
+  else Result := 1; //Single OpfRecord
+end;
+
+destructor TRtfDataset.Destroy;
+begin
+  if FreeDataset
+  then FreeAndNil(FDataset);
+  inherited;
+end;
+
+
+{ TRtfArgument }
+
+constructor TRtfArgument.Create(AParser: TtiRtfParser);
+begin
+  inherited Create(true);
+  FParser := AParser;
+end;
+
+function TRtfArgument.Add(AValue: variant; ATokenType: TRtfToken): TRtfArgument;
+begin
+  Result := TRtfArgument.Create(Parser);
+  inherited Add(Result);
+  Result.Value := AValue;
+  Result.Token := ATokenType;
+end;
+
+function TRtfArgument.Add(AArgument: TRtfArgument): TRtfArgument;
+begin
+  inherited Add(AArgument);
+  Result := AArgument;
+end;
+
+function TRtfArgument.GetItem(Index: integer): TRtfArgument;
+begin
+  Result := TRtfArgument(inherited Items[Index]);
+end;
+
+procedure TRtfArgument.Notify(Ptr: pointer; Action: TListNotification);
+//Nice way of setting the parent reference
+begin
+  inherited;
+  case Action of
+    lnAdded: TRtfArgument(Ptr).FParent := Self;
+    lnExtracted: TRtfArgument(Ptr).FParent := nil;
+  end;
+end;
+
+function TRtfArgument.Check(AParam: integer; ATokens: TRtfTokenSet): boolean;
+begin
+  if AParam >= Count then begin
+    Result := false;
+    exit;
+  end;
+  if not(Items[AParam].Token in ATokens) then begin
+    Result := false;
+    exit;
+  end;
+  Result := true;
+end;
+
+function TRtfArgument.Check(ATokens: array of TRtfTokenSet): boolean;
+var i: integer;
+begin
+  for i := Low(ATokens)to High(ATokens)do begin
+    Result := Check(i, ATokens[i]);
+    if not Result
+    then exit;
+  end;
+  Result := true;
+end;
+
+procedure TRtfArgument.ParseExpression(AExpression: string);
+//Add token to the argument list. Parameters surrounded by parentheses will
+//be added to the nested arguments. This will make a nice argument tree.
+//Constant .9 wont be parse, but that's ok
+var FSourcePtr, p, TokenStart: PChar;
+  ALastArgument, ALast: TRtfArgument;
+  AInts: array[0..6]of integer;
+  ASeps: array[0..6]of char;
+  AFunction: TRtfFunction;
+  AFloatResult: boolean;
+  AIntIndex: integer;
+  AValue: variant;
+  AToken: string;
+begin
+  ALast := nil;
+  Value := varEmpty;
+  Token := etNothing;
+  ALastArgument := Self;
+  FSourcePtr := PChar(AExpression);
+  while FSourcePtr^ <> #0 do begin
+
+    p := FSourcePtr;
+    while(P^ <> #0)and(P^ <= ' ')do begin
+      ALast := nil;
+      Inc(p);
+    end;
+
+    TokenStart := p;
+    case P^ of
+      'A'..'Z', 'a'..'z', '_', '@': begin //De '@' voor referentie variabelen (nieuw)
+        Inc(p);
+        ALast := nil;
+        while P^ in['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '@']do Inc(p);
+        if TokenStart^ = '@' then begin
+          Inc(TokenStart); //Remove the '@' prefix
+          SetString(AToken, TokenStart, p - TokenStart);
+          ALast := ALastArgument.Add(AToken, etVariable)
+        end else begin
+          SetString(AToken, TokenStart, p - TokenStart);
+          AFunction := Parser.Functions.Find(AToken);
+          if Assigned(AFunction)
+          then ALastArgument.Add(AFunction.Name, AFunction.Token)
+          else ALast := ALastArgument.Add(AToken, etFieldName); //Field or tablename, what else can it be?
+        end;
+      end;
+      Chr(39): begin
+        Inc(p);
+        TokenStart := p;
+        while true do begin
+          if P^ = Chr(39) then begin
+            SetString(AToken, TokenStart, p - TokenStart);
+            //Concatenate etFieldName."Field with spaces"
+            if Assigned(ALast)and(ALast.Token in[etVariable, etFieldName])
+            then ALast.Value := ALast.Value + AToken
+            else ALastArgument.Add(AToken, etLitString);
+            Inc(p);
+            Break;
+          end;
+          if P^ = #0
+          then raise TRtfException.Create(rsUnterminatedStringConstant);
+          Inc(p);
+        end;
+      end;
+      '"': begin
+        Inc(p);
+        TokenStart := p;
+        while true do begin
+          if P^ = '"' then begin
+            SetString(AToken, TokenStart, p - TokenStart);
+            //Concatenate etFieldName."Field with spaces"
+            if Assigned(ALast)and(ALast.Token in[etVariable, etFieldName])
+            then ALast.Value := ALast.Value + AToken
+            else ALastArgument.Add(AToken, etLitString);
+            Inc(p);
+            Break;
+          end;
+          if P^ = #0
+          then raise TRtfException.Create(rsUnterminatedStringConstant);
+          Inc(p);
+        end;
+      end;
+      '-': begin
+        Inc(p);
+        ALast := nil;
+        ALastArgument.Add(AToken, etSUB);
+      end;
+      '0'..'9': begin //Ik ga ervan uit dat alles in het amerikaans genoteerd word
+        Inc(p);
+        ALast := nil;
+        AFloatResult := false;
+        while P^ in['0'..'9']do Inc(p);
+        if P^ = '.' then begin //Floating point
+          Inc(p);
+          AFloatResult := true;
+          while P^ in['0'..'9']do Inc(p);
+        end;
+        if P^ in['e', 'E'] then begin //1.700000E+308
+          AFloatResult := true;
+          Inc(p);
+          if P^ in['+', '-']
+          then Inc(p);
+          while P^ in['0'..'9']do Inc(p);
+        end;
+        SetString(AToken, TokenStart, p - TokenStart);
+        if AFloatResult
+        then AValue := StrToFloat(AToken)
+        else AValue := StrToInt(AToken);
+        if AFloatResult
+        then ALastArgument.Add(AValue, etLitFloat)
+        else ALastArgument.Add(AValue, etLitInt);
+      end;
+      '(': begin
+        Inc(p);
+        ALast := nil;
+        //Add them to the last function if possible..
+        if(ALastArgument.Count > 0)and(ALastArgument[ALastArgument.Count - 1].Token in[etFunction, etProcedure])
+        then ALastArgument := ALastArgument[ALastArgument.Count - 1]
+        else ALastArgument := ALastArgument.Add('()', etParenthesis);
+      end;
+      ')': begin
+        Inc(p);
+        ALast := nil;
+        ALastArgument := ALastArgument.Parent;
+        if not Assigned(ALastArgument)
+        then raise TRtfException.Create(rsToManyClosingParenthesis);
+      end;
+      '<': begin
+        Inc(p);
+        ALast := nil;
+        case P^ of
+          '=': begin
+            Inc(p);
+            ALastArgument.Add('<=', etLE);
+          end;
+          '>': begin
+            Inc(p);
+            ALastArgument.Add('<>', etNE);
+          end;
+          else ALastArgument.Add('<', etLT);
+        end;
+      end;
+      '=': begin
+        Inc(p);
+        ALast := nil;
+        ALastArgument.Add('=', etEq);
+      end;
+      ':': begin
+        Inc(p);
+        ALast := nil;
+        if P^ = '=' then begin
+          Inc(p);
+          ALastArgument.Add(':=', etAssign);
+        end
+        else raise TRtfException.CreateFmt(rsInvalidExpressionCharacter,[P^]);
+      end;
+      '&': begin
+        Inc(p);
+        ALast := nil;
+        if P^ = '&' then begin
+          Inc(p);
+          ALastArgument.Add('and', etAnd);
+        end
+        else raise TRtfException.CreateFmt(rsInvalidExpressionCharacter,[P^]);
+      end;
+      '|': begin
+        Inc(p);
+        ALast := nil;
+        if P^ = '|' then begin
+          Inc(p);
+          ALastArgument.Add('or', etOr);
+        end
+        else raise TRtfException.CreateFmt(rsInvalidExpressionCharacter,[P^]);
+      end;
+      '!': begin
+        Inc(p);
+        ALast := nil;
+        if P^ = '=' then begin
+          Inc(p);
+          ALastArgument.Add('!=', etNe);
+        end
+        else ALastArgument.Add(AToken, etNot);
+      end;
+      '>': begin
+        Inc(p);
+        ALast := nil;
+        if P^ = '=' then begin
+          Inc(p);
+          ALastArgument.Add('>=', etGE);
+        end
+        else ALastArgument.Add('>', etGT);
+      end;
+      '+': begin
+        Inc(p);
+        ALast := nil;
+        ALastArgument.Add('+', etADD);
+      end;
+      '*': begin
+        Inc(p);
+        ALast := nil;
+        ALastArgument.Add('*', etMUL);
+      end;
+      '/': begin
+        Inc(p);
+        ALast := nil;
+        ALastArgument.Add('/', etDIV);
+      end;
+      ',': begin
+        Inc(p);
+        ALast := nil;
+        ALastArgument.Add(',', etComma);
+      end;
+      '\': begin //a date/time constant. Since these are
+      //in a fixed format we need to parse them ourselves.
+        Inc(p);
+        ALast := nil;
+        if P^ = '{' then begin
+          Inc(p);
+          FillChar(AInts[0], SizeOf(AInts), 0);
+          FillChar(ASeps[0], SizeOf(ASeps), 0);
+
+          AIntIndex := 0;
+          while(p^ <> #0)and(p^ in['0'..'9', ' ', ':', '-'])do begin
+            //read integer parts
+            TokenStart := p;
+            while P^ in['0'..'9']do Inc(p);
+            SetString(AToken, TokenStart, p - TokenStart);
+            if AToken = ''
+            then raise TRtfException.Create(rsInvalidDateConstant);
+            ASeps[AIntIndex] := p^;
+            AInts[AIntIndex] := StrToInt(AToken);
+            Inc(AIntIndex);
+            if AIntIndex > 6
+            then raise TRtfException.Create(rsInvalidDateConstant);
+            if(p^ in[' ', '-', ':'])
+            then Inc(p);
+          end;
+
+          //There shoud be at least two values entered
+          if AIntIndex < 2
+          then raise TRtfException.Create(rsInvalidDateConstant);
+
+          if not(p^ in['\'])
+          then raise TRtfException.Create(rsInvalidDateConstant);
+          Inc(p);
+          if P^ <> '}'
+          then raise TRtfException.Create(rsInvalidDateConstant);
+          Inc(p);
+
+          if ASeps[0] = '-' then begin
+            //Its a date/time constant.. There should be at least 3 ints
+            if AIntIndex < 3
+            then raise TRtfException.Create(rsInvalidDateConstant);
+            if ASeps[1] <> '-'
+            then raise TRtfException.Create(rsInvalidDateSeparator);
+            if not(ASeps[2]in[' ', '\'])
+            then raise TRtfException.Create(rsInvalidDateSeparator);
+            AValue := EncodeDate(AInts[0], AInts[1], AInts[2]);
+
+            //Followed by a optional time constant? There should be at least 2 ints in it
+            if AIntIndex > 3 then begin
+              if AIntIndex < 5
+              then raise TRtfException.Create(rsInvalidTimeConstant);
+              if not(ASeps[2]in[' '])
+              then raise TRtfException.Create(rsInvalidTimeSeparator);
+              if not(ASeps[3]in[':', ' ', '\'])
+              then raise TRtfException.Create(rsInvalidTimeSeparator);
+              AValue := AValue + EncodeTime(AInts[3], AInts[4], AInts[5], 0);
+            end;
+          end else if ASeps[0] = ':' then begin
+            //Its a time constant.. There should be at least 2 ints
+            if AIntIndex < 1
+            then raise TRtfException.Create(rsInvalidTimeConstant);
+            if not(ASeps[1]in[':', ' ', '\'])
+            then raise TRtfException.Create(rsInvalidTimeSeparator);
+            AValue := EncodeTime(AInts[0], AInts[1], AInts[2], 0);
+          end;
+          ALastArgument.Add(AValue, etLitDate)
+        end
+        else raise TRtfException.CreateFmt(rsInvalidExpressionCharacter,[P^]);
+      end;
+      else begin
+        if p^ <> #0
+        then raise TRtfException.CreateFmt(rsInvalidExpressionCharacter,[P^]);
+      end;
+    end;
+    FSourcePtr := p;
+  end;
+  if ALastArgument <> Self
+  then raise TRtfException.Create(rsExpectedClosingParenthesis);
+end;
+
+procedure TRtfArgument.EvaluateUnaryBinary(APrevItem, AArgument, ANextItem: TRtfArgument);
+begin
+  case APrevItem.Token of
+    etLitString: begin
+      case ANextItem.Token of
+        etLitString: begin
+          if AArgument.Token <> etAdd
+          then raise TRtfException.Create('Unable to combine strings with other types');
+          APrevItem.Value := APrevItem.Value + ANextItem.Value;
+          Remove(AArgument);
+          Remove(ANextItem);
+        end;
+        else raise TRtfException.Create('Unable to combine strings with other types');
+      end;
+    end;
+    etLitInt: begin
+      case ANextItem.Token of
+        etLitInt, etLitDate, etLitFloat: begin
+          case AArgument.Token of
+            etAdd: APrevItem.Value := APrevItem.Value + ANextItem.Value;
+            etSub: APrevItem.Value := APrevItem.Value - ANextItem.Value;
+            etMul: APrevItem.Value := APrevItem.Value * ANextItem.Value;
+            etDiv: APrevItem.Value := APrevItem.Value / ANextItem.Value;
+          end;
+          if ANextItem.Token = etLitDate
+          then APrevItem.Token := etLitDate
+          else if ANextItem.Token = etLitFloat
+          then APrevItem.Token := etLitFloat
+          else if AArgument.Token = etDiv
+          then APrevItem.Token := etLitFloat
+          else APrevItem.Token := etLitInt;
+          Remove(AArgument);
+          Remove(ANextItem);
+        end;
+        else raise TRtfException.Create('Invalid formula');
+      end;
+    end;
+    etLitFloat: begin
+      case ANextItem.Token of
+        etLitInt, etLitFloat, etLitDate: begin
+          case AArgument.Token of
+            etAdd: APrevItem.Value := APrevItem.Value + ANextItem.Value;
+            etSub: APrevItem.Value := APrevItem.Value - ANextItem.Value;
+            etMul: APrevItem.Value := APrevItem.Value * ANextItem.Value;
+            etDiv: APrevItem.Value := APrevItem.Value / ANextItem.Value;
+          end;
+          if ANextItem.Token = etLitDate
+          then APrevItem.Token := etLitDate
+          else APrevItem.Token := etLitFloat;
+          Remove(AArgument);
+          Remove(ANextItem);
+        end;
+        else raise TRtfException.Create('Invalid formula');
+      end;
+    end;
+    etLitDate: begin
+      case ANextItem.Token of
+        etLitInt, etLitFloat, etLitDate: begin
+          case AArgument.Token of
+            etAdd: APrevItem.Value := APrevItem.Value + ANextItem.Value;
+            etSub: APrevItem.Value := APrevItem.Value - ANextItem.Value;
+            etMul: APrevItem.Value := APrevItem.Value * ANextItem.Value;
+            etDiv: APrevItem.Value := APrevItem.Value / ANextItem.Value;
+          end;
+          APrevItem.Token := etLitDate;
+          Remove(AArgument);
+          Remove(ANextItem);
+        end;
+        else raise TRtfException.Create('Invalid formula');
+      end;
+    end;
+    etComma: begin
+    //Fix for constant int's and float's
+      case ANextItem.Token of
+        etLitInt, etLitFloat, etLitDate: begin
+          case AArgument.Token of
+            etAdd:; //nothing just a (..., +Value)
+            etSub: ANextItem.Value := ANextItem.Value * - 1;
+            else raise TRtfException.Create('Invalid formula');
+          end;
+          Remove(AArgument);
+        end;
+        else raise TRtfException.Create('Invalid formula');
+      end;
+    end;
+    etAssign: begin
+    //Fix for constant int's and float's
+      case ANextItem.Token of
+        etLitInt, etLitFloat, etLitDate: begin
+          case AArgument.Token of
+            etAdd:; //nothing just a @Variable := +Value
+            etSub: ANextItem.Value := ANextItem.Value * - 1;
+            else raise TRtfException.Create('Invalid formula');
+          end;
+          Remove(AArgument);
+        end;
+        else raise TRtfException.Create('Invalid formula');
+      end;
+    end;
+    else raise TRtfException.Create('Invalid formula'); //Otherwise it wont advance
+  end;
+  if Assigned(Parser.OnEvalutate)
+  then Parser.OnEvalutate(Self);
+end;
+
+procedure TRtfArgument.EvaluateComparison(APrevItem, AArgument, ANextItem: TRtfArgument);
+begin
+  if(APrevItem.Token = etLitString)and(ANextItem.Token <> etLitString)
+  then raise TRtfException.Create('Invalid comparison');
+  if(ANextItem.Token = etLitString)and(APrevItem.Token <> etLitString)
+  then raise TRtfException.Create('Invalid comparison');
+
+  case AArgument.Token of
+    etEQ: APrevItem.Value := APrevItem.Value = ANextItem.Value;
+    etNE: APrevItem.Value := APrevItem.Value <> ANextItem.Value;
+    etGE: APrevItem.Value := APrevItem.Value >= ANextItem.Value;
+    etLE: APrevItem.Value := APrevItem.Value <= ANextItem.Value;
+    etGT: APrevItem.Value := APrevItem.Value > ANextItem.Value;
+    etLT: APrevItem.Value := APrevItem.Value < ANextItem.Value;
+    etOr: APrevItem.Value := APrevItem.Value or ANextItem.Value;
+    etAnd: APrevItem.Value := APrevItem.Value and ANextItem.Value;
+    else raise TRtfException.Create('Invalid comparison');
+  end;
+  if APrevItem.Value
+  then APrevItem.Token := etLitTrue
+  else APrevItem.Token := etLitFalse;
+
+  Remove(AArgument);
+  Remove(ANextItem);
+  if Assigned(Parser.OnEvalutate)
+  then Parser.OnEvalutate(Self);
+end;
+
+procedure TRtfArgument.EvaluateAssign(APrevItem, AArgument, ANextItem: TRtfArgument);
+var AVariable: TRtfVariable;
+begin
+  if APrevItem.Token <> etVariable
+  then raise TRtfException.Create('Invalid assignment');
+
+  AVariable := Parser.Variables.Find(APrevItem.Value);
+  if Assigned(AVariable) then begin
+    AVariable.Value := ANextItem.Value;
+    AVariable.Token := ANextItem.Token;
+  end
+  else AVariable := Parser.Variables.Add(APrevItem.Value, ANextItem.Value, ANextItem.Token);
+
+  APrevItem.Value := AVariable.Value;
+  APrevItem.Token := AVariable.Token;
+
+  Remove(AArgument);
+  Remove(ANextItem);
+  if Assigned(Parser.OnEvalutate)
+  then Parser.OnEvalutate(Self);
+end;
+
+procedure TRtfArgument.GetPictureData(ABuffer: pointer; ALength: cardinal; var Result: string);
+var ASrc: Pbyte;
+  ADst: pchar;
+  AIndex: cardinal;
+  i: integer;
+  s: string;
+begin
+  if poBinary in Parser.PictureOptions then begin
+    //Save graphic binary
+    Result := Format('%s\bin%d ',[Result, ALength]);
+    AIndex := Length(Result);
+    SetLength(Result, AIndex + ALength);
+    ADst := @Result[AIndex + 1];
+    System.Move(ABuffer^, ADst^, ALength);
+  end else begin
+    //Save graphics as hex
+    ASrc := ABuffer;
+    Result := Result + ' ';
+    AIndex := Length(Result);
+    SetLength(Result, AIndex + 2 *(ALength +(ALength div 128)));
+    ADst := @Result[AIndex + 1];
+    for i := 0 to ALength - 1 do begin
+      s := IntToHex(ASrc^, 2);
+      ADst^ := s[1];
+      Inc(ADst);
+      ADst^ := s[2];
+      Inc(ADst);
+      if(i > 0)and(i and 127 = 0) then begin
+        ADst^ := #13;
+        Inc(ADst);
+        ADst^ := #10;
+        Inc(ADst);
+      end;
+      Inc(ASrc);
+    end;
+  end;
+  Result := Result + #13#10 + '}';
+end;
+
+function TRtfArgument.GetPicture(APicture: TPicture): string;
+//Convert a picture to a string suitable for in the Rtf
+(*
+var
+  xw, yh: word;
+  Rect: TRect;
+  ARefDC: HDC;
+  ABuffer: pointer;
+  ALength: cardinal;
+  AMetafile: TMetafile;
+  ABorderWidth: integer;
+  APictureAttr: TRtfPictureAttr;
+  ppi, AColorIndex, xtw, ytw: integer;
+*)
+begin
+  Result := '';
+  (*
+  ppi := Screen.PixelsPerInch;
+
+  AMetafile := TMetaFile.Create;
+  try
+    AMetafile.Enhanced := true;
+
+    if poMetafile in Parser.PictureOptions then begin
+      AMetafile.Width := Round(APicture.Graphic.Width * ppi / 96);
+      AMetafile.Height := Round(APicture.Graphic.Height * ppi / 96);
+    end else begin
+      if(APicture.graphic is TMetafile)and not APicture.Metafile.Enhanced then begin
+        AMetafile.Height := APicture.graphic.Height;
+        AMetafile.Width := APicture.graphic.Width;
+      end else begin
+        AMetafile.Height := Round(APicture.graphic.Height * ppi / 96);
+        AMetafile.Width := Round(APicture.graphic.Width * ppi / 96);
+      end;
+    end;
+
+    Rect.Top := 0;
+    Rect.Left := 0;
+    Rect.Right := AMetafile.Width - 1;
+    Rect.Bottom := AMetafile.Height - 1;
+
+    with TMetaFileCanvas.Create(AMetafile, 0)do try
+      if ppi = 96
+      then Draw(0, 0, APicture.Graphic)
+      else StretchDraw(Rect, APicture.Graphic);
+    finally
+      Free;
+    end;
+
+    if(APicture.Graphic is TMetafile)and not APicture.Metafile.Enhanced then begin
+      xw := Round(APicture.Width * 96 / ppi);
+      yh := Round(APicture.Height * 96 / ppi);
+    end else begin
+      xw := APicture.Width;
+      yh := APicture.Height;
+    end;
+
+    APictureAttr := TRtfPictureAttr.Create(xw, yh);
+    try
+      AMetafile.MMWidth := Round(APictureAttr.Widthmm * 100);
+      AMetafile.MMHeight := Round(APictureAttr.Heigthmm * 100);
+
+      if poMetafile in Parser.PictureOptions then begin
+        xtw := Round(APictureAttr.Width * 26.4596930676);
+        ytw := Round(APictureAttr.Heigth * 26.4596930676);
+      end else begin
+        xtw := Round(5669 * APictureAttr.Widthmm / 100);
+        ytw := Round(5669 * APictureAttr.Heigthmm / 100);
+      end;
+
+      if Assigned(Parser.OnPictureAttr)
+      then Parser.OnPictureAttr(APictureAttr);
+
+      Result := Format('{\pict\picscalex%d\picscaley%d\piccropl0' +
+        '\piccropr0\piccropt0\piccropb0\picw%d\pich%d',
+        [APictureAttr.ScaleX, APictureAttr.ScaleY, xtw, ytw]);
+      if poMetafile in Parser.PictureOptions
+      then Result := Result + '\wmetafile8'
+      else Result := Result + '\emfblip';
+
+      if(APictureAttr.BorderType <> brNone)and(APictureAttr.BorderWidth > 0) then begin
+        case APictureAttr.BorderType of
+          brSingle: Result := Result + '\brdrs';
+          brDouble: Result := Result + '\brdrdb';
+          brThick: Result := Result + '\brdrth';
+          brShadow: Result := Result + '\brdrsh';
+          brDot: Result := Result + '\brdrdot';
+          brHair: Result := Result + '\brdrhair';
+        end;
+
+        ABorderWidth := APictureAttr.BorderWidth;
+        if ABorderWidth > 75
+        then ABorderWidth := 75;
+
+        AColorIndex := Parser.ColorList.UseColor(APictureAttr.BorderColor);
+        Result := Format('%s\brdrw%d\brdrcf%d',[Result, ABorderWidth, AColorIndex]);
+      end;
+    finally
+      APictureAttr.Free;
+    end;
+
+
+    if poMetafile in Parser.PictureOptions then begin
+      ARefDC := GetDC(0);
+      try
+        ALength := GetWinMetaFileBits(AMetafile.Handle, 0, nil, MM_ANISOTROPIC, ARefDC);
+        GetMem(ABuffer, ALength);
+        try
+          GetWinMetaFileBits(AMetafile.Handle, ALength, ABuffer, MM_ANISOTROPIC, ARefDC);
+          GetPictureData(ABuffer, ALength, Result);
+        finally
+          FreeMem(ABuffer);
+        end;
+      finally
+        ReleaseDC(0, ARefDc);
+      end;
+    end else begin
+      ALength := GetEnhMetaFileBits(AMetafile.Handle, 0, nil);
+      GetMem(ABuffer, ALength);
+      try
+        GetEnhMetaFileBits(AMetafile.Handle, ALength, ABuffer);
+        GetPictureData(ABuffer, ALength, Result);
+      finally
+        FreeMem(ABuffer);
+      end;
+    end;
+  finally
+    AMetafile.Free;
+  end;
+  *)
+end;
+
+procedure TRtfArgument.GetGraphicsValue(ADataset: TRtfDataset; AFieldName: string);
+(*
+var
+  APicture: TPicture;
+  ABlob: TBlobField;
+  APhoto: TJPEGImage;
+  AStream: TStringStream;
+  s: string[20];
+  AField: TField;
+*)
+begin
+(*
+  Value := varEmpty;
+  Token := etNothing;
+  if ADataset.Dataset is TDataset then begin
+    AField :=(ADataset.Dataset as TDataset).FieldByName(AFieldName);
+
+    APicture := TPicture.Create;
+    try
+      ABlob := AField as TBlobField;
+      s := Copy(ABlob.Value, 1, 20);
+      if(Pos('GIF8', s) > 0)or(Pos('JFIF', s) > 0) then begin
+        APhoto := TJPEGImage.Create;
+        try
+          AStream := TStringStream.Create(ABlob.AsString);
+          APhoto.LoadFromStream(AStream);
+          APicture.Assign(APhoto);
+        finally
+          FreeAndNil(APhoto);
+          FreeAndNil(AStream);
+        end;
+      end
+      else APicture.Assign(ABlob);
+
+      if Assigned(APicture.Graphic) then begin
+        Value := GetPicture(APicture);
+        Token := etLitString;
+      end;
+
+    finally
+      APicture.Free;
+    end;
+  end
+  else
+    raise TRtfException.Create('Graphic fields worden alleen ondersteund via de tdataset!');
+*)
+end;
+
+procedure TRtfArgument.ResolveFieldValue(ADataset: TRtfDataset; AFieldName: string);
+//Get field data from a dataset object
+var
+  AObject: TObject;
+  APropInfo: PPropInfo;
+  ATypedata: PTypeData;
+  ATable: TDataset;
+  AField: TField;
+begin
+  //Can't resolve that
+  if AFieldName = '' then
+    raise TRtfException.Create('invalid fieldname');
+
+  if ADataset.Dataset is TDataset then
+  begin
+    ATable := ADataset.Dataset as TDataset;
+    AField := ATable.FieldByName(AFieldName);
+    case AField.DataType of
+      ftMemo, ftFmtMemo, ftFixedChar, ftWideString, ftString: begin
+        Token := etLitString;
+        Value := AField.AsString;
+      end;
+      ftLargeint, ftAutoInc, ftSmallint, ftInteger, ftWord: begin
+        Token := etLitInt;
+        Value := AField.AsInteger;
+      end;
+      ftBoolean: begin
+        Value := AField.AsBoolean;
+        if Value then
+          Token := etLitTrue
+        else
+          Token := etLitFalse;
+      end;
+      ftFloat, ftCurrency, ftBCD: begin
+        Token := etLitFloat;
+        Value := AField.AsFloat;
+      end;
+      ftDate, ftTime, ftDateTime, ftTimeStamp: begin
+        Token := etLitDate;
+        Value := AField.AsDateTime;
+      end;
+      ftGraphic: begin
+        GetGraphicsValue(ADataset, AFieldName);
+      end;
+      else
+        raise TRtfException.CreateFmt('Unable to convert field "%s" value',[AFieldName]);
+    end;
+  end
+  else
+  begin
+    AObject := ADataset.Dataset;
+    if AObject is TtiObjectList then
+    begin
+      //Get the right record from the array
+      if ADataset.TableIndex <(AObject as TtiObjectList).Count then
+        AObject :=(AObject as TtiObjectList)[ADataset.TableIndex]
+      else
+      begin //Trying beyond eof (or empty dataset) big problem; nah?
+        Token := etNothing;
+        Value := varEmpty;
+        exit;
+      end;
+    end;
+    APropInfo := GetPropInfo(AObject, AFieldName);
+    if not Assigned(APropInfo) then
+      raise TRtfException.CreateFmt('Field "%s" does not exist',[AFieldName]);
+    if not Assigned(APropInfo^.GetProc) then
+      raise TRtfException.CreateFmt('Cannot access field "%s"',[AFieldName]);
+    {$IFDEF FPC}
+    ATypeData := GetTypeData(APropInfo^.PropType);
+    {$ELSE}
+    ATypeData := GetTypeData(APropInfo^.PropType^);
+    {$ENDIF}
+
+    case APropInfo^.PropType^.Kind of
+      tkChar, tkString, tkLString, tkWString{$IFDEF FPC},tkAString{$ENDIF}: begin
+        Token := etLitString;
+        Value := GetStrProp(AObject, APropInfo);
+      end;
+      tkInt64: begin
+        Token := etLitInt;
+        Value := GetInt64Prop(AObject, APropInfo);
+      end;
+      tkSet, tkInteger: begin
+        Token := etLitInt;
+        Value := GetOrdProp(AObject, APropInfo);
+      end;
+      tkEnumeration: begin
+        {$IFDEF FPC}
+        if ATypeData^.BaseType = TypeInfo(boolean) then
+        {$ELSE}
+        if ATypeData^.BaseType^ = TypeInfo(boolean) then
+        {$ENDIF}
+        begin
+          Value := GetOrdProp(AObject, APropInfo) = 1;
+          if Value then
+            Token := etLitTrue
+          else
+            Token := etLitFalse;
+        end
+        else
+        begin
+          Token := etLitInt;
+          Value := GetOrdProp(AObject, APropInfo);
+        end;
+      end;
+      tkFloat: begin
+        if SameText(APropInfo^.PropType^.Name, 'TDate')
+            or SameText(APropInfo^.PropType^.Name, 'TTime')
+            or SameText(APropInfo^.PropType^.Name, 'TDateTime') then
+          Token := etLitDate
+        else
+          Token := etLitFloat;
+        Value := GetFloatProp(AObject, APropInfo);
+      end;
+      else
+        raise TRtfException.CreateFmt('Unable to convert field "%s" value',[AFieldName]);
+    end;  { case }
+  end;  { if/else }
+end;
+
+procedure TRtfArgument.ResolveVariable;
+var AVariable: TRtfVariable;
+  AText, AFieldName: string;
+  ADataset: TRtfDataset;
+  AIndex: integer;
+begin
+  AText := Value;
+  AIndex := Pos('.', AText);
+  if AIndex > 0 then begin
+    //Its a dataset reference @Table.Fieldname
+    AFieldName := Copy(AText, AIndex + 1, Maxint);
+    AText := Copy(AText, 1, AIndex - 1);
+
+    AVariable := Parser.Variables.Find(AText);
+    if not Assigned(AVariable)
+    then raise TRtfException.Create('variable does not exist');
+    Token := AVariable.Token;
+    Value := AVariable.Value;
+    if Token <> etDataset
+    then raise TRtfException.Create('variable is not a dataset');
+
+    ADataset := TRtfDataset(integer(Value));
+    ADataset := ADataset.ResolveNestedFields(ADataset, AFieldName, AFieldName);
+    if AFieldName = '' then begin
+      //Its a (nested) dataset
+      Token := etDataset;
+      Value := integer(ADataset);
+    end
+    else ResolveFieldValue(ADataset, AFieldName);
+  end else begin
+    AVariable := Parser.Variables.Find(AText);
+    if not Assigned(AVariable)
+    then raise TRtfException.Create('variable does not exist');
+    Token := AVariable.Token;
+    Value := AVariable.Value;
+  end;
+end;
+
+procedure TRtfArgument.ResolveFieldName;
+//Resolve dataset names or fieldnames (seperated with ".")
+var ADataset: TRtfDataset;
+  AFieldName: string;
+begin
+  //Otherwise it should be a table reference or fieldname
+  ADataset := Parser.Datasets.Find(Value, AFieldName);
+  if not Assigned(ADataset) //There should be at least a table reference.
+  then raise TRtfException.CreateFmt('Dataset "%s" not found',[Value]);
+  if AFieldName <> ''
+  then ResolveFieldValue(ADataset, AFieldName)
+  else begin
+    //Its a dataset or objectlist reference
+    Token := etDataset;
+    Value := integer(ADataset);
+  end;
+end;
+
+procedure TRtfArgument.Walk(ATokenset: TRtfTokenSet; AExecproc: TRtfArgumentEvent);
+//Not really neat (what can you expect in 1 day)
+var i: integer;
+  AText: string;
+  AResolve: boolean;
+  AParent, APrevItem, AArgument, ANextItem: TRtfArgument;
+begin
+  if Count > 0 then begin
+    i := 0;
+    while i < Count do begin
+      AArgument := Items[i];
+
+      if AArgument.Token = etVariable then begin
+        if(i >= Count - 1)or(Items[i + 1].Token <> etAssign)
+        then AArgument.ResolveVariable;
+      end else if AArgument.Token = etFieldName then begin
+        //An exception is the DbPicture(Table.Field). It shoud not evaluate
+        //since the DbPicture function should be responsible for that.
+        AResolve := true;
+        AParent := AArgument.Parent;
+        if Assigned(AParent) then begin
+          AText := AParent.Value;
+          if SameText(AText, 'DbPicture')
+          then AResolve := false;
+        end;
+        if AResolve
+        then AArgument.ResolveFieldName;
+      end;
+
+      if AArgument.Token = etNot then begin
+        if i < Count - 1
+        then ANextItem := Items[i + 1]
+        else raise TRtfException.Create('invalid formula');
+        if ANextItem.Token = etLitFalse
+        then ANextItem.Value := true
+        else if ANextItem.Token = etLitTrue
+        then ANextItem.Value := false
+        else raise TRtfException.Create('invalid formula');
+        Remove(AArgument);
+      end else if AArgument.Token in ATokenSet then begin
+        if i > 0
+        then APrevItem := Items[i - 1]
+        else raise TRtfException.Create('invalid formula');
+        if i < Count - 1
+        then ANextItem := Items[i + 1]
+        else raise TRtfException.Create('invalid formula');
+        AExecproc(APrevItem, AArgument, ANextItem);
+      end
+      else Inc(i);
+    end;
+
+    if(Count = 1)and(Token = etParenthesis) then begin
+      //Advance the answer from between parenthesis to parent.
+      AArgument := Items[0];
+      Value := AArgument.Value;
+      Token := AArgument.Token;
+      Remove(AArgument);
+      if Assigned(Parser.OnEvalutate)
+      then Parser.OnEvalutate(Self);
+    end;
+  end;
+end;
+
+procedure TRtfArgument.EvaluateExpression;
+//Not really neat (what can you expect in 1 day)
+//Evaluate the entered expression via ParseExpression()
+var AFunction: TRtfFunction;
+  AArgument: TRtfArgument;
+  i: integer;
+begin
+  if Count > 0 then begin
+    //First the binary operators
+    Walk([etMul, etDiv], {$IFDEF FPC}@{$ENDIF}EvaluateUnaryBinary);
+    //Secondly the unary operators
+    Walk([etAdd, etSub], {$IFDEF FPC}@{$ENDIF}EvaluateUnaryBinary);
+    //And finally the simple comparisons
+    Walk([etEQ, etNE, etGE, etLE, etGT, etLT], {$IFDEF FPC}@{$ENDIF}EvaluateComparison);
+    //And finally the more "complicated" comparisons
+    Walk([etAnd, etOr], {$IFDEF FPC}@{$ENDIF}EvaluateComparison);
+  end;
+
+
+  if Token in[etFunction, etProcedure] then begin
+    AFunction := Parser.Functions.Find(Value);
+    if not Assigned(AFunction)
+    then raise TRtfException.Create('Cannot resolve function');
+
+    if not Assigned(AFunction.OnExecute)
+    then raise TRtfException.Create('Cannot resolve function');
+
+    //Remove now redundant comma's
+    for i := Count - 1 downto 0 do begin
+      AArgument := Items[i];
+      if AArgument.Token = etComma
+      then Remove(AArgument)
+      else if VarIsEmpty(AArgument.Value)
+      then raise TRtfException.Create('Function needs valid parameters');
+    end;
+
+    if Count < AFunction.Min
+    then raise TRtfException.Create('expected more parameters');
+    if Count > AFunction.Max
+    then raise TRtfException.Create('to many parameters');
+
+    Value := varEmpty;
+    Token := etNothing;
+    if Assigned(Parser.OnEvalutate)
+    then Parser.OnEvalutate(Self);
+    AFunction.OnExecute(Self);
+    Clear; //Clear parameters
+    if Assigned(Parser.OnEvalutate)
+    then Parser.OnEvalutate(Self);
+  end;
+
+  //And not to forget  any optional assignments
+  if Count > 0
+  then Walk([etAssign], {$IFDEF FPC}@{$ENDIF}EvaluateAssign);
+end;
+
+procedure TRtfArgument.Evaluate;
+//Not really neat (what can you expect in 1 day)
+//Evaluate the expression (not very efficient, but what the hack)
+var i: integer;
+  AText: string;
+  AArgument: TRtfArgument;
+begin
+  for i := 0 to Count - 1 do begin
+    AArgument := Items[i];
+    AArgument.Evaluate;
+  end;
+  EvaluateExpression;
+
+  if(Parent = nil)and(Count > 1)
+  then raise TRtfException.Create('invalid formula');
+
+  if Count = 1 then begin
+    //Advance the answer from between parenthesis to parent.
+    AArgument := Items[0];
+    Value := AArgument.Value;
+    Token := AArgument.Token;
+    Param := AArgument.Param;
+    Clear;
+    if Assigned(Parser.OnEvalutate)
+    then Parser.OnEvalutate(Self);
+  end;
+
+  if Token = etLitString then begin
+    //Fix: DbExpres appends a #0 character to memo fields
+    AText := Value;
+    if(Length(AText) > 0)and(AText[Length(AText)] = #0)
+    then Value := Copy(AText, 1, Length(AText) - 1);
+  end;
+end;
+
+
+{ TRtfColor }
+
+function TRtfColor.GetAsString: string;
+begin
+  Result := Format('\red%d\green%d\blue%d;',[Red, Green, Blue]);
+end;
+
+{ TRtfColorList }
+
+function TRtfColorList.GetItem(Index: integer): TRtfColor;
+begin
+  Result := TRtfColor(inherited Items[Index]);
+end;
+
+procedure TRtfColorList.Clear;
+begin
+  inherited;
+  Add(0, 0, 0); //Dummy color..
+end;
+
+function TRtfColorList.Add(ARed, AGreen, ABlue: integer): integer;
+var AColor: TRtfColor;
+begin
+  AColor := TRtfColor.Create;
+  AColor.Red := ARed;
+  AColor.Green := AGreen;
+  AColor.Blue := ABlue;
+  Result := inherited Add(AColor);
+end;
+
+function TRtfColorList.Find(ARed, AGreen, ABlue: integer): integer;
+var
+  i: integer;
+  AColor: TRtfColor;
+begin
+  //0 is a dummy color
+  for i := 1 to Count - 1 do
+  begin
+    AColor := Items[i];
+    if(AColor.Red = ARed)and(AColor.Green = AGreen)and(AColor.Blue = ABlue) then
+    begin
+      Result := i;
+      exit;
+    end;
+  end;
+  Result := - 1;
+end;
+
+function TRtfColorList.GetAsString: string;
+var
+  i: integer;
+  AColor: TRtfColor;
+begin
+  Result := '';
+  //0 is a dummy color
+  for i := 1 to Count - 1 do
+  begin
+    AColor := Items[i];
+    Result := Result + AColor.AsString;
+  end;
+end;
+
+function TRtfColorList.UseColor(ARed, AGreen, ABlue: integer): integer;
+begin
+  Result := Find(ARed, AGreen, ABlue);
+  if Result < 0
+  then Result := Add(ARed, AGreen, ABlue);
+end;
+
+function TRtfColorList.UseColor(AColor: TColor): integer;
+var ARed, AGreen, ABlue: integer;
+begin
+  ARed := AColor and 255;
+  AColor := AColor shr 8;
+  AGreen := AColor and 255;
+  AColor := AColor shr 8;
+  ABlue := AColor and 255;
+  Result := UseColor(ARed, AGreen, ABlue);
+end;
+
+
+{ TtiRtfParser }
+
+constructor TtiRtfParser.Create;
+begin
+  inherited Create;
+  FBoolTrue := 'Ja';
+  FBoolFalse := 'Nee';
+  FErrorForeColor := clRed;
+  FErrorBackColor := clYellow;
+  FPictureOptions :=[poMetafile, poBinary];
+  FHlpItems := TRtfItem.Create;
+  TmpItems := TObjectlist.Create;
+  FDatasets := TRtfDataset.Create;
+  FRtfItems := TRtfItemList.Create;
+  FRawItems := TRtfItemList.Create;
+  FColorList := TRtfColorList.Create;
+  FVariables := TRtfVariableList.Create;
+  FFunctions := TRtfFunctionList.Create;
+  AddFunctions;
+end;
+
+destructor TtiRtfParser.Destroy;
+begin
+  FDatasets.Free;
+  FRtfItems.Free;
+  TmpItems.Free;
+  FHlpItems.Free;
+  FVariables.Free;
+  FFunctions.Free;
+  FRawItems.Free;
+  FColorList.Free;
+  inherited;
+end;
+
+procedure TtiRtfParser.Clear;
+begin
+  TmpItems.Clear;
+  RawItems.Clear;
+  RtfItems.Clear;
+  HlpItems.Clear;
+  ColorList.Clear;
+end;
+
+procedure TtiRtfParser.SaveToFile(AFileName: string);
+var AStream: TMemoryStream;
+begin
+  AStream := TMemoryStream.Create;
+  try
+    RtfItems.SaveToStream(AStream, ColorList.AsString);
+    AStream.SaveToFile(AFileName);
+  finally
+    AStream.Free;
+  end;
+end;
+
+function TtiRtfParser.SaveToString: string;
+var AStream: TMemoryStream;
+begin
+  Result := '';
+  AStream := TMemoryStream.Create;
+  try
+    RtfItems.SaveToStream(AStream, ColorList.AsString);
+    SetLength(Result, AStream.Size);
+    if AStream.Size > 0 //Humble admitted its a bit dirty
+    then Move(AStream.Memory^, Result[1], AStream.Size);
+  finally
+    AStream.Free;
+  end;
+end;
+
+procedure TtiRtfParser.SaveToStream(AStream: TMemoryStream);
+begin
+  RtfItems.SaveToStream(AStream, ColorList.AsString);
+end;
+
+function TtiRtfParser.AddVariable(AName: string; AValue: variant; AToken: TRtfToken): TRtfVariable;
+begin
+  Result := Variables.Add(AName, AValue, AToken);
+end;
+
+function TtiRtfParser.AddDataset(ATable: TObject; AName: string; AFreeDataset: boolean = false): TRtfDataset;
+begin
+  Result := Datasets.Add(ATable, AName, AFreeDataset);
+end;
+
+function TtiRtfParser.AddFunction(AName: string; ATokenType: TRtfToken; AMin, AMax: smallint; AOnexecute: TRtfFunctionExecute): TRtfFunction;
+begin
+  Result := Functions.Add(ATokenType, AName, AMin, AMax, AOnexecute);
+end;
+
+function TtiRtfParser.AddToRtfItems(AItem: TRtfItem): TRtfItem;
+begin
+  Result := TRtfItem.Create;
+  Result.Assign(AItem);
+  RtfItems.Add(Result);
+end;
+
+procedure TtiRtfParser.LoadFromFile(AFilename: string);
+//Tokenize the raw rtf and put it into rawitems
+var
+  AStream: TMemoryStream;
+begin
+  Clear;
+  AStream := TMemoryStream.Create;
+  try
+    AStream.LoadFromFile(AFileName);
+    LoadFromBuffer(AStream.Memory, AStream.Size);
+  finally
+    FreeAndNil(AStream);
+  end;
+end;
+
+procedure TtiRtfParser.LoadFromStream(AStream: TMemoryStream);
+//Tokenize the raw rtf and put it into rawitems
+begin
+  LoadFromBuffer(AStream.Memory, AStream.Size);
+end;
+
+procedure TtiRtfParser.LoadFromString(AString: string);
+//Tokenize the raw rtf and put it into rawitems
+begin
+  LoadFromBuffer(pchar(AString), Length(AString));
+end;
+
+procedure TtiRtfParser.LoadFromBuffer(ABuffer: pchar; ASize: integer);
+//Tokenize the raw rtf and put it into rawitems
+var AColorTable: TRtfItem;
+  AColors, AToken: string;
+  ANumber, ARed, AGreen, ABlue: integer;
+  p: pchar;
+begin
+  Clear;
+  with TRawRtfParser.Create do try
+    Execute(FRawItems, ABuffer, ASize);
+    AColorTable := ColorTable;
+  finally
+    Free;
+  end;
+
+  if not Assigned(AColorTable)
+  then raise TRtfException.Create('no colortbl found');
+
+  //Parse the color table (tiny parser)
+  ARed := 0;
+  ABlue := 0;
+  AGreen := 0;
+  AColors := Copy(AColorTable.RtfTextBuf, 11, Maxint);
+  p := pchar(AColors);
+  while p <> #0 do begin
+    case p^ of
+      '\': begin
+        inc(p);
+        AToken := '';
+        ANumber := 0;
+        while(p^ in['A'..'Z', 'a'..'z'])do begin
+          AToken := AToken + p^;
+          inc(p);
+        end;
+        while(p^ in['0'..'9'])do begin
+          ANumber :=(ANumber * 10) +(ord(p^) - ord('0'));
+          inc(p);
+        end;
+        ANumber := ANumber and 255;
+        if SameText(AToken, 'red')
+        then ARed := ANumber
+        else if SameText(AToken, 'blue')
+        then ABlue := ANumber
+        else if SameText(AToken, 'green')
+        then AGreen := ANumber;
+      end;
+      ';': begin
+        inc(p);
+        ColorList.UseColor(ARed, AGreen, ABlue);
+        ARed := 0;
+        ABlue := 0;
+        AGreen := 0;
+      end;
+      #13, #10: inc(p);
+      '}': break;
+      else raise TRtfException.Create('Invalid character in colortbl');
+    end;
+  end;
+
+  (*
+  {\colortbl;\red0\green0\blue;\red255\green0\blue;\red255\green255\blue;\red0\green255\blue;\red255\green0\blue;\red0\green0\blue;\red0\green255\blue;\red255\green255\blue;\red128\green0\blue;\red128\green128\blue;\red0\green128\blue;\red128\green0\blue;\red0\green0\blue;\red0\green128\blue;\red128\green128\blue;\red192\green192\blue;}
+  *)
+end;
+
+procedure TtiRtfParser.Execute;
+//Rtf has been already been loaded
+begin
+  PreParse; //Create a tree for easy parsing of if-then-else and scan-endscan etc.
+  Parse(HlpItems); //Parse the tree items in the structure..
+end;
+
+procedure TtiRtfParser.PreParse;
+//Preparse the items from Items to Structure
+//This will make a tree from (sub)expressions and code.
+//Specially for the if/else/endif and scan/scanend
+var AIndex, AForeColor, ABackColor: integer;
+  AItem, AStart, ABranche: TRtfItem;
+  AArguments: TRtfArgument;
+  ARemoveParagraph: boolean;
+  AFirstArgument: string;
+  AFirstToken: TRtfToken;
+  AText: string;
+begin
+  AItem := RawItems.Head;
+  AArguments := TRtfArgument.Create(Self);
+  try
+    //Round 1: create expression nodes
+    while Assigned(AItem)do begin
+      if AItem.RtfClass = RtfParsebegin then begin
+
+        //Items starts with a RtfParseBegin
+        AText := AItem.RtfTextBuf; //Initial expression
+        AStart := HlpItems[HlpItems.Add(AItem)];
+        AStart.RtfClass := RtfExpression;
+        AStart.RtfMajor := RtfNormalExpression;
+        AStart.RtfTextBuf := '';
+        AItem := AItem.Next;
+        while Assigned(AItem)do begin
+          case AItem.RtfClass of
+            RtfParseEnd: begin //End of expression
+              AText := AText + AItem.RtfTextBuf;
+              AItem := AItem.Next; //Skip's ParseEnd
+              break;
+            end;
+            RtfParseBegin: begin //WTF: Start of expression, this should not happen. Inform user
+              raise TRtfException.Create('Error in preparse? at ' + AText);
+            end;
+            RtfText: AText := AText + AItem.RtfTextBuf;
+            RtfControl: begin
+              case AItem.RtfMajor of
+                RtfSpecialChar: begin //Add some special characters
+                  case AItem.RtfMinor of
+                    RtfPar, RtfParDef:; //Ignore these
+                    RtflQuote, RtfrQuote: AText := AText + Chr(39);
+                    RtflDblQuote, RtfrDblQuote: AText := AText + '"';
+                    else AText := AText + AItem.RtfTextBuf; //Hope this is Ok?
+                  end;
+                end;
+                else HlpItems.Add(AItem);
+              end;
+            end;
+            else HlpItems.Add(AItem);
+          end;
+          AItem := AItem.Next;
+        end;
+
+        AStart.RtfTextBuf := StringReplace(AText, #13#10, '',[rfReplaceAll]);
+        AArguments.Clear;
+        ARemoveParagraph := true;
+        try
+          AArguments.ParseExpression(AText);
+        except
+          on e: Exception do begin
+            //Ignore at this moment, it will be triggered again in the Parse()
+          end;
+        end;
+        if AArguments.Count > 0 then begin
+          AFirstToken := AArguments[0].Token;
+          AFirstArgument := AArguments[0].Value;
+          if SameText(AFirstArgument, 'if')
+          then AStart.RtfMajor := RtfIfExpression
+          else if SameText(AFirstArgument, 'else')
+          then AStart.RtfMajor := RtfElseExpression
+          else if SameText(AFirstArgument, 'endif')
+          then AStart.RtfMajor := RtfEndifExpression
+          else if SameText(AFirstArgument, 'scan')
+          then AStart.RtfMajor := RtfScan
+          else if SameText(AFirstArgument, 'endscan')
+          then AStart.RtfMajor := RtfScanEnd
+          else if SameText(AFirstArgument, 'scanentry')
+          then AStart.RtfMajor := RtfScanEntry
+          else if SameText(AFirstArgument, 'scanfooter')
+          then AStart.RtfMajor := RtfScanFooter;
+          ARemoveParagraph := AFirstToken in[etVariable, etProcedure, etNothing];
+          if(AFirstToken = etVariable)and(AArguments.Count = 1)
+          then ARemoveParagraph := false; //One exception: variable reference
+        end;
+
+        if ARemoveParagraph
+        then AItem := SkipParagraph(AItem);
+      end else begin
+        HlpItems.Add(AItem);
+        AItem := AItem.Next;
+      end;
+    end;
+
+  finally
+    AArguments.Free;
+  end;
+
+  //Round 2: create if then else expression sub-nodes
+  AIndex := 0;
+  ABranche := nil;
+  while AIndex < HlpItems.Count do begin
+    AItem := HlpItems[AIndex];
+    try
+
+      if AItem.CheckItem(RtfExpression, RtfIfExpression) then begin
+        if Assigned(ABranche) then begin
+          HlpItems.Extract(AItem);
+          ABranche.Add(AItem);
+        end
+        else Inc(AIndex);
+
+        ABranche := TRtfItem.Create;
+        ABranche.RtfClass := RtfBranche;
+        ABranche.RtfMajor := RtfThenExpression;
+        TmpItems.Add(ABranche); //Otherwise memory leak
+        AItem.Add(ABranche);
+      end else if AItem.CheckItem(RtfExpression, RtfElseExpression) then begin
+        if not Assigned(ABranche)
+        then raise TRtfException.Create('unexpected else');
+
+        HlpItems.Extract(AItem); //Remove else item
+        AItem := ABranche.Parent; //Points to "if" statement
+        if AItem.RtfClass = RtfBranche
+        then AItem := AItem.Parent; //Points to "if" statement
+        if not Assigned(AItem)
+        then raise TRtfException.Create('unexpected else');
+        if not AItem.CheckItem(RtfExpression, RtfIfExpression)
+        then raise TRtfException.Create('unexpected scanentry');
+
+        ABranche := TRtfItem.Create;
+        ABranche.RtfClass := RtfBranche;
+        ABranche.RtfMajor := RtfElseExpression;
+        TmpItems.Add(ABranche); //Otherwise memory leak
+        AItem.Add(ABranche);
+      end else if AItem.CheckItem(RtfExpression, RtfEndifExpression) then begin
+        if not Assigned(ABranche)
+        then raise TRtfException.Create('unexpected endif');
+
+        HlpItems.Extract(AItem); //Remove item
+        ABranche := ABranche.Parent;
+        ABranche := ABranche.Parent;
+        if ABranche = HlpItems
+        then ABranche := nil;
+      end else if AItem.CheckItem(RtfExpression, RtfScan) then begin
+
+        if Assigned(ABranche) then begin
+          HlpItems.Extract(AItem);
+          ABranche.Add(AItem);
+        end
+        else Inc(AIndex);
+
+        ABranche := TRtfItem.Create;
+        ABranche.RtfClass := RtfBranche;
+        ABranche.RtfMajor := RtfScan;
+        TmpItems.Add(ABranche); //Otherwise memory leak
+        AItem.Add(ABranche);
+      end else if AItem.CheckItem(RtfExpression, RtfScanEntry) then begin
+        if not Assigned(ABranche)
+        then raise TRtfException.Create('unexpected scanentry');
+
+        HlpItems.Extract(AItem); //Remove else item
+        AItem := ABranche.Parent; //Points to "scan" statement
+        if AItem.RtfClass = RtfBranche
+        then AItem := AItem.Parent; //Points to "scan" statement
+        if not Assigned(AItem)
+        then raise TRtfException.Create('unexpected scanentry');
+        if not AItem.CheckItem(RtfExpression, RtfScan)
+        then raise TRtfException.Create('unexpected scanentry');
+
+        ABranche := TRtfItem.Create;
+        ABranche.RtfClass := RtfBranche;
+        ABranche.RtfMajor := RtfScanEntry;
+        TmpItems.Add(ABranche); //Otherwise memory leak
+        AItem.Add(ABranche);
+      end else if AItem.CheckItem(RtfExpression, RtfScanFooter) then begin
+        if not Assigned(ABranche)
+        then raise TRtfException.Create('unexpected scanfooter');
+
+        HlpItems.Extract(AItem); //Remove item
+        AItem := ABranche.Parent; //Points to "scan" statement
+        if AItem.RtfClass = RtfBranche
+        then AItem := AItem.Parent; //Points to "scan" statement
+        if not Assigned(AItem)
+        then raise TRtfException.Create('unexpected scanfooter');
+        if not AItem.CheckItem(RtfExpression, RtfScan)
+        then raise TRtfException.Create('unexpected scanfooter');
+
+        ABranche := TRtfItem.Create;
+        ABranche.RtfClass := RtfBranche;
+        ABranche.RtfMajor := RtfScanFooter;
+        TmpItems.Add(ABranche); //Otherwise memory leak
+        AItem.Add(ABranche);
+      end else if AItem.CheckItem(RtfExpression, RtfScanEnd) then begin
+        if not Assigned(ABranche)
+        then raise TRtfException.Create('unexpected scanend');
+
+        HlpItems.Extract(AItem); //Remove item
+        ABranche := ABranche.Parent;
+        ABranche := ABranche.Parent;
+        if ABranche = HlpItems
+        then ABranche := nil;
+      end else begin
+        if Assigned(ABranche) then begin
+          HlpItems.Extract(AItem);
+          ABranche.Add(AItem);
+        end
+        else Inc(AIndex);
+      end;
+    except
+      on e: Exception do begin
+        fpgApplication.HandleException(e);
+{
+        if Assigned(AItem)
+        then AItem.RtfTextBuf := AItem.RtfTextBuf + ' ' + E.Message;
+}
+      end;
+    end;
+  end;
+
+  if Assigned(ABranche) then begin
+    if Assigned(AItem) then begin
+      AForeColor := ColorList.UseColor(ErrorForeColor);
+      ABackColor := ColorList.UseColor(ErrorBackColor);
+      AItem.FRtfTextBuf := Format('{\b\ul\highlight%d\cf%d <<<<endif or endscan missing}%s',[ABackColor, AForeColor, AItem.RtfTextBuf]);
+    end;
+  end;
+end;
+
+function TtiRtfParser.SkipParagraph(AItem: TRtfItem): TRtfItem;
+//Remove paragraph breaks if it was just a procedure (or a VAR/SET etc.)
+//This can be multiple breaks (CrLf and /Par controls) but
+//do not remove more than a single item from each of them
+var AEnter, APar, AParDef: boolean;
+begin
+  APar := false;
+  AEnter := false;
+  AParDef := false;
+  while Assigned(AItem) do
+  begin
+    case AItem.RtfClass of
+      RtfText: begin
+        if not AEnter and(Pos(#13#10, AItem.RtfTextBuf) > 0) then
+        begin
+          //Crap, it can contain multiple #13#10's
+          AItem.RtfTextBuf := StringReplace(AItem.RtfTextBuf, #13#10, '',[rfReplaceAll]);
+          AItem := AItem.Next;
+          AEnter := true;
+          continue;
+        end
+        else
+          break;
+      end;
+      RtfControl: begin
+        case AItem.RtfMajor of
+          RtfSpecialChar: begin
+            case AItem.RtfMinor of
+              RtfPar: begin
+                if not APar then
+                begin
+                  AItem := AItem.Next;
+                  APar := true;
+                  continue;
+                end
+                else
+                  break;
+              end;
+              RtfParDef: begin
+                if not AParDef then
+                begin
+                  AItem := AItem.Next;
+                  AParDef := true;
+                  continue;
+                end
+                else
+                  break;
+              end;
+            end;
+          end;
+        end;
+      end;
+    end;
+    break;
+  end;
+  Result := AItem;
+end;
+
+procedure TtiRtfParser.Parse(AItems: TRtfItem);
+//Forward all stuff to the output list
+var
+  i: integer;
+  AItem: TRtfItem;
+begin
+  for i := 0 to AItems.Count - 1 do
+  begin
+    AItem := AItems[i];
+    if AItem.RtfClass = RtfExpression then
+      ParseExpression(AItem)
+    else
+      AddToRtfItems(AItem);
+  end;
+end;
+
+procedure TtiRtfParser.ParseExpression(AItem: TRtfItem);
+var
+  i, ABackColor, AForeColor: integer;
+  ARemove: boolean;
+  ADataset: TRtfDataset;
+  AScanNoEof: boolean;
+  AExpression: string;
+  AResultValue: variant;
+  AResultParam: integer;
+  AResultToken: TRtfToken;
+  AArguments: TRtfArgument;
+  AAnswer, ATemp, AHeader, ARecord, AFooter: TRtfItem;
+begin
+  AExpression := AItem.RtfTextBuf;
+  AAnswer := AddToRtfItems(AItem);
+  AAnswer.RtfTextBuf := '';
+
+  try
+    ARemove := true;
+    AArguments := TRtfArgument.Create(Self);
+    try
+      AArguments.ParseExpression(AExpression);
+      if AArguments.Count > 0 then
+      begin
+        //procedures and variables have no returning value and etNothing, well
+        ARemove := AArguments[0].Token in[etVariable, etProcedure, etNothing];
+        if (AArguments[0].Token = etVariable) and (AArguments.Count = 1) then
+          ARemove := false; //But show a single variable
+      end;
+      if Assigned(OnEvalutate) then //debug
+        OnEvalutate(AArguments);
+      AArguments.Evaluate;
+      AResultToken := AArguments.Token;
+      AResultValue := AArguments.Value;
+      AResultParam := AArguments.Param;
+      if Assigned(OnEvalutate) then //debug
+        OnEvalutate(AArguments);
+
+      case AItem.RtfMajor of
+        RtfNormalExpression: begin
+          if not ARemove then begin
+            //Expand booleans and date to text values (date because Variant
+            //have no typing for it. Place the text into the output rtf
+            if AResultToken = etLitTrue then
+              AAnswer.RtfTextBuf := BoolTrue
+            else if AResultToken = etLitFalse then
+              AAnswer.RtfTextBuf := BoolFalse
+            else if AResultToken = etLitDate then
+            begin
+              if Frac(AResultValue) = 0 then
+                AAnswer.RtfTextBuf := DateToStr(AResultValue)
+              else if Int(AResultValue) = 0 then
+                AAnswer.RtfTextBuf := TimeToStr(AResultValue)
+              else
+                AAnswer.RtfTextBuf := DateTimeToStr(AResultValue);
+            end
+            else
+              AAnswer.RtfTextBuf := VarToStr(AResultValue);
+          end;
+        end;
+        
+        RtfIfExpression:
+            begin
+              if AResultToken = etLitTrue then
+                Parse(AItem[0])
+              else if(AResultToken = etLitFalse)and(AItem.Count > 1) then
+                Parse(AItem[1]);
+            end;
+
+        RtfScan:
+            begin
+        //Scan(Dataset). Find out what items is header, record and footer
+          ARecord := nil;
+          AHeader := nil;
+          AFooter := nil;
+          ADataset := TRtfDataset(integer(AResultValue)); //Dirty!
+
+          for i := 0 to AItem.Count - 1 do begin
+            ATemp := AItem[i];
+            case ATemp.RtfMajor of
+              RtfScan: AHeader := ATemp;
+              RtfScanEntry: ARecord := ATemp;
+              RtfScanFooter: AFooter := ATemp;
+            end;
+          end;
+
+          if AHeader = ARecord
+          then AHeader := nil;
+          if ARecord = nil then begin
+            ARecord := AHeader;
+            AHeader := nil;
+          end;
+
+          AScanNoEof := AResultParam = 1;
+
+          //And evaluate the Scan(dataset)
+          ADataset.Open;
+          if Assigned(AHeader)
+          then Parse(AHeader);
+          ADataset.First;
+
+          if AScanNoEof and ADataset.Eof
+          then exit; //Also no footer..
+
+          while not ADataset.Eof do begin
+            if Assigned(ARecord)
+            then Parse(ARecord);
+            ADataset.Next;
+          end;
+          if Assigned(AFooter)
+          then Parse(AFooter);
+        end;
+      end;
+    finally
+      AArguments.Free;
+    end;
+
+  except
+    on e: Exception do begin
+      AForeColor := ColorList.UseColor(ErrorForeColor);
+      ABackColor := ColorList.UseColor(ErrorBackColor);
+      AAnswer.FRtfTextBuf := Format('{\b\ul\highlight%d\cf%d %s %s}',[ABackColor, AForeColor, AExpression, E.Message]);
+    end;
+  end;
+end;
+
+procedure TtiRtfParser.AddFunctions;
+begin
+  //Extra tokens not tokenized by RawParser
+  FFunctions.Add(etOr, 'Or', 0, 0, nil);
+  FFunctions.Add(etNot, 'Not', 0, 0, nil);
+  FFunctions.Add(etAnd, 'And', 0, 0, nil);
+  FFunctions.Add(etLitTrue, 'True', 0, 0, nil);
+  FFunctions.Add(etLitFalse, 'False', 0, 0, nil);
+
+  //Date time functions/conversions
+  FFunctions.Add(etFunction, 'Year', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfYear);
+  FFunctions.Add(etFunction, 'Month', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfMonth);
+  FFunctions.Add(etFunction, 'Day', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfDay);
+  FFunctions.Add(etFunction, 'SYear', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfSYear);
+  FFunctions.Add(etFunction, 'SMonth', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfSMonth);
+  FFunctions.Add(etFunction, 'SDay', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfSDay);
+  FFunctions.Add(etFunction, 'Dtos', 1, 2, {$IFDEF FPC}@{$ENDIF}UdfDtos);
+  FFunctions.Add(etFunction, 'Stod', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStod);
+  FFunctions.Add(etFunction, 'DateToStr', 1, 2, {$IFDEF FPC}@{$ENDIF}UdfDateToStr);
+  FFunctions.Add(etFunction, 'TimeToStr', 1, 2, {$IFDEF FPC}@{$ENDIF}UdfTimeToStr);
+  FFunctions.Add(etFunction, 'DateTimeToStr', 1, 2, {$IFDEF FPC}@{$ENDIF}UdfDateTimeToStr);
+  FFunctions.Add(etFunction, 'StrToDate', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStrToDate);
+  FFunctions.Add(etFunction, 'StrToTime', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStrToTime);
+  FFunctions.Add(etFunction, 'StrToDateTime', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStrToDateTime);
+  FFunctions.Add(etFunction, 'ShortMonthName', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfShortMonthName);
+  FFunctions.Add(etFunction, 'ShortDayName', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfShortDayName);
+  FFunctions.Add(etFunction, 'LongMonthName', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfLongMonthName);
+  FFunctions.Add(etFunction, 'LongDayName', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfLongDayName);
+
+  //String, int, float functions/conversions
+  FFunctions.Add(etFunction, 'Int', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfInt);
+  FFunctions.Add(etFunction, 'Chr', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfChr);
+  FFunctions.Add(etFunction, 'Iif', 3, 3, {$IFDEF FPC}@{$ENDIF}UdfIif);
+  FFunctions.Add(etFunction, 'Str', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStr);
+  FFunctions.Add(etFunction, 'Val', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfVal);
+  FFunctions.Add(etFunction, 'Nul', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfNul);
+  FFunctions.Add(etFunction, 'Now', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfNow);
+  FFunctions.Add(etFunction, 'Frac', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfFrac);
+  FFunctions.Add(etFunction, 'Padr', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfPadr);
+  FFunctions.Add(etFunction, 'Padl', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfPadl);
+  FFunctions.Add(etFunction, 'Date', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDate);
+  FFunctions.Add(etFunction, 'Time', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfTime);
+  FFunctions.Add(etFunction, 'Mid', 2, 3, {$IFDEF FPC}@{$ENDIF}UdfSubStr);
+  FFunctions.Add(etFunction, 'Copy', 2, 3, {$IFDEF FPC}@{$ENDIF}UdfSubStr);
+  FFunctions.Add(etFunction, 'SubStr', 2, 3, {$IFDEF FPC}@{$ENDIF}UdfSubStr);
+  FFunctions.Add(etFunction, 'Trunc', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfTrunc);
+  FFunctions.Add(etFunction, 'Round', 1, 2, {$IFDEF FPC}@{$ENDIF}UdfRound);
+  FFunctions.Add(etFunction, 'Upper', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfUpper);
+  FFunctions.Add(etFunction, 'Lower', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfLower);
+  FFunctions.Add(etFunction, 'Trim', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfTrim);
+  FFunctions.Add(etFunction, 'Empty', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfEmpty);
+  FFunctions.Add(etFunction, 'TrimLeft', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfTrimLeft);
+  FFunctions.Add(etFunction, 'TrimRight', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfTrimRight);
+  FFunctions.Add(etFunction, 'IntToStr', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfIntToStr);
+  FFunctions.Add(etFunction, 'StrToInt', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStrToInt);
+  FFunctions.Add(etFunction, 'FloatToStr', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfFloatToStr);
+  FFunctions.Add(etFunction, 'StrToFloat', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfStrToFloat);
+  FFunctions.Add(etFunction, 'Power', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfIntPower);
+  FFunctions.Add(etFunction, 'IntPower', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfIntPower);
+  FFunctions.Add(etFunction, 'FormatFloat', 2, 2, {$IFDEF FPC}@{$ENDIF}UdfFormatFloat);
+  FFunctions.Add(etFunction, 'FBool', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfFbool);
+
+  //Dataset
+  FFunctions.Add(etFunction, 'Bof', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfBof);
+  FFunctions.Add(etFunction, 'Eof', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfEof);
+  FFunctions.Add(etProcedure, 'Next', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfNext);
+  FFunctions.Add(etProcedure, 'Prev', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfPrior);
+  FFunctions.Add(etProcedure, 'Open', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfOpen);
+  FFunctions.Add(etProcedure, 'First', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfFirst);
+  FFunctions.Add(etProcedure, 'Last', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfLast);
+  FFunctions.Add(etFunction, 'IsEmpty', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfIsEmpty);
+  FFunctions.Add(etFunction, 'RecordCount', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfRecordCount);
+  FFunctions.Add(etProcedure, 'Scan', 1, 9999, {$IFDEF FPC}@{$ENDIF}UdfScan);
+  FFunctions.Add(etProcedure, 'EndScan', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy);
+  FFunctions.Add(etProcedure, 'ScanEntry', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy);
+  FFunctions.Add(etProcedure, 'ScanFooter', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy);
+  FFunctions.Add(etProcedure, 'Dataset', 3, 9999, {$IFDEF FPC}@{$ENDIF}UdfDataset);
+
+  //Misc routines
+  FFunctions.Add(etProcedure, 'If', 1, 9999, {$IFDEF FPC}@{$ENDIF}UdfIf);
+  FFunctions.Add(etProcedure, 'Else', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy);
+  FFunctions.Add(etProcedure, 'Endif', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy);
+  FFunctions.Add(etProcedure, 'NoPar', 0, 0, {$IFDEF FPC}@{$ENDIF}UdfDummy);
+  FFunctions.Add(etFunction, 'Picture', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfPicture);
+  FFunctions.Add(etFunction, 'DbPicture', 1, 1, {$IFDEF FPC}@{$ENDIF}UdfDbPicture);
+end;
+
+procedure TtiRtfParser.UdfDummy(AArgument: TRtfArgument);
+begin
+  //Nothing, since its an etProcedure the Rtf paragraph will be removed
+end;
+
+procedure TtiRtfParser.UdfChr(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitInt])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Value := Chr(StrToInt(AArgument[0].Value));
+  AArgument.Token := etLitString;
+end;
+
+procedure TtiRtfParser.UdfNow(AArgument: TRtfArgument);
+begin
+  AArgument.Value := Now;
+  AArgument.Token := etLitDate;
+end;
+
+procedure TtiRtfParser.UdfDate(AArgument: TRtfArgument);
+begin
+  AArgument.Value := Date;
+  AArgument.Token := etLitDate;
+end;
+
+procedure TtiRtfParser.UdfTime(AArgument: TRtfArgument);
+begin
+  AArgument.Value := Time;
+  AArgument.Token := etLitDate;
+end;
+
+procedure TtiRtfParser.UdfIntToStr(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitInt])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Value := IntToStr(AArgument[0].Value);
+  AArgument.Token := etLitString;
+end;
+
+procedure TtiRtfParser.UdfStrToInt(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Value := StrToInt(AArgument[0].Value);
+  AArgument.Token := etLitInt;
+end;
+
+procedure TtiRtfParser.UdfFloatToStr(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitFloat])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Value := FloatToStr(Extended(AArgument[0].Value));
+  AArgument.Token := etLitString;
+end;
+
+procedure TtiRtfParser.UdfStrToFloat(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Value := StrToFloat(AArgument[0].Value);
+  AArgument.Token := etLitFloat;
+end;
+
+procedure TtiRtfParser.UdfNul(AArgument: TRtfArgument);
+var AStr: string;
+  ACnt: integer;
+begin
+  if not AArgument.Check([[etLitInt],[etLitInt]])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AStr := AArgument[0].Value;
+  ACnt := AArgument[1].Value;
+  while Length(AStr) < ACnt do AStr := '0' + AStr;
+  while Length(AStr) > ACnt do Delete(AStr, 1, 1);
+  AArgument.Value := AStr;
+  AArgument.Token := etLitString;
+end;
+
+procedure TtiRtfParser.UdfPadl(AArgument: TRtfArgument);
+var AStr: string;
+  ACnt: integer;
+begin
+  if not AArgument.Check([[etLitString],[etLitInt]])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AStr := AArgument[0].Value;
+  ACnt := AArgument[1].Value;
+  AStr := Copy(AStr, 1, ACnt);
+  while Length(AStr) < ACnt do begin
+    AStr := ' ' + AStr;
+  end;
+  AArgument.Value := AStr;
+  AArgument.Token := etLitString;
+end;
+
+procedure TtiRtfParser.UdfPadr(AArgument: TRtfArgument);
+var AStr: string;
+  ACnt: integer;
+begin
+  if not AArgument.Check([[etLitString],[etLitInt]])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AStr := AArgument[0].Value;
+  ACnt := AArgument[1].Value;
+  AStr := Copy(AStr, 1, ACnt);
+  while Length(AStr) < ACnt do begin
+    AStr := AStr + ' ';
+  end;
+  AArgument.Value := AStr;
+  AArgument.Token := etLitString;
+end;
+
+procedure TtiRtfParser.UdfIif(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitFalse, etLitTrue])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  if AArgument[0].Token = etLitTrue then begin
+    AArgument.Value := AArgument[1].Value;
+    AArgument.Token := AArgument[1].Token;
+  end else begin
+    AArgument.Value := AArgument[2].Value;
+    AArgument.Token := AArgument[2].Token;
+  end;
+end;
+
+procedure TtiRtfParser.UdfIf(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitFalse, etLitTrue])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Value := AArgument[0].Value;
+  AArgument.Token := AArgument[0].Token;
+end;
+
+procedure TtiRtfParser.UdfScan(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etDataset])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Value := AArgument[0].Value;
+  AArgument.Token := AArgument[0].Token;
+  if AArgument.Count > 1 then begin
+    if AArgument[1].Token = etLitTrue
+    then AArgument.Param := 1;
+  end;
+end;
+
+procedure TtiRtfParser.UdfDataset(AArgument: TRtfArgument);
+var ADatabase, AAliasName, ASqlScript: string;
+  ADataset: TRtfDataset;
+  AObject: TObject;
+begin
+  if not AArgument.Check([[etLitString],[etLitString],[etLitString]])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+
+  ADatabase := AArgument[0].Value;
+  AAliasName := AArgument[1].Value;
+  ASqlScript := AArgument[2].Value;
+
+  //Delete first argument so Sql params become first
+  AArgument.Delete(0);
+  AArgument.Delete(0);
+  AArgument.Delete(0);
+
+  //Remove existing dataset with same aliasname
+  ADataset := Datasets.Find(AAliasName);
+  if Assigned(ADataset)
+  then Datasets.Remove(ADataset);
+
+  //Create the new query or dataset (whatever)
+  if Assigned(OnCreateDataset)
+  then OnCreateDataset(ADatabase, AAliasName, ASqlScript, AArgument)
+  else raise TRtfException.Create('OnCreateDataset is not assigned');
+  if VarIsEmpty(AArgument.Value)
+  then raise TRtfException.Create('OnCreateDataset did not return a dataset object');
+
+  AObject := TObject(integer(AArgument.Value));
+  ADataset := Datasets.Add(AObject, AAliasname, true);
+  AArgument.Token := etDataset;
+  AArgument.Value := integer(ADataset);
+end;
+
+procedure TtiRtfParser.UdfLower(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Token := etLitString;
+  AArgument.Value := LowerCase(AArgument[0].Value);
+end;
+
+procedure TtiRtfParser.UdfUpper(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Token := etLitString;
+  AArgument.Value := UpperCase(AArgument[0].Value);
+end;
+
+procedure TtiRtfParser.UdfTrim(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Token := etLitString;
+  AArgument.Value := Trim(AArgument[0].Value);
+end;
+
+procedure TtiRtfParser.UdfTrimLeft(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Token := etLitString;
+  AArgument.Value := TrimLeft(AArgument[0].Value);
+end;
+
+procedure TtiRtfParser.UdfTrimRight(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Token := etLitString;
+  AArgument.Value := TrimRight(AArgument[0].Value);
+end;
+
+procedure TtiRtfParser.UdfSubStr(AArgument: TRtfArgument);
+var AStr: string;
+  APos, ACnt: integer;
+begin
+  ACnt := Maxint;
+  if not AArgument.Check([[etLitString],[etLitInt]])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  if AArgument.Count > 2 then begin
+    if not AArgument.Check(2,[etLitInt]) then
+      raise TRtfException.Create(rsUnexpectedParameterType);
+    ACnt := AArgument[2].Value;
+  end;
+  AStr := AArgument[0].Value;
+  APos := AArgument[1].Value;
+  AStr := Copy(AStr, APos, ACnt);
+  AArgument.Value := AStr;
+  AArgument.Token := etLitString;
+end;
+
+procedure TtiRtfParser.UdfStr(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitFloat, etLitInt]) then
+    raise TRtfException.Create(rsUnexpectedParameterType);
+  if AArgument[0].Token = etLitFloat then
+  begin
+    AArgument.Token := etLitString;
+    AArgument.Value := FloatToStr(AArgument[0].Value);
+  end
+  else
+  begin
+    AArgument.Token := etLitString;
+    AArgument.Value := IntToStr(AArgument[0].Value);
+  end;
+end;
+
+procedure TtiRtfParser.UdfVal(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString]) then
+    raise TRtfException.Create(rsUnexpectedParameterType);
+  if (Pos('.', AArgument[0].Value) > 0)or(Pos(',', AArgument[0].Value) > 0) then
+  begin
+    AArgument.Token := etLitString;
+    AArgument.Value := StrToFloat(AArgument[0].Value)
+  end
+  else
+  begin
+    AArgument.Token := etLitString;
+    AArgument.Value := StrToInt(AArgument[0].Value)
+  end;
+end;
+
+procedure TtiRtfParser.UdfBof(AArgument: TRtfArgument);
+var ATable: TRtfDataset;
+begin
+  if not AArgument.Check(0,[etDataset]) then
+    raise TRtfException.Create(rsUnexpectedParameterType);
+  ATable := TRtfDataset(integer(AArgument[0].Value));
+  if ATable.Bof then
+  begin
+    AArgument.Token := etLitTrue;
+    AArgument.Value := true;
+  end
+  else
+  begin
+    AArgument.Token := etLitFalse;
+    AArgument.Value := false;
+  end;
+end;
+
+procedure TtiRtfParser.UdfEof(AArgument: TRtfArgument);
+var ATable: TRtfDataset;
+begin
+  if not AArgument.Check(0,[etDataset]) then
+    raise TRtfException.Create(rsUnexpectedParameterType);
+  ATable := TRtfDataset(integer(AArgument[0].Value));
+  if ATable.Eof then
+  begin
+    AArgument.Token := etLitTrue;
+    AArgument.Value := true;
+  end
+  else
+  begin
+    AArgument.Token := etLitFalse;
+    AArgument.Value := false;
+  end;
+end;
+
+
+procedure TtiRtfParser.UdfRecordCount(AArgument: TRtfArgument);
+var ATable: TRtfDataset;
+begin
+  if not AArgument.Check(0,[etDataset])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  ATable := TRtfDataset(integer(AArgument[0].Value));
+  AArgument.Token := etLitInt;
+  AArgument.Value := ATable.RecordCount
+end;
+
+procedure TtiRtfParser.UdfIsEmpty(AArgument: TRtfArgument);
+var ATable: TRtfDataset;
+begin
+  if not AArgument.Check(0,[etDataset])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  ATable := TRtfDataset(integer(AArgument[0].Value));
+  if ATable.IsEmpty then begin
+    AArgument.Token := etLitTrue;
+    AArgument.Value := true;
+  end else begin
+    AArgument.Token := etLitFalse;
+    AArgument.Value := false;
+  end;
+end;
+
+procedure TtiRtfParser.UdfFirst(AArgument: TRtfArgument);
+var ATable: TRtfDataset;
+begin
+  if not AArgument.Check(0,[etDataset])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  ATable := TRtfDataset(integer(AArgument[0].Value));
+  ATable.First;
+end;
+
+procedure TtiRtfParser.UdfLast(AArgument: TRtfArgument);
+var ATable: TRtfDataset;
+begin
+  if not AArgument.Check(0,[etDataset])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  ATable := TRtfDataset(integer(AArgument[0].Value));
+  ATable.Last;
+end;
+
+procedure TtiRtfParser.UdfNext(AArgument: TRtfArgument);
+var ATable: TRtfDataset;
+begin
+  if not AArgument.Check(0,[etDataset])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  ATable := TRtfDataset(integer(AArgument[0].Value));
+  ATable.Next;
+end;
+
+procedure TtiRtfParser.UdfOpen(AArgument: TRtfArgument);
+var ATable: TRtfDataset;
+begin
+  if not AArgument.Check(0,[etDataset])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  ATable := TRtfDataset(integer(AArgument[0].Value));
+  ATable.Open;
+end;
+
+procedure TtiRtfParser.UdfPrior(AArgument: TRtfArgument);
+var ATable: TRtfDataset;
+begin
+  if not AArgument.Check(0,[etDataset])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  ATable := TRtfDataset(integer(AArgument[0].Value));
+  ATable.Prior;
+end;
+
+procedure TtiRtfParser.UdfInt(AArgument: TRtfArgument);
+//Returns the integer part of a float
+begin
+  if not AArgument.Check(0,[etLitFloat, etLitInt])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  if AArgument[0].Token = etLitFloat then begin
+    AArgument.Token := etLitFloat;
+    AArgument.Value := Int(AArgument[0].Value);
+  end else begin
+    AArgument.Token := etLitInt;
+    AArgument.Value := AArgument[0].Value;
+  end;
+end;
+
+procedure TtiRtfParser.UdfFrac(AArgument: TRtfArgument);
+//Returns the fractional part of a float
+begin
+  if not AArgument.Check(0,[etLitFloat, etLitInt])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  if AArgument[0].Token = etLitFloat then begin
+    AArgument.Token := etLitFloat;
+    AArgument.Value := Frac(AArgument[0].Value);
+  end else begin
+    AArgument.Token := etLitInt;
+    AArgument.Value := 0;
+  end;
+end;
+
+procedure TtiRtfParser.UdfRound(AArgument: TRtfArgument);
+//0.5 is always rounded to largest integer number
+var
+  ASign, ADecimals, AInt: integer;
+  AFloat, APower, AFrac: Double;
+begin
+  ADecimals := 0;
+  if not AArgument.Check(0,[etLitFloat, etLitInt]) then
+    raise TRtfException.Create(rsUnexpectedParameterType);
+  if AArgument.Count > 1 then
+  begin
+    if not AArgument.Check(1,[etLitInt]) then
+      raise TRtfException.Create(rsUnexpectedParameterType);
+    ADecimals := AArgument[1].Value;
+  end;
+
+  if AArgument[0].Token = etLitFloat then
+  begin
+    AFloat := AArgument[0].Value;
+
+    ASign := 1;
+    if AFloat < 0 then
+    begin
+      AFloat := - AFloat;
+      ASign := - 1;
+    end;
+
+    if ADecimals = 0 then
+    begin
+      AInt := Trunc(AFloat); //integer part
+      AFrac := AFloat - AInt; //fractional part
+      if AFrac >= 0.5 then
+        AArgument.Value := ASign *(AInt + 1)
+      else
+        AArgument.Value := ASign * AInt;
+      AArgument.Token := etLitFloat;
+    end
+    else
+    begin
+      APower := IntPower(10, ADecimals);
+      AInt := Trunc(AFloat * APower); //integer part * 10^ADecimals
+      AFrac := AFloat * APower - AInt; //fractional part
+      if AFrac >= 0.5 then
+        AArgument.Value := ASign * IntPower(10, - ADecimals) *(AInt + 1)
+      else
+        AArgument.Value := ASign * IntPower(10, - ADecimals) * AInt;
+      AArgument.Token := etLitFloat;
+    end;
+  end
+  else
+  begin
+    AArgument.Token := etLitInt;
+    AArgument.Value := AArgument[0].Value;
+  end;
+end;
+
+procedure TtiRtfParser.UdfTrunc(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitFloat, etLitInt])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  if AArgument[0].Token = etLitFloat then begin
+    AArgument.Token := etLitFloat;
+    AArgument.Value := Trunc(AArgument[0].Value);
+  end else begin
+    AArgument.Token := etLitInt;
+    AArgument.Value := AArgument[0].Value;
+  end;
+end;
+
+procedure TtiRtfParser.UdfIntPower(AArgument: TRtfArgument);
+var AFloat: Double;
+  AExponent: integer;
+begin
+  if not AArgument.Check([[etLitInt, etLitFloat],[etLitInt]]) then
+    raise TRtfException.Create(rsUnexpectedParameterType);
+  AFloat := AArgument[0].Value;
+  AExponent := AArgument[1].Value;
+  AArgument.Token := etLitFloat;
+  AArgument.Value := IntPower(AFloat, AExponent);
+end;
+
+procedure TtiRtfParser.UdfPower(AArgument: TRtfArgument);
+var AFloat, AExponent: Double;
+begin
+  if not AArgument.Check([[etLitInt, etLitFloat],[etLitInt, etLitFloat]])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AFloat := AArgument[0].Value;
+  AExponent := AArgument[1].Value;
+  AArgument.Token := etLitFloat;
+  AArgument.Value := Pwr(AFloat, AExponent);
+end;
+
+procedure TtiRtfParser.UdfEmpty(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  if Trim(AArgument[0].Value) = '' then begin
+    AArgument.Token := etLitTrue;
+    AArgument.Value := true;
+  end else begin
+    AArgument.Token := etLitFalse;
+    AArgument.Value := false;
+  end;
+end;
+
+procedure TtiRtfParser.UdfDay(AArgument: TRtfArgument);
+var AYear, AMonth, ADay: word;
+begin
+  if not AArgument.Check(0,[etLitDate])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  DecodeDate(AArgument[0].Value, AYear, AMonth, ADay);
+  AArgument.Token := etLitInt;
+  AArgument.Value := AYear;
+end;
+
+procedure TtiRtfParser.UdfMonth(AArgument: TRtfArgument);
+var AYear, AMonth, ADay: word;
+begin
+  if not AArgument.Check(0,[etLitDate])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  DecodeDate(AArgument[0].Value, AYear, AMonth, ADay);
+  AArgument.Token := etLitInt;
+  AArgument.Value := AMonth;
+end;
+
+procedure TtiRtfParser.UdfYear(AArgument: TRtfArgument);
+var AYear, AMonth, ADay: word;
+begin
+  if not AArgument.Check(0,[etLitDate])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  DecodeDate(AArgument[0].Value, AYear, AMonth, ADay);
+  AArgument.Token := etLitInt;
+  AArgument.Value := ADay;
+end;
+
+procedure TtiRtfParser.UdfShortDayName(AArgument: TRtfArgument);
+var AYear, AMonth, ADay: word;
+begin
+  if not AArgument.Check(0,[etLitDate])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  DecodeDate(AArgument[0].Value, AYear, AMonth, ADay);
+  AArgument.Token := etLitString;
+  AArgument.Value := ShortDayNames[ADay];
+end;
+
+procedure TtiRtfParser.UdfShortMonthName(AArgument: TRtfArgument);
+var AYear, AMonth, ADay: word;
+begin
+  if not AArgument.Check(0,[etLitDate])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  DecodeDate(AArgument[0].Value, AYear, AMonth, ADay);
+  AArgument.Token := etLitString;
+  AArgument.Value := ShortMonthNames[AMonth];
+end;
+
+procedure TtiRtfParser.UdfLongDayName(AArgument: TRtfArgument);
+var AYear, AMonth, ADay: word;
+begin
+  if not AArgument.Check(0,[etLitDate])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  DecodeDate(AArgument[0].Value, AYear, AMonth, ADay);
+  AArgument.Token := etLitString;
+  AArgument.Value := LongMonthNames[AMonth];
+end;
+
+procedure TtiRtfParser.UdfLongMonthName(AArgument: TRtfArgument);
+var AYear, AMonth, ADay: word;
+begin
+  if not AArgument.Check(0,[etLitDate])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  DecodeDate(AArgument[0].Value, AYear, AMonth, ADay);
+  AArgument.Token := etLitString;
+  AArgument.Value := LongMonthNames[AMonth];
+end;
+
+procedure TtiRtfParser.UdfSDay(AArgument: TRtfArgument);
+var AYear, AMonth, ADay: word;
+begin
+  if not AArgument.Check(0,[etLitDate])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  DecodeDate(AArgument[0].Value, AYear, AMonth, ADay);
+  AArgument.Token := etLitString;
+  AArgument.Value := Format('%0.4d',[AYear]);
+end;
+
+procedure TtiRtfParser.UdfSMonth(AArgument: TRtfArgument);
+var AYear, AMonth, ADay: word;
+begin
+  if not AArgument.Check(0,[etLitDate])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  DecodeDate(AArgument[0].Value, AYear, AMonth, ADay);
+  AArgument.Token := etLitString;
+  AArgument.Value := Format('%0.2d',[AMonth]);
+end;
+
+procedure TtiRtfParser.UdfSYear(AArgument: TRtfArgument);
+var AYear, AMonth, ADay: word;
+begin
+  if not AArgument.Check(0,[etLitDate])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  DecodeDate(AArgument[0].Value, AYear, AMonth, ADay);
+  AArgument.Token := etLitString;
+  AArgument.Value := Format('%0.2d',[ADay]);
+end;
+
+procedure TtiRtfParser.UdfStod(AArgument: TRtfArgument);
+var AYear, AMonth, ADay: word;
+  AStr: string;
+begin
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AStr := AArgument[0].Value;
+  AYear := StrToInt(Copy(AStr, 1, 4));
+  AMonth := StrToInt(Copy(AStr, 5, 2));
+  ADay := StrToInt(Copy(AStr, 7, 2));
+  AArgument.Token := etLitDate;
+  AArgument.Value := EncodeDate(AYear, AMonth, ADay);
+end;
+
+procedure TtiRtfParser.UdfDateTimeTo(AArgument: TRtfArgument; AFormat: string);
+begin
+  if not AArgument.Check(0,[etLitDate]) then
+    raise TRtfException.Create(rsUnexpectedParameterType);
+  if AArgument.Count > 1 then
+  begin
+    if not AArgument.Check(1,[etLitString]) then
+      raise TRtfException.Create(rsUnexpectedParameterType);
+    AFormat := AArgument[1].Value;
+  end;
+  AArgument.Token := etLitString;
+  AArgument.Value := FormatDateTime(AFormat, AArgument[0].Value);
+end;
+
+procedure TtiRtfParser.UdfDtos(AArgument: TRtfArgument);
+begin
+  UdfDateTimeTo(AArgument, 'YYYYMMDD');
+end;
+
+procedure TtiRtfParser.UdfDateToStr(AArgument: TRtfArgument);
+begin
+  UdfDateTimeTo(AArgument, ShortDateFormat);
+end;
+
+procedure TtiRtfParser.UdfTimeToStr(AArgument: TRtfArgument);
+begin
+  UdfDateTimeTo(AArgument, ShortTimeFormat);
+end;
+
+procedure TtiRtfParser.UdfDateTimeToStr(AArgument: TRtfArgument);
+begin
+  UdfDateTimeTo(AArgument, ShortDateFormat + ' ' + ShortTimeFormat);
+end;
+
+procedure TtiRtfParser.UdfStrToDate(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString]) then
+    raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Token := etLitString;
+  AArgument.Value := StrToDate(AArgument[0].Value);
+end;
+
+procedure TtiRtfParser.UdfStrToTime(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Token := etLitString;
+  AArgument.Value := StrToTime(AArgument[0].Value);
+end;
+
+procedure TtiRtfParser.UdfStrToDateTime(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  AArgument.Token := etLitString;
+  AArgument.Value := StrToDateTime(AArgument[0].Value);
+end;
+
+procedure TtiRtfParser.UdfFormatFloat(AArgument: TRtfArgument);
+var AFormat: string;
+  AFloat: Double;
+begin
+  if not AArgument.Check([[etLitString],[etLitFloat, etLitInt]]) then
+    raise TRtfException.Create(rsUnexpectedParameterType);
+  AFormat := AArgument[0].Value;
+  AFloat := AArgument[1].Value;
+  AArgument.Token := etLitString;
+  AArgument.Value := FormatFloat(AFormat, AFloat);
+end;
+
+procedure TtiRtfParser.UdfFBool(AArgument: TRtfArgument);
+begin
+  if not AArgument.Check(0,[etLitFalse, etLitTrue]) then
+    raise TRtfException.Create(rsUnexpectedParameterType);
+  if AArgument[0].Token = etLitFalse then
+  begin
+    AArgument.Token := etLitString;
+    AArgument.Value := BoolFalse;
+  end else begin
+    AArgument.Token := etLitString;
+    AArgument.Value := BoolTrue;
+  end;
+end;
+
+procedure TtiRtfParser.UdfPicture(AArgument: TRtfArgument);
+var
+  APicture: TPicture;
+  AFilename: string;
+begin
+(*
+  if not AArgument.Check(0,[etLitString])
+  then raise TRtfException.Create(rsUnexpectedParameterType);
+  APicture := TPicture.Create;
+  try
+    AFilename := AArgument[0].Value;
+    if Assigned(OnPicturePath)
+    then OnPicturePath(AFilename);
+
+    APicture.LoadFromFile(AFilename);
+    if not Assigned(APicture.Graphic)or APicture.Graphic.Empty then begin
+      AArgument.Token := etNothing;
+      AArgument.Value := varEmpty;
+    end else begin
+      AArgument.Value := AArgument.GetPicture(APicture);
+      AArgument.Token := etLitString;
+    end;
+  finally
+    APicture.Free;
+  end;
+  *)
+end;
+
+procedure TtiRtfParser.UdfDbPicture(AArgument: TRtfArgument);
+//Since a simple blob (not ftGraphic field) can contain an image
+//It has become kind of a typecast for a dataset field.
+var ADataset: TRtfDataset;
+  AFieldName: string;
+begin
+  if not AArgument.Check(0,[etFieldName]) then
+    raise TRtfException.Create(rsUnexpectedParameterType);
+  ADataset := Datasets.Find(AArgument[0].Value, AFieldName);
+  if not Assigned(ADataset) then //There should be at least a table reference.
+    raise TRtfException.Create('Dataset not found');
+  AArgument.GetGraphicsValue(ADataset, AFieldName);
+end;
+
+end.
+
+
+
+
+
diff --git a/extras/tiopf/mvp/basic_intf.pas b/extras/tiopf/mvp/basic_intf.pas
index 36f56f32..a569db9a 100644
--- a/extras/tiopf/mvp/basic_intf.pas
+++ b/extras/tiopf/mvp/basic_intf.pas
@@ -17,13 +17,13 @@ type
 
   
   IObserver = interface(IInterface)
-  ['{16CD208B-5F37-41FC-82A4-BFDD16DB3203}']
+    ['{16CD208B-5F37-41FC-82A4-BFDD16DB3203}']
     procedure Update(const ASubject: IInterface);
   end;
   
-  
+
   ISubject = interface(IInterface)
-  ['{004B3299-C221-4A44-87A7-7657D90B6493}']
+    ['{004B3299-C221-4A44-87A7-7657D90B6493}']
     procedure Attach(Observer: IObserver);
     procedure Detach(Observer: IObserver);
     procedure Notify;
@@ -33,18 +33,18 @@ type
   
   
   IVisitor = interface(IInterface)
-  ['{35E154D2-6573-42DA-9854-156F3B19C95F}']
+    ['{35E154D2-6573-42DA-9854-156F3B19C95F}']
     // empty interface
   end;
 
   IVisited = interface(IInterface)
-  ['{7CF62F51-9412-445C-9E8C-DE94F2B1E280}']
+    ['{7CF62F51-9412-445C-9E8C-DE94F2B1E280}']
     procedure Accept(const Visitor: IVisitor);
   end;
 
   
   IListModel = interface(IInterface)
-  ['{1A772375-1263-4790-8827-F7BEA358674A}']
+    ['{1A772375-1263-4790-8827-F7BEA358674A}']
     function GetCount: Integer;
     function GetItem(Idx: Integer): IInterface;
     procedure Add(const Item: IInterface);
@@ -59,7 +59,7 @@ type
 
 (*
   IController = interface(IInterface)
-  ['{4A99C01A-D025-4562-8E94-3A0C873CE894}']
+    ['{4A99C01A-D025-4562-8E94-3A0C873CE894}']
     function GetModel: IModel;
     function GetView: IView;
     procedure SetModel(const AValue: IModel);
@@ -70,7 +70,7 @@ type
 *)
 
   IString = interface(IInterface)
-  ['{E76984A4-1287-4353-8370-A7332B9FB1CB}']
+    ['{E76984A4-1287-4353-8370-A7332B9FB1CB}']
     function GetAsString: string;
     procedure SetAsString(const AValue: string);
     property AsString: string read GetAsString write SetAsString;
@@ -78,14 +78,14 @@ type
   
   
   IStringListModel = interface(IListModel)
-  ['{769804CD-89E4-43C7-B8EF-783BFE27214E}']
+    ['{769804CD-89E4-43C7-B8EF-783BFE27214E}']
     function GetItem(Idx: Integer): IString; overload;
     property Item[Idx: Integer]: IString read GetItem;
   end;
   
   
   ISelection = interface(IInterface)
-  ['{F4DDA0EA-E982-4785-8602-5B32E8DD6DA2}']
+    ['{F4DDA0EA-E982-4785-8602-5B32E8DD6DA2}']
     procedure AddItem(const Item: IInterface);
     procedure Clear;
     function GetCount: integer;
@@ -95,7 +95,7 @@ type
   
   
   ICommand = interface(IInterface)
-  ['{B333C7E1-B124-4D08-A640-DC02F36264C7}']
+    ['{B333C7E1-B124-4D08-A640-DC02F36264C7}']
     procedure BindSelection(const Selection: ISelection);
     function Execute: Boolean;
     function GetEnabled: Boolean;
@@ -106,25 +106,25 @@ type
   
   
   ICommandSet = interface(IInterface)
-  ['{1622FF69-3104-47EA-8741-9C1B05ADA30B}']
+    ['{1622FF69-3104-47EA-8741-9C1B05ADA30B}']
     // empty interface
   end;
   
   
   ICommandVisitor = interface(IVisitor)
-  ['{628B3A4A-30D1-48D3-8B46-090F08AD2AC8}']
+    ['{628B3A4A-30D1-48D3-8B46-090F08AD2AC8}']
     procedure VisitComand(const Command: ICommand);
   end;
   
   
   ICommandMenu = interface(IInterface)
-  ['{3C666D8F-6BED-454B-8BFE-28422943B300}']
+    ['{3C666D8F-6BED-454B-8BFE-28422943B300}']
     function AddItem(const Caption: string; Enabled: Boolean): ICommandMenuItem;
   end;
   
   
   ICommandMenuItem = interface(IInterface)
-  ['{7DFCF2BD-70DA-4DAC-B8D5-C6FB882267CF}']
+    ['{7DFCF2BD-70DA-4DAC-B8D5-C6FB882267CF}']
     function GetCaption: string;
     function GetChecked: Boolean;
     function GetCommand: ICommand;
@@ -138,7 +138,7 @@ type
   
 
   IStringVisitor = interface(IVisitor)
-  ['{DA12355F-0727-41B3-9080-DDAF20797FC5}']
+    ['{DA12355F-0727-41B3-9080-DDAF20797FC5}']
     function GetTheString: IString;
     procedure VisitString(const Str: IString);
     property TheString: IString
@@ -147,7 +147,7 @@ type
   
   
   IMVPModel = interface(IInterface)
-  ['{85223140-B263-4413-89E3-BFA37E9D3112}']
+    ['{85223140-B263-4413-89E3-BFA37E9D3112}']
     function GetCommandSet: ICommandSet;
     function GetCurrentSelection: ISelection;
     property CommandSet: ICommandSet read GetCommandSet;
@@ -156,7 +156,7 @@ type
   
 
   IMVPPresenter = interface(IInterface)
-  ['{5B8477DA-A006-4DE1-B304-9512BFAD7507}']
+    ['{5B8477DA-A006-4DE1-B304-9512BFAD7507}']
     function GetCommandMenu: ICommandMenu;
     function GetModel: IMVPModel;
     function GetView: IMVPView;
@@ -170,14 +170,14 @@ type
   
   
   IMVPView = interface(IInterface)
-  ['{2C575FE7-BACD-46EC-9D72-AEDA44836B20}']
+    ['{2C575FE7-BACD-46EC-9D72-AEDA44836B20}']
     procedure AdoptCommandMenu(const Value: ICommandMenu);
     procedure OrphanCommandMenu(const Value: ICommandMenu);
   end;
   
   
   IStringListView = interface(IMVPView)
-  ['{D834710A-9C1A-42D1-A29B-7F9F8FB46426}']
+    ['{D834710A-9C1A-42D1-A29B-7F9F8FB46426}']
     function GetOnSelectString: TSelectStringEvent;
     procedure SetOnSelectString(const AValue: TSelectStringEvent);
     property OnSelectString: TSelectStringEvent read GetOnSelectString write SetOnSelectString;
@@ -185,7 +185,7 @@ type
 
 
   IStringMoveVisitor = interface(IStringVisitor)
-  ['{DB89C96F-DA90-43ED-A621-51B70E6C600E}']
+    ['{DB89C96F-DA90-43ED-A621-51B70E6C600E}']
     function GetCanDemote: Boolean;
     function GetCanPromote: Boolean;
     property CanDemote: Boolean read GetCanDemote;
diff --git a/extras/tiopf/mvp/fpgui_intf.pas b/extras/tiopf/mvp/fpgui_intf.pas
index f6e9e4ca..fea8b153 100644
--- a/extras/tiopf/mvp/fpgui_intf.pas
+++ b/extras/tiopf/mvp/fpgui_intf.pas
@@ -10,7 +10,7 @@ uses
 type
 
   IPopupCommandMenu = interface(IInterface)
-  ['{812C1940-A8BD-4BB4-AE8D-37A912D44A6D}']
+    ['{812C1940-A8BD-4BB4-AE8D-37A912D44A6D}']
     function GetMenu: TfpgPopupMenu;
     procedure SetMenu(const AValue: TfpgPopupMenu);
     property Menu: TfpgPopupMenu read GetMenu write SetMenu;
diff --git a/extras/tiopf/tiOPFfpGUI.lpk b/extras/tiopf/tiOPFfpGUI.lpk
index 663bee3b..5906feb0 100644
--- a/extras/tiopf/tiOPFfpGUI.lpk
+++ b/extras/tiopf/tiOPFfpGUI.lpk
@@ -21,7 +21,7 @@
     <License Value="Mozilla Public License v1.1
 "/>
     <Version Major="2" Release="4"/>
-    <Files Count="7">
+    <Files Count="8">
       <Item1>
         <Filename Value="gui/tiGUIUtils.pas"/>
         <UnitName Value="tiGUIUtils"/>
@@ -50,6 +50,10 @@
         <Filename Value="gui/tiCompositeMediators.pas"/>
         <UnitName Value="tiCompositeMediators"/>
       </Item7>
+      <Item8>
+        <Filename Value="gui/tiRtfReport.pas"/>
+        <UnitName Value="tiRtfReport"/>
+      </Item8>
     </Files>
     <RequiredPkgs Count="3">
       <Item1>
diff --git a/extras/tiopf/tiOPFfpGUI.pas b/extras/tiopf/tiOPFfpGUI.pas
index b7d5cc8b..8ca8f183 100644
--- a/extras/tiopf/tiOPFfpGUI.pas
+++ b/extras/tiopf/tiOPFfpGUI.pas
@@ -8,7 +8,7 @@ interface
 
 uses
   tiGUIUtils, tiDialogs, tiGUIINI, tiGenericEditMediators, tiGUIConstants, 
-    tiGenericListMediators, tiCompositeMediators; 
+    tiGenericListMediators, tiCompositeMediators, tiRtfReport; 
 
 implementation