rvrtfprops.pas

richview1.7 full.source

unit RVRTFProps;

interface
{$I RV_Defs.inc}
uses SysUtils, Windows, Classes, Forms, Math,
     {$IFNDEF RVDONOTUSERTFIMPORT}
     RVRTF,
     {$ENDIF}
     {$IFNDEF RVDONOTUSELISTS}
     RVMarker,
     {$ENDIF}
     RVScroll, CRVData, CRVFData, RVStyle, Graphics, RVRTFErr, RVUni, RVItem,
     RVMapWht, RVFuncs,
     RVClasses;

{$IFNDEF RICHVIEWCBDEF3}
{$DEFINE RVDONOTUSEUNICODE}
{$ENDIF}
{$IFDEF RVDONOTUSERVF}
{$DEFINE RVDONOTUSETABLES}
{$ENDIF}

const
  RV_TableGridEps: Integer = 1;

type
  TRVBorderGlueMode = (rvbgVisibleBorders, rvbgNegativeSpacing);

  TRVAllowUseStyleEvent = procedure (StyleNo: Integer; TextStyle: Boolean;
                                     var Allow: Boolean) of object;
  {$IFNDEF RVDONOTUSERTFIMPORT}
  TRVCustomImageItemEvent = procedure (RVData: TCustomRVData; Graphic: TGraphic; Hypertext: Boolean;
                                     var item: TCustomRVItemInfo;
                                     var FreeGraphic: Boolean;
                                     RTFPicture: TRVRTFPicture) of object;
  {$ENDIF}


  TRVRTFReaderProperties = class (TPersistent)
    private
      FUnicodeMode: TRVReaderUnicode;
      FTextStyleMode: TRVReaderStyleMode;
      FParaStyleMode: TRVReaderStyleMode;
      FIgnorePictures: Boolean;
      FUseHypertextStyles: Boolean;
      FParaNo: Integer;
      FStyleNo: Integer;
      FTableBorderGlueMode: TRVBorderGlueMode;
      FExplicitTableWidth: Boolean;
      FSkipHiddenText: Boolean;
      FHideTableGridLines: Boolean;
      FLineBreaksAsParagraphs: Boolean;
      {$IFNDEF RVDONOTUSERTFIMPORT}
      FEmptyPara: Integer;
      RVData, CurrentRVData: TCustomRVData;
      RVStyle: TRVStyle;
      PageBreak: Boolean;
      PixelsPerTwip: Double;
      Reader: TRVRTFReader;
      FirstTime: Boolean;
      InsertPoint, CurrentRow, CurrentCol: Integer;
      Tables: TRVList;
      FHeaderRVData, FFooterRVData: TCustomRVData;
      FHeaderYMM, FFooterYMM: Integer;
      FConvertHighlight: TRVRTFHighlight;
      HFType: TRVRTFHeaderFooterType;
      FBasePath: String;
      {$IFNDEF RVDONOTUSELISTS}
      IgnoreLists: Boolean;
      LastMarkerIndex: Integer;
      LevelToListNo: TRVIntegerList;
      ListTableMap97: TRVIntegerList;
      {$ENDIF}
      procedure InitReader;
      procedure DoneReader;
      function ReturnParaNo(Position: TRVRTFPosition): Integer;
      function CreateTextItem(const Text: String;
                              {$IFDEF RICHVIEWCBDEF3}
                              const WideText: WideString;
                              {$ENDIF}
                              StyleNo, ParaNo: Integer; UseUnicode: Boolean;
                              var ResText: String): TRVTextItemInfo;
      {$IFNDEF RVDONOTUSELISTS}
      function GetMarkerIndex(RTFMarker: TRVRTFMarkerProperties): Integer;
      function InsertMarker(ParaNo: Integer): Boolean;
      procedure InsertMarker97(ParaNo: Integer);
      procedure ReaderUpdateMarker(Sender: TObject);
      procedure MergeListTable97;
      function AreListStylesEqual97(RVList: TRVListInfo;
        RTFList: TRVRTFList97): Boolean;
      function FindListStyle97(RTFList: TRVRTFList97;
        ForbiddenStyles: TRVIntegerList): Integer;
      {$ENDIF}
      procedure InsertItem(var Text: String; item: TCustomRVItemInfo; Position: TRVRTFPosition);
      procedure CurrentBorder(var RVBorderStyle: TRVBorderStyle;
                              var RVBorderWidth, RVBorderIntWidth: Integer;
                              var BorderColor: TColor);
      function FindParaNo(RVBorderStyle: TRVBorderStyle;
                          RVBorderWidth, RVBorderIntWidth: Integer;
                          BorderColor: TColor): Integer;
      {$IFNDEF RVDONOTUSETABLES}
      function GetEmptyParaNo(Alignment: TRVAlignment): Integer;
      function GetEmptyStyleNo: Integer;
      {$ENDIF}
      function FindBestParaNo: Integer;
      function FindStyleNo(AUnicode, AHypertext: Boolean): Integer;
      function FindBestStyleNo(AUnicode, AHypertext: Boolean): Integer;
      procedure AddPara(RVBorderStyle: TRVBorderStyle;
                          RVBorderWidth, RVBorderIntWidth: Integer;
                          BorderColor: TColor);
      procedure AddStyle(AUnicode, AHypertext: Boolean);
      function ReturnParaNo_: Integer;
      function ReturnStyleNo(AUnicode: Boolean): Integer;
      function IsHypertext_: Boolean;
      function IsHypertext(var Target, Extras: String): Boolean;
      function AllowUseStyle(StyleNo: Integer; TextStyle: Boolean): Boolean;
      {$ENDIF}
      procedure SetParaNo(const Value: Integer);
      procedure SetStyleNo(const Value: Integer);
    protected
      {$IFNDEF RVDONOTUSERTFIMPORT}
      procedure NewReaderText(Sender: TRVRTFReader; const Text: String; Position: TRVRTFPosition);
      {$IFDEF RICHVIEWCBDEF3}
      procedure NewReaderUnicodeText(Sender: TRVRTFReader; const Text: WideString; Position: TRVRTFPosition);
      {$ENDIF}
      procedure NewReaderPicture(Sender: TRVRTFReader; RTFPicture: TRVRTFPicture; Graphic: TGraphic;
                               Position: TRVRTFPosition);
      {$IFNDEF RVDONOTUSETABLES}
      procedure AssignRowProperties;
      procedure ReaderTable(Sender: TRVRTFReader; WhatHappens: TRVRTFTableEventKind);
      {$ENDIF}
      procedure ReaderPageBreak(Sender: TObject);
      procedure ReaderHeaderFooter(Sender: TRVRTFReader; HFType: TRVRTFHeaderFooterType; Starting: Boolean);
      {$ENDIF}
    public
      EditFlag: Boolean;
      ErrorCode: TRVRTFErrorCode;
      FailedBecauseOfProtect, FullReformat: Boolean;
      NonFirstItemsAdded: Integer;
      AllowNewPara: Boolean;
      OnAllowUseStyle:   TRVAllowUseStyleEvent;
      {$IFNDEF RVDONOTUSERTFIMPORT}
      OnCustomImageItem: TRVCustomImageItemEvent;
      {$ENDIF}
      Index: Integer;
      constructor Create;
      procedure Assign(Source: TPersistent); override;
      function ReadFromFile(const AFileName: String; ARVData: TCustomRVData): TRVRTFErrorCode;
      function ReadFromStream(AStream: TStream; ARVData: TCustomRVData): TRVRTFErrorCode;
      function InsertFromStreamEd(AStream: TStream; ARVData: TCustomRVData; var AIndex: Integer): TRVRTFErrorCode;
      property TableBorderGlueMode: TRVBorderGlueMode read FTableBorderGlueMode write FTableBorderGlueMode;
      property ExplicitTableWidth: Boolean read FExplicitTableWidth write FExplicitTableWidth default False;
      {$IFNDEF RVDONOTUSERTFIMPORT}
      procedure SetHeader(RVData: TCustomRVData);
      procedure SetFooter(RVData: TCustomRVData);
      property HeaderYMM: Integer read FHeaderYMM;
      property FooterYMM: Integer read FFooterYMM;
      property BasePath: String read FBasePath write FBasePath;
      {$ENDIF}
    published
      property UnicodeMode: TRVReaderUnicode read FUnicodeMode write FUnicodeMode default rvruNoUnicode;
      property TextStyleMode: TRVReaderStyleMode read FTextStyleMode write FTextStyleMode default rvrsUseClosest;
      property ParaStyleMode: TRVReaderStyleMode read FParaStyleMode write FParaStyleMode default rvrsUseClosest;
      property IgnorePictures: Boolean read FIgnorePictures write FIgnorePictures default False;
      property UseHypertextStyles: Boolean read FUseHypertextStyles write FUseHypertextStyles default False;
      property TextStyleNo: Integer read FStyleNo write SetStyleNo default 0;
      property ParaStyleNo: Integer read FParaNo write SetParaNo default 0;
      property SkipHiddenText: Boolean read FSkipHiddenText write FSkipHiddenText default True;
      property AutoHideTableGridLines: Boolean read FHideTableGridLines write FHideTableGridLines default False;
      property LineBreaksAsParagraphs: Boolean read FLineBreaksAsParagraphs write FLineBreaksAsParagraphs default False;
      {$IFNDEF RVDONOTUSERTFIMPORT}
      property ConvertHighlight: TRVRTFHighlight read FConvertHighlight write FConvertHighlight default rtfhlColorTable;
      {$ENDIF}
  end;

implementation
uses RVStr
  {$IFNDEF RVDONOTUSETABLES}
  , RVTable
  {$ENDIF}
  ;

{$IFNDEF RVDONOTUSERTFIMPORT}

{$IFNDEF RVDONOTUSETABLES}
{=============================== TTableInfo ===================================}
type
  TTableInfo = class
    public
      HRules: TRVIntegerList;
      ParentRow, ParentCol, PrevColCount: Integer;
      table, lastrow: TRVTableItemInfo;
      VSpacingTw, VBorderSpacing1Tw,VBorderSpacing2Tw: Integer;
      HSpacingTw, CellPaddingTw, CellPaddingCount, BestWidth: Integer;
      BorderWidthTw, CellBorderWidthTw, CellCount, BorderCount, CellBorderCount: Integer;
      UseHSpacing, UseVSpacing, Word2000, CellFlatBorder, RichViewSpecial: Boolean;
      RowFinished: Boolean;
      constructor Create;
      destructor Destroy; override;
      procedure Finalize(PixelsPerTwip: Double; GlueMode: TRVBorderGlueMode; DefStyleNo, DefParaNo: Integer;
                         ExplicitTableWidth, AutoHideGridLines: Boolean);
  end;
{------------------------------------------------------------------------------}
constructor TTableInfo.Create;
begin
  inherited Create;
  HRules := TRVIntegerList.Create;
  CellFlatBorder := True;
end;
{------------------------------------------------------------------------------}
destructor TTableInfo.Destroy;
begin
  lastrow.Free;
  HRules.Free;
  inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TTableInfo.Finalize(PixelsPerTwip: Double; GlueMode: TRVBorderGlueMode; DefStyleNo, DefParaNo: Integer;
                              ExplicitTableWidth, AutoHideGridLines: Boolean);
var r,c,r2,c2: Integer;
    Cell1, Cell2: TRVTableCellData;
begin
  if CellFlatBorder then
    table.CellBorderStyle := rvtbColor;
  if table.BorderColor=table.BorderLightColor then
    table.BorderStyle := rvtbColor;
  if CellPaddingCount>0 then
    table.CellPadding := Round(PixelsPerTwip*CellPaddingTw / CellPaddingCount)
  else
    table.CellPadding := 0;
  for r := 0 to table.Rows.Count-1 do
    for c := 0 to table.Rows[r].Count-1 do begin
      Cell1 := table.Cells[r,c];
      if (Cell1<>nil) then begin
        if not RichViewSpecial and (Cell1.BestWidth>table.CellPadding*2) then
          Cell1.BestWidth := Cell1.BestWidth-table.CellPadding*2;
        if (Cell1.Items.Count=0) then
         Cell1.AddNL('', DefStyleNo, DefParaNo);
      end;
    end;

  if not UseVSpacing or not UseHSpacing and (GlueMode=rvbgVisibleBorders) then
    for r := 0 to table.Rows.Count-1 do
      for c := 0 to table.Rows[r].Count-1 do begin
        Cell1 := table.Cells[r,c];
        if (Cell1<>nil) and Cell1.VisibleBorders.Left and not UseHSpacing and (c>0) then begin
          Cell2 := table.Rows.GetMainCell(r,c-1,r2,c2);
          if Cell2.VisibleBorders.Right then
            Cell1.VisibleBorders.Left := False;
        end;
        if (Cell1<>nil) and Cell1.VisibleBorders.Top and not UseVSpacing and (r>0) then begin
          Cell2 := table.Rows.GetMainCell(r-1,c,r2,c2);
          if Cell2.VisibleBorders.Bottom then
            Cell1.VisibleBorders.Top := False;
        end;
      end;
  if UseVSpacing then begin
    if table.Rows.Count>1 then
      table.CellVSpacing := Round(PixelsPerTwip*VSpacingTw / (table.Rows.Count-1));
      table.BorderVSpacing := Round(PixelsPerTwip*(VBorderSpacing1Tw+VBorderSpacing2Tw));
    end
  else begin
    if GlueMode=rvbgVisibleBorders then begin
      table.CellVSpacing := 0;
      table.BorderVSpacing := 0;
      end
    else  begin
      table.CellVSpacing := -1;
      table.BorderVSpacing := -1;
    end
  end;
  if UseHSpacing then
    table.CellHSpacing := Round(PixelsPerTwip*HSpacingTw / table.Rows.Count)
  else begin
    if GlueMode=rvbgVisibleBorders then
      table.CellHSpacing := 0
    else
      table.CellHSpacing := -1;
  end;
  table.BorderHSpacing := table.CellHSpacing;
  if RichViewSpecial then
    table.BestWidth := BestWidth
  else
    if BestWidth>0 then begin
      if BorderCount>0 then
        table.BestWidth := Round(PixelsPerTwip*(BestWidth-BorderWidthTw/BorderCount))
      else
        table.BestWidth := Round(PixelsPerTwip*BestWidth);
      end
    else if BestWidth<0 then
      table.BestWidth := BestWidth div 50
    else if ExplicitTableWidth then
      table.BestWidth := Round((HRules[HRules.Count-1]-HRules[0])*PixelsPerTwip);
  if CellBorderCount>0 then
    table.CellBorderWidth :=  Round(PixelsPerTwip*CellBorderWidthTw/CellBorderCount);
  if BorderCount>0 then
    table.BorderWidth :=  Round(PixelsPerTwip*BorderWidthTw/BorderCount);
  if not UseVSpacing and not UseHSpacing and (table.BorderWidth=table.CellBorderWidth) then begin
    table.BorderWidth := 0;
    table.BorderHSpacing := 0;
    table.BorderVSpacing := 0;
  end;
  if AutoHideGridLines then
    table.Options := table.Options + [rvtoHideGridLines];
end;
{$ENDIF}
{==============================================================================}
procedure BorderRTF2RV(StyleRTF:TRVRTFBorderType; WidthRTF: Integer;
                       var StyleRV: TRVBorderStyle; var WidthRV, IntWidthRV: Integer;
                       PixelPerTwips: Double;
                       InvertSides: Boolean);
begin
  IntWidthRV := 0;
  case StyleRTF of
    rtf_brdr_None:
      begin
        StyleRV := rvbNone;
        WidthRV := 0;
      end;
    rtf_brdr_SingleThickness,
    rtf_brdr_Inset, rtf_brdr_Outset, rtf_brdr_Shadow,
    rtf_brdr_Dot, rtf_brdr_Dash, rtf_brdr_DashSmall,
    rtf_brdr_DotDash, rtf_brdr_DotDotDash,
    rtf_brdr_Wavy, rtf_brdr_Striped,
    rtf_brdr_Emboss, rtf_brdr_Engrave:
      begin
       // WidthRTF = width of line
        StyleRV := rvbSingle;
        WidthRV    := Round(WidthRTF*PixelPerTwips);
      end;
    rtf_brdr_DoubleThickness:
      begin
        // WidthRTF = width of line / 2
        StyleRV := rvbSingle;
        WidthRV    := Round(WidthRTF*PixelPerTwips*2);
      end;
    rtf_brdr_Double, rtf_brdr_DoubleWavy:
      begin
        // WidthRTF = width of line = width of space
        StyleRV := rvbDouble;
        WidthRV    := Round(WidthRTF*PixelPerTwips);
        IntWidthRV := WidthRV*2-1;