📄 preview.pas
字号:
{------------------------------------------------------------------------------}
{ }
{ Print Preview Components Suit }
{ by Kambiz R. Khojasteh }
{ }
{ kambiz@delphiarea.com }
{ http://www.delphiarea.com }
{ }
{ TPrintPreview v4.76 }
{ TPaperPreview v1.03 }
{ TThumbnailPreview v1.02 }
{ }
{ Special thanks to: }
{ Rinaldo Andrea (Italy) <laser@nuovacs.it> }
{ Jens Christian Fogtmann <jefo@post2.tele.dk> }
{ Damian Tarnawsky <tarnawsky@ali.com.au> }
{ Bill Miller <w2m@netheaven.com> }
{ Wen Shihong <wenshihong@justep.com> }
{ Peter Hedlund <peter@peterandlinda.com> }
{ Pavel Zidek (Czech) <delphi@kopr.cz> (SaveZoomPos) }
{ Roy M Klever <roy.magne@os.ino.no> //rmk }
{ Paul Van Gundy <b06pxv@FDS.com> //pvg }
{ Hubert "Johnny_Bit" Kowalski <johnnybit@poczta.onet.pl> }
{ Tomas Koutny <rawos@rawos.com> }
{ Patrizio Zelotti <pzelotti@libero.it> }
{ Bria Dorin <briadorin@yahoo.com> }
{ Arpad Toth <atsoft@atsoftware.czweb.org> }
{ Janet Agney <janet.agney@vaisala.com> }
{ MeW <marco@wobben.com> }
{ Mixy N/A //Mixy }
{ Miguel Gastelumendi <mgd@satelier.com.br> }
{ akeix N/A }
{ DwrCymru N/A }
{ John Hodgson <JohnHodgson@qmap.co.uk> }
{ }
{------------------------------------------------------------------------------}
// Use ZLib Compression and Decompression for Streaming
// Get the library at http://www.gzip.org/zlib
{.$DEFINE ZLIB}
// If you need transparent image printing, define IMAGE_TRANSPARENCY
// Transparency on printers is not guaranteed. Instead, combine images
// as needed, and then draw the final image to the printer.
{.$DEFINE IMAGE_TRANSPARENCY}
{$I DELPHIAREA.INC}
unit Preview;
interface
uses
Windows, WinSpool, Messages, Classes, Graphics, Controls, SysUtils, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, Menus, Printers;
const
crHand = 10;
crGrab = 11; //pvg
type
EInvalidPreviewData = class(Exception);
EMissingPDFLibrary = class(Exception);
{ TMetafileList }
TMetafileChangeEvent = procedure(Sender: TObject; Index: Integer) of object;
TMetafileList = class(TObject)
private
FRecords: TList;
FDataStream: TStream;
FLoadedIndex: Integer;
FLoadedMetafile: TMetafile;
FUseTempFile: Boolean;
FTempFile: String;
FOnChange: TNotifyEvent;
FOnCurrentChange: TMetafileChangeEvent;
function GetCount: Integer;
function GetItems(Index: Integer): TMetafile;
procedure SetLoadedIndex(Value: Integer);
procedure SetUseTempFile(Value: Boolean);
procedure MetafileChanged(Sender: TObject);
protected
function CreateMetafileStream: TStream;
procedure Cleanup;
property LoadedIndex: Integer read FLoadedIndex write SetLoadedIndex;
property LoadedMetafile: TMetafile read FLoadedMetafile;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
function Add(AMetafile: TMetafile): Integer;
procedure LoadFromStream(Stream: TStream);
procedure SaveToStream(Stream: TStream);
procedure LoadFromFile(const FileName: String);
procedure SaveToFile(const FileName: String);
property Count: Integer read GetCount;
property Items[Index: Integer]: TMetafile read GetItems; default;
property UseTempFile: Boolean read FUseTempFile write SetUseTempFile;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnCurrentChange: TMetafileChangeEvent read FOnCurrentChange write FOnCurrentChange;
end;
{ TPaperPreview }
TPaperPaintEvent = procedure(Sender: TObject; Canvas: TCanvas;
const PageRect: TRect) of object;
TPaperPreview = class(TCustomControl)
private
FPaperColor: TColor;
FBorderColor: TColor;
FBorderSize: TBorderWidth;
FShadowColor: TColor;
FShadowSize: TBorderWidth;
FOnResize: TNotifyEvent;
FOnPaint: TPaperPaintEvent;
FOffScreen: TBitmap;
FOffScreenValid: Boolean;
FOffScreenPrepared: Boolean;
FOffScreenDrawn: Boolean;
procedure SetPaperWidth(Value: Integer);
function GetPaperWidth: Integer;
procedure SetPaperHeight(Value: Integer);
function GetPaperHeight: Integer;
procedure SetPaperColor(Value: TColor);
procedure SetBorderColor(Value: TColor);
procedure SetBorderSize(Value: TBorderWidth);
procedure SetShadowColor(Value: TColor);
procedure SetShadowSize(Value: TBorderWidth);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
protected
procedure Paint; override;
procedure PrepareOffScreen; virtual;
procedure GetPageRect(var Rect: TRect); virtual;
function ActualSize(Value: Integer): Integer;
function LogicalSize(Value: Integer): Integer;
property OffScreenValid: Boolean read FOffScreenValid;
property OffScreenPrepared: Boolean read FOffScreenPrepared;
property OffScreenIsDirty: Boolean read FOffScreenDrawn;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Invalidate; override;
published
property Align;
property BorderColor: TColor read FBorderColor write SetBorderColor default clBlack;
property BorderSize: TBorderWidth read FBorderSize write SetBorderSize default 1;
property Color;
property Cursor;
property DragCursor;
property DragMode;
property ParentColor;
property ParentShowHint;
property PopupMenu;
property PaperColor: TColor read FPaperColor write SetPaperColor default clWhite;
property PaperWidth: Integer read GetPaperWidth write SetPaperWidth;
property PaperHeight: Integer read GetPaperHeight write SetPaperHeight;
property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow;
property ShadowSize: TBorderWidth read FShadowSize write SetShadowSize default 3;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize: TNotifyEvent read FOnResize write FOnResize;
property OnPaint: TPaperPaintEvent read FOnPaint write FOnPaint;
end;
{ TPaperPreviewOptions }
TPaperPreviewOptions = class(TPersistent)
private
FPaperColor: TColor;
FBorderColor: TColor;
FBorderWidth: TBorderWidth;
FShadowColor: TColor;
FShadowWidth: TBorderWidth;
FCursor: TCursor;
FDragCursor: TCursor;
FGrabCursor: TCursor; //pvg
FPopupMenu: TPopupMenu;
FOnChange: TNotifyEvent;
procedure SetPaperColor(Value: TColor);
procedure SetBorderColor(Value: TColor);
procedure SetBorderWidth(Value: TBorderWidth);
procedure SetShadowColor(Value: TColor);
procedure SetShadowWidth(Value: TBorderWidth);
procedure SetCursor(Value: TCursor);
procedure SetDragCursor(Value: TCursor);
procedure SetGrabCursor(Value: TCursor); //pvg
procedure SetPopupMenu(Value: TPopupMenu);
protected
procedure DoChange;
public
constructor Create;
procedure Assign(Source: TPersistent); override;
procedure AssignTo(Source: TPersistent); override;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
published
property BorderColor: TColor read FBorderColor write SetBorderColor default clBlack;
property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 1;
property Cursor: TCursor read FCursor write SetCursor default crDefault;
property DragCursor: TCursor read FDragCursor write SetDragCursor default crHand;
property GrabCursor: TCursor read FGrabCursor write SetGrabCursor default crGrab; //pvg
property PaperColor: TColor read FPaperColor write SetPaperColor default clWhite;
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow;
property ShadowWidth: TBorderWidth read FShadowWidth write SetShadowWidth default 3;
end;
{ TPrintPreview}
TThumbnailPreview = class;
TPreviewPrintProgress = procedure(Sender: TObject; PageNo, Progress: Integer;
var AbortIt: Boolean) of object;
TPreviewAutoCustomForm = procedure(Sender: TObject; const CustomFormName: String;
Operation: TOperation) of object;
TPreviewPageDraw = procedure(Sender: TObject; PageNo: Integer; Canvas: TCanvas) of object;
TVertAlign = (vaTop, vaCenter, vaBottom); //rmk
THorzAlign = (haLeft, haCenter, haRight); //rmk
TGrayscaleOption = (gsPreview, gsPrint);
TGrayscaleOptions = set of TGrayscaleOption;
TPreviewState = (psReady, psCreating, psPrinting, psEditing);
TZoomState = (zsZoomOther, zsZoomToWidth, zsZoomToHeight, zsZoomToFit);
TUnits = (mmPixel, mmLoMetric, mmHiMetric, mmLoEnglish, mmHiEnglish, mmTWIPS, mmPoints);
TPaperType = (pLetter, pLetterSmall, pTabloid, pLedger, pLegal, pStatement,
pExecutive, pA3, pA4, pA4Small, pA5, pB4, pB5, pFolio, pQuatro, p10x14,
p11x17, pNote, pEnv9, pEnv10, pEnv11, pEnv12, pEnv14, pCSheet, pDSheet,
pESheet, pEnvDL, pEnvC5, pEnvC3, pEnvC4, pEnvC6, pEnvC65, pEnvB4, pEnvB5,
pEnvB6, pEnvItaly, pEnvMonarch, pEnvPersonal, pFanfoldUSStd, pFanfoldGermanStd,
pFanfoldGermanLegal, pB4ISO, pJapanesePostcard, p9x11, p10x11, p15x11,
pEnvInvite, pLetterExtra, pLegalExtra, TabloidExtra, pA4Extra, pLetterTransverse,
pA4Transverse, pLetterExtraTransverse, pAPlus, pBPlus, pLetterPlus, pA4Plus,
pA5Transverse, pB5Transverse, pA3Extra, pA5Extra, pB5Extra, pA2, pA3Transverse,
pA3ExtraTransverse, pCustom);
TPrintPreview = class(TScrollBox)
private
FThumbnailViews: TList;
FPaperView: TPaperPreview;
FPaperViewOptions: TPaperPreviewOptions;
FPrintJobTitle: String;
FPages: TMetafileList;
FPageCanvas: TCanvas;
FUnits: TUnits;
FDeviceExt: TPoint;
FPageExt: TPoint;
FAborted: Boolean;
FOrientation: TPrinterOrientation;
FCurrentPage: Integer;
FPaperType: TPaperType;
FState: TPreviewState;
FZoom: Integer;
FZoomState: TZoomState;
FZoomSavePos: Boolean;
FZoomMin: Integer;
FZoomMax: Integer;
FZoomStep: Integer;
FFastPrint: Boolean; // obsolete
FUsePrinterOptions: Boolean;
FDirectPrint: Boolean;
FDirectPrinting: Boolean;
FDirectPrintPageCount: Integer;
FOldMousePos: TPoint;
FCanScrollHorz: Boolean;
FCanScrollVert: Boolean;
FIsDragging: Boolean;
FEditingPage: Integer;
FFormName: String;
FAutoFormName: String;
FAnnotation: Boolean;
FBackground: Boolean;
FGrayscale: TGrayscaleOptions;
FOnBeginDoc: TNotifyEvent;
FOnEndDoc: TNotifyEvent;
FOnNewPage: TNotifyEvent;
FOnEndPage: TNotifyEvent;
FOnAbort: TNotifyEvent;
FOnChange: TNotifyEvent;
FOnPrintProgress: TPreviewPrintProgress;
FOnBeforePrint: TNotifyEvent;
FOnAfterPrint: TNotifyEvent;
FOnZoomChange: TNotifyEvent;
FOnAutoCustomForm: TPreviewAutoCustomForm;
FOnAnnotation: TPreviewPageDraw;
FOnBackground: TPreviewPageDraw;
PageMetafile: TMetafile;
AnnotationMetafile: TMetafile;
BackgroundMetafile: TMetafile;
WheelAccumulator: Integer;
procedure SetPaperViewOptions(Value: TPaperPreviewOptions);
procedure SetUnits(Value: TUnits);
procedure SetPaperType(Value: TPaperType);
function GetPaperWidth: Integer;
procedure SetPaperWidth(Value: Integer);
function GetPaperHeight: Integer;
procedure SetPaperHeight(Value: Integer);
procedure SetPaperTypeByID(ID: Integer);
procedure SetPaperSize(Width, Height: Integer);
procedure SetAnnotation(Value: Boolean);
procedure SetBackground(Value: Boolean);
procedure SetGrayscale(Value: TGrayscaleOptions);
function GetFormName: String;
procedure SetFormName(const Value: String);
function GetPageBounds: TRect;
function GetPrinterPageBounds: TRect;
procedure SetOrientation(Value: TPrinterOrientation);
procedure SetZoomState(Value: TZoomState);
procedure SetZoom(Value: Integer);
procedure SetZoomMin(Value: Integer);
procedure SetZoomMax(Value: Integer);
procedure SetCurrentPage(Value: Integer);
function GetUseTempFile: Boolean;
procedure SetUseTempFile(Value: Boolean);
function GetTotalPages: Integer;
function GetPages(PageNo: Integer): TMetafile;
function GetCanvas: TCanvas;
function GetPrinterInstalled: Boolean;
function CalculateViewSize(const Space: TPoint): TPoint;
function IsCustomPaper: Boolean;
function IsZoomStored: Boolean;
procedure PaperClick(Sender: TObject);
procedure PaperDblClick(Sender: TObject);
procedure PaperMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PaperMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure PaperMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PaperViewOptionsChanged(Sender: TObject);
procedure PagesChanged(Sender: TObject);
procedure PageChanged(Sender: TObject; PageIndex: Integer);
procedure CNKeyDown(var Message: TWMKey); message CN_KEYDOWN;
procedure WMMouseWheel(var Message: TMessage); message WM_MOUSEWHEEL;
protected
procedure Loaded; override;
procedure Resize; override;
procedure DoAnnotation(PageNo: Integer); virtual;
procedure DoBackground(PageNo: Integer); virtual;
procedure DoProgress(Current, Done, Total: Integer); virtual;
procedure PaintPage(Sender: TObject; Canvas: TCanvas; const PageRect: TRect); virtual;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -