rvrtf.pas

richview1.7 full.source

    TRVRTFFont = class
      public
        Number: Integer;
        Name: String;
        Family: TRVRTFFontFamily;
        {$IFDEF RICHVIEWCBDEF3}
        Charset: TFontCharset;
        {$ENDIF}
    end;

    TRVRTFFontList = class (TRVList)
      private
        function Get(Index: Integer): TRVRTFFont;
        procedure Put(Index: Integer; const Value: TRVRTFFont);
      public
        function GetFontIndex(Number, Default: Integer): Integer;
        procedure Add(Number: Integer);
        property Items[Index: Integer]: TRVRTFFont read Get write Put; default;
    end;
    {----------------------------------------------------------------------}
    // RTF color table
    TRVRTFColorList = class (TList)
      private
        function Get(Index: Integer): TColor;
        procedure Put(Index: Integer; const Value: TColor);
        procedure ResetLast;
        procedure SetLastRed(Value: Integer);
        procedure SetLastGreen(Value: Integer);
        procedure SetLastBlue(Value: Integer);
        procedure Finalize;
      public
        procedure Add;
        property Items[Index: Integer]: TColor read Get write Put; default;
    end;
{------------------------------------------------------------------------------}
    TRVRTFCurrentBorderType = (rtf_bt_Para, rtf_bt_Row, rtf_bt_Cell);
    TRVRTFReaderState =  class
      private
        FCharProps: TRVRTFCharProperties;
        FParaProps: TRVRTFParaProperties;
        FSectProps: TRVRTFSectionProperties;
        FDocProps:  TRVRTFDocProperties;
        FRowProps:  TRVRTFRowProperties;
        FCurrentBorderType: TRVRTFCurrentBorderType;
        rds: TRTFrds;
        ris: TRTFris;
        FFieldCode: String;
        FFieldPictureIncluded: Boolean;
        DefFontNumber: Integer;
        FHFType: TRVRTFHeaderFooterType;
        procedure ChangeFontStyle(fs: TFontStyle; Val: Integer);
        procedure ChangeFontStyleEx(fs: TRVRTFFontStyleEx; Val: Integer);
        function GetRowProps: TRVRTFRowProperties;
        function GetCurrentBorderSide: TRVRTFBorderSide;
      public
        constructor Create;
        destructor Destroy; override;
        procedure Assign(Source: TRVRTFReaderState);
        procedure Reset;
        property ParaProps: TRVRTFParaProperties    read FParaProps;
        property CharProps: TRVRTFCharProperties    read FCharProps;
        property SectProps: TRVRTFSectionProperties read FSectProps;
        property DocProps:  TRVRTFDocProperties     read FDocProps;
        property RowProps:  TRVRTFRowProperties     read GetRowProps;
        property FieldCode: String read FFieldCode;
    end;
{------------------------------------------------------------------------------}
    TRVRTFReader  = class(TComponent)
      private
        Stream: TStream;
        StreamSize,InputStringIndex: Integer;
        Text,InputString: String;
        {$IFDEF RICHVIEWCBDEF3}
        TextW: WideString;
        {$ENDIF}
        LastChar: Char;
        UseLastChar: Boolean;
        FOnNewText: TRVRTFNewTextEvent;
        FOnHeaderFooter: TRVRTFHeaderFooterEvent;
        {$IFDEF RICHVIEWCBDEF3}
        FOnNewUnicodeText: TRVRTFNewUnicodeTextEvent;
        {$ENDIF}
        FOnNewPicture: TRVRTFNewPictureEvent;
        FOnTable: TRVRTFTableEvent;
        FStyleSheet: TRVRTFStyleSheet;
        FFontTable:  TRVRTFFontList;
        FColorTable: TRVRTFColorList;
        FListTable: TRVRTFListTable97;
        FListOverrideTable: TRVRTFListOverrideTable97;
        FRTFState: TRVRTFReaderState;
        FPicture: TRVRTFPicture;
        FMarkerProps: TRVRTFMarkerProperties;
        FDefCodePage, FCodePage: Cardinal;
        SkipAnsiCount, SkipNext: Integer;
        FOnRequiredPageBreak: TNotifyEvent;
        CurrentNestingLevel: Integer;
        FConvertHighlight: TRVRTFHighlightConvert;
        FOnUpdateMarker: TNotifyEvent;
        FCurPNSecLvl: Integer;
        FBasePath: String;
        function FindKeyword(const Keyword: String): Integer;
      protected
        ForceEvenEmptyNewLine: Boolean;
        Position: TRVRTFPosition;
        cGroup: Integer;
        SaveList: TRVList;
        cbBin,
        lParam: LongInt;
        PicHexVal: Byte;
        PicHexStrt: Boolean;
        fSkipDestIfUnk: Boolean;
        fpIn: TextFile;
        function EndGroupAction(rds: TRTFrds): TRVRTFErrorCode;
        function TranslateKeyword(const Keyword: String; param: Integer; fParam:Boolean): TRVRTFErrorCode;
        function ParseSpecialProperty(iprop: TRTFiprop; val: Integer): TRVRTFErrorCode;
        function ChangeDest(idest:  TRTFidest; Val: Integer): TRVRTFErrorCode;
        function ParseSpecialKeyword(ipfn:TRTFIPFN): TRVRTFErrorCode;
        function ApplyPropChange(iprop: TRTFiprop; val: Integer): TRVRTFErrorCode;
        function ApplyPropChange_SSEntry(iprop: TRTFiprop; val: Integer): TRVRTFErrorCode;
        function ApplyPropChange_Picture(iprop: TRTFiprop; val: Integer): TRVRTFErrorCode;
        function ApplyPropChange_PN(iprop: TRTFiprop; val: Integer): TRVRTFErrorCode;
        function ApplyPropChange_List(iprop: TRTFiprop; val: Integer): TRVRTFErrorCode;
        function ApplyPropChange_ListLevel(iprop: TRTFiprop; val: Integer): TRVRTFErrorCode;
        function ApplyPropChange_LO(iprop: TRTFiprop; val: Integer): TRVRTFErrorCode;
        function ApplyPropChange_LOLevel(iprop: TRTFiprop; val: Integer): TRVRTFErrorCode;
        function Parse: TRVRTFErrorCode;
        function PushRtfState: TRVRTFErrorCode;
        function PopRtfState: TRVRTFErrorCode;
        function ParseRtfKeyword: TRVRTFErrorCode;
        function ParseChar(ch: Char): TRVRTFErrorCode;
        procedure UpdateMarker;
        function FlushOutput(var NextPosition: TRVRTFPosition): TRVRTFErrorCode;
        function OutputChar(ch: Char; ACheckTableEnd, ACheckTable: Boolean): TRVRTFErrorCode;
        function InsertExternalPicture: TRVRTFErrorCode;
        function InsertSymbol: TRVRTFErrorCode;
        {$IFDEF RICHVIEWCBDEF3}
        function OutputWideChar(ch: WideChar): TRVRTFErrorCode;
        {$ENDIF}
        procedure UngetC;
        function GetC: Char;
        function IsEOF: Boolean;
        function DoNewText(Position: TRVRTFPosition; var NextPosition: TRVRTFPosition): TRVRTFErrorCode;
        function DoNewPicture(gr: TGraphic): TRVRTFErrorCode;
        procedure DoTable(WhatHappens: TRVRTFTableEventKind);
        procedure CheckTable(AllowEnd: Boolean);
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure Clear;
        function ReadFromStream(AStream: TStream): TRVRTFErrorCode;
        function ReadFromFile(const AFileName: String): TRVRTFErrorCode;
        {$IFDEF RICHVIEWCBDEF3}
        function AnsiToUnicode(const s: String; CodePage: Cardinal): WideString;
        function UnicodeToAnsi(const s: WideString): String;
        {$ENDIF}
        property StyleSheet: TRVRTFStyleSheet read FStyleSheet;
        property FontTable:  TRVRTFFontList read FFontTable;
        property ColorTable: TRVRTFColorList read FColorTable;
        property ListTable: TRVRTFListTable97 read FListTable;
        property ListOverrideTable: TRVRTFListOverrideTable97 read FListOverrideTable;
        property RTFState: TRVRTFReaderState read FRTFState;
        property BasePath: String read FBasePath write FBasePath;
      published
        property OnNewText: TRVRTFNewTextEvent read FOnNewText write FOnNewText;
        {$IFDEF RICHVIEWCBDEF3}
        property OnNewUnicodeText: TRVRTFNewUnicodeTextEvent read FOnNewUnicodeText write FOnNewUnicodeText;
        {$ENDIF}
        property OnNewPicture: TRVRTFNewPictureEvent read FOnNewPicture write FOnNewPicture;
        property OnUpdateMarker: TNotifyEvent read FOnUpdateMarker write FOnUpdateMarker;
        property OnTable: TRVRTFTableEvent read FOnTable write FOnTable;
        property OnRequiredPageBreak: TNotifyEvent read FOnRequiredPageBreak write FOnRequiredPageBreak;
        property OnHeaderFooter: TRVRTFHeaderFooterEvent read FOnHeaderFooter write FOnHeaderFooter;
        property DefCodePage: Cardinal  read FDefCodePage write FDefCodePage default CP_ACP;
        property ConvertHighlight: TRVRTFHighlightConvert read FConvertHighlight write FConvertHighlight default rtf_hl_FixedColors;
    end;

{$IFNDEF RICHVIEW}
type
  TRV_CreateGraphicsFunction = function (GraphicClass: TGraphicClass): TGraphic;
  TRV_AfterImportGraphicsProc = procedure(Graphic: TGraphic);
var
  RV_CreateGraphics: TRV_CreateGraphicsFunction;
  RV_AfterImportGraphic: TRV_AfterImportGraphicsProc;
{$ENDIF}


implementation

// Keyword descriptions
const
 isymMax = 301{$IFDEF RICHVIEW}+3{$ENDIF};
 rgsymRtf:array[0..isymMax] of TRVRTFsymbol = (
    (Keyword:'b';        DefValue:1;            UseDef:False;  kwd:rtf_kwd_Prop; idx:ord(ipropBold);      AffectTo:rtf_af_CharProp),
    (Keyword:'ul';       DefValue:1;            UseDef:False;  kwd:rtf_kwd_Prop; idx:ord(ipropUnderline); AffectTo:rtf_af_CharProp),
    (Keyword:'ulnone';   DefValue:0;            UseDef:True;   kwd:rtf_kwd_Prop; idx:ord(ipropUnderline); AffectTo:rtf_af_CharProp),
    (Keyword:'i';        DefValue:1;            UseDef:False;  kwd:rtf_kwd_Prop; idx:ord(ipropItalic);    AffectTo:rtf_af_CharProp),
    (Keyword:'strike';   DefValue:1;            UseDef:False;  kwd:rtf_kwd_Prop; idx:ord(ipropStrike);    AffectTo:rtf_af_CharProp),
    (Keyword:'fs';       DefValue:24;           UseDef:False;  kwd:rtf_kwd_Prop; idx:ord(ipropFontSize);  AffectTo:rtf_af_CharProp),
    (Keyword:'cf';       DefValue:0;            UseDef:False;  kwd:rtf_kwd_Prop; idx:ord(ipropTextColor); AffectTo:rtf_af_CharProp),
    (Keyword:'chcbpat';  DefValue:0;            UseDef:False;  kwd:rtf_kwd_Prop; idx:ord(ipropTextBackColor); AffectTo:rtf_af_CharProp),
    (Keyword:'cbpat';    DefValue:0;            UseDef:False;  kwd:rtf_kwd_Prop; idx:ord(ipropParaColor); AffectTo:rtf_af_ParaProp),
    (Keyword:'li';       DefValue:0;            UseDef:False;  kwd:rtf_kwd_Prop; idx:ord(ipropLeftInd);   AffectTo:rtf_af_ParaProp),
    (Keyword:'ri';       DefValue:0;            UseDef:False;  kwd:rtf_kwd_Prop; idx:ord(ipropRightInd);  AffectTo:rtf_af_ParaProp),