pjcontrol.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.006                            *)
(*  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 PJControl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, PSJob, PJBitmap, Controls;

type
  TCustomControlPrintJob = class(TCustomBitmapPrintJob)
  private
    { Private declarations }
    FControl: TControl;
    FEntireWindow: Boolean;
    procedure SetControl(const Value: TControl);
    procedure SetEntireWindow(const Value: Boolean);
  protected
    { Protected declarations }
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property Control: TControl read FControl write SetControl;
    property EntireWindow: Boolean read FEntireWindow write SetEntireWindow default False;
  public
    { Public declarations }
    procedure GetBitmap(const Bitmap: TBitmap); override;
  published
    { Published declarations }
  end;

  TControlPrintJob = class(TCustomControlPrintJob)
  published
    // TCustomControlPrintJob properties
    property Control;
    property EntireWindow;
    // TCustomBitmapPrintJob properties
    property StretchMode;
    property Scale;
    property MultiPage;
    property AlignVertical;
    property AlignHorizontal;
    // TCustomPrintJob properties
    property Title;
    property Margins;
    property MarginsUnits;
    property MarginsError;
    property Header;
    property HeaderUnits;
    property Footer;
    property FooterUnits;
    property PageMode;
    property PageWidth;
    property PageHeight;
    property PageUnits;
    property Orientation;
    property Options;
    property RelativeCoords;
    property DefaultDrawing;
    property OnCreate;
    property OnDestroy;
    property OnDraw;
    property OnPrinterSetupChange;
    property OnStartPrint;
    property OnEndPrint;
    property OnPrintProgress;
    property OnStartPrintPage;
    property OnEndPrintPage;
    property OnUpdate;
  end;

procedure Register;

implementation

procedure TCustomControlPrintJob.SetControl(const Value: TControl);
begin
  if Value<>FControl then
  begin
    FControl:=Value;
    UpdateBitmap;
  end;
end;

procedure TCustomControlPrintJob.SetEntireWindow(const Value: Boolean);
begin
  if Value<>FEntireWindow then
  begin
    FEntireWindow:=Value;
    UpdateBitmap;
  end;
end;

procedure TCustomControlPrintJob.Loaded;
begin
  inherited;
  UpdateBitmap;
end;

procedure TCustomControlPrintJob.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (AComponent<>Owner) and (AComponent=FControl) and (Operation=opRemove)
    and not (csDestroying in ComponentState) and not (csDesigning in ComponentState) then Control:=nil;
end;

procedure TCustomControlPrintJob.GetBitmap(const Bitmap: TBitmap);
var
  R: TRect;
  ControlCanvas: TCanvas;
begin
  if not (csDesigning in ComponentState) then
    if Assigned(FControl) then
    begin
      ControlCanvas:=TCanvas.Create;
      with Bitmap,ControlCanvas do
      try
        if FEntireWindow then
        begin
          Width:=FControl.Width;
          Height:=FControl.Height;
        end
        else
        begin
          Width:=FControl.ClientWidth;
          Height:=FControl.ClientHeight;
        end;
        if FControl is TWinControl then
        begin
          if FEntireWindow then Handle:=GetDCEx(TWinControl(FControl).Handle,0,DCX_WINDOW or DCX_CACHE)
          else Handle:=GetDC(TWinControl(FControl).Handle);
          try
            if FEntireWindow then R:=Rect(0,0,Width,Height)
            else R:=FControl.ClientRect;
            Canvas.CopyRect(Rect(0,0,Width,Height),ControlCanvas,R);
          finally
            Handle:=0;
          end;
        end
        else
        begin
          Handle:=GetDC(FControl.Parent.Handle);
          try
            Canvas.CopyRect(Rect(0,0,Width,Height),ControlCanvas,FControl.BoundsRect);
          finally
            Handle:=0;
          end;
        end;
      finally
        Free;
      end;
    end
    else ClearBitmap;
end;

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

end.