📄 preview.pas
字号:
function FindPaperType(APaperWidth, APaperHeight: Integer; InUnits: TUnits): TPaperType;
procedure CheckForAutoCustomForm;
procedure CalculateMetafileSize;
procedure CreateMetafileCanvas(out AMetafile: TMetafile; out ACanvas: TCanvas);
procedure CloseMetafileCanvas(var AMetafile: TMetafile; var ACanvas: TCanvas);
procedure CreatePrinterCanvas(out ACanvas: TCanvas);
procedure ClosePrinterCanvas(var ACanvas: TCanvas);
procedure ScaleCanvas(ACanvas: TCanvas);
procedure RegisterThumbnailView(ThumbnailView: TThumbnailPreview);
procedure UnregisterThumbnailView(ThumbnailView: TThumbnailPreview);
procedure UpdateThumbnailViews(Rebuild: Boolean);
procedure UpdateThumbnailPage(PageIndex: Integer);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ConvertX(Value: Integer; InUnits, OutUnits: TUnits): Integer;
function ConvertY(Value: Integer; InUnits, OutUnits: TUnits): Integer;
function ConvertXY(X, Y: Integer; InUnits, OutUnits: TUnits): TPoint;
procedure ConvertPoints(var Points; NumPoints: Integer; InUnits, OutUnits: TUnits);
function ClientToPaper(const Pt: TPoint): TPoint;
function PaperToClient(const Pt: TPoint): TPoint;
function PaintGraphic(X, Y: Integer; Graphic: TGraphic): TPoint;
function PaintGraphicEx(const Rect: TRect; Graphic: TGraphic;
Proportinal, ShrinkOnly, Center: Boolean): TRect;
function PaintGraphicEx2(const Rect: TRect; Graphic: TGraphic; //rmk
VertAlign: TVertAlign; HorzAlign: THorzAlign): TRect; //rmk
function PaintWinControl(X, Y: Integer; WinControl: TWinControl): TPoint;
function PaintWinControlEx(const Rect: TRect; WinControl: TWinControl;
Proportinal, ShrinkOnly, Center: Boolean): TRect;
function PaintRichText(const Rect: TRect; RichEdit: TCustomRichEdit;
MaxPages: Integer; pOffset: PInteger): Integer;
function GetRichTextRect(var Rect: TRect; RichEdit: TCustomRichEdit;
pOffset: PInteger): Integer;
procedure Clear;
function BeginEdit(PageNo: Integer): Boolean;
procedure EndEdit;
procedure BeginDoc;
procedure EndDoc;
procedure NewPage;
procedure Abort;
procedure Print;
procedure UpdateZoom;
procedure UpdateAnnotation;
procedure UpdateBackground;
procedure SetPrinterOptions;
procedure GetPrinterOptions;
function FetchFormNames(FormNames: TStrings): Boolean;
function GetFormSize(const AFormName: String; out FormWidth, FormHeight: Integer): Boolean;
function AddNewForm(const AFormName: String; FormWidth, FormHeight: DWORD): Boolean;
function RemoveForm(const AFormName: String): Boolean;
procedure PrintPages(FirstPage, LastPage: Integer);
procedure LoadFromStream(Stream: TStream);
procedure SaveToStream(Stream: TStream);
procedure LoadFromFile(const FileName: String);
procedure SaveToFile(const FileName: String);
procedure SaveAsPDF(const FileName: String);
function CanSaveAsPDF: Boolean;
property Aborted: Boolean read FAborted;
property Canvas: TCanvas read GetCanvas;
property TotalPages: Integer read GetTotalPages;
property State: TPreviewState read FState;
property PageSize: TPoint read FPageExt;
property PagePixels: TPoint read FDeviceExt;
property PageBounds: TRect read GetPageBounds;
property PrinterPageBounds: TRect read GetPrinterPageBounds;
property PrinterInstalled: Boolean read GetPrinterInstalled;
property CurrentPage: Integer read FCurrentPage write SetCurrentPage;
property FormName: String read GetFormName write SetFormName;
property AutoFormName: String read FAutoFormName;
property Pages[PageNo: Integer]: TMetafile read GetPages;
property FastPrint: Boolean read FFastPrint write FFastPrint; // obsolete
published
property Align default alClient;
property Annotation: Boolean read FAnnotation write SetAnnotation default False;
property Background: Boolean read FBackground write SetBackground default False;
property DirectPrint: Boolean read FDirectPrint write FDirectPrint default False;
property Grayscale: TGrayscaleOptions read FGrayscale write SetGrayscale default [];
property Units: TUnits read FUnits write SetUnits default mmHiMetric;
property Orientation: TPrinterOrientation read FOrientation write SetOrientation default poPortrait;
property PaperType: TPaperType read FPaperType write SetPaperType default pA4;
property PaperView: TPaperPreviewOptions read FPaperViewOptions write SetPaperViewOptions;
property PaperWidth: Integer read GetPaperWidth write SetPaperWidth stored IsCustomPaper;
property PaperHeight: Integer read GetPaperHeight write SetPaperHeight stored IsCustomPaper;
property ParentFont default False;
property PrintJobTitle: String read FPrintJobTitle write FPrintJobTitle;
property TabStop default True;
property UsePrinterOptions: Boolean read FUsePrinterOptions write FUsePrinterOptions default False;
property UseTempFile: Boolean read GetUseTempFile write SetUseTempFile default False;
property ZoomState: TZoomState read FZoomState write SetZoomState default zsZoomToFit;
property Zoom: Integer read FZoom write SetZoom stored IsZoomStored;
property ZoomMin: Integer read FZoomMin write SetZoomMin default 10;
property ZoomMax: Integer read FZoomMax write SetZoomMax default 500;
property ZoomSavePos: Boolean read FZoomSavePos write FZoomSavePos default True;
property ZoomStep: Integer read FZoomStep write FZoomStep default 10;
property OnBeginDoc: TNotifyEvent read FOnBeginDoc write FOnBeginDoc;
property OnEndDoc: TNotifyEvent read FOnEndDoc write FOnEndDoc;
property OnNewPage: TNotifyEvent read FOnNewPage write FOnNewPage;
property OnEndPage: TNotifyEvent read FOnEndPage write FOnEndPage;
property OnAbort: TNotifyEvent read FOnAbort write FOnAbort;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnPrintProgress: TPreviewPrintProgress read FOnPrintProgress write FOnPrintProgress;
property OnBeforePrint: TNotifyEvent read FOnBeforePrint write FOnBeforePrint;
property OnAfterPrint: TNotifyEvent read FOnAfterPrint write FOnAfterPrint;
property OnZoomChange: TNotifyEvent read FOnZoomChange write FOnZoomChange;
property OnAutoCustomForm: TPreviewAutoCustomForm read FOnAutoCustomForm write FOnAutoCustomForm;
property OnAnnotation: TPreviewPageDraw read FOnAnnotation write FOnAnnotation;
property OnBackground: TPreviewPageDraw read FOnBackground write FOnBackground;
end;
{ TThumbnailPreview }
TThumbnailClass = class of TThumbnail;
TThumbnail = class(TObject)
protected
PageNo: Integer;
PageView: TPaperPreview;
PageLabel: TLabel;
public
constructor Create(AOwner: TThumbnailPreview; APageNo: Integer); virtual;
destructor Destroy; override;
function GetBoundRect: TRect; virtual;
function HasAsMember(Component: TComponent): Boolean; virtual;
end;
TThumbnailPreview = class(TScrollBox)
private
FThumbnails: TList;
FZoom: Integer;
FMargin: Byte;
FMarkerColor: TColor;
FOrientation: TScrollBarKind;
FPrintPreview: TPrintPreview;
FPaperViewOptions: TPaperPreviewOptions;
FRowCount: Integer;
FColCount: Integer;
FThumbnailClass: TThumbnailClass;
FOnChange: TNotifyEvent;
WheelAccumulator: Integer;
ActiveThumb: TThumbnail;
Updating: Boolean;
procedure SetZoom(Value: Integer);
procedure SetMargin(Value: Byte);
procedure SetMarkerColor(Value: TColor);
procedure SetOrientation(Value: TScrollBarKind);
procedure SetPrintPreview(Value: TPrintPreview);
procedure SetThumbnailClass(Value: TThumbnailClass);
procedure SetPaperViewOptions(Value: TPaperPreviewOptions);
procedure PaperViewOptionsChanged(Sender: TObject);
procedure ThumbnailClick(Sender: TObject);
procedure ThumbnailPaint(Sender: TObject; Canvas: TCanvas; const PageRect: TRect);
procedure CNKeyDown(var Message: TWMKey); message CN_KEYDOWN;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure WMMouseWheel(var Message: TMessage); message WM_MOUSEWHEEL;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Resize; override;
procedure MakeVisible(const Bounds: TRect); virtual;
procedure UpdateThumbnails(Rebuild: Boolean); virtual;
procedure UpdatePage(Index: Integer); virtual;
procedure CalculateElementBounds(out ViewPos, ViewSize, LabelPos,
LabelSize, ThumbSize: TPoint); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property RowCount: Integer read FRowCount;
property ColCount: Integer read FColCount;
property ThumbnailClass: TThumbnailClass read FThumbnailClass write SetThumbnailClass;
published
property Align default alLeft;
property Margin: Byte read FMargin write SetMargin default 6;
property MarkerColor: TColor read FMarkerColor write SetMarkerColor default clBlue;
property Orientation: TScrollBarKind read FOrientation write SetOrientation default sbVertical;
property PrintPreview: TPrintPreview read FPrintPreview write SetPrintPreview;
property PaperView: TPaperPreviewOptions read FPaperViewOptions write SetPaperViewOptions;
property TabStop default True;
property Zoom: Integer read FZoom write SetZoom default 10;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TPaperSizeInfo = record
ID: SmallInt;
Width, Height: Integer;
Units: TUnits;
end;
const
// Paper Sizes
PaperSizes: array[TPaperType] of TPaperSizeInfo = (
(ID: DMPAPER_LETTER; Width: 08500; Height: 11000; Units: mmHiEnglish),
(ID: DMPAPER_LETTER; Width: 08500; Height: 11000; Units: mmHiEnglish),
(ID: DMPAPER_TABLOID; Width: 11000; Height: 17000; Units: mmHiEnglish),
(ID: DMPAPER_LEDGER; Width: 17000; Height: 11000; Units: mmHiEnglish),
(ID: DMPAPER_LEGAL; Width: 08500; Height: 14000; Units: mmHiEnglish),
(ID: DMPAPER_STATEMENT; Width: 05500; Height: 08500; Units: mmHiEnglish),
(ID: DMPAPER_EXECUTIVE; Width: 07250; Height: 10500; Units: mmHiEnglish),
(ID: DMPAPER_A3; Width: 02970; Height: 04200; Units: mmLoMetric),
(ID: DMPAPER_A4; Width: 02100; Height: 02970; Units: mmLoMetric),
(ID: DMPAPER_A4SMALL; Width: 02100; Height: 02970; Units: mmLoMetric),
(ID: DMPAPER_A5; Width: 01480; Height: 02100; Units: mmLoMetric),
(ID: DMPAPER_B4; Width: 02500; Height: 03540; Units: mmLoMetric),
(ID: DMPAPER_B5; Width: 01820; Height: 02570; Units: mmLoMetric),
(ID: DMPAPER_FOLIO; Width: 08500; Height: 13000; Units: mmHiEnglish),
(ID: DMPAPER_QUARTO; Width: 02150; Height: 02750; Units: mmLoMetric),
(ID: DMPAPER_10X14; Width: 10000; Height: 14000; Units: mmHiEnglish),
(ID: DMPAPER_11X17; Width: 11000; Height: 17000; Units: mmHiEnglish),
(ID: DMPAPER_NOTE; Width: 08500; Height: 11000; Units: mmHiEnglish),
(ID: DMPAPER_ENV_9; Width: 03875; Height: 08875; Units: mmHiEnglish),
(ID: DMPAPER_ENV_10; Width: 04125; Height: 09500; Units: mmHiEnglish),
(ID: DMPAPER_ENV_11; Width: 04500; Height: 10375; Units: mmHiEnglish),
(ID: DMPAPER_ENV_12; Width: 04750; Height: 11000; Units: mmHiEnglish),
(ID: DMPAPER_ENV_14; Width: 05000; Height: 11500; Units: mmHiEnglish),
(ID: DMPAPER_CSHEET; Width: 17000; Height: 22000; Units: mmHiEnglish),
(ID: DMPAPER_DSHEET; Width: 22000; Height: 34000; Units: mmHiEnglish),
(ID: DMPAPER_ESHEET; Width: 34000; Height: 44000; Units: mmHiEnglish),
(ID: DMPAPER_ENV_DL; Width: 01100; Height: 02200; Units: mmLoMetric),
(ID: DMPAPER_ENV_C5; Width: 01620; Height: 02290; Units: mmLoMetric),
(ID: DMPAPER_ENV_C3; Width: 03240; Height: 04580; Units: mmLoMetric),
(ID: DMPAPER_ENV_C4; Width: 02290; Height: 03240; Units: mmLoMetric),
(ID: DMPAPER_ENV_C6; Width: 01140; Height: 01620; Units: mmLoMetric),
(ID: DMPAPER_ENV_C65; Width: 01140; Height: 02290; Units: mmLoMetric),
(ID: DMPAPER_ENV_B4; Width: 02500; Height: 03530; Units: mmLoMetric),
(ID: DMPAPER_ENV_B5; Width: 01760; Height: 02500; Units: mmLoMetric),
(ID: DMPAPER_ENV_B6; Width: 01760; Height: 01250; Units: mmLoMetric),
(ID: DMPAPER_ENV_ITALY; Width: 01100; Height: 02300; Units: mmLoMetric),
(ID: DMPAPER_ENV_MONARCH; Width: 03875; Height: 07500; Units: mmHiEnglish),
(ID: DMPAPER_ENV_PERSONAL; Width: 03625; Height: 06500; Units: mmHiEnglish),
(ID: DMPAPER_FANFOLD_US; Width: 14875; Height: 11000; Units: mmHiEnglish),
(ID: DMPAPER_FANFOLD_STD_GERMAN; Width: 08500; Height: 12000; Units: mmHiEnglish),
(ID: DMPAPER_FANFOLD_LGL_GERMAN; Width: 08500; Height: 13000; Units: mmHiEnglish),
(ID: DMPAPER_ISO_B4; Width: 02500; Height: 03530; Units: mmLoMetric),
(ID: DMPAPER_JAPANESE_POSTCARD; Width: 01000; Height: 01480; Units: mmLoMetric),
(ID: DMPAPER_9X11; Width: 09000; Height: 11000; Units: mmHiEnglish),
(ID: DMPAPER_10X11; Width: 10000; Height: 11000; Units: mmHiEnglish),
(ID: DMPAPER_15X11; Width: 15000; Height: 11000; Units: mmHiEnglish),
(ID: DMPAPER_ENV_INVITE; Width: 02200; Height: 02200; Units: mmLoMetric),
(ID: DMPAPER_LETTER_EXTRA; Width: 09500; Height: 12000; Units: mmHiEnglish),
(ID: DMPAPER_LEGAL_EXTRA; Width: 09500; Height: 15000; Units: mmHiEnglish),
(ID: DMPAPER_TABLOID_EXTRA; Width: 11690; Height: 18000; Units: mmHiEnglish),
(ID: DMPAPER_A4_EXTRA; Width: 09270; Height: 12690; Units: mmHiEnglish),
(ID: DMPAPER_LETTER_TRANSVERSE; Width: 08500; Height: 11000; Units: mmHiEnglish),
(ID: DMPAPER_A4_TRANSVERSE; Width: 02100; Height: 02970; Units: mmLoMetric),
(ID: DMPAPER_LETTER_EXTRA_TRANSVERSE; Width: 09500; Height: 12000; Units: mmHiEnglish),
(ID: DMPAPER_A_PLUS; Width: 02270; Height: 03560; Units: mmLoMetric),
(ID: DMPAPER_B_PLUS; Width: 03050; Height: 04870; Units: mmLoMetric),
(ID: DMPAPER_LETTER_PLUS; Width: 08500; Height: 12690; Units: mmHiEnglish),
(ID: DMPAPER_A4_PLUS; Width: 02100; Height: 03300; Units: mmLoMetric),
(ID: DMPAPER_A5_TRANSVERSE; Width: 01480; Height: 02100; Units: mmLoMetric),
(ID: DMPAPER_B5_TRANSVERSE; Width: 01820; Height: 02570; Units: mmLoMetric),
(ID: DMPAPER_A3_EXTRA; Width: 03220; Height: 04450; Units: mmLoMetric),
(ID: DMPAPER_A5_EXTRA; Width: 01740; Height: 02350; Units: mmLoMetric),
(ID: DMPAPER_B5_EXTRA; Width: 02010; Height: 02760; Units: mmLoMetric),
(ID: DMPAPER_A2; Width: 04200; Height: 05940; Units: mmLoMetric),
(ID: DMPAPER_A3_TRANSVERSE; Width: 02970; Height: 04200; Units: mmLoMetric),
(ID: DMPAPER_A3_EXTRA_TRANSVERSE; Width: 03220; Height: 04450; Units: mmLoMetric),
(ID: DMPAPER_USER; Width: 0; Height: 0; Units: mmPixel));
function ConvertUnits(Value, DPI: Integer; InUnits, OutUnits: TUnits): Integer;
procedure DrawGraphic(Canvas: TCanvas; X, Y: Integer; Graphic: TGraphic);
procedure StretchDrawGraphic(Canvas: TCanvas; const Rect: TRect; Graphic: TGraphic);
procedure DrawGrayscale(Canvas: TCanvas; X, Y: Integer; Graphic: TGraphic);
procedure StretchDrawGrayscale(Canvas: TCanvas; const Rect: TRect; Graphic: TGraphic);
procedure ConvertBitmapToGrayscale(Bitmap: TBitmap);
procedure Register;
implementation
uses
RichEdit {$IFDEF ZLIB}, ZLib, Types {$ENDIF};
const
dsPDF_lib = 'dspdf.dll';
type
TdsPDF = record
Handle: HMODULE;
BeginDoc: function(FileName: PChar): Integer; stdcall;
EndDoc: function: Integer; stdcall;
NewPage: function: Integer; stdcall;
PrintPageMemory: function(Data: Pointer; Size: Integer): Integer; stdcall;
PrintPageFile: function(FileName: PChar): Integer; stdcall;
SetParameters: function(AOffsetX, AOffsetY: Integer; AConverterX, AConverterY: Double): Integer; stdcall;
SetPage: function(ps, orientation, w, h: Integer): Integer; stdcall;
end;
var
dsPDF: TdsPDF;
{$R *.RES}
procedure Register;
begin
RegisterComponents('Delphi Area', [TPaperPreview, TThumbnailPreview, TPrintPreview]);
end;
{ Helper Functions }
const
ZLibSignature = $9C78;
PageInfoSignature = $13490208;
MetafilesSignature = $50502D4B;
SNotEnoughMemory = 'Not enough memory to create a new page';
SInvalidPreviewData = 'The content is not Print Preview data';
function GetTemporaryFileName: String;
var
TempPath: array[0..255] of Char;
TempFile: array[0..255] of Char;
begin
GetTempPath(SizeOf(TempPath), TempPath);
GetTempFileName(TempPath, 'PP', 0, TempFile);
Result := StrPas(TempFile);
end;
{$IFDEF IMAGE_TRANSPARENCY}
procedure TransparentStretchDIBits(dstDC: HDC;
dstX, dstY: Integer; dstW, dstH: Integer;
srcX, srcY: Integer; srcW, srcH: Integer;
bmpBits: Pointer; var bmpInfo: TBitmapInfo;
mskBits: Pointer; var mskInfo: TBitmapInfo;
Usage: DWORD);
var
MemDC: HDC;
MemBmp: HBITMAP;
Save: THandle;
crText, crBack: TColorRef;
memInfo: pBitmapInfo;
memBits: Pointer;
HeaderSize: DWORD;
ImageSize: DWORD;
begin
MemDC := CreateCompatibleDC(0);
try
MemBmp := CreateCompatibleBitmap(dstDC, srcW, srcH);
try
Save := SelectObject(MemDC, MemBmp);
SetStretchBltMode(MemDC, ColorOnColor);
StretchDIBits(MemDC, 0, 0, srcW, srcH, 0, 0, srcW, srcH, mskBits, mskInfo, Usage, SrcCopy);
StretchDIBits(MemDC, 0, 0, srcW, srcH, 0, 0, srcW, srcH, bmpBits, bmpInfo, Usage, SrcErase);
if Save <> 0 then SelectObject(MemDC, Save);
GetDIBSizes(MemBmp, HeaderSize, ImageSize);
GetMem(memInfo, HeaderSize);
try
GetMem(memBits, ImageSize);
try
GetDIB(MemBmp, 0, memInfo^, memBits^);
crText := SetTextColor(dstDC, RGB(0, 0, 0));
crBack := SetBkColor(dstDC, RGB(255, 255, 255));
SetStretchBltMode(dstDC, ColorOnColor);
StretchDIBits(dstDC, dstX, dstY, dstW, dstH, srcX, srcY, srcW, srcH, mskBits, mskInfo, Usage, SrcAnd);
StretchDIBits(dstDC, dstX, dstY, dstW, dstH, srcX, srcY, srcW, srcH, memBits, memInfo^, Usage, SrcInvert);
SetTextColor(dstDC, crText);
SetBkColor(dstDC, crBack);
finally
FreeMem(memBits);
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -