ptblrv.pas

richview1.7 full.source

{=========================} unit PtblRV; {==============================}
{ unit PtblRV:                                                          }
{ components:                                                           }
{   TRVPrint (registered in "RichView" palette page)                    }
{-----------------------------------------------------------------------}
{ Copyright (C) S.Tkachenko                                             }
{=======================================================================}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  RVScroll, RichView, RVItem, RVStyle, Printers, CommDlg, DLines, RVFuncs,
  CRVData, CRVFData, RVRVData, PtRVData;

{$I RV_Defs.inc}

type
  TCustomRVPrint = class;
  TRVPrint = class;  
  {------------------------------------------------------------}
  TRVPrintComponentEvent =
    procedure (Sender: TCustomRVPrint;
               PrintMe: TControl;
               var ComponentImage: TBitmap) of object;
  {------------------------------------------------------------}
  TRVPrintingEvent = procedure (Sender: TCustomRichView; PageCompleted: Integer; Step:TRVPrintingStep) of object;
  {------------------------------------------------------------}
  TRVPagePrepaintEvent = procedure (Sender: TRVPrint; PageNo: Integer;
                               Canvas: TCanvas; Preview: Boolean;
                               PageRect, PrintAreaRect: TRect) of object;
  {------------------------------------------------------------}
  TCustomPrintableRV = class(TCustomRichView)
    private
      FRVPrint: TCustomRVPrint;
    public
      constructor Create(AOwner: TComponent); override;
      function FormatPages: Integer;
      procedure DrawPage(pgNo: Integer; Canvas: TCanvas; Preview, Correction: Boolean);
      property RVPrint: TCustomRVPrint read FRVPrint write FRVPrint;
  end;
  {------------------------------------------------------------}
  TPrintableRV = class(TCustomPrintableRV)
    private
      procedure DoOnPrinting(PageCompleted: Integer; Step:TRVPrintingStep);
    protected
      function GetDataClass: TRichViewRVDataClass; override;
    public
      FMirrorMargins: Boolean;
      FLeftMarginMM, FRightMarginMM, FTopMarginMM, FBottomMarginMM: Integer;
      procedure PrintPages(firstPgNo, lastPgNo: Integer;
                         const Title: String;
                         Copies: Integer; Collate: Boolean);
      procedure Print(const Title: String;
                    Copies: Integer; Collate: Boolean);
      procedure ContinuousPrint;
  end;
  {------------------------------------------------------------}
  TCustomRVPrint = class(TComponent)
    private
      { Private declarations }
      FPreviewCorrection: Boolean;
      FOnPrintComponent: TRVPrintComponentEvent;
      function GetPagesCount: Integer;
      function GetTransparentBackground: Boolean;
      procedure SetTransparentBackground(const Value: Boolean);
      function GetPreview100PercentHeight: Integer;
      function GetPreview100PercentWidth: Integer;
    protected
      { Protected declarations }
      procedure Loaded; override;
      function CreateRichView: TCustomPrintableRV; virtual;
    public
      { Public declarations }
      rv: TCustomPrintableRV;
      Ready: Boolean;
      StartAt,EndAt: Integer;
      constructor Create(AOwner: TComponent); override;
      procedure Clear;
      procedure UpdatePaletteInfo;
      procedure GetFirstItemOnPage(PageNo: Integer; var ItemNo, OffsetInItem: Integer);
      procedure GetFirstItemOnPageEx(PageNo: Integer; var ItemNo, OffsetInItem, ExtraData: Integer);
      procedure DrawPreview(pgNo: Integer; Canvas:  TCanvas; const PageRect: TRect);
      procedure DrawMarginsRect(Canvas:  TCanvas; const PageRect: TRect; PageNo: Integer);
      {$IFNDEF RVDONOTUSERVF}
      function SavePageAsRVF(Stream: TStream; PageNo: Integer): Boolean;
      {$ENDIF}
      property PagesCount: Integer read GetPagesCount;
      property Preview100PercentWidth: Integer read GetPreview100PercentWidth;
      property Preview100PercentHeight: Integer read GetPreview100PercentHeight;
    published
      { Published declarations }
      property PreviewCorrection: Boolean read FPreviewCorrection  write FPreviewCorrection;
      property OnPrintComponent: TRVPrintComponentEvent read FOnPrintComponent write FOnPrintComponent;
      property TransparentBackground: Boolean read GetTransparentBackground write SetTransparentBackground default False;
  end;

  TRVPrint = class(TCustomRVPrint)
    private
      { Private declarations }
      FOnFormatting, FOnPrinting: TRVPrintingEvent;
      FOnPagePrepaint, FOnPagePostPaint: TRVPagePrepaintEvent;
      FClipMargins: Boolean;
      function GetLM: Integer;
      function GetRM: Integer;
      function GetTM: Integer;
      function GetBM: Integer;
      procedure SetLM(mm: Integer);
      procedure SetRM(mm: Integer);
      procedure SetTM(mm: Integer);
      procedure SetBM(mm: Integer);
      function GetMirrorMargins: Boolean;
      procedure SetMirrorMargins(const Value: Boolean);
      function GetFooterY: Integer;
      function GetHeaderY: Integer;
      procedure SetFooterY(const Value: Integer);
      procedure SetHeaderY(const Value: Integer);
    protected
      { Protected declarations }
      function CreateRichView: TCustomPrintableRV; override;
    public
      { Public declarations }
      constructor Create(AOwner: TComponent); override;
      procedure AssignSource(PrintMe: TCustomRichView);
      procedure SetHeader(RVData: TCustomRVFormattedData);
      procedure SetFooter(RVData: TCustomRVFormattedData);      
      function FormatPages(PrintOptions:TRVDisplayOptions): Integer;
      procedure PrintPages(firstPgNo, lastPgNo: Integer; Title: String;
                         Copies: Integer; Collate: Boolean);
      procedure Print(Title: String; Copies: Integer; Collate: Boolean);
      procedure ContinuousPrint;
      procedure MakePreview(pgNo: Integer; bmp: TBitmap);
      procedure MakeScaledPreview(pgNo: Integer; bmp: TBitmap);
      function GetHeaderRect: TRect;
      function GetFooterRect: TRect;
    published
      { Published declarations }
      property ClipMargins:   Boolean read FClipMargins write FClipMargins default False;
      property MirrorMargins: Boolean read GetMirrorMargins write SetMirrorMargins default False;
      property LeftMarginMM:  Integer read GetLM write SetLM;
      property RightMarginMM: Integer read GetRM write SetRM;
      property TopMarginMM:   Integer read GetTM write SetTM;
      property BottomMarginMM:Integer read GetBM write SetBM;
      property FooterYMM:     Integer read GetFooterY write SetFooterY default 10;
      property HeaderYMM:     Integer read GetHeaderY write SetHeaderY default 10;
      property OnFormatting: TRVPrintingEvent read FOnFormatting write FOnFormatting;
      property OnSendingToPrinter: TRVPrintingEvent read FOnPrinting write FOnPrinting;
      property OnPagePrepaint: TRVPagePrepaintEvent read FOnPagePrepaint write FOnPagePrepaint;
      property OnPagePostpaint: TRVPagePrepaintEvent read FOnPagePostpaint write FOnPagePostpaint;      
  end;

function RV_GetPrinterDC: HDC;
implementation
{==============================================================================}
type
  TPrinterDevice = class
    Driver, Device, Port: String;
  end;

function RV_GetPrinterDC: HDC;
var ADevice, ADriver, APort: array[0..79] of Char;
    ADeviceMode: THandle;
    DevMode: PDeviceMode;
begin
  Printer.GetPrinter(ADevice,ADriver,APort,ADeviceMode);
  if ADeviceMode<>0 then
    DevMode := PDeviceMode(GlobalLock(ADeviceMode))
  else
    DevMode := nil;
  Result := CreateDC(ADriver, ADevice, APort, DevMode);
  if ADeviceMode<>0 then
    GlobalUnlock(ADeviceMode);
end;
{=============================== TCustomRVPrint ===============================}
constructor TCustomRVPrint.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  rv := CreateRichView;
  rv.FRVPrint := Self;
  if not (csDesigning in ComponentState) then
    rv.Parent := TWinControl(Self.Owner);
  PreviewCorrection := True;
end;
{------------------------------------------------------------------------------}
function TCustomRVPrint.CreateRichView: TCustomPrintableRV;
begin
  Result := nil;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVPrint.Clear;
begin
  rv.Clear;
  Ready := False;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVPrint.GetFirstItemOnPageEx(PageNo: Integer; var ItemNo, OffsetInItem, ExtraData: Integer);
var dino, dioffs, Part: Integer;
begin
  dino := TRVPageInfo(TPrintableRVData(rv.RVData).PagesColl.Items[PageNo-1]).StartDrawItemNo;
  Part := TRVPageInfo(TPrintableRVData(rv.RVData).PagesColl.Items[PageNo-1]).StartPart;
  if Part>0 then
    ExtraData := TRVMultiDrawItemPart((rv.RVData.DrawItems[dino] as TRVMultiDrawItemInfo).PartsList.Items[Part-1]).GetSoftPageBreakInfo
  else
    ExtraData := -1;

  if rv.GetItemStyle(rv.RVData.DrawItems[dino].ItemNo)<0 then
    dioffs := 0
  else
    dioffs := 1;
  rv.RVData.DrawItem2Item(dino, dioffs, ItemNo, OffsetInItem);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVPrint.GetFirstItemOnPage(PageNo: Integer; var ItemNo,
  OffsetInItem: Integer);
var ExtraData: Integer;
begin
  GetFirstItemOnPageEx(PageNo, ItemNo, OffsetInItem, ExtraData);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSERVF}
function TCustomRVPrint.SavePageAsRVF(Stream: TStream; PageNo: Integer): Boolean;
begin
  Result := TCustomMainPtblRVData(rv.RVData).SavePageAsRVF(Stream, PageNo, rv.Color, rv.Background);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function TCustomRVPrint.GetPagesCount: Integer;
begin
  Result := TPrintableRVData(rv.RVData).PagesColl.Count;
end;
{------------------------------------------------------------------------------}
function TCustomRVPrint.GetTransparentBackground: Boolean;
begin
  Result := TPrintableRVData(rv.RVData).Transparent;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVPrint.SetTransparentBackground(const Value: Boolean);
begin
  TPrintableRVData(rv.RVData).Transparent := Value;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVPrint.Loaded;
begin
  inherited Loaded;
  UpdatePaletteInfo;
end;
{------------------------------------------------------------------------------}
procedure TCustomRVPrint.UpdatePaletteInfo;
begin
  rv.UpdatePaletteInfo;
end;
{------------------------------------------------------------------------------}
function TCustomRVPrint.GetPreview100PercentHeight: Integer;
begin
  with TCustomMainPtblRVData(rv.RVData) do
    Result := MulDiv(rv.ClientHeight+TmpTM+TmpBM,
                     PrnSaD.ppiyScreen, PrnSaD.ppiyDevice);
end;
{------------------------------------------------------------------------------}
function TCustomRVPrint.GetPreview100PercentWidth: Integer;
begin
  with TCustomMainPtblRVData(rv.RVData) do
    Result := MulDiv(rv.ClientWidth+TmpLM+TmpRM,
                   PrnSaD.ppixScreen, PrnSaD.ppixDevice);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVPrint.DrawPreview(pgNo: Integer; Canvas: TCanvas;
  const PageRect: TRect);
begin
   SetMapMode(Canvas.Handle,MM_TEXT);
   Canvas.Brush.Color := clWhite;
   Canvas.Pen.Color := clWhite;
   Canvas.FillRect(PageRect);
   SetMapMode(Canvas.Handle,MM_ANISOTROPIC);
   with TCustomMainPtblRVData(rv.RVData) do
     SetWindowExtEx(Canvas.Handle,
                    rv.ClientWidth +TmpLM+TmpRM,
                    rv.ClientHeight+TmpTM+TmpBM,nil);
   with PageRect do begin
     SetViewportExtEx(Canvas.Handle, Right-Left, Bottom-Top,nil);
     SetViewportOrgEx(Canvas.Handle,Left,Top,nil);
   end;
   if TCustomMainPtblRVData(rv.RVData).PrnSaD.ppixDevice>TCustomMainPtblRVData(rv.RVData).PrnSaD.ppiyDevice then
      Canvas.Font.PixelsPerInch := TCustomMainPtblRVData(rv.RVData).PrnSaD.ppiyDevice
   else
      Canvas.Font.PixelsPerInch := TCustomMainPtblRVData(rv.RVData).PrnSaD.ppixDevice;
   rv.DrawPage(pgNo, Canvas, True, PreviewCorrection);
   SetMapMode(Canvas.Handle,MM_TEXT);
   SetViewportOrgEx(Canvas.Handle,0,0,nil);
end;
{------------------------------------------------------------------------------}
procedure TCustomRVPrint.DrawMarginsRect(Canvas: TCanvas; const PageRect: TRect; PageNo: Integer);