gmpagelist.pas

GmPrintSuite 2.96.7] a

{******************************************************************************}
{                                                                              }
{                               GmPageList.pas                                 }
{                                                                              }
{           Copyright (c) 2003 Graham Murt  - www.MurtSoft.co.uk               }
{                                                                              }
{   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
{                                                                              }
{                           [e-mail]                              }
{                                                                              }
{******************************************************************************}

unit GmPageList;

interface

uses Windows, Classes, Controls, Graphics, GmClasses, GmTypes, GmCanvas,
  GmPrinter, GmResource, StdCtrls;

type
  TGmHeaderFooter = class;

  TGmScrollingPageControl = class(TGmCanvasWinControl);

  TGmPageList = class;

  TGmBeforeLoadEvent       = procedure(Sender: TObject; FileVersion: Extended; var LoadFile: Boolean) of object;
  TGmObjectMouseEvent      = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: TGmValue; AGmObject: TGmVisibleObject) of object;
  TGmPrintProgressEvent    = procedure(Sender: TObject; Printed, Total: integer) of object;

  //----------------------------------------------------------------------------

  // *** TGmHeaderFooterCaption ***

  TGmHeaderFooterCaption = class(TPersistent)
  private
    FCaption: string;
    FFont: TFont;
    FHeaderFooter: TGmHeaderFooter;
    // events...
    FOnChange: TNotifyEvent;
    procedure Changed;
    procedure DrawToCanvas(ACanvas: TCanvas; ARect: TRect; PpiX, PpiY: integer; AAlign: TGmCaptionAlign; PageNum, NumPages: integer);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure SetCaption(Value: string);
    procedure SetFont(Value: TFont);
    // events...
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create(AHeaderFooter: TGmHeaderFooter; const ChangeEvent: TNotifyEvent = nil);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Caption: string read FCaption write SetCaption;
    property Font: TFont read FFont write SetFont;
  end;
  //----------------------------------------------------------------------------

  // *** TGmHeaderFooter ***

  TGmHeaderFooter = class(TPersistent)
  private
    FCaptions: array[gmLeft..gmRight] of TGmHeaderFooterCaption;
    FHeight: TGmValue;
    FPen: TPen;
    FShowLine: Boolean;
    FVisible: Boolean;
    // events...
    FOnChange: TNotifyEvent;
    function GetCaptionIndex(index: integer): TGmHeaderFooterCaption;
    function GetHeight(Measurement: TGmMeasurement): Extended;
    function GetLargestFont: TFont;
    procedure Changed(Sender: TObject);
    procedure DrawToCanvas(ACanvas: TCanvas; AMargins: TGmMargins; APageSize: TGmSize;
      PpiX, PpiY: integer; Page, NumPages: integer); virtual; abstract;
    procedure SetCaptionIndex(index: integer; Value: TGmHeaderFooterCaption);
    procedure SetHeight(Measurement: TGmMeasurement; Value: Extended);
    procedure SetPen(Value: TPen);
    procedure SetShowLine(Value: Boolean);
    procedure SetVisible(Value: Boolean);
    // events...
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create(const ChangeEvent: TNotifyEvent = nil);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    property Height[Measurement: TGmMeasurement]: Extended read GetHeight write SetHeight;
  published
    property CaptionLeft: TGmHeaderFooterCaption index 0 read GetCaptionIndex write SetCaptionIndex;
    property CaptionCenter: TGmHeaderFooterCaption index 1 read GetCaptionIndex write SetCaptionIndex;
    property CaptionRight: TGmHeaderFooterCaption index 2 read GetCaptionIndex write SetCaptionIndex;
    property Pen: TPen read FPen write SetPen;
    property ShowLine: Boolean read FShowLine write SetShowLine default True;
    property Visible: Boolean read FVisible write SetVisible default False;
  end;

  //----------------------------------------------------------------------------

  // *** TGmHeader ***

  TGmHeader = class(TGmHeaderFooter)
  public
    procedure DrawToCanvas(ACanvas: TCanvas; AMargins: TGmMargins; APageSize: TGmSize;
      PpiX, PpiY: integer; Page, NumPages: integer); override;
  end;

  //----------------------------------------------------------------------------

  // *** TGmFooter ***

  TGmFooter = class(TGmHeaderFooter)
  public
    procedure DrawToCanvas(ACanvas: TCanvas; AMargins: TGmMargins; APageSize: TGmSize;
      PpiX, PpiY: integer; Page, NumPages: integer); override;
  end;

  //----------------------------------------------------------------------------

  // *** TGmPage ***

  TGmPage = class(TObject)
  private
    FObjects: TGmBaseObjectList;
    FOrientation: TGmOrientation;
    FPageList: TGmPageList;
    FPageSizeInch: TGmSize;
    FRtfInfo: TGmPageRtfInfo;
    FShowFooter: Boolean;
    FShowHeader: Boolean;
    // events...
    FOnChange: TNotifyEvent;
    FOnChangeOrientation: TNotifyEvent;
    function AddObject(AObject: TGmBaseObject): TGmBaseObject;
    function CreateGmObject(ObjectID: integer): TGmBaseObject;
    function GetCount: integer;
    function GetGmObject(index: integer): TGmBaseObject;
    function GetPageNum: integer;
    function GetPageSize(Measurement: TGmMeasurement): TGmSize;
    procedure Changed(Sender: TObject);
    procedure DrawRichText(ACanvas: TCanvas; PpiX, PpiY: integer; WrapRichText: Boolean);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure SetOrientation(Value: TGmOrientation);
    procedure SetPageSize(AWidth, AHeight: Extended);
    procedure SetShowFooter(Value: Boolean);
    procedure SetShowHeader(Value: Boolean);
    // events...
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnChangeOrientation: TNotifyEvent read FOnChangeOrientation write FOnChangeOrientation;
  public
    constructor Create(APageList: TGmPageList);
    destructor Destroy; override;
    function ObjectAtPos(x, y: Extended; Measurement: TGmMeasurement; var AObject: TGmVisibleObject): Boolean;
    procedure Clear;
    procedure DeleteGmObject(AObject: TGmBaseObject);
    procedure DeleteLastGmObject;
    procedure DrawToCanvas(ACanvas: TCanvas; PpiX, PpiY: integer; FastDraw: Boolean);
    property Count: integer read GetCount;
    property GmObject[index: integer]: TGmBaseObject read GetGmObject;
    property Orientation: TGmOrientation read FOrientation write SetOrientation default gmPortrait;
    property PageNum: integer read GetPageNum;
    property PageSize[Measurement: TGmMeasurement]: TGmSize read GetPageSize;
    property RtfInfo: TGmPageRtfInfo read FRtfInfo write FRtfInfo;
    property ShowFooter: Boolean read FShowFooter write SetShowFooter default True;
    property ShowHeader: Boolean read FShowHeader write SetShowHeader default True;
  end;

  //----------------------------------------------------------------------------

  // *** TGmPageList ***

  TGmPageList = class(TGmObjectList)
  private
    FCanvas: TGmCanvas;
    FCurrentPage: integer;
    FFooter: TGmFooter;
    FHeader: TGmHeader;
    FMargins: TGmMargins;
    FOrientation: TGmOrientation;
    FPagesPerSheet: TGmPagesPerSheet;
    FPaperSize: TGmPaperSize;
    FPaperSizeInch: TGmSize;
    FPrinter: TGmPrinter;
    FResourceTable: TGmResourceTable;
    FUpdateCount: integer;
    FValueRect: TGmValueRect;
    FValueSize: TGmValueSize;
    // events...
    FBeforeLoad: TGmBeforeLoadEvent;
    FOnClear: TNotifyEvent;
    FOnHeaderFooterChanged: TNotifyEvent;
    FOnNeedRichEdit: TGmNeedRichEditEvent;
    FOnNewPage: TNotifyEvent;
    FOnOrientationChanged: TNotifyEvent;
    FOnPageChanged: TNotifyEvent;
    FOnPageMarginsChanged: TNotifyEvent;
    FOnPageNumChanging: TNotifyEvent;
    FOnPageCountChanged: TNotifyEvent;
    FOnPageNumChanged: TNotifyEvent;
    FOnPaperSizeChanged: TNotifyEvent;
    FOnPrintProgress: TGmPrintProgressEvent;
    function GetPage(index: integer): TGmPage;
    function GetUpdating: Boolean;
    procedure ChangeObjectLevel(Sender: TObject; LevelChange: TGmArrangeObject);
    procedure DoPrintProgress(Printed, Total: integer);
    procedure InitPaperSize;
    procedure HeaderFooterChanged(Sender: TObject);
    procedure PageChanged(Sender: TObject);
    procedure PageCountChanged(Sender: TObject);
    procedure PageMarginsChanged(Sender: TObject);
    //procedure PageSizeChanged(Sender: TObject);
    procedure SetCurrentPage(Value: integer);
    procedure SetOrientation(Value: TGmOrientation);
    procedure SetPage(index: integer; APage: TGmPage);
    procedure SetPaperSize(Value: TGmPaperSize);
  public
    constructor Create;
    destructor Destroy; override;
    function AddObject(AObject: TGmBaseObject; AOrigin: TGmCoordsRelative): TGmBaseObject;
    function AddPage: TGmPage;
    function InsertPage(index: integer): TGmPage;
    function AvailablePageRect: TGmValueRect;
    function FooterRect: TGmValueRect;
    function HeaderRect: TGmValueRect;
    procedure BeginUpdate;
    procedure ClearPages(const FreeAll: Boolean = False; const FreeResources: Boolean = True);
    procedure DeletePage(index: integer);
    procedure EndUpdate;
    procedure FindText(AText: string; CaseSensative: Boolean; AList: TList);
    procedure LoadFromStream(Stream: TStream);
    procedure NeedRichEdit(Sender: TObject; var ARichEdit: TCustomMemo);
    procedure Print;
    procedure PrintPages(Pages: array of integer);
    procedure PrintRange(AFromPage, AToPage: integer);
    procedure PrintToFile(AFileName: string);
    procedure SaveToStream(Stream: TStream);
    procedure SetPageSize(AWidth, AHeight: Extended; Measurement: TGmMeasurement);
    procedure UsePrinterPageSize;
    property Canvas: TGmCanvas read FCanvas;
    property CurrentPage: integer read FCurrentPage write SetCurrentPage;
    property Footer: TGmFooter read FFooter;
    property GmPrinter: TGmPrinter read FPrinter write FPrinter;
    property Header: TGmHeader read FHeader;
    property Margins: TGmMargins read FMargins write FMargins;
    property Orientation: TGmOrientation read FOrientation write SetOrientation default gmPortrait;
    property Page[index: integer]: TGmPage read GetPage write SetPage; default;
    property PagesPerSheet: TGmPagesPerSheet read FPagesPerSheet write FPagesPerSheet default gmOnePage;
    property PageSizeInch: TGmSize read FPaperSizeInch;
    property PaperSize: TGmPaperSize read FPaperSize write SetPaperSize default A4;
    property ResourceTable: TGmResourceTable read FResourceTable;
    property Updating: Boolean read GetUpdating;
    // event...
    property BeforeLoad: TGmBeforeLoadEvent read FBeforeLoad write FBeforeLoad;
    property OnClear: TNotifyEvent read FOnClear write FOnClear;
    property OnHeaderFooterChanged: TNotifyEvent read FOnHeaderFooterChanged write FOnHeaderFooterChanged;
    property OnNeedRichEdit: TGmNeedRichEditEvent read FOnNeedRichEdit write FOnNeedRichEdit;
    property OnNewPage: TNotifyEvent read FOnNewPage write FOnNewPage;
    property OnOrientationChanged: TNotifyEvent read FOnOrientationChanged write FOnOrientationChanged;
    property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged;
    property OnPageNumChanging: TNotifyEvent read FOnPageNumChanging write FOnPageNumChanging;
    property OnPageNumChanged: TNotifyEvent read FOnPageNumChanged write FOnPageNumChanged;
    property OnPageCountChanged: TNotifyEvent read FOnPageCountChanged write FOnPageCountChanged;
    property OnPageMarginsChanged: TNotifyEvent read FOnPageMarginsChanged write FOnPageMarginsChanged;
    property OnPaperSizeChanged: TNotifyEvent read FOnPaperSizeChanged write FOnPaperSizeChanged;
    property OnPrintProgress: TGmPrintProgressEvent read FOnPrintProgress write FOnPrintProgress;
  end;

implementation

uses GmFuncs, GmObjects, SysUtils, GmConst, GmStream, RichEdit, Math, Forms;

//------------------------------------------------------------------------------

// *** TGmHeaderFooterCaption ***

constructor TGmHeaderFooterCaption.Create(AHeaderFooter: TGmHeaderFooter; const ChangeEvent: TNotifyEvent = nil);
begin
  inherited Create;
  FHeaderFooter := AHeaderFooter;
  FFont := TFont.Create;
  FFont.Size := 12;
  FFont.Name := 'Arial';
  FFont.OnChange := ChangeEvent;
  OnChange := ChangeEvent;
end;

destructor TGmHeaderFooterCaption.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TGmHeaderFooterCaption.Assign(Source: TPersistent);
begin
  if (Source is TGmHeaderFooterCaption) then
  begin
    FCaption := (Source as TGmHeaderFooterCaption).Caption;
    FFont.Assign((Source as TGmHeaderFooterCaption).Font);
  end
  else
    inherited Assign(Source);
end;

procedure TGmHeaderFooterCaption.DrawToCanvas(ACanvas: TCanvas; ARect: TRect; PpiX, PpiY: integer; AAlign: TGmCaptionAlign; PageNum, NumPages: integer);
var
  CaptionExtent: TGmSize;
  XPos: integer;
  ACaption: string;
  Ppi: integer;
begin
  ACaption := Tokenize(FCaption, PageNum, NumPages, GlobalDateTokenFormat, GlobalTimeTokenFormat);
  ACanvas.Font.PixelsPerInch := PpiX;
  ACanvas.Font.Assign(FFont);
  CaptionExtent := GmFontMapper.TextExtent(ACanvas, ACaption);

  Ppi := ACanvas.Font.PixelsPerInch;
  XPos := ARect.Left;
  case AAlign of
    gmCenter: XPos := ((ARect.Right+ARect.Left) - (Round(CaptionExtent.Width * Ppi))) div 2;
    gmRight : XPos := ARect.Right - Round(CaptionExtent.Width * Ppi);
  end;
  if FHeaderFooter is TGmHeader then
    GmFontMapper.TextOut(ACanvas, XPos, ARect.Bottom-Round(CaptionExtent.Height * Ppi), nil, ACaption)
  else
    GmFontMapper.TextOut(ACanvas, XPos, ARect.Top, nil, ACaption);
end;

procedure TGmHeaderFooterCaption.LoadFromStream(Stream: TStream);
var
  AValues: TGmValueList;
  AFont: TGmFont;
begin
  AValues := TGmValueList.Create;
  try
    AValues.LoadFromStream(Stream);
    FCaption := AValues.ReadStringValue(C_T, '');
  finally
    AValues.Free;
  end;
  AFont := TGmFont.Create;
  try
    AFont.LoadFromStream(Stream);
    AFont.AssignToFont(FFont);
  finally
    AFont.Free;
  end;
end;

procedure TGmHeaderFooterCaption.SaveToStream(Stream: TStream);
var
  AValues: TGmValueList;
  AFont: TGmFont;
begin
  AValues := TGmValueList.Create;
  try
    AValues.WriteStringValue(C_T, FCaption);
    AValues.SaveToStream(Stream);
  finally
    AValues.Free;
  end;
  AFont := TGmFont.Create;
  try
    AFont.Assign(FFont);
    AFont.SaveToStream(Stream);
  finally
    AFont.Free;
  end;
end;