pjdraft.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.008                            *)
(*  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 PJDraft;

interface

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

type
  TCustomDraftPrintJob = class(TCustomPrintJob)
  private
    { Private declarations }
    FPrintJob: TCustomPrintJob;
    FScale: Integer;
    FSeparators: Boolean;
    procedure SetPrintJob(const Value: TCustomPrintJob);
    procedure SetScale(const Value: Integer);
    procedure SetSeparators(const Value: Boolean);
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property PrintJob: TCustomPrintJob read FPrintJob write SetPrintJob;
    property Scale: Integer read FScale write SetScale default 2;
    property Separators: Boolean read FSeparators write SetSeparators default False;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure Update; override;
    procedure Draw(TheCanvas: TCanvas; PageIndex: Integer; Target: TDrawTarget); override;
    procedure DrawSeparator(TheCanvas: TCanvas; FromPoint,ToPoint: TPoint); virtual;
  published
    { Published declarations }
  end;

  TDraftPrintJob = class(TCustomDraftPrintJob)
  published
    // TCustomDraftPrintJob properties
    property PrintJob;
    property Scale;
    property Separators;
    // 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 TCustomDraftPrintJob.SetPrintJob(const Value: TCustomPrintJob);
begin
  if Value=Self then EPrintJobException.Create('TDraftPrintJob cannot link with himself')
  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 TCustomDraftPrintJob.SetScale(const Value: Integer);
var
  IValue: Integer;
begin
  IValue:=Value;
  if IValue<2 then IValue:=2;
  if IValue>10 then IValue:=10;
  if IValue<>FScale then
  begin
    FScale:=IValue;
    LockJobsUpdate;
    try
      Update;
    finally
      UnlockJobsUpdate;
    end;
  end;
end;

procedure TCustomDraftPrintJob.SetSeparators(const Value: Boolean);
begin
  if Value<>FSeparators then
  begin
    FSeparators:=Value;
    LockJobsUpdate;
    try
      Update;
    finally
      UnlockJobsUpdate;
    end;
  end;
end;

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

constructor TCustomDraftPrintJob.Create(AOwner: TComponent);
begin
  inherited;
  FScale:=2;
end;

procedure TCustomDraftPrintJob.Update;
begin
  if not UpdateLocked then
  begin
    LockUpdate;
    try
      if Assigned(FPrintJob) then
      begin
        with FPrintJob do
          Self.PageCount:=
            (PageCount div Sqr(FScale))+
            Integer(PageCount mod Sqr(FScale) <> 0);
        PageUnits:=FPrintJob.PageUnits;
        PageMode:=FPrintJob.PageMode;
        PageWidth:=FPrintJob.PageWidth;
        PageHeight:=FPrintJob.PageHeight;
        Orientation:=FPrintJob.Orientation;
      end;
    finally
      UnlockUpdate;
    end;
    LockJobsUpdate;
    try
      inherited;
    finally
      UnlockJobsUpdate;
    end;
  end;
end;

procedure TCustomDraftPrintJob.Draw(TheCanvas: TCanvas; PageIndex: Integer;
  Target: TDrawTarget);
var
  i,SubPage,NormalPage,PW,PH: Integer;
  OldViewport1,OldViewport2,OldWindow: TSize;
  OldOrg: TPoint;
  R: TRect;
begin
  if not DrawLocked then
  begin
    LockUpdate;
    try
      if Assigned(FPrintJob) then
        with FPrintJob,TheCanvas do
        begin
          PW:=Round(ConvertUnits(PageWidth,PageUnits,unPixels,dirHorizontal,PhysicalPageWidth));
          PH:=Round(ConvertUnits(PageHeight,PageUnits,unPixels,dirVertical,PhysicalPageHeight));
          ResetToDefaultPage;
          SetMapMode(Handle,MM_ANISOTROPIC);
          SetWindowExtEx(Handle,Round(PW),Round(PH),@OldWindow);
          R:=Rect(0,0,Round(PW),Round(PH));
          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);
            ScaleViewportExtEx(Handle,1,FScale,1,FScale,@OldViewport2);
            try
              for SubPage:=1 to Sqr(FScale) do
              begin
                NormalPage:=Pred(PageIndex)*Sqr(FScale)+SubPage;
                if NormalPage>PageCount then Break;
                SetViewportOrgEx(
                  Handle,
                  Left+(Right-Left)*(Pred(SubPage) mod FScale) div FScale,
                  Top+(Bottom-Top)*(Pred(SubPage) div FScale) div FScale,
                  @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;
            if FSeparators then
              for i:=1 to Pred(FScale) do
              begin
                DrawSeparator(
                  TheCanvas,
                  Point(Left+i*(Right-Left) div FScale,Top),
                  Point(Left+i*(Right-Left) div FScale,Bottom));
                DrawSeparator(
                  TheCanvas,
                  Point(Left,Top+i*(Bottom-Top) div FScale),
                  Point(Right,Top+i*(Bottom-Top) div FScale));
              end;
          end;
        end;
    finally
      UnlockUpdate;
    end;
  end;
end;

procedure TCustomDraftPrintJob.DrawSeparator(TheCanvas: TCanvas; FromPoint,ToPoint: TPoint);
var
  OldPen: TPen;
  OldBrush: TBrush;
begin
  with TheCanvas do
  begin
    OldPen:=TPen.Create;
    OldPen.Assign(Pen);
    OldBrush:=TBrush.Create;
    OldBrush.Assign(Brush);
    try
      Brush.Style:=bsClear;
      with Pen do
      begin
        Style:=psDot;
        Color:=clBlack;
        Mode:=pmCopy;
      end;
      with FromPoint do MoveTo(X,Y);
      with ToPoint do LineTo(X,Y);
    finally
      Brush.Assign(OldBrush);
      OldBrush.Free;
      Pen.Assign(OldPen);
      OldPen.Free;
    end;
  end;
end;

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

end.