pjduplex.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.001                            *)
(*  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 PJDuplex;

interface

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

type
  TCustomDuplexPrintJob = class(TCustomPrintJob)
  private
    { Private declarations }
    FPrintJob: TCustomPrintJob;
    procedure SetPrintJob(const Value: TCustomPrintJob);
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ResetToDefaultPage; override;
    property PrintJob: TCustomPrintJob read FPrintJob write SetPrintJob;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure Update; override;
    procedure Draw(TheCanvas: TCanvas; PageIndex: Integer; Target: TDrawTarget); override;
  published
    { Published declarations }
  end;

  TDuplexPrintJob = class(TCustomDuplexPrintJob)
  published
    // TCustomDuplexPrintJob properties
    property PrintJob;
    // TCustomPrintJob properties
    property MultiDoc;
    property Title;
    // TCustomPrintJob events
    property OnCreate;
    property OnDestroy;
    property OnPrinterSetupChange;
    property OnStartPrint;
    property OnEndPrint;
    property OnPrintProgress;
    property OnStartPrintPage;
    property OnEndPrintPage;
    property OnUpdate;
  end;

procedure Register;

implementation

procedure TCustomDuplexPrintJob.SetPrintJob(const Value: TCustomPrintJob);
begin
  if Value=Self then EPrintJobException.Create('TDuplexPrintJob cannot be linked with itself')
  else
    if Value<>FPrintJob then
    begin
      if Assigned(FPrintJob) then FPrintJob.DeletePrintJobNotification(Self);
      FPrintJob:=Value;
      if Assigned(FPrintJob) then FPrintJob.AddPrintJobNotification(Self);
      Update;
    end;
end;

procedure TCustomDuplexPrintJob.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation=opRemove) and Assigned(FPrintJob) and (AComponent=FPrintJob) then
    PrintJob:=nil;
end;

procedure TCustomDuplexPrintJob.ResetToDefaultPage;
begin
end;

constructor TCustomDuplexPrintJob.Create(AOwner: TComponent);
begin
  inherited;
  PageMode:=pmCustom;
  Options:=[joMargins];
end;

procedure TCustomDuplexPrintJob.Update;
begin
  if not UpdateLocked then
  begin
    LockUpdate;
    try
      if Assigned(FPrintJob) then
      begin
        PageCount:=FPrintJob.PageCount div 2;
        PageHeight:=FPrintJob.PageWidth;
        PageWidth:=FPrintJob.PageHeight;
        case FPrintJob.Orientation of
          orLandscape: Orientation:=orPortrait;
          orPortrait: Orientation:=orLandscape;
          orDefault:
            case Printer.Orientation of
              poLandscape: Orientation:=orPortrait;
              poPortrait: Orientation:=orLandscape;
            end;
        end;
      end;
    finally
      UnlockUpdate;
    end;
    LockJobsUpdate;
    try
      inherited;
    finally
      UnlockJobsUpdate;
    end;
  end;
end;

procedure TCustomDuplexPrintJob.Draw(TheCanvas: TCanvas; PageIndex: Integer;
  Target: TDrawTarget);

var
  i,SubPage,NormalPage: Integer;
  OldViewport1,OldViewport2,OldWindow: TSize;
  OldOrg: TPoint;
  R: TRect;

  function Min(V1,V2: Double): Integer;
  begin
    if V1<V2 then Result:=Round(10*V1)
    else Result:=Round(10*V2);
  end;

  function Max(V1,V2: Double): Integer;
  begin
    if V1>V2 then Result:=Round(10*V1)
    else Result:=Round(10*V2);
  end;

  function GetSubPageRect(SubPage: Integer): TRect;
  begin
    Result:=GetMarginRect;
    with Result do
      if (FPrintJob.Orientation=orPortrait) or
        (FPrintJob.Orientation=orDefault) and (Printer.Orientation=poPortrait) then
          if Odd(SubPage) then Right:=(Left+Right) div 2
          else Left:=(Left+Right) div 2
      else
        if Odd(SubPage) then Bottom:=(Top+Bottom) div 2
        else Top:=(Top+Bottom) div 2
  end;

begin
  if not DrawLocked and not (csLoading in ComponentState) then
  begin
    LockUpdate;
    try
      if Assigned(FPrintJob) then
        with FPrintJob,TheCanvas do
        begin
          ResetToDefaultPage;
          SetMapMode(Handle,MM_ANISOTROPIC);
          SetWindowExtEx(Handle,Round(PageWidth),Round(PageHeight),@OldWindow);
          R:=Rect(0,0,Round(PageWidth),Round(PageHeight));
          with R do
          begin
            i:=GetDeviceCaps(Printer.Handle,PHYSICALOFFSETX);
            if Left<i then Left:=i;
            Inc(i,Printer.PageWidth);
            if Right>i then Right:=i;
            i:=GetDeviceCaps(Printer.Handle,PHYSICALOFFSETY);
            if Top<i then Top:=i;
            Inc(i,Printer.PageHeight);
            if Bottom>i then Bottom:=i;
            SetViewportExtEx(
              Handle,
              Right-Left,
              Bottom-Top,
              @OldViewport1);
            with FPrintJob do
              ScaleViewportExtEx(
                Handle,
                Min(PageWidth,PageHeight),
                Max(PageWidth,PageHeight),
                Min(PageWidth,PageHeight),
                Max(PageWidth,PageHeight),
                @OldViewport2);
            try
              for SubPage:=1 to 2 do
              begin
                NormalPage:=Pred(PageIndex)*2+SubPage;
                if NormalPage>PageCount then Break;
                with GetSubPageRect(SubPage) do
                  SetViewportOrgEx(Handle,Left,Top,@OldOrg);
                try
                  FPrintJob.Draw(TheCanvas,NormalPage,Target);
                finally
                  with OldOrg do SetViewportOrgEx(Handle,X,Y,nil);
                end;
              end;
            finally
              begin
                with OldViewport2 do SetViewportExtEx(Handle,CX,CY,nil);
                with OldViewport1 do SetViewportExtEx(Handle,CX,CY,nil);
                with OldWindow do SetWindowExtEx(Handle,CX,CY,nil);
              end;
            end;
          end;
        end;
    finally
      UnlockUpdate;
    end;
  end;
end;

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

end.