ptrvdata.pas

richview1.7 full.source

unit PtRVData;

interface
uses Classes, Windows, Graphics, Printers,
     DLines, RVFuncs, RVItem, RVBack,
     CRVData, CRVFData, RVRVData,
     RVStyle, RVScroll, RichView, RVUni, RVClasses;
{$I RV_Defs.inc}
type
  TRVMultiDrawItemInfo = class (TRVDrawLineInfo)
    FPartsList: TRVList;
    public
      constructor Create;
      destructor Destroy; override;
      property PartsList: TRVList read FPartsList;
  end;

  TCustomPrintableRVData = class(TRichViewRVData)
    protected
      function GetBack: TRVBackground; virtual;
      function GetTopCoord(PageNo: Integer): Integer; virtual;
      function GetTopCoord2(PageNo: Integer): Integer; virtual;
      function GetPrintableAreaTop: Integer; virtual;
      procedure DoPagePrepaint(Canvas: TCanvas; PageNo: Integer; Preview, Correction: Boolean); virtual;
      procedure DoPagePostpaint(Canvas: TCanvas; PageNo: Integer; Preview: Boolean); virtual;
      procedure GetDrawItemsRange(PageNo: Integer; var StartNo, EndNo, Part: Integer);  virtual;
      procedure CheckPageNo(PageNo: Integer); virtual;
      function ShareItems: Boolean; override;
      function InitPrinterCanvas: TCanvas; dynamic;
      procedure DonePrinterCanvas(Canvas: TCanvas); dynamic;
    public
      ParentDrawsBack: Boolean;
      function GetPrintableAreaLeft(PageNo: Integer): Integer; virtual;
      procedure DrawPage(pgNo: Integer; Canvas: TCanvas; Preview, Correction: Boolean);
  end;

  TCustomMainPtblRVData = class(TCustomPrintableRVData)
    private
      TmpTMPix, TmpBMPix: Integer;
    protected
      StreamSavePage: Integer;
      PrinterCanvas : TCanvas;
      procedure DoFormatting(PageCompleted: Integer; Step:TRVPrintingStep); dynamic;
      function GetBack: TRVBackground; override;
      function GetTopCoord(PageNo: Integer): Integer; override;
      function GetTopCoord2(PageNo: Integer): Integer; override;
      procedure GetSADForFormatting(Canvas: TCanvas; var sad: TRVScreenAndDevice); override;
      function GetPrintableAreaTop: Integer; override;
      procedure GetDrawItemsRange(PageNo: Integer; var StartNo, EndNo, Part: Integer);  override;
      procedure CheckPageNo(PageNo: Integer); override;
      function GetPageWidth: Integer; dynamic;
      function GetPageHeight: Integer; dynamic;
      procedure Prepare; dynamic;
      procedure RVFGetLimits(SaveScope: TRVFSaveScope;
                             var StartItem, EndItem, StartOffs, EndOffs: Integer;
                             var StartPart, EndPart: TRVMultiDrawItemPart); override;
    public
      PagesColl: TCollection;
      PrnSad: TRVScreenAndDevice;
      FTopMarginPix, FBottomMarginPix: Integer;
      Transparent: Boolean;
      TmpLM, TmpTM: Integer;
      TmpRM, TmpBM: Integer;
      function GetPrintableAreaLeft(PageNo: Integer): Integer; override;
      function FormatPages: Integer;
      procedure FormatNextPage(var i, StartAt, StartY, Y: Integer; var Splitting: Boolean;
                               MaxHeight: Integer);
      function GetColor: TColor; override;
      {$IFNDEF RVDONOTUSERVF}
      function SavePageAsRVF(Stream: TStream; PageNo: Integer; Color: TColor; Background: TRVBackground): Boolean;
      {$ENDIF}
      constructor Create(RichView: TRVScroller); override;
      destructor Destroy; override;
  end;

  TRVHeaderFooterRVData = class;

  TPrintableRVData = class(TCustomMainPtblRVData)
    protected
      procedure DoFormatting(PageCompleted: Integer; Step:TRVPrintingStep); override;
      function InitPrinterCanvas: TCanvas; override;
      procedure DonePrinterCanvas(Canvas: TCanvas); override;
      procedure DoPagePrepaint(Canvas: TCanvas; PageNo:Integer; Preview, Correction: Boolean); override;
      procedure DoPagePostpaint(Canvas: TCanvas; PageNo:Integer; Preview: Boolean); override;
      function GetPageWidth: Integer; override;
      function GetPageHeight: Integer; override;
      procedure Prepare; override;
    public
      TmpLMMir: Integer;
      Header, Footer: TRVHeaderFooterRVData;
      HeaderY, FooterY: Integer;
      function GetPrintableAreaLeft(PageNo: Integer): Integer; override;
      constructor Create(RichView: TRVScroller); override;
      destructor Destroy; override;
  end;

  TRectPtblRVData = class(TCustomPrintableRVData)
    protected
      procedure GetSADForFormatting(Canvas: TCanvas; var sad: TRVScreenAndDevice); override;
      function GetPrintableAreaTop: Integer; override;
      function GetTopCoord(PageNo: Integer): Integer; override;
      function InitPrinterCanvas: TCanvas; override;
    public
      FPrintingData: TCustomRVFormattedData;
      Left,Top,DX,DY,Width,Height: Integer;
      FColor: TColor;
      function GetPrintableAreaLeft(PageNo: Integer): Integer; override;
      function GetParentData: TCustomRVData; override;
      function GetRootData: TCustomRVData; override;
      constructor Create(RichView: TRVScroller; PrintingData: TCustomRVFormattedData); {$IFDEF RICHVIEWDEF4} reintroduce;{$ENDIF}
      function GetWidth: Integer; override;
      function GetHeight: Integer; override;
      function GetLeftMargin: Integer; override;
      function GetRightMargin: Integer; override;
      function GetTopMargin: Integer; override;
      function GetBottomMargin: Integer; override;
      function GetCanvas: TCanvas; override;
      function GetColor: TColor; override;
  end;

  TRVHeaderFooterRVData = class (TRectPtblRVData)
    public
      constructor Create(RichView: TRVScroller; PrintingData: TCustomRVFormattedData);
      function GetRVStyle: TRVStyle; override;
      function GetMaxTextWidth: Integer; override;
  end;

  TRVPageInfo = class (TCollectionItem)
    public
      StartY, StartDrawItemNo, StartPart, StartY2 : Integer;
      procedure Assign(Source: TPersistent); override;
  end;

implementation
uses PtblRV, RVStr;
{============================ TRVMultiDrawItemInfo ============================}
constructor TRVMultiDrawItemInfo.Create;
begin
  inherited Create;
  FPartsList := TRVList.Create;
end;
{------------------------------------------------------------------------------}
destructor TRVMultiDrawItemInfo.Destroy;
begin
  FPartsList.Free;
  inherited  Destroy;
end;
{=============================== TRVPageInfo ==================================}
procedure TRVPageInfo.Assign(Source: TPersistent);
begin
  if Source is TRVPageInfo then begin
    StartY := TRVPageInfo(Source).StartY;
    StartDrawItemNo := TRVPageInfo(Source).StartDrawItemNo;
    end
  else
    inherited Assign(Source);
end;
{============================== TCustomPrintableRVData ========================}
procedure TCustomPrintableRVData.DonePrinterCanvas(Canvas: TCanvas);
begin

end;
{------------------------------------------------------------------------------}
function TCustomPrintableRVData.ShareItems: Boolean;
begin
  Result := True;
end;
{------------------------------------------------------------------------------}
function TCustomPrintableRVData.InitPrinterCanvas: TCanvas;
begin
  Result := nil;
end;
{------------------------------------------------------------------------------}
function TCustomPrintableRVData.GetBack: TRVBackground;
begin
  Result := nil;
end;
{------------------------------------------------------------------------------}
function TCustomPrintableRVData.GetTopCoord(PageNo: Integer): Integer;
begin
  Result := 0;
end;
{------------------------------------------------------------------------------}
function TCustomPrintableRVData.GetTopCoord2(PageNo: Integer): Integer;
begin
  Result := 0;
end;
{------------------------------------------------------------------------------}
function TCustomPrintableRVData.GetPrintableAreaLeft(PageNo: Integer): Integer;
begin
  Result := 0;
end;
{------------------------------------------------------------------------------}
function TCustomPrintableRVData.GetPrintableAreaTop: Integer;
begin
  Result := 0;
end;
{------------------------------------------------------------------------------}
procedure TCustomPrintableRVData.DoPagePrepaint(Canvas: TCanvas; PageNo:Integer; Preview, Correction: Boolean);
begin

end;
{------------------------------------------------------------------------------}
procedure TCustomPrintableRVData.DoPagePostpaint(Canvas: TCanvas; PageNo: Integer; Preview: Boolean);
begin

end;
{------------------------------------------------------------------------------}
procedure TCustomPrintableRVData.GetDrawItemsRange(PageNo: Integer; var StartNo, EndNo, Part: Integer);
begin
  StartNo := 0;
  EndNo   := DrawItems.Count-1;
  Part    := -1;
  //FirstOffs := 0;
end;
{------------------------------------------------------------------------------}
procedure TCustomPrintableRVData.CheckPageNo(PageNo: Integer);
begin

end;
{------------------------------------------------------------------------------}
procedure TCustomPrintableRVData.DrawPage(pgNo: Integer; Canvas: TCanvas; Preview, Correction: Boolean);
var i,no: Integer;
    dli:TRVDrawLineInfo;
    li: TCustomRVItemInfo;
    zerocoord: Integer;
    first, last, part: Integer;
    backgroundbmp, tmpbmp : TBitmap;
    XPos, DefCharExtra,CharExtra,LineWidth, LeftOffs: Integer;
    RVStyle: TRVStyle;
    sad: TRVScreenAndDevice;
    {.......................................}
    function GetDevX(ScreenX: Integer):Integer;
    begin
      Result := MulDiv(ScreenX, sad.ppixDevice, sad.ppixScreen);
    end;
    {.......................................}
    function GetDevY(ScreenY: Integer):Integer;
    begin
      Result := MulDiv(ScreenY, sad.ppiyDevice, sad.ppiyScreen);
    end;
    {.......................................}
    procedure DrawBackground; // in-out: backgroundbmp
                              // in: Canvas
    var BackWidth, BackHeight: Integer;
    begin
      BackWidth  := MulDiv(GetWidth,  sad.ppixScreen, sad.ppixDevice);
      BackHeight := MulDiv(GetHeight, sad.ppiyScreen, sad.ppiyDevice);
      if (GetBack<>nil) and
         (GetBack.Style <> bsNoBitmap) and
         not GetBack.Bitmap.Empty then begin
        if GetBack.Style=bsTiledAndScrolled then
          GetBack.Style:=bsTiled;
        backgroundbmp := TBitmap.Create;
        backgroundbmp.Width := BackWidth;
        backgroundbmp.Height := BackHeight;
        if Preview and (GetRVLogPalette<>nil) then
          backgroundbmp.Palette := CreatePalette(GetRVLogPalette^);
        GetBack.Draw(backgroundbmp.Canvas.Handle, Rect(0,0, BackWidth, BackHeight),
                 0,0, BackWidth, BackHeight, GetColor);
        RV_PictureToDevice(Canvas, GetPrintableAreaLeft(pgNo), GetPrintableAreaTop, -1, -1, sad, backgroundbmp, Preview);
        end
      else begin
        backgroundbmp := nil;
        if not ParentDrawsBack then
          with Canvas do
            if GetColor<>clNone then begin
              Pen.Color := GetColor;
              Brush.Color := GetColor;
              Brush.Style := bsSolid;
              FillRect(Bounds(GetPrintableAreaLeft(pgNo), GetPrintableAreaTop, GetWidth,GetHeight));
            end;
      end;
      DoPagePrepaint(Canvas, pgNo, Preview, Correction);
    end;
    {.......................................}
    procedure DrawBackTotmpbmp(Top: Integer); // in: backgroundbmp,tmpbmp,dli,li
    var pi: TParaInfo;
        Clr: TColor;
    begin
      pi := GetRVStyle.ParaStyles[li.ParaNo];
      if (pi.Background.Color=clNone) and (backgroundbmp<>nil) then
        tmpbmp.Canvas.CopyRect(Rect(0,0, tmpbmp.Width, tmpbmp.Height),
          backgroundbmp.Canvas,
            Bounds(
                 MulDiv(dli.Left, sad.ppixScreen, sad.ppixDevice)+li.GetBorderWidth,
                 MulDiv({dli.Top-(zerocoord+GetPrintableAreaTop)} Top-GetPrintableAreaTop, sad.ppiyScreen, sad.ppiyDevice)+li.GetBorderHeight,
                 tmpbmp.Width, tmpbmp.Height
                )
            )
      else begin
        Clr := pi.Background.Color;
        if Clr = clNone then
          Clr := GetColor;
        if Clr = clNone then
          Clr := clWhite;
        tmpbmp.Canvas.Pen.Color := Clr;
        tmpbmp.Canvas.Brush.Color := Clr;
        tmpbmp.Canvas.FillRect(Rect(0,0, tmpbmp.Width, tmpbmp.Height));
      end;
    end;
    {.......................................}
    procedure DrawParagraph(i: Integer);
    var R, R1: TRect;
        dli: TRVDrawLineInfo;
        li: TCustomRVItemInfo;
        pi: TParaInfo;
        j: Integer;
    begin
      dli := DrawItems[i];
      li := GetItem(dli.ItemNo);
      pi := GetRVStyle.ParaStyles[li.ParaNo];
      if (pi.Border.Style=rvbNone) and (pi.Background.Color=clNone) and not Assigned(RVStyle.OnDrawParaBack) then
        exit;
      R.Left := GetPrintableAreaLeft(pgNo)+GetDevX(GetLeftMargin+pi.LeftIndent);
      if pi.FirstIndent<0 then
        inc(R.Left, GetDevX(pi.FirstIndent));
      R.Right:= GetPrintableAreaLeft(pgNo)+GetWidth-GetDevX(GetRightMargin+pi.RightIndent);
      if (i=first) and (part>=0) then begin
        R.Top := 0;
        R.Bottom := TRVMultiDrawItemPart(TRVMultiDrawItemInfo(dli).PartsList[part]).Height;
        end
      else begin
        R.Top := dli.Top;
        if (i=last) and (dli is TRVMultiDrawItemInfo) and
          (TRVMultiDrawItemInfo(dli).PartsList.Count>0) then
          R.Bottom := dli.Top+TRVMultiDrawItemPart(TRVMultiDrawItemInfo(dli).PartsList[0]).Height
        else
          R.Bottom := dli.Top+dli.Height+dli.ExtraSpaceBelow;
      end;
      for j := i+1 to last do begin
        dli := DrawItems[j];
        if (dli.ItemNo<>DrawItems[j-1].ItemNo) and
           TCustomRVItemInfo(Items.Objects[dli.ItemNo]).CanBeBorderStart then break;
        if dli.Top<R.Top then
          R.Top := dli.Top;
        if (j=last) and (dli is TRVMultiDrawItemInfo) and
          (TRVMultiDrawItemInfo(dli).PartsList.Count>0) then
          R.Bottom := dli.Top+TRVMultiDrawItemPart(TRVMultiDrawItemInfo(dli).PartsList[0]).Height
        else
          if dli.Top+dli.Height+dli.ExtraSpaceBelow>R.Bottom then
            R.Bottom := dli.Top+dli.Height+dli.ExtraSpaceBelow;
      end;
      OffsetRect(R,0,-zerocoord);
      R1 := R;
      pi.Background.PrepareDrawSaD(R1, sad);
      GetRVStyle.DrawParaBack(Canvas, li.ParaNo, R1);
      pi.Border.DrawSaD(R, Canvas, sad);
    end;
    {.......................................}
var ItemTop, w, h: Integer;
    BiDiMode, BiDiMode2: TRVBiDiMode;
    Dummy: Boolean;
    TextStyle: TFontInfo;
begin
  RVStyle := GetRVStyle;
  if RVStyle=nil then
    raise ERichViewError.Create(errStyleIsNotAssigned);
  GetSADForFormatting(Canvas, sad);

  GetDrawItemsRange(pgNo, first, last, part);
  zerocoord := GetTopCoord(PgNo);
  LeftOffs  := GetPrintableAreaLeft(pgNo);
  Canvas.Brush.Style := bsClear;
  DrawBackground;