pjmulti.pas

GREATIS Print Suite Pro for Delphi (3-7,2005,2006,2007) and C++ Builder (3-6) Set of components for

(*  GREATIS PRINT SUITE PRO                          *)
(*  unit version 1.85.020                            *)
(*  Copyright (C) 2001-2007 Greatis Software         *)
(*  http://www.greatis.com/delphicb/printsuite/      *)
(*  http://www.greatis.com/delphicb/printsuite/faq/  *)
(*  http://www.greatis.com/bteam.html                *)

unit PJMulti;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PSJob, Printers;

type

  TCustomMultiPrintJob = class(TCustomPrintJob)
  private
    { Private declarations }
    FPrintJobs: TStrings;
    FPrinterOrientation: TPageOrientation;
    FInterlacing: Boolean;
    function GetPrintJob(Index: Integer): TCustomPrintJob;
    function GetPrintJobCount: Integer;
    procedure SetInterlacing(const Value: Boolean);
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
    procedure AddNotifications;
    procedure DeleteNotifications;
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Loaded; override;
    procedure WriteState(Writer: TWriter); override;
    procedure DefineProperties(Filer: TFiler); override;
    property Interlacing: Boolean read FInterlacing write SetInterlacing;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ActiveInstance(PageIndex: Integer): TCustomPrintJob; override;
    procedure Update; override;
    procedure Draw(TheCanvas: TCanvas; PageIndex: Integer; Target: TDrawTarget); override;
    procedure StartPrint; override;
    procedure StartPrintPage(PageIndex: Integer); override;
    procedure ForceNewPage(PageIndex: Integer); override;
    procedure Add(APrintJob: TCustomPrintJob);
    procedure Insert(Index: Integer; APrintJob: TCustomPrintJob);
    procedure Clear;
    procedure Delete(Index: Integer);
    function IndexOf(APrintJob: TCustomPrintJob): Integer;
    function IndexOfName(AName: string): Integer;
    procedure Move(CurIndex,NewIndex: Integer);
    function GetPageJob(Page: Integer): TCustomPrintJob;
    function GetLocalPage(Page: Integer): Integer;
    function GetGlobalPage(PrintJob: TCustomPrintJob; Page: Integer): Integer;
    procedure EditPrintJobs;
    property PrintJobCount: Integer read GetPrintJobCount;
    property PrintJobs[Index: Integer]: TCustomPrintJob read GetPrintJob;
    property PrintJobList: TStrings read FPrintJobs;
  end;

  TMultiPrintJob = class(TCustomMultiPrintJob)
  published
    property MultiDoc;
    property Title;
    property Interlacing;
    property OnCreate;
    property OnDestroy;
    property OnPrinterSetupChange;
    property OnStartPrint;
    property OnEndPrint;
    property OnPrintProgress;
    property OnStartPrintPage;
    property OnEndPrintPage;
    property OnUpdate;
  end;

procedure Register;

implementation

uses PJMultiEditor;

{ TCustomMultiPrintJob }

function TCustomMultiPrintJob.GetPrintJob(Index: Integer): TCustomPrintJob;
begin
  if Assigned(FPrintJobs) and (Index<FPrintJobs.Count) then
    Result:=TCustomPrintJob(FPrintJobs.Objects[Index])
  else Result:=nil;
end;

function TCustomMultiPrintJob.GetPrintJobCount: Integer;
begin
  if Assigned(FPrintJobs) then Result:=FPrintJobs.Count
  else Result:=0;
end;

procedure TCustomMultiPrintJob.SetInterlacing(const Value: Boolean);
begin
  if Value<>FInterlacing then
  begin
    FInterlacing:=Value;
    LockJobsUpdate;
    try
      Update;
    finally
      UnlockJobsUpdate;
    end;
  end;
end;

procedure TCustomMultiPrintJob.ReadData(Reader: TReader);
begin
  with FPrintJobs do
  begin
    Reader.ReadListBegin;
    BeginUpdate;
    try
      Clear;
      while not Reader.EndOfList do Add(Reader.ReadString);
    finally
      EndUpdate;
    end;
    Reader.ReadListEnd;
  end;
end;

procedure TCustomMultiPrintJob.WriteData(Writer: TWriter);
var
  i: Integer;
begin
  Writer.WriteListBegin;
  with FPrintJobs do
    for i:=0 to Pred(Count) do Writer.WriteString(FPrintJobs[i]);
  Writer.WriteListEnd;
end;

procedure TCustomMultiPrintJob.AddNotifications;
var
  i: Integer;
begin
  for i:=0 to Pred(PrintJobCount) do
  try
    PrintJobs[i].AddPrintJobNotification(Self);
  except
  end;
end;

procedure TCustomMultiPrintJob.DeleteNotifications;
var
  i: Integer;
begin
  for i:=0 to Pred(PrintJobCount) do
  try
    PrintJobs[i].DeletePrintJobNotification(Self);
  except
  end;
end;

procedure TCustomMultiPrintJob.Notification(AComponent: TComponent; Operation: TOperation);
var
  I: Integer;
begin
  inherited;
  if (Operation=opRemove) and (AComponent<>Self) and Assigned(FPrintJobs) then
    with FPrintJobs do
    begin
      I:=IndexOfObject(AComponent);
      if I<>-1 then
      begin
        try
          (AComponent as TCustomPrintJob).DeletePrintJobNotification(Self);
        except
        end;
        Delete(I);
      end;
    end;
end;

procedure TCustomMultiPrintJob.Loaded;
var
  i: Integer;
begin
  inherited;
  if Assigned(FPrintJobs) then
    with FPrintJobs do
      for i:=0 to Pred(Count) do
        FPrintJobs.Objects[i]:=Owner.FindComponent(FPrintJobs[i]);
  AddNotifications;
  LockJobsUpdate;
  try
    Update;
  finally
    UnlockJobsUpdate;
  end;
end;

procedure TCustomMultiPrintJob.WriteState(Writer: TWriter);
var
  i: Integer;
begin
  if Assigned(FPrintJobs) then
    with FPrintJobs do
      for i:=0 to Pred(Count) do
        FPrintJobs[i]:=TComponent(Objects[i]).Name;
  inherited;
end;

procedure TCustomMultiPrintJob.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('PrintJobs',ReadData,WriteData,True);
end;

constructor TCustomMultiPrintJob.Create(AOwner: TComponent);
begin
  inherited;
  FPrintJobs:=TStringList.Create;
end;

destructor TCustomMultiPrintJob.Destroy;
begin
  try
    DeleteNotifications;
    FPrintJobs.Free;
  except
  end;
  inherited;
end;

function TCustomMultiPrintJob.ActiveInstance(PageIndex: Integer): TCustomPrintJob;
begin
  Result:=GetPageJob(PageIndex);
  if not Assigned(Result) then Result:=Self;
end;

procedure TCustomMultiPrintJob.Update;
var
  i,PC: Integer;
begin
  if not UpdateLocked then
  begin
    PC:=0;
    if FInterlacing then
    begin
      for i:=0 to Pred(PrintJobCount) do
        if PrintJobs[i].PageCount>PC then PC:=PrintJobs[i].PageCount;
      PC:=PC*PrintJobCount;
    end
    else
    begin
      for i:=0 to Pred(PrintJobCount) do Inc(PC,PrintJobs[i].PageCount);
    end;
    PageCount:=PC;
    LockJobsUpdate;
    try
      inherited;
    finally
      UnlockJobsUpdate;
    end;
  end;
end;

procedure TCustomMultiPrintJob.Draw(TheCanvas: TCanvas; PageIndex: Integer; Target: TDrawTarget);
var
  PJ: TCustomPrintJob;
begin
  if not DrawLocked then
  begin
    PJ:=GetPageJob(PageIndex);
    if Assigned(PJ) and (GetLocalPage(PageIndex)<=PJ.PageCount) then
    begin
      LockUpdate;
      try
        PageMode:=PJ.PageMode;
        PageWidth:=PJ.PageWidth;
        PageHeight:=PJ.PageHeight;
      finally
        UnlockUpdate;
      end;
      if (Target<>dtPrint) and not Printer.Printing then
        Orientation:=PJ.Orientation;
      PJ.Draw(TheCanvas,GetLocalPage(PageIndex),Target);
    end;
  end;
end;

procedure TCustomMultiPrintJob.StartPrint;
var
  PJ: TCustomPrintJob;
begin
  PJ:=PrintJobs[0];
  if Assigned(PJ) then FPrinterOrientation:=PJ.Orientation
  else FPrinterOrientation:=orDefault;
  inherited;
end;

procedure TCustomMultiPrintJob.StartPrintPage(PageIndex: Integer);
var
  PJ: TCustomPrintJob;
begin
  PJ:=GetPageJob(PageIndex);
  if Assigned(PJ) and (PJ.Orientation<>orDefault) and (PJ.Orientation<>FPrinterOrientation) then
  begin
    FPrinterOrientation:=PJ.Orientation;
    with Printer do
    begin
      if Printing then EndDoc;
      Orientation:=TPrinterOrientation(Pred(FPrinterOrientation));
      if not Printing then BeginDoc;
    end;
  end;
  inherited;
end;

procedure TCustomMultiPrintJob.ForceNewPage(PageIndex: Integer);
var
  PJ: TCustomPrintJob;
begin
  PJ:=GetPageJob(PageIndex);
  if Assigned(PJ) and 
     (
      (GetLocalPage(PageIndex)<PJ.PageCount)or
      (IndexOf(PJ) < (PrintJobCount - 1))
     ) then
    inherited;
end;

procedure TCustomMultiPrintJob.Add(APrintJob: TCustomPrintJob);
begin
  FPrintJobs.AddObject(APrintJob.Name,APrintJob);
  APrintJob.AddPrintJobNotification(Self);
  Update;
end;

procedure TCustomMultiPrintJob.Insert(Index: Integer; APrintJob: TCustomPrintJob);
begin
  FPrintJobs.InsertObject(Index,APrintJob.Name,APrintJob);
  APrintJob.AddPrintJobNotification(Self);
  LockJobsUpdate;
  try
    Update;
  finally
    UnlockJobsUpdate;
  end;
end;

procedure TCustomMultiPrintJob.Clear;
begin
  DeleteNotifications;
  FPrintJobs.Clear;
  LockJobsUpdate;
  try
    Update;
  finally
    UnlockJobsUpdate;
  end;
end;

procedure TCustomMultiPrintJob.Delete(Index: Integer);
begin
  PrintJobs[Index].DeletePrintJobNotification(Self);
  FPrintJobs.Delete(Index);
  LockJobsUpdate;
  try
    Update;
  finally
    UnlockJobsUpdate;
  end;
end;

function TCustomMultiPrintJob.IndexOf(APrintJob: TCustomPrintJob): Integer;
begin
  Result:=FPrintJobs.IndexOfObject(APrintJob);
end;

function TCustomMultiPrintJob.IndexOfName(AName: string): Integer;
begin
  Result:=FPrintJobs.IndexOf(AName);
end;

procedure TCustomMultiPrintJob.Move(CurIndex,NewIndex: Integer);
begin
  FPrintJobs.Move(CurIndex,NewIndex);
  LockJobsUpdate;
  try
    Update;
  finally
    UnlockJobsUpdate;
  end;
end;

function TCustomMultiPrintJob.GetPageJob(Page: Integer): TCustomPrintJob;
var
  i,P: Integer;
begin
  Result:=nil;
  P:=1;
  if FInterlacing then Result:=PrintJobs[Pred(Page) mod PrintJobCount]
  else
    for i:=0 to Pred(PrintJobCount) do
      if Assigned(PrintJobs[i]) then
      begin
        Inc(P,PrintJobs[i].PageCount);
        if P>Page then
        begin
          Result:=PrintJobs[i];
          Break;
        end;
      end;
end;

function TCustomMultiPrintJob.GetLocalPage(Page: Integer): Integer;
var
  i: Integer;
begin
  Result:=1;
  if FInterlacing then Result:=Succ(Pred(Page) div PrintJobCount)
  else
    for i:=0 to Pred(PrintJobCount) do
    begin
      Inc(Result,PrintJobs[i].PageCount);
      if Result>Page then
      begin
        Result:=Succ(PrintJobs[i].PageCount-(Result-Page));
        Break;
      end;
    end;
end;

function TCustomMultiPrintJob.GetGlobalPage(PrintJob: TCustomPrintJob; Page: Integer): Integer;
var
  i,Index: Integer;
begin
  Index:=IndexOf(PrintJob);
  if Index<>-1 then
  begin
    Result:=0;
    for i:=0 to Pred(Index) do Inc(Result,PrintJobs[i].PageCount);
    Inc(Result,Page);
  end
  else Result:=-1;
end;

procedure TCustomMultiPrintJob.EditPrintJobs;
var
  i: Integer;
begin
  with TfrmMultiEditor.Create(Application) do
  try
    Caption:=Self.Owner.Name+'.'+Self.Name+'.PrintJobs';
    PrintJob:=Self;
    for i:=0 to Pred(PrintJobCount) do
      if PrintJobs[i]<>Pointer(Self) then
        with lsvPrintJobs.Items.Add,TCustomPrintJob(PrintJobs[i]) do
        begin
          Caption:=Name;
          SubItems.Add(Title);
          Data:=PrintJobs[i];
        end;
    if ShowModal=mrOk then
      with lsvPrintJobs,Items do
      begin
        FPrintJobs.Clear;
        for i:=0 to Pred(Count) do FPrintJobs.AddObject(Items[i].Caption,Items[i].Data);
        PrintJob.Update;
      end;
  finally
    Free;
  end;
end;

procedure Register;
begin
  RegisterComponents('Print Jobs', [TMultiPrintJob]);
end;

end.