pjscreenshot.pas

来自「GREATIS Print Suite Pro for Delphi (3-7,」· PAS 代码 · 共 104 行

(*  GREATIS PRINT SUITE PRO                          *)
(*  unit version 1.85.004                            *)
(*  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 PJScreenshot;

interface

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

type
  TCustomScreenshotPrintJob = class(TCustomBitmapPrintJob)
  private
    { Private declarations }
  protected
    { Protected declarations }
    procedure Loaded; override;
  public
    { Public declarations }
    procedure GetBitmap(const Bitmap: TBitmap); override;
  published
    { Published declarations }
  end;

  TScreenshotPrintJob = class(TCustomScreenshotPrintJob)
  published
    // 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 TCustomScreenshotPrintJob.Loaded;
begin
  inherited;
  UpdateBitmap;
end;

procedure TCustomScreenshotPrintJob.GetBitmap(const Bitmap: TBitmap);
var
  R: TRect;
  Desktop: TCanvas;
begin
  Desktop:=TCanvas.Create;
  with Bitmap,Desktop do
  try
    Width:=GetSystemMetrics(SM_CXSCREEN);
    Height:=GetSystemMetrics(SM_CYSCREEN);
    Handle:=GetDC(GetDesktopWindow);
    try
      R:=Rect(0,0,Width,Height);
      Canvas.CopyRect(R,Desktop,R);
    finally
      Handle:=0;
    end;
  finally
    Free;
  end;
end;

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

end.