2867 lines
82 KiB
Plaintext
2867 lines
82 KiB
Plaintext
{$IFDEF FPC}
|
|
{$MODE DelphiUnicode}
|
|
{$ENDIF FPC}
|
|
|
|
{$A8,B-,E-,F-,G+,H+,I+,J-,K-,M-,N-,P+,Q-,R-,S-,T-,U-,V+,X+,Z1}
|
|
{$STRINGCHECKS OFF}
|
|
|
|
unit EM.PdfiumCtrl;
|
|
|
|
// Show invalidated paint regions. Don't enable this if you aren't trying to optimize the repainting
|
|
{.$DEFINE REPAINTTEST}
|
|
|
|
{$IFDEF FPC}
|
|
{$DEFINE USE_PRINTCLIENT_WORKAROUND}
|
|
{$ELSE}
|
|
{$IF CompilerVersion <= 20.0} // 2009 and older
|
|
{$DEFINE USE_PRINTCLIENT_WORKAROUND}
|
|
{$IFEND}
|
|
{$IF CompilerVersion >= 21.0} // 2010+
|
|
{$DEFINE VCL_HAS_TOUCH}
|
|
{$IFEND}
|
|
{$ENDIF FPC}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF FPC}
|
|
LCLType, PrintersDlgs, Win32Extra,
|
|
{$ENDIF FPC}
|
|
Windows, Messages, ShellAPI, Types, SysUtils, Classes, Contnrs, Graphics, Controls,
|
|
Forms, Dialogs, EM.PdfiumCore;
|
|
|
|
type
|
|
TPdfControlLinkOptionType = (
|
|
loAutoGoto, // Jumps in the document are allowed and automatically handled
|
|
loAutoRemoteGotoReplaceDocument, // Jumps to a remote document are allowed and automatically handled by replacing the loaded document
|
|
loAutoOpenURI, // Jumps to URI are allowed and automatically handled by using ShellExecuteEx. Disables OnWebLinkClick if loTreatWebLinkAsUriAnnotationLink is set
|
|
loAutoLaunch, // Allow executing/opening a program/file automatically by using ShellExecuteEx
|
|
loAutoEmbeddedGotoReplaceDocument, // Jumps to an attached PDF document are allowed and automatically handled by replacing the loaded document
|
|
|
|
loTreatWebLinkAsUriAnnotationLink, // OnAnnotationLinkClick also handles WebLinks
|
|
loAlwaysDetectWebAndUriLink // If if OnWebLinkClick and OnAnnotationLinkClick aren't assigned, URI and WebLinks are detected
|
|
);
|
|
TPdfControlLinkOptions = set of TPdfControlLinkOptionType;
|
|
|
|
const
|
|
cPdfControlDefaultDrawOptions = [proAnnotations];
|
|
cPdfControlDefaultLinkOptions = [loAutoGoto, loTreatWebLinkAsUriAnnotationLink, loAlwaysDetectWebAndUriLink];
|
|
cPdfControlAllAutoLinkOptions = [loAutoGoto, loAutoRemoteGotoReplaceDocument, loAutoOpenURI,
|
|
loAutoLaunch, loAutoEmbeddedGotoReplaceDocument];
|
|
|
|
type
|
|
TPdfControlScaleMode = (
|
|
smFitAuto,
|
|
smFitWidth,
|
|
smFitHeight,
|
|
smZoom
|
|
);
|
|
|
|
TPdfControlWebLinkClickEvent = procedure(Sender: TObject; Url: string) of object;
|
|
TPdfControlAnnotationLinkClickEvent = procedure(Sender: TObject; LinkInfo: TPdfLinkInfo; var Handled: Boolean) of object;
|
|
TPdfControlRectArray = array of TRect;
|
|
|
|
TPdfControl = class(TCustomControl)
|
|
private
|
|
FDocument: TPdfDocument;
|
|
FPageIndex: Integer;
|
|
FRenderedPageIndex: Integer;
|
|
FPageBitmap: HBITMAP;
|
|
FDrawX: Integer;
|
|
FDrawY: Integer;
|
|
FDrawWidth: Integer;
|
|
FDrawHeight: Integer;
|
|
FRotation: TPdfPageRotation;
|
|
{$IFDEF USE_PRINTCLIENT_WORKAROUND}
|
|
FPrintClient: Boolean;
|
|
{$ENDIF USE_PRINTCLIENT_WORKAROUND}
|
|
FMousePressed: Boolean;
|
|
FSelectionActive: Boolean;
|
|
FAllowUserTextSelection: Boolean;
|
|
FAllowUserPageChange: Boolean;
|
|
FAllowFormEvents: Boolean;
|
|
FBufferedPageDraw: Boolean;
|
|
FSmoothScroll: Boolean;
|
|
FScrollTimerActive: Boolean;
|
|
FScrollTimer: Boolean;
|
|
FChangePageOnMouseScrolling: Boolean;
|
|
FSelStartCharIndex: Integer;
|
|
FSelStopCharIndex: Integer;
|
|
FMouseDownPt: TPoint;
|
|
FCheckForTrippleClick: Boolean;
|
|
FWebLinkInfo: TPdfPageWebLinksInfo;
|
|
FDrawOptions: TPdfPageRenderOptions;
|
|
FScaleMode: TPdfControlScaleMode;
|
|
FZoomPercentage: Integer;
|
|
FPageColor: TColor;
|
|
FScrollMousePos: TPoint;
|
|
FLinkOptions: TPdfControlLinkOptions;
|
|
FHighlightTextRects: TPdfRectArray;
|
|
FHighlightTexts: TObjectList;
|
|
FFormOutputSelectedRects: TPdfRectArray;
|
|
FFormFieldFocused: Boolean;
|
|
FPageShadowSize: Integer;
|
|
FPageShadowColor: TColor;
|
|
FPageShadowPadding: Integer;
|
|
FPageBorderColor: TColor;
|
|
|
|
FOnWebLinkClick: TPdfControlWebLinkClickEvent;
|
|
FOnAnnotationLinkClick: TPdfControlAnnotationLinkClickEvent;
|
|
FOnPageChange: TNotifyEvent;
|
|
FOnPaint: TNotifyEvent;
|
|
FOnPrintDocument: TNotifyEvent;
|
|
|
|
procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
|
|
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
|
|
procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
|
|
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
|
|
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
|
|
procedure CMColorchanged(var Message: TMessage); message CM_COLORCHANGED;
|
|
{$IFDEF USE_PRINTCLIENT_WORKAROUND}
|
|
procedure WMPrintClient(var Message: TWMPrintClient); message WM_PRINTCLIENT;
|
|
{$ENDIF USE_PRINTCLIENT_WORKAROUND}
|
|
procedure CMMouseleave(var Message: TMessage); message CM_MOUSELEAVE;
|
|
|
|
procedure GetPageWebLinks;
|
|
function GetCurrentPage: TPdfPage;
|
|
function GetPageCount: Integer;
|
|
procedure SetPageIndex(Value: Integer);
|
|
function InternSetPageIndex(Value: Integer; ScrollTransition, InverseScrollTransition: Boolean): Boolean;
|
|
procedure SetRotation(const Value: TPdfPageRotation);
|
|
function SetSelStopCharIndex(X, Y: Integer): Boolean;
|
|
function GetSelText: string;
|
|
function GetSelLength: Integer;
|
|
function GetSelStart: Integer;
|
|
procedure SetSelection(Active: Boolean; StartIndex, StopIndex: Integer);
|
|
procedure SetScaleMode(const Value: TPdfControlScaleMode);
|
|
procedure SetPageBorderColor(const Value: TColor);
|
|
procedure SetPageShadowColor(const Value: TColor);
|
|
procedure SetPageShadowPadding(const Value: Integer);
|
|
procedure SetPageShadowSize(const Value: Integer);
|
|
procedure AdjustDrawPos;
|
|
procedure UpdatePageDrawInfo;
|
|
procedure SetPageColor(const Value: TColor);
|
|
procedure SetDrawOptions(const Value: TPdfPageRenderOptions);
|
|
procedure InvalidateRectDiffs(const OldRects, NewRects: TPdfControlRectArray);
|
|
procedure InvalidatePdfRectDiffs(const OldRects, NewRects: TPdfRectArray);
|
|
procedure StopScrollTimer;
|
|
procedure DocumentLoaded;
|
|
procedure DrawSelection(DC: HDC; Page: TPdfPage);
|
|
procedure DrawHighlightText(DC: HDC; Page: TPdfPage);
|
|
procedure DrawBorderAndShadow(DC: HDC);
|
|
function InternPageToDevice(Page: TPdfPage; PageRect: TPdfRect; ANormalize: Boolean): TRect;
|
|
procedure SetZoomPercentage(Value: Integer);
|
|
procedure DrawPage(DC: HDC; Page: TPdfPage; DirectDrawPage: Boolean);
|
|
procedure CalcHighlightTextRects;
|
|
procedure InitDocument;
|
|
function ShellOpenFileName(const FileName: string; Launch: Boolean): Boolean;
|
|
|
|
procedure FormInvalidate(Document: TPdfDocument; Page: TPdfPage; const PageRect: TPdfRect);
|
|
procedure FormOutputSelectedRect(Document: TPdfDocument; Page: TPdfPage; const PageRect: TPdfRect);
|
|
procedure FormGetCurrentPage(Document: TPdfDocument; var Page: TPdfPage);
|
|
procedure FormFieldFocus(Document: TPdfDocument; Value: PWideChar; ValueLen: Integer; FieldFocused: Boolean);
|
|
procedure ExecuteNamedAction(Document: TPdfDocument; NamedAction: TPdfNamedActionType);
|
|
|
|
procedure DrawAlphaRects(DC: HDC; Page: TPdfPage; const Rects: TPdfRectArray; Color: TColor);
|
|
procedure DrawAlphaSelection(DC: HDC; Page: TPdfPage; const Rects: TPdfRectArray);
|
|
procedure DrawFormOutputSelectedRects(DC: HDC; Page: TPdfPage);
|
|
protected
|
|
procedure Paint; override;
|
|
procedure Resize; override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
|
|
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure WMKeyDown(var Message: TWMKeyDown); message {$IFDEF FPC}CN_KEYDOWN{$ELSE}WM_KEYDOWN{$ENDIF};
|
|
procedure WMKeyUp(var Message: TWMKeyUp); message {$IFDEF FPC}CN_KEYUP{$ELSE}WM_KEYUP{$ENDIF};
|
|
procedure WMChar(var Message: TWMChar); message {$IFDEF FPC}CN_CHAR{$ELSE}WM_CHAR{$ENDIF};
|
|
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
|
|
|
|
function LinkHandlingNeeded: Boolean;
|
|
function IsClickableLinkAt(X, Y: Integer): Boolean;
|
|
procedure WebLinkClick(const Url: string); virtual;
|
|
procedure AnnotationLinkClick(LinkInfo: TPdfLinkInfo); virtual;
|
|
procedure PageChange; virtual;
|
|
procedure PageContentChanged(Closing: Boolean);
|
|
procedure PageLayoutChanged;
|
|
function IsPageValid: Boolean;
|
|
function GetSelectionRects: TPdfControlRectArray;
|
|
procedure DestroyWnd; override;
|
|
|
|
property DrawX: Integer read FDrawX;
|
|
property DrawY: Integer read FDrawY;
|
|
property DrawWidth: Integer read FDrawWidth;
|
|
property DrawHeight: Integer read FDrawHeight;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
{ InvalidatePage forces the page to be rendered again and invalidates the control. }
|
|
procedure InvalidatePage;
|
|
{ PrintDocument uses OnPrintDocument to print. If OnPrintDocument is not assigned it does nothing. }
|
|
procedure PrintDocument;
|
|
|
|
procedure OpenWithDocument(Document: TPdfDocument); // takes ownership
|
|
procedure LoadFromCustom(ReadFunc: TPdfDocumentCustomReadProc; Size: LongWord; Param: Pointer; const Password: UTF8String = '');
|
|
procedure LoadFromActiveStream(Stream: TStream; const Password: UTF8String = ''); // Stream must not be released until the document is closed
|
|
procedure LoadFromActiveBuffer(Buffer: Pointer; Size: Int64; const Password: UTF8String = ''); // Buffer must not be released until the document is closed
|
|
procedure LoadFromBytes(const Bytes: TBytes; const Password: UTF8String = ''); overload; // The content of the Bytes array must not be changed until the document is closed
|
|
procedure LoadFromBytes(const Bytes: TBytes; Index: Integer; Count: Integer; const Password: UTF8String = ''); overload; // The content of the Bytes array must not be changed until the document is closed
|
|
procedure LoadFromStream(Stream: TStream; const Password: UTF8String = '');
|
|
procedure LoadFromFile(const FileName: string; const Password: UTF8String = ''; LoadOption: TPdfDocumentLoadOption = dloDefault);
|
|
procedure Close;
|
|
|
|
function DeviceToPage(DeviceX, DeviceY: Integer): TPdfPoint; overload;
|
|
function DeviceToPage(DeviceRect: TRect): TPdfRect; overload;
|
|
function PageToDevice(PageX, PageY: Double): TPoint; overload;
|
|
function PageToDevice(PageRect: TPdfRect): TRect; overload;
|
|
function GetPageRect: TRect;
|
|
|
|
procedure CopyFormTextToClipboard;
|
|
procedure CutFormTextToClipboard;
|
|
procedure PasteFormTextFromClipboard;
|
|
procedure SelectAllFormText;
|
|
|
|
procedure CopyToClipboard;
|
|
procedure ClearSelection;
|
|
procedure SelectAll;
|
|
procedure SelectText(CharIndex, Count: Integer);
|
|
function SelectWord(CharIndex: Integer): Boolean; // includes symbols like Chrome
|
|
function SelectLine(CharIndex: Integer): Boolean;
|
|
|
|
function GetTextInRect(const R: TRect): string;
|
|
{ HightlightText() highlights all occurences of the specified text and clears previously
|
|
hightlighted texts. }
|
|
procedure HightlightText(const SearchText: string; MatchCase, MatchWholeWord: Boolean);
|
|
{ AddHightlightText() highlights all occurences of the specified text but keeps previously
|
|
hightlighted texts. }
|
|
procedure AddHightlightText(const SearchText: string; MatchCase, MatchWholeWord: Boolean);
|
|
procedure ClearHighlightText;
|
|
|
|
function IsWebLinkAt(X, Y: Integer): Boolean; overload;
|
|
function IsWebLinkAt(X, Y: Integer; var Url: string): Boolean; overload;
|
|
function IsUriAnnotationLinkAt(X, Y: Integer): Boolean;
|
|
function IsAnnotationLinkAt(X, Y: Integer): Boolean;
|
|
function GetAnnotationLinkAt(X, Y: Integer): TPdfAnnotation;
|
|
|
|
function GotoNextPage(ScrollTransition: Boolean = False): Boolean;
|
|
function GotoPrevPage(ScrollTransition: Boolean = False): Boolean;
|
|
function ScrollContent(XOffset, YOffset: Integer; Smooth: Boolean = False): Boolean; virtual;
|
|
function ScrollContentTo(X, Y: Integer; Smooth: Boolean = False): Boolean;
|
|
function GotoDestination(const LinkGotoDestination: TPdfLinkGotoDestination): Boolean;
|
|
|
|
property Document: TPdfDocument read FDocument;
|
|
property CurrentPage: TPdfPage read GetCurrentPage;
|
|
|
|
property PageCount: Integer read GetPageCount;
|
|
property PageIndex: Integer read FPageIndex write SetPageIndex;
|
|
property SelStart: Integer read GetSelStart; // in CharIndex, not TextIndex (Length(SelText) may not be SelLength)
|
|
property SelLength: Integer read GetSelLength; // in CharIndex, not TextIndex (Length(SelText) may not be SelLength)
|
|
property SelText: string read GetSelText;
|
|
|
|
property Canvas;
|
|
published
|
|
property ScaleMode: TPdfControlScaleMode read FScaleMode write SetScaleMode default smFitAuto;
|
|
property ZoomPercentage: Integer read FZoomPercentage write SetZoomPercentage default 100;
|
|
property PageColor: TColor read FPageColor write SetPageColor default clWhite;
|
|
property Rotation: TPdfPageRotation read FRotation write SetRotation default prNormal;
|
|
property BufferedPageDraw: Boolean read FBufferedPageDraw write FBufferedPageDraw default True;
|
|
property AllowUserTextSelection: Boolean read FAllowUserTextSelection write FAllowUserTextSelection default True;
|
|
property AllowUserPageChange: Boolean read FAllowUserPageChange write FAllowUserPageChange default True; // PgDn/PgUp
|
|
property AllowFormEvents: Boolean read FAllowFormEvents write FAllowFormEvents default True;
|
|
property DrawOptions: TPdfPageRenderOptions read FDrawOptions write SetDrawOptions default cPdfControlDefaultDrawOptions;
|
|
property SmoothScroll: Boolean read FSmoothScroll write FSmoothScroll default False;
|
|
property ScrollTimer: Boolean read FScrollTimer write FScrollTimer default True;
|
|
property ChangePageOnMouseScrolling: Boolean read FChangePageOnMouseScrolling write FChangePageOnMouseScrolling default False;
|
|
property LinkOptions: TPdfControlLinkOptions read FLinkOptions write FLinkOptions default cPdfControlDefaultLinkOptions;
|
|
|
|
property PageBorderColor: TColor read FPageBorderColor write SetPageBorderColor default clNone;
|
|
property PageShadowColor: TColor read FPageShadowColor write SetPageShadowColor default clNone;
|
|
property PageShadowSize: Integer read FPageShadowSize write SetPageShadowSize default 4;
|
|
property PageShadowPadding: Integer read FPageShadowPadding write SetPageShadowPadding default 44;
|
|
|
|
{ OnWebLinkClick is only called for WebLinks (URLs parsed from the document text). If OnAnnotationLinkClick is
|
|
not assigned, OnWebLinkClick is also called URI link annontations for backward compatibility reasons. }
|
|
property OnWebLinkClick: TPdfControlWebLinkClickEvent read FOnWebLinkClick write FOnWebLinkClick;
|
|
{ OnAnnotationLinkClick is called for all link annotation but not for WebLinks. }
|
|
property OnAnnotationLinkClick: TPdfControlAnnotationLinkClickEvent read FOnAnnotationLinkClick write FOnAnnotationLinkClick;
|
|
{ OnPageChange is called if the current page is switched. }
|
|
property OnPageChange: TNotifyEvent read FOnPageChange write FOnPageChange;
|
|
{ OnPrintDocument is called from PrintDocument }
|
|
property OnPrintDocument: TNotifyEvent read FOnPrintDocument write FOnPrintDocument;
|
|
|
|
property Align;
|
|
property Anchors;
|
|
property Color default clGray;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property ParentBackground default False;
|
|
property ParentColor default False;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop default True;
|
|
property Visible;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
{$IFNDEF FPC}
|
|
property OnMouseActivate;
|
|
{$ENDIF ~FPC}
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
{$IFDEF VCL_HAS_TOUCH}
|
|
property Touch;
|
|
property OnGesture;
|
|
{$ENDIF VCL_HAS_TOUCH}
|
|
end;
|
|
|
|
TPdfDocumentVclPrinter = class(TPdfDocumentPrinter)
|
|
private
|
|
FBeginDocCalled: Boolean;
|
|
FPagePrinted: Boolean;
|
|
protected
|
|
function PrinterStartDoc(const AJobTitle: string): Boolean; override;
|
|
procedure PrinterEndDoc; override;
|
|
procedure PrinterStartPage; override;
|
|
procedure PrinterEndPage; override;
|
|
function GetPrinterDC: HDC; override;
|
|
public
|
|
{ If AShowPrintDialog is false PrintDocument prints the document to the default printer.
|
|
If AShowPrintDialog is true the print dialog is shown and the user can select the
|
|
printer, page range and number of copies (if supported by the printer driver).
|
|
Returns true if the page was send to the printer driver. }
|
|
class function PrintDocument(ADocument: TPdfDocument; const AJobTitle: string;
|
|
AShowPrintDialog: Boolean = True; AllowPageRange: Boolean = True;
|
|
AParentWnd: HWND = 0): Boolean; static;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math, Clipbrd, Character, Printers;
|
|
|
|
const
|
|
cScrollTimerId = 1;
|
|
cTrippleClickTimerId = 2;
|
|
cScrollTimerInterval = 50;
|
|
cDefaultScrollOffset = 25;
|
|
|
|
type
|
|
THighlightTextInfo = class(TObject)
|
|
private
|
|
FText: string;
|
|
FMatchCase: Boolean;
|
|
FMatchWholeWord: Boolean;
|
|
public
|
|
constructor Create(const AText: string; AMatchCase, AMatchWholeWord: Boolean);
|
|
function IsSame(const AText: string; AMatchCase, AMatchWholeWord: Boolean): Boolean;
|
|
|
|
property Text: string read FText;
|
|
property MatchCase: Boolean read FMatchCase;
|
|
property MatchWholeWord: Boolean read FMatchWholeWord;
|
|
end;
|
|
|
|
function IsWhitespace(Ch: Char): Boolean;
|
|
begin
|
|
{$IFDEF FPC}
|
|
Result := TCharacter.IsWhiteSpace(Ch);
|
|
{$ELSE}
|
|
{$IF CompilerVersion >= 25.0} // XE4
|
|
Result := Ch.IsWhiteSpace;
|
|
{$ELSE}
|
|
Result := TCharacter.IsWhiteSpace(Ch);
|
|
{$IFEND}
|
|
{$ENDIF FPC}
|
|
end;
|
|
|
|
function VclAbortProc(Prn: HDC; Error: Integer): Bool; stdcall;
|
|
begin
|
|
Application.ProcessMessages;
|
|
Result := not Printer.Aborted;
|
|
end;
|
|
|
|
function FastVclAbortProc(Prn: HDC; Error: Integer): Bool; stdcall;
|
|
begin
|
|
Result := not Printer.Aborted;
|
|
end;
|
|
|
|
|
|
{ THighlightTextInfo }
|
|
|
|
constructor THighlightTextInfo.Create(const AText: string; AMatchCase, AMatchWholeWord: Boolean);
|
|
begin
|
|
inherited Create;
|
|
FText := AText;
|
|
FMatchCase := AMatchCase;
|
|
FMatchWholeWord := AMatchWholeWord;
|
|
end;
|
|
|
|
function THighlightTextInfo.IsSame(const AText: string; AMatchCase, AMatchWholeWord: Boolean): Boolean;
|
|
begin
|
|
Result := (AMatchCase = FMatchCase) and
|
|
(AMatchWholeWord = FMatchWholeWord) and
|
|
(AText = FText);
|
|
end;
|
|
|
|
{ TPdfDocumentVclPrinter }
|
|
|
|
function TPdfDocumentVclPrinter.PrinterStartDoc(const AJobTitle: string): Boolean;
|
|
begin
|
|
Result := False;
|
|
FPagePrinted := False;
|
|
if not Printer.Printing then
|
|
begin
|
|
if AJobTitle <> '' then
|
|
Printer.Title := AJobTitle;
|
|
Printer.BeginDoc;
|
|
FBeginDocCalled := Printer.Printing;
|
|
Result := FBeginDocCalled;
|
|
end;
|
|
if Result and Printer.Printing then
|
|
begin
|
|
// The Printers.AbortProc function calls ProcessMessages. That not only slows down the performance
|
|
// but it also allows the user to do things in the UI.
|
|
SetAbortProc(GetPrinterDC, @FastVclAbortProc);
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfDocumentVclPrinter.PrinterEndDoc;
|
|
begin
|
|
if Printer.Printing then
|
|
begin
|
|
SetAbortProc(GetPrinterDC, @VclAbortProc); // restore default behavior
|
|
if FBeginDocCalled then
|
|
Printer.EndDoc;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfDocumentVclPrinter.PrinterStartPage;
|
|
begin
|
|
// Printer has only "NewPage" and the very first page doesn't need a NewPage call because
|
|
// Printer.BeginDoc already called Windows.StartPage.
|
|
if (Printer.PageNumber > 1) or FPagePrinted then
|
|
Printer.NewPage;
|
|
end;
|
|
|
|
procedure TPdfDocumentVclPrinter.PrinterEndPage;
|
|
begin
|
|
FPagePrinted := True;
|
|
// The VCL uses "NewPage". For the very last page Printer.EndDoc calls Windows.EndPage.
|
|
end;
|
|
|
|
function TPdfDocumentVclPrinter.GetPrinterDC: HDC;
|
|
begin
|
|
Result := Printer.Canvas.Handle;
|
|
end;
|
|
|
|
class function TPdfDocumentVclPrinter.PrintDocument(ADocument: TPdfDocument;
|
|
const AJobTitle: string; AShowPrintDialog, AllowPageRange: Boolean; AParentWnd: HWND): Boolean;
|
|
var
|
|
PdfPrinter: TPdfDocumentVclPrinter;
|
|
Dlg: TPrintDialog;
|
|
FromPage, ToPage: Integer;
|
|
begin
|
|
Result := False;
|
|
if ADocument = nil then
|
|
Exit;
|
|
|
|
FromPage := 1;
|
|
ToPage := ADocument.PageCount;
|
|
|
|
if AShowPrintDialog then
|
|
begin
|
|
Dlg := TPrintDialog.Create(nil);
|
|
try
|
|
// Set the PrintDialog options
|
|
if AllowPageRange then
|
|
begin
|
|
Dlg.MinPage := 1;
|
|
Dlg.MaxPage := ADocument.PageCount;
|
|
Dlg.Options := Dlg.Options + [poPageNums];
|
|
end;
|
|
|
|
// Show the PrintDialog
|
|
{$IFDEF FPC}
|
|
Result := Dlg.Execute;
|
|
{$ELSE}
|
|
if (AParentWnd = 0) or not IsWindow(AParentWnd) then
|
|
Result := Dlg.Execute
|
|
else
|
|
Result := Dlg.Execute(AParentWnd);
|
|
{$ENDIF FPC}
|
|
|
|
if not Result then
|
|
Exit;
|
|
|
|
// Adjust print options
|
|
if AllowPageRange and (Dlg.PrintRange = prPageNums) then
|
|
begin
|
|
FromPage := Dlg.FromPage;
|
|
ToPage := Dlg.ToPage;
|
|
end;
|
|
finally
|
|
Dlg.Free;
|
|
end;
|
|
end;
|
|
|
|
PdfPrinter := TPdfDocumentVclPrinter.Create;
|
|
try
|
|
if PdfPrinter.BeginPrint(AJobTitle) then
|
|
begin
|
|
try
|
|
Result := PdfPrinter.Print(ADocument, FromPage - 1, ToPage - 1);
|
|
finally
|
|
PdfPrinter.EndPrint;
|
|
end;
|
|
end;
|
|
finally
|
|
PdfPrinter.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TPdfControl }
|
|
|
|
constructor TPdfControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csOpaque];
|
|
|
|
FScaleMode := smFitAuto;
|
|
FZoomPercentage := 100;
|
|
FPageColor := clWhite;
|
|
FRotation := prNormal;
|
|
FAllowUserTextSelection := True;
|
|
FAllowUserPageChange := True;
|
|
FAllowFormEvents := True;
|
|
FDrawOptions := cPdfControlDefaultDrawOptions;
|
|
FScrollTimer := True;
|
|
FBufferedPageDraw := True;
|
|
FLinkOptions := cPdfControlDefaultLinkOptions;
|
|
|
|
FPageBorderColor := clNone;
|
|
FPageShadowColor := clNone;
|
|
FPageShadowSize := 4;
|
|
FPageShadowPadding := 44;
|
|
|
|
FDocument := TPdfDocument.Create;
|
|
InitDocument;
|
|
|
|
ParentDoubleBuffered := False;
|
|
ParentBackground := False;
|
|
ParentColor := False;
|
|
TabStop := True;
|
|
Color := clGray;
|
|
Width := 130;
|
|
Height := 180;
|
|
end;
|
|
|
|
destructor TPdfControl.Destroy;
|
|
begin
|
|
if FPageBitmap <> 0 then
|
|
DeleteObject(FPageBitmap);
|
|
FreeAndNil(FWebLinkInfo);
|
|
FDocument.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TPdfControl.InitDocument;
|
|
begin
|
|
FDocument.OnFormInvalidate := FormInvalidate;
|
|
FDocument.OnFormOutputSelectedRect := FormOutputSelectedRect;
|
|
FDocument.OnFormGetCurrentPage := FormGetCurrentPage;
|
|
FDocument.OnFormFieldFocus := FormFieldFocus;
|
|
FDocument.OnExecuteNamedAction := ExecuteNamedAction;
|
|
end;
|
|
|
|
procedure TPdfControl.DestroyWnd;
|
|
begin
|
|
StopScrollTimer;
|
|
if FCheckForTrippleClick then
|
|
KillTimer(Handle, cTrippleClickTimerId);
|
|
inherited DestroyWnd;
|
|
end;
|
|
|
|
{$IFDEF USE_PRINTCLIENT_WORKAROUND}
|
|
procedure TPdfControl.WMPrintClient(var Message: TWMPrintClient);
|
|
// Emulate Delphi 2010's TControlState.csPrintClient
|
|
var
|
|
LastPrintClient: Boolean;
|
|
begin
|
|
LastPrintClient := FPrintClient;
|
|
try
|
|
FPrintClient := True;
|
|
inherited;
|
|
finally
|
|
FPrintClient := LastPrintClient;
|
|
end;
|
|
end;
|
|
{$ENDIF USE_PRINTCLIENT_WORKAROUND}
|
|
|
|
procedure TPdfControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
|
|
begin
|
|
Message.Result := 1;
|
|
end;
|
|
|
|
procedure TPdfControl.DrawAlphaSelection(DC: HDC; Page: TPdfPage; const Rects: TPdfRectArray);
|
|
begin
|
|
DrawAlphaRects(DC, Page, Rects, RGB(50, 142, 254));
|
|
end;
|
|
|
|
procedure TPdfControl.DrawAlphaRects(DC: HDC; Page: TPdfPage; const Rects: TPdfRectArray; Color: TColor);
|
|
var
|
|
Count: Integer;
|
|
I: Integer;
|
|
R: TRect;
|
|
BmpDC: HDC;
|
|
SelBmp: TBitmap;
|
|
BlendFunc: TBlendFunction;
|
|
begin
|
|
Count := Length(Rects);
|
|
if Count > 0 then
|
|
begin
|
|
SelBmp := TBitmap.Create;
|
|
try
|
|
SelBmp.Canvas.Brush.Color := Color;
|
|
SelBmp.SetSize(100, 50);
|
|
{$IFDEF FPC}
|
|
// Delphi fills the bitmap with the brush if it is resized, FPC doesn't
|
|
SelBmp.Canvas.FillRect(0, 0, SelBmp.Width, SelBmp.Height);
|
|
{$ENDIF FPC}
|
|
BlendFunc.BlendOp := AC_SRC_OVER;
|
|
BlendFunc.BlendFlags := 0;
|
|
BlendFunc.SourceConstantAlpha := 127;
|
|
BlendFunc.AlphaFormat := 0;
|
|
BmpDC := SelBmp.Canvas.Handle;
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
R := InternPageToDevice(Page, Rects[I], True);
|
|
if RectVisible(DC, R) then
|
|
AlphaBlend(DC, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
|
|
BmpDC, 0, 0, SelBmp.Width, SelBmp.Height,
|
|
BlendFunc);
|
|
end;
|
|
finally
|
|
SelBmp.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.DrawSelection(DC: HDC; Page: TPdfPage);
|
|
var
|
|
Count: Integer;
|
|
I: Integer;
|
|
Rects: TPdfRectArray;
|
|
begin
|
|
Count := Page.GetTextRectCount(SelStart, SelLength);
|
|
if Count > 0 then
|
|
begin
|
|
SetLength(Rects, Count);
|
|
for I := 0 to Count - 1 do
|
|
Rects[I] := Page.GetTextRect(I);
|
|
DrawAlphaSelection(DC, Page, Rects);
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.DrawFormOutputSelectedRects(DC: HDC; Page: TPdfPage);
|
|
begin
|
|
DrawAlphaSelection(DC, Page, FFormOutputSelectedRects);
|
|
end;
|
|
|
|
procedure TPdfControl.DrawHighlightText(DC: HDC; Page: TPdfPage);
|
|
begin
|
|
DrawAlphaRects(DC, Page, FHighlightTextRects, RGB(254, 142, 50));
|
|
end;
|
|
|
|
procedure TPdfControl.DrawBorderAndShadow(DC: HDC);
|
|
var
|
|
BorderBrush, ShadowBrush: HBRUSH;
|
|
begin
|
|
// Draw page borders
|
|
if PageBorderColor <> clNone then
|
|
begin
|
|
BorderBrush := CreateSolidBrush(ColorToRGB(PageBorderColor));
|
|
FillRect(DC, Rect(FDrawX, FDrawY, FDrawX + FDrawWidth, FDrawY + 1), BorderBrush); // top border
|
|
FillRect(DC, Rect(FDrawX, FDrawY, FDrawX + 1, FDrawY + FDrawHeight), BorderBrush); // left border
|
|
FillRect(DC, Rect(FDrawX + FDrawWidth - 1, FDrawY, FDrawX + FDrawWidth, FDrawY + FDrawHeight), BorderBrush); // right border
|
|
FillRect(DC, Rect(FDrawX, FDrawY + FDrawHeight - 1, FDrawX + FDrawWidth, FDrawY + FDrawHeight), BorderBrush); // bottom border
|
|
DeleteObject(BorderBrush);
|
|
end;
|
|
|
|
// Draw page shadow
|
|
if (PageShadowColor <> clNone) and (PageShadowSize > 0) then
|
|
begin
|
|
ShadowBrush := CreateSolidBrush(ColorToRGB(PageShadowColor));
|
|
FillRect(DC, Rect(FDrawX + FDrawWidth, FDrawY + PageShadowSize,
|
|
FDrawX + FDrawWidth + PageShadowSize, FDrawY + FDrawHeight + PageShadowSize),
|
|
ShadowBrush); // right shadow
|
|
FillRect(DC, Rect(FDrawX + PageShadowSize, FDrawY + FDrawHeight,
|
|
FDrawX + FDrawWidth + PageShadowSize, FDrawY + FDrawHeight + PageShadowSize),
|
|
ShadowBrush); // bottom shadow
|
|
DeleteObject(ShadowBrush);
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.DrawPage(DC: HDC; Page: TPdfPage; DirectDrawPage: Boolean);
|
|
|
|
procedure Draw(DC: HDC; X, Y: Integer; Page: TPdfPage);
|
|
var
|
|
PageBrush: HBRUSH;
|
|
ColorRef: TColorRef;
|
|
begin
|
|
if PageColor = clDefault then
|
|
ColorRef := ColorToRGB(Color)
|
|
else
|
|
ColorRef := ColorToRGB(PageColor);
|
|
|
|
// Page.Draw doesn't paint the background if proPrinting is enabled.
|
|
if proPrinting in FDrawOptions then
|
|
begin
|
|
PageBrush := CreateSolidBrush(ColorRef);
|
|
FillRect(DC, Rect(X, Y, X + FDrawWidth, Y + FDrawHeight), PageBrush);
|
|
DeleteObject(PageBrush);
|
|
end;
|
|
|
|
Page.Draw(DC, X, Y, FDrawWidth, FDrawHeight, Rotation, FDrawOptions, ColorRef);
|
|
end;
|
|
|
|
var
|
|
PageDC: HDC;
|
|
OldPageBmp: HBITMAP;
|
|
bmi: TBitmapInfo;
|
|
BmpData: Windows.TBitmap;
|
|
Bits: Pointer;
|
|
begin
|
|
if DirectDrawPage then
|
|
begin
|
|
if FPageBitmap <> 0 then
|
|
begin
|
|
DeleteObject(FPageBitmap);
|
|
FPageBitmap := 0;
|
|
end;
|
|
FRenderedPageIndex := -1;
|
|
Draw(DC, FDrawX, FDrawY, Page);
|
|
end
|
|
else
|
|
begin
|
|
if (FPageBitmap = 0) or
|
|
(GetObject(FPageBitmap, SizeOf(BmpData), @BmpData) <> SizeOf(BmpData)) or
|
|
(FDrawWidth <> BmpData.bmWidth) or
|
|
(FDrawHeight <> BmpData.bmHeight) then
|
|
begin
|
|
FRenderedPageIndex := -1; // force rendering
|
|
if FPageBitmap <> 0 then
|
|
DeleteObject(FPageBitmap);
|
|
if GetDeviceCaps(DC, BITSPIXEL) = 32 then
|
|
FPageBitmap := CreateCompatibleBitmap(DC, FDrawWidth, FDrawHeight)
|
|
else
|
|
begin
|
|
FillChar(bmi, SizeOf(bmi), 0);
|
|
bmi.bmiHeader.biSize := SizeOf(TBitmapInfoHeader);
|
|
bmi.bmiHeader.biWidth := FDrawWidth;
|
|
bmi.bmiHeader.biHeight := -FDrawHeight; // top-down
|
|
bmi.bmiHeader.biPlanes := 1;
|
|
bmi.bmiHeader.biBitCount := 32;
|
|
bmi.bmiHeader.biCompression := BI_RGB;
|
|
FPageBitmap := CreateDIBSection(DC, bmi, DIB_RGB_COLORS, Bits, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
PageDC := CreateCompatibleDC(DC);
|
|
OldPageBmp := SelectObject(PageDC, FPageBitmap);
|
|
try
|
|
if FRenderedPageIndex <> PageIndex then
|
|
begin
|
|
FRenderedPageIndex := PageIndex;
|
|
Draw(PageDC, 0, 0, Page);
|
|
end;
|
|
BitBlt(DC, FDrawX, FDrawY, FDrawWidth, FDrawHeight, PageDC, 0, 0, SRCCOPY);
|
|
finally
|
|
SelectObject(PageDC, OldPageBmp);
|
|
DeleteDC(PageDC);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.Paint;
|
|
var
|
|
Page: TPdfPage;
|
|
DC, DrawDC: HDC;
|
|
DrawBmp, OldDrawBmp: HBITMAP;
|
|
Rgn: HRGN;
|
|
DirectPageDraw: Boolean;
|
|
WndR, ClipR: TRect;
|
|
begin
|
|
DC := Canvas.Handle;
|
|
{$IFDEF REPAINTTEST}
|
|
FillRect(DC, ClientRect, GetStockObject(BLACK_BRUSH));
|
|
GdiFlush;
|
|
Sleep(70);
|
|
{$ENDIF REPAINTTEST}
|
|
|
|
if IsPageValid then
|
|
begin
|
|
DirectPageDraw := not BufferedPageDraw or
|
|
((Int64(FDrawWidth) * FDrawHeight) > (Int64(Width) * Height)) and
|
|
(Int64(FDrawWidth) * FDrawHeight > 4096*2160); // 4K is too much for the system resources
|
|
|
|
if DirectPageDraw or FSelectionActive or (FHighlightTextRects <> nil) then
|
|
begin
|
|
case GetClipBox(DC, ClipR) of
|
|
NULLREGION:
|
|
Exit; // nothing to paint
|
|
ERROR:
|
|
Windows.GetClientRect(Handle, ClipR);
|
|
end;
|
|
// Double buffer, minimal bitmap size
|
|
DrawDC := CreateCompatibleDC(DC);
|
|
DrawBmp := CreateCompatibleBitmap(DC, ClipR.Right - ClipR.Left, ClipR.Bottom - ClipR.Top);
|
|
OldDrawBmp := SelectObject(DrawDC, DrawBmp);
|
|
OffsetWindowOrgEx(DrawDC, ClipR.Left, ClipR.Top, nil);
|
|
|
|
// copy the clipping region and adjust to the bitmap's device units
|
|
Rgn := CreateRectRgn(0, 0, 1, 1);
|
|
{$IFDEF USE_PRINTCLIENT_WORKAROUND}
|
|
if FPrintClient then
|
|
{$ELSE}
|
|
if csPrintClient in ControlState then
|
|
{$ENDIF USE_PRINTCLIENT_WORKAROUND}
|
|
begin
|
|
if GetClipRgn(DC, Rgn) = 1 then // application clip region
|
|
begin
|
|
OffsetRgn(Rgn, -ClipR.Left, -ClipR.Top);
|
|
if SelectClipRgn(DrawDC, Rgn) = NULLREGION then
|
|
Exit; // nothing to paint
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if GetRandomRgn(DC, Rgn, SYSRGN) = 1 then // system clip region, set by BeginPaint, in screen coordinates
|
|
begin
|
|
GetWindowRect(Handle, WndR);
|
|
OffsetRgn(Rgn, -WndR.Left - ClipR.Left, -WndR.Top - ClipR.Top);
|
|
SelectClipRgn(DrawDC, Rgn);
|
|
if SelectClipRgn(DrawDC, Rgn) = NULLREGION then
|
|
Exit; // nothing to paint
|
|
end;
|
|
end;
|
|
DeleteObject(Rgn);
|
|
end
|
|
else
|
|
begin
|
|
DrawDC := DC;
|
|
DrawBmp := 0;
|
|
OldDrawBmp := 0;
|
|
end;
|
|
|
|
try
|
|
// Draw borders
|
|
FillRect(DrawDC, Rect(0, 0, Width, FDrawY), Brush.Handle); // top bar
|
|
FillRect(DrawDC, Rect(0, FDrawY, FDrawX, FDrawY + FDrawHeight), Brush.Handle); // left bar
|
|
FillRect(DrawDC, Rect(FDrawX + FDrawWidth, FDrawY, Width, FDrawY + FDrawHeight), Brush.Handle); // right bar
|
|
FillRect(DrawDC, Rect(0, FDrawY + FDrawHeight, Width, Height), Brush.Handle); // bottom bar
|
|
|
|
// Draw the page
|
|
Page := CurrentPage;
|
|
DrawPage(DrawDC, Page, DirectPageDraw);
|
|
// Draw the selection overlay
|
|
if FSelectionActive then
|
|
DrawSelection(DrawDC, Page);
|
|
|
|
DrawFormOutputSelectedRects(DrawDC, Page);
|
|
|
|
// Draw the highlighted text overlay
|
|
DrawHighlightText(DrawDC, Page);
|
|
|
|
DrawBorderAndShadow(DrawDC);
|
|
|
|
// User painting
|
|
if Assigned(FOnPaint) then
|
|
begin
|
|
Canvas.Handle := DrawDC;
|
|
try
|
|
FOnPaint(Self);
|
|
finally
|
|
Canvas.Handle := DC;
|
|
end;
|
|
end;
|
|
|
|
if DrawDC <> DC then
|
|
BitBlt(DC, 0, 0, Width, Height, DrawDC, 0, 0, SRCCOPY);
|
|
finally
|
|
if DrawBmp <> 0 then
|
|
begin
|
|
SelectObject(DrawDC, OldDrawBmp);
|
|
DeleteObject(DrawBmp);
|
|
end;
|
|
if DrawDC <> DC then
|
|
DeleteDC(DrawDC);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// empty page
|
|
if FPageBitmap <> 0 then
|
|
begin
|
|
DeleteObject(FPageBitmap);
|
|
FPageBitmap := 0;
|
|
end;
|
|
FillRect(DC, Rect(0, 0, Width, Height), Brush.Handle);
|
|
DrawBorderAndShadow(DC);
|
|
if Assigned(FOnPaint) then
|
|
FOnPaint(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.PageContentChanged(Closing: Boolean);
|
|
begin
|
|
FSelStartCharIndex := 0;
|
|
FSelStopCharIndex := 0;
|
|
FSelectionActive := False;
|
|
CalcHighlightTextRects;
|
|
GetPageWebLinks;
|
|
PageLayoutChanged;
|
|
if not Closing then
|
|
PageChange;
|
|
end;
|
|
|
|
procedure TPdfControl.PageLayoutChanged;
|
|
begin
|
|
FRenderedPageIndex := -1;
|
|
UpdatePageDrawInfo;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TPdfControl.InvalidatePage;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
FRenderedPageIndex := -1;
|
|
if HandleAllocated then
|
|
begin
|
|
R := GetPageRect;
|
|
InvalidateRect(Handle, @R, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.PrintDocument;
|
|
begin
|
|
if Document.Active then
|
|
begin
|
|
if Assigned(FOnPrintDocument) then
|
|
FOnPrintDocument(Self)
|
|
else
|
|
TPdfDocumentVclPrinter.PrintDocument(Document, ExtractFileName(Document.FileName));
|
|
end;
|
|
end;
|
|
|
|
function TPdfControl.GetCurrentPage: TPdfPage;
|
|
begin
|
|
if IsPageValid then
|
|
Result := FDocument.Pages[PageIndex]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TPdfControl.GetPageCount: Integer;
|
|
begin
|
|
Result := FDocument.PageCount;
|
|
end;
|
|
|
|
procedure TPdfControl.SetPageIndex(Value: Integer);
|
|
begin
|
|
InternSetPageIndex(Value, False, False);
|
|
end;
|
|
|
|
function TPdfControl.InternSetPageIndex(Value: Integer; ScrollTransition, InverseScrollTransition: Boolean): Boolean;
|
|
var
|
|
ScrollInfo: TScrollInfo;
|
|
ScrollY: Integer;
|
|
OldPageIndex: Integer;
|
|
begin
|
|
if Value >= PageCount then
|
|
Value := PageCount - 1;
|
|
if Value < 0 then
|
|
Value := 0;
|
|
|
|
if Value <> FPageIndex then
|
|
begin
|
|
ClearSelection;
|
|
// Close the previous page to keep memory usage low (especially for large PDF files)
|
|
if (FPageIndex >= 0) and (FPageIndex < PageCount) and FDocument.IsPageLoaded(FPageIndex) and
|
|
not FDocument.Pages[FPageIndex].Annotations.AnnotationsLoaded then // Issue #28: Don't close the page if annotations are loaded
|
|
begin
|
|
FDocument.Pages[FPageIndex].Close;
|
|
end;
|
|
OldPageIndex := FPageIndex;
|
|
FPageIndex := Value;
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
if ScrollTransition then
|
|
begin
|
|
// Keep the Scroll XOffset but scroll the page to the top or the bottom depending on the
|
|
// PageIndex change.
|
|
ScrollY := 0;
|
|
ScrollInfo.fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
|
|
if GetScrollInfo(Handle, SB_VERT, ScrollInfo) then
|
|
begin
|
|
if InverseScrollTransition then
|
|
begin
|
|
if FPageIndex < OldPageIndex then
|
|
ScrollY := 0
|
|
else
|
|
ScrollY := ScrollInfo.nMax {- Integer(ScrollInfo.nPage)};
|
|
end
|
|
else
|
|
begin
|
|
if FPageIndex > OldPageIndex then
|
|
ScrollY := 0
|
|
else
|
|
ScrollY := ScrollInfo.nMax {- Integer(ScrollInfo.nPage)};
|
|
end;
|
|
end;
|
|
if ScrollInfo.nPos <> ScrollY then
|
|
begin
|
|
ScrollInfo.fMask := SIF_POS;
|
|
ScrollInfo.nPos := ScrollY;
|
|
SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
|
|
end;
|
|
end
|
|
else // Scroll to the page to the left/top corner
|
|
begin
|
|
ScrollInfo.fMask := SIF_POS;
|
|
ScrollInfo.nPos := 0;
|
|
SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
|
|
SetScrollInfo(Handle, SB_HORZ, ScrollInfo, True);
|
|
end;
|
|
PageContentChanged(False);
|
|
Result := True;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function TPdfControl.GotoNextPage(ScrollTransition: Boolean): Boolean;
|
|
begin
|
|
Result := PageIndex < PageCount - 1;
|
|
if Result then
|
|
InternSetPageIndex(PageIndex + 1, ScrollTransition, False);
|
|
end;
|
|
|
|
function TPdfControl.GotoPrevPage(ScrollTransition: Boolean): Boolean;
|
|
begin
|
|
Result := PageIndex > 0;
|
|
if Result then
|
|
InternSetPageIndex(PageIndex - 1, ScrollTransition, False);
|
|
end;
|
|
|
|
procedure TPdfControl.PageChange;
|
|
begin
|
|
if Assigned(FOnPageChange) then
|
|
FOnPageChange(Self);
|
|
end;
|
|
|
|
function TPdfControl.IsPageValid: Boolean;
|
|
begin
|
|
Result := FDocument.Active and (PageIndex < PageCount);
|
|
end;
|
|
|
|
procedure TPdfControl.DocumentLoaded;
|
|
begin
|
|
FPageIndex := 0;
|
|
PageContentChanged(False);
|
|
end;
|
|
|
|
procedure TPdfControl.OpenWithDocument(Document: TPdfDocument);
|
|
begin
|
|
Close;
|
|
if Document = nil then
|
|
Exit;
|
|
|
|
FreeAndNil(FDocument);
|
|
FDocument := Document;
|
|
InitDocument;
|
|
end;
|
|
|
|
procedure TPdfControl.LoadFromCustom(ReadFunc: TPdfDocumentCustomReadProc; Size: LongWord;
|
|
Param: Pointer; const Password: UTF8String);
|
|
begin
|
|
try
|
|
FDocument.LoadFromCustom(ReadFunc, Size, Param, Password);
|
|
finally
|
|
DocumentLoaded;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.LoadFromActiveStream(Stream: TStream; const Password: UTF8String);
|
|
begin
|
|
try
|
|
FDocument.LoadFromActiveStream(Stream, Password);
|
|
finally
|
|
DocumentLoaded;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.LoadFromActiveBuffer(Buffer: Pointer; Size: Int64; const Password: UTF8String);
|
|
begin
|
|
try
|
|
FDocument.LoadFromActiveBuffer(Buffer, Size, Password);
|
|
finally
|
|
DocumentLoaded;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.LoadFromBytes(const Bytes: TBytes; Index, Count: Integer;
|
|
const Password: UTF8String);
|
|
begin
|
|
try
|
|
FDocument.LoadFromBytes(Bytes, Index, Count, Password);
|
|
finally
|
|
DocumentLoaded;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.LoadFromBytes(const Bytes: TBytes; const Password: UTF8String);
|
|
begin
|
|
try
|
|
FDocument.LoadFromBytes(Bytes, Password);
|
|
finally
|
|
DocumentLoaded;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.LoadFromStream(Stream: TStream; const Password: UTF8String);
|
|
begin
|
|
try
|
|
FDocument.LoadFromStream(Stream, Password);
|
|
finally
|
|
DocumentLoaded;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.LoadFromFile(const FileName: string; const Password: UTF8String;
|
|
LoadOption: TPdfDocumentLoadOption);
|
|
begin
|
|
try
|
|
FDocument.LoadFromFile(FileName, Password, LoadOption);
|
|
finally
|
|
DocumentLoaded;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.Close;
|
|
begin
|
|
FDocument.Close;
|
|
FPageIndex := 0;
|
|
FFormFieldFocused := False;
|
|
PageContentChanged(True);
|
|
end;
|
|
|
|
procedure TPdfControl.CMColorchanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if PageColor = clDefault then
|
|
PageLayoutChanged
|
|
else
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TPdfControl.Resize;
|
|
begin
|
|
UpdatePageDrawInfo;
|
|
inherited Resize;
|
|
end;
|
|
|
|
procedure TPdfControl.SetScaleMode(const Value: TPdfControlScaleMode);
|
|
begin
|
|
if Value <> FScaleMode then
|
|
begin
|
|
FScaleMode := Value;
|
|
UpdatePageDrawInfo;
|
|
PageLayoutChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.SetZoomPercentage(Value: Integer);
|
|
begin
|
|
if Value < 1 then
|
|
Value := 1
|
|
else if Value > 10000 then
|
|
Value := 10000;
|
|
if Value <> FZoomPercentage then
|
|
begin
|
|
FZoomPercentage := Value;
|
|
PageLayoutChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.SetPageColor(const Value: TColor);
|
|
begin
|
|
if Value <> FPageColor then
|
|
begin
|
|
FPageColor := Value;
|
|
InvalidatePage;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.SetDrawOptions(const Value: TPdfPageRenderOptions);
|
|
begin
|
|
if Value <> FDrawOptions then
|
|
begin
|
|
FDrawOptions := Value;
|
|
InvalidatePage;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.SetRotation(const Value: TPdfPageRotation);
|
|
begin
|
|
if Value <> FRotation then
|
|
begin
|
|
FRotation := Value;
|
|
PageLayoutChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.SetPageBorderColor(const Value: TColor);
|
|
begin
|
|
if Value <> FPageBorderColor then
|
|
begin
|
|
FPageBorderColor := Value;
|
|
InvalidatePage;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.SetPageShadowColor(const Value: TColor);
|
|
begin
|
|
if Value <> FPageShadowColor then
|
|
begin
|
|
FPageShadowColor := Value;
|
|
InvalidatePage;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.SetPageShadowPadding(const Value: Integer);
|
|
begin
|
|
if Value <> FPageShadowPadding then
|
|
begin
|
|
FPageShadowPadding := Value;
|
|
InvalidatePage;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.SetPageShadowSize(const Value: Integer);
|
|
begin
|
|
if Value <> FPageShadowSize then
|
|
begin
|
|
FPageShadowSize := Value;
|
|
InvalidatePage;
|
|
end;
|
|
end;
|
|
|
|
function TPdfControl.GetPageRect: TRect;
|
|
begin
|
|
Result := Rect(FDrawX, FDrawY, FDrawX + FDrawWidth, FDrawY + FDrawHeight);
|
|
end;
|
|
|
|
function TPdfControl.DeviceToPage(DeviceX, DeviceY: Integer): TPdfPoint;
|
|
var
|
|
Page: TPdfPage;
|
|
begin
|
|
Page := CurrentPage;
|
|
if Page <> nil then
|
|
Result := Page.DeviceToPage(FDrawX, FDrawY, FDrawWidth, FDrawHeight, DeviceX, DeviceY, Rotation)
|
|
else
|
|
Result := TPdfPoint.Empty;
|
|
end;
|
|
|
|
function TPdfControl.DeviceToPage(DeviceRect: TRect): TPdfRect;
|
|
var
|
|
Page: TPdfPage;
|
|
begin
|
|
Page := CurrentPage;
|
|
if Page <> nil then
|
|
Result := Page.DeviceToPage(FDrawX, FDrawY, FDrawWidth, FDrawHeight, DeviceRect, Rotation)
|
|
else
|
|
Result := TPdfRect.Empty;
|
|
end;
|
|
|
|
function TPdfControl.PageToDevice(PageX, PageY: Double): TPoint;
|
|
var
|
|
Page: TPdfPage;
|
|
begin
|
|
Page := CurrentPage;
|
|
if Page <> nil then
|
|
Result := Page.PageToDevice(FDrawX, FDrawY, FDrawWidth, FDrawHeight, PageX, PageY, Rotation)
|
|
else
|
|
Result := Point(0, 0);
|
|
end;
|
|
|
|
function TPdfControl.PageToDevice(PageRect: TPdfRect): TRect;
|
|
var
|
|
Page: TPdfPage;
|
|
begin
|
|
Page := CurrentPage;
|
|
if Page <> nil then
|
|
Result := Page.PageToDevice(FDrawX, FDrawY, FDrawWidth, FDrawHeight, PageRect, Rotation)
|
|
else
|
|
Result := Rect(0, 0, 0, 0);
|
|
end;
|
|
|
|
function TPdfControl.InternPageToDevice(Page: TPdfPage; PageRect: TPdfRect; ANormalize: Boolean): TRect;
|
|
var
|
|
Value: Integer;
|
|
begin
|
|
Result := Page.PageToDevice(FDrawX, FDrawY, FDrawWidth, FDrawHeight, PageRect, Rotation);
|
|
if ANormalize then
|
|
begin
|
|
if Result.Left > Result.Right then
|
|
begin
|
|
Value := Result.Right;
|
|
Result.Right := Result.Left;
|
|
Result.Left := Value;
|
|
end;
|
|
if Result.Top > Result.Bottom then
|
|
begin
|
|
Value := Result.Bottom;
|
|
Result.Bottom := Result.Top;
|
|
Result.Top := Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TPdfControl.SetSelStopCharIndex(X, Y: Integer): Boolean;
|
|
var
|
|
PagePt: TPdfPoint;
|
|
CharIndex: Integer;
|
|
Active: Boolean;
|
|
R: TRect;
|
|
Page: TPdfPage;
|
|
begin
|
|
Page := CurrentPage;
|
|
if Page <> nil then
|
|
begin
|
|
PagePt := DeviceToPage(X, Y);
|
|
CharIndex := Page.GetCharIndexAt(PagePt.X, PagePt.Y, MAXWORD, MAXWORD);
|
|
Result := CharIndex >= 0;
|
|
if not Result then
|
|
CharIndex := FSelStopCharIndex;
|
|
|
|
if FSelStartCharIndex <> CharIndex then
|
|
Active := True
|
|
else
|
|
begin
|
|
R := PageToDevice(Page.GetCharBox(FSelStartCharIndex));
|
|
Active := PtInRect(R, FMouseDownPt) xor PtInRect(R, Point(X, Y));
|
|
end;
|
|
SetSelection(Active, FSelStartCharIndex, CharIndex);
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TPdfControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
PagePt: TPdfPoint;
|
|
CharIndex: Integer;
|
|
Page: TPdfPage;
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if Button = mbLeft then
|
|
begin
|
|
StopScrollTimer;
|
|
SetFocus;
|
|
FMousePressed := True;
|
|
FMouseDownPt := Point(X, Y); // used to find out if the selection must be cleared or not
|
|
end;
|
|
|
|
Page := CurrentPage;
|
|
if Page <> nil then
|
|
begin
|
|
if AllowFormEvents then
|
|
begin
|
|
PagePt := DeviceToPage(X, Y);
|
|
if Button = mbLeft then
|
|
begin
|
|
if Page.FormEventLButtonDown(Shift, PagePt.X, PagePt.Y) then
|
|
Exit;
|
|
end
|
|
else if Button = mbRight then
|
|
begin
|
|
if Page.FormEventFocus(Shift, PagePt.X, PagePt.Y) then
|
|
Exit;
|
|
if Page.FormEventRButtonDown(Shift, PagePt.X, PagePt.Y) then
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
if AllowUserTextSelection and not FFormFieldFocused then
|
|
begin
|
|
if Button = mbLeft then
|
|
begin
|
|
PagePt := DeviceToPage(X, Y);
|
|
CharIndex := Page.GetCharIndexAt(PagePt.X, PagePt.Y, MAXWORD, MAXWORD);
|
|
if FCheckForTrippleClick and (CharIndex >= SelStart) and (CharIndex < SelStart + SelLength) then
|
|
begin
|
|
FMousePressed := False;
|
|
KillTimer(Handle, cTrippleClickTimerId);
|
|
FCheckForTrippleClick := False;
|
|
SelectLine(CharIndex);
|
|
end
|
|
else if ssDouble in Shift then
|
|
begin
|
|
FMousePressed := False;
|
|
SelectWord(CharIndex);
|
|
FCheckForTrippleClick := True;
|
|
SetTimer(Handle, cTrippleClickTimerId, GetDoubleClickTime, nil);
|
|
end
|
|
else
|
|
begin
|
|
FCheckForTrippleClick := False;
|
|
SetSelection(False, CharIndex, CharIndex);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
PagePt: TPdfPoint;
|
|
Url: string;
|
|
Page: TPdfPage;
|
|
LinkAnnotation: TPdfAnnotation;
|
|
LinkInfo: TPdfLinkInfo;
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
|
|
if AllowFormEvents and IsPageValid then
|
|
begin
|
|
PagePt := DeviceToPage(X, Y);
|
|
Page := CurrentPage;
|
|
if (Button = mbLeft) and Page.FormEventLButtonUp(Shift, PagePt.X, PagePt.Y) then
|
|
begin
|
|
if FMousePressed and (Button = mbLeft) then
|
|
begin
|
|
FMousePressed := False;
|
|
StopScrollTimer;
|
|
end;
|
|
Exit;
|
|
end;
|
|
if (Button = mbRight) and Page.FormEventRButtonUp(Shift, PagePt.X, PagePt.Y) then
|
|
Exit;
|
|
end;
|
|
|
|
if FMousePressed then
|
|
begin
|
|
if Button = mbLeft then
|
|
begin
|
|
FMousePressed := False;
|
|
StopScrollTimer;
|
|
if AllowUserTextSelection and not FFormFieldFocused then
|
|
SetSelStopCharIndex(X, Y);
|
|
if not FSelectionActive then
|
|
begin
|
|
if LinkHandlingNeeded then
|
|
begin
|
|
LinkAnnotation := GetAnnotationLinkAt(X, Y);
|
|
LinkInfo := nil;
|
|
if LinkAnnotation <> nil then
|
|
LinkInfo := TPdfLinkInfo.Create(LinkAnnotation, '')
|
|
else if IsWebLinkAt(X, Y, Url) then // If we have a Link Annotation and a WebLink, then the link annotation is prefered
|
|
begin
|
|
if loTreatWebLinkAsUriAnnotationLink in LinkOptions then
|
|
LinkInfo := TPdfLinkInfo.Create(nil, Url)
|
|
else
|
|
WebLinkClick(Url);
|
|
end;
|
|
if LinkInfo <> nil then
|
|
begin
|
|
try
|
|
AnnotationLinkClick(LinkInfo);
|
|
finally
|
|
LinkInfo.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
PagePt: TPdfPoint;
|
|
Style: NativeInt;
|
|
NewCursor: TCursor;
|
|
Page: TPdfPage;
|
|
Proceed: Boolean;
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
NewCursor := Cursor;
|
|
try
|
|
if AllowFormEvents and IsPageValid then
|
|
begin
|
|
PagePt := DeviceToPage(X, Y);
|
|
Page := CurrentPage;
|
|
if Page.FormEventMouseMove(Shift, PagePt.X, PagePt.Y) then
|
|
begin
|
|
Proceed := False;
|
|
case Page.HasFormFieldAtPoint(PagePt.X, PagePt.Y) of
|
|
fftUnknown:
|
|
// Could be a annotation link with a URL
|
|
Proceed := True;
|
|
fftTextField:
|
|
NewCursor := crIBeam;
|
|
fftComboBox,
|
|
fftSignature:
|
|
NewCursor := crHandPoint;
|
|
else
|
|
NewCursor := crDefault;
|
|
end;
|
|
if not Proceed then
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
if AllowUserTextSelection and not FFormFieldFocused then
|
|
begin
|
|
if FMousePressed then
|
|
begin
|
|
// Auto scroll
|
|
FScrollMousePos := Point(X, Y);
|
|
Style := GetWindowLong(Handle, GWL_STYLE);
|
|
if ((Style and WS_VSCROLL <> 0) and ((Y < 0) or (Y > Height))) or
|
|
((Style and WS_HSCROLL <> 0) and ((X < 0) or (X > Width))) then
|
|
begin
|
|
if ScrollTimer and not FScrollTimerActive then
|
|
begin
|
|
SetTimer(Handle, cScrollTimerId, cScrollTimerInterval, nil);
|
|
FScrollTimerActive := True;
|
|
end;
|
|
end
|
|
else
|
|
StopScrollTimer;
|
|
|
|
if SetSelStopCharIndex(X, Y) then
|
|
begin
|
|
if NewCursor <> crIBeam then
|
|
begin
|
|
NewCursor := crIBeam;
|
|
Cursor := NewCursor;
|
|
SetCursor(Screen.Cursors[Cursor]); // show the mouse cursor change immediately
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if IsPageValid then
|
|
begin
|
|
PagePt := DeviceToPage(X, Y);
|
|
if IsClickableLinkAt(X, Y) then
|
|
NewCursor := crHandPoint
|
|
else if CurrentPage.GetCharIndexAt(PagePt.X, PagePt.Y, 5, 5) >= 0 then
|
|
NewCursor := crIBeam
|
|
else if Cursor <> crDefault then
|
|
NewCursor := crDefault;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
if NewCursor <> Cursor then
|
|
Cursor := NewCursor;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.CMMouseleave(var Message: TMessage);
|
|
begin
|
|
if (Cursor = crIBeam) or (Cursor = crHandPoint) then
|
|
begin
|
|
if AllowUserTextSelection or Assigned(FOnWebLinkClick) or Assigned(FOnAnnotationLinkClick) or (LinkOptions <> []) then
|
|
Cursor := crDefault;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
function TPdfControl.GetTextInRect(const R: TRect): string;
|
|
begin
|
|
if IsPageValid then
|
|
Result := CurrentPage.GetTextAt(DeviceToPage(R))
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
procedure TPdfControl.CopyToClipboard;
|
|
begin
|
|
Clipboard.AsText := GetSelText;
|
|
end;
|
|
|
|
procedure TPdfControl.CopyFormTextToClipboard;
|
|
var
|
|
S: string;
|
|
begin
|
|
if FFormFieldFocused and IsPageValid then
|
|
begin
|
|
S := CurrentPage.FormGetSelectedText;
|
|
if S <> '' then
|
|
Clipboard.AsText := S;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.CutFormTextToClipboard;
|
|
begin
|
|
if FFormFieldFocused and IsPageValid then
|
|
begin
|
|
CopyFormTextToClipboard;
|
|
CurrentPage.FormReplaceSelection('');
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.PasteFormTextFromClipboard;
|
|
begin
|
|
if FFormFieldFocused and IsPageValid then
|
|
begin
|
|
Clipboard.Open;
|
|
try
|
|
if Clipboard.HasFormat(CF_UNICODETEXT) or Clipboard.HasFormat(CF_TEXT) then
|
|
CurrentPage.FormReplaceSelection(Clipboard.AsText);
|
|
finally
|
|
Clipboard.Close;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.SelectAllFormText;
|
|
begin
|
|
if FFormFieldFocused and IsPageValid then
|
|
CurrentPage.FormSelectAllText;
|
|
end;
|
|
|
|
function TPdfControl.GetSelText: string;
|
|
begin
|
|
if FSelectionActive and IsPageValid then
|
|
Result := CurrentPage.ReadText(SelStart, SelLength)
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TPdfControl.GetSelLength: Integer;
|
|
begin
|
|
if FSelectionActive and IsPageValid then
|
|
Result := Abs(FSelStartCharIndex - FSelStopCharIndex) + 1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TPdfControl.GetSelStart: Integer;
|
|
begin
|
|
if FSelectionActive and IsPageValid then
|
|
Result := Min(FSelStartCharIndex, FSelStopCharIndex)
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TPdfControl.GetSelectionRects: TPdfControlRectArray;
|
|
var
|
|
Count: Integer;
|
|
I: Integer;
|
|
Page: TPdfPage;
|
|
begin
|
|
if FSelectionActive and HandleAllocated then
|
|
begin
|
|
Page := CurrentPage;
|
|
if Page <> nil then
|
|
begin
|
|
Count := Page.GetTextRectCount(SelStart, SelLength);
|
|
SetLength(Result, Count);
|
|
for I := 0 to Count - 1 do
|
|
Result[I] := InternPageToDevice(Page, Page.GetTextRect(I), True);
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TPdfControl.InvalidateRectDiffs(const OldRects, NewRects: TPdfControlRectArray);
|
|
|
|
function ContainsRect(const Rects: TPdfControlRectArray; const R: TRect): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := True;
|
|
for I := 0 to Length(Rects) - 1 do
|
|
if (Rects[I].Left = R.Left) and (Rects[I].Top = R.Top) and (Rects[I].Right = R.Right) and (Rects[I].Bottom = R.Bottom) then
|
|
Exit;
|
|
Result := False;
|
|
end;
|
|
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if HandleAllocated then
|
|
begin
|
|
for I := 0 to Length(OldRects) - 1 do
|
|
if not ContainsRect(NewRects, OldRects[I]) then
|
|
InvalidateRect(Handle, @OldRects[I], True);
|
|
|
|
for I := 0 to Length(NewRects) - 1 do
|
|
if not ContainsRect(OldRects, NewRects[I]) then
|
|
InvalidateRect(Handle, @NewRects[I], True);
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.InvalidatePdfRectDiffs(const OldRects, NewRects: TPdfRectArray);
|
|
var
|
|
I: Integer;
|
|
OldRs, NewRs: TPdfControlRectArray;
|
|
Page: TPdfPage;
|
|
begin
|
|
Page := CurrentPage;
|
|
if (Page <> nil) and HandleAllocated then
|
|
begin
|
|
SetLength(OldRs, Length(OldRects));
|
|
for I := 0 to Length(OldRects) - 1 do
|
|
OldRs[I] := InternPageToDevice(Page, OldRects[I], True);
|
|
|
|
SetLength(NewRs, Length(NewRects));
|
|
for I := 0 to Length(NewRects) - 1 do
|
|
NewRs[I] := InternPageToDevice(Page, NewRects[I], True);
|
|
|
|
InvalidateRectDiffs(OldRs, NewRs);
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.SetSelection(Active: Boolean; StartIndex, StopIndex: Integer);
|
|
var
|
|
OldRects, NewRects: TPdfControlRectArray;
|
|
begin
|
|
if (Active <> FSelectionActive) or (StartIndex <> FSelStartCharIndex) or (StopIndex <> FSelStopCharIndex) then
|
|
begin
|
|
OldRects := GetSelectionRects;
|
|
|
|
FSelStartCharIndex := StartIndex;
|
|
FSelStopCharIndex := StopIndex;
|
|
FSelectionActive := Active and (FSelStartCharIndex >= 0) and (FSelStopCharIndex >= 0);
|
|
|
|
NewRects := GetSelectionRects;
|
|
InvalidateRectDiffs(OldRects, NewRects);
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.ClearSelection;
|
|
begin
|
|
SetSelection(False, 0, 0);
|
|
end;
|
|
|
|
procedure TPdfControl.SelectAll;
|
|
begin
|
|
SelectText(0, -1);
|
|
end;
|
|
|
|
procedure TPdfControl.SelectText(CharIndex, Count: Integer);
|
|
begin
|
|
if (Count = 0) or not IsPageValid then
|
|
ClearSelection
|
|
else
|
|
begin
|
|
if Count = -1 then
|
|
SetSelection(True, 0, CurrentPage.GetCharCount - 1)
|
|
else
|
|
SetSelection(True, CharIndex, Min(CharIndex + Count - 1, CurrentPage.GetCharCount - 1));
|
|
end;
|
|
end;
|
|
|
|
function TPdfControl.SelectWord(CharIndex: Integer): Boolean;
|
|
var
|
|
Ch: WideChar;
|
|
StartCharIndex, StopCharIndex, CharCount: Integer;
|
|
Page: TPdfPage;
|
|
begin
|
|
Result := False;
|
|
Page := CurrentPage;
|
|
if Page <> nil then
|
|
begin
|
|
ClearSelection;
|
|
CharCount := Page.GetCharCount;
|
|
if (CharIndex >= 0) and (CharIndex < CharCount) then
|
|
begin
|
|
while (CharIndex < CharCount) and IsWhiteSpace(Page.ReadChar(CharIndex)) do
|
|
Inc(CharIndex);
|
|
|
|
if CharIndex < CharCount then
|
|
begin
|
|
StartCharIndex := CharIndex - 1;
|
|
while StartCharIndex >= 0 do
|
|
begin
|
|
Ch := Page.ReadChar(StartCharIndex);
|
|
if IsWhiteSpace(Ch) then
|
|
Break;
|
|
Dec(StartCharIndex);
|
|
end;
|
|
Inc(StartCharIndex);
|
|
|
|
StopCharIndex := CharIndex + 1;
|
|
while StopCharIndex < CharCount do
|
|
begin
|
|
Ch := Page.ReadChar(StopCharIndex);
|
|
if IsWhiteSpace(Ch) then
|
|
Break;
|
|
Inc(StopCharIndex);
|
|
end;
|
|
Dec(StopCharIndex);
|
|
|
|
SetSelection(True, StartCharIndex, StopCharIndex);
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TPdfControl.SelectLine(CharIndex: Integer): Boolean;
|
|
var
|
|
Ch: WideChar;
|
|
StartCharIndex, StopCharIndex, CharCount: Integer;
|
|
Page: TPdfPage;
|
|
begin
|
|
Result := False;
|
|
Page := CurrentPage;
|
|
if Page <> nil then
|
|
begin
|
|
ClearSelection;
|
|
CharCount := Page.GetCharCount;
|
|
if (CharIndex >= 0) and (CharIndex < CharCount) then
|
|
begin
|
|
StartCharIndex := CharIndex - 1;
|
|
while StartCharIndex >= 0 do
|
|
begin
|
|
Ch := Page.ReadChar(StartCharIndex);
|
|
case Ch of
|
|
#10, #13:
|
|
Break;
|
|
end;
|
|
Dec(StartCharIndex);
|
|
end;
|
|
Inc(StartCharIndex);
|
|
|
|
StopCharIndex := CharIndex + 1;
|
|
while StopCharIndex < CharCount do
|
|
begin
|
|
Ch := Page.ReadChar(StopCharIndex);
|
|
case Ch of
|
|
#10, #13:
|
|
Break;
|
|
end;
|
|
Inc(StopCharIndex);
|
|
end;
|
|
Dec(StopCharIndex);
|
|
|
|
SetSelection(True, StartCharIndex, StopCharIndex);
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.WMGetDlgCode(var Message: TWMGetDlgCode);
|
|
begin
|
|
inherited;
|
|
Message.Result := Message.Result or DLGC_WANTARROWS or DLGC_WANTTAB;
|
|
end;
|
|
|
|
procedure TPdfControl.KeyDown(var Key: Word; Shift: TShiftState);
|
|
var
|
|
XOffset, YOffset: Integer;
|
|
ScrollInfo: TScrollInfo;
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
XOffset := 0;
|
|
YOffset := 0;
|
|
case Key of
|
|
Ord('C'), VK_INSERT:
|
|
if AllowUserTextSelection then
|
|
begin
|
|
if Shift = [ssCtrl] then
|
|
begin
|
|
if FSelectionActive then
|
|
CopyToClipboard;
|
|
Key := 0;
|
|
end
|
|
end;
|
|
|
|
Ord('A'):
|
|
if AllowUserTextSelection then
|
|
begin
|
|
if Shift = [ssCtrl] then
|
|
begin
|
|
SelectAll;
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
VK_LEFT, VK_RIGHT:
|
|
begin
|
|
if ssShift in Shift then
|
|
XOffset := cDefaultScrollOffset * 2
|
|
else
|
|
XOffset := cDefaultScrollOffset;
|
|
if Key = VK_LEFT then
|
|
XOffset := -XOffset;
|
|
end;
|
|
|
|
VK_UP, VK_DOWN:
|
|
begin
|
|
if ssShift in Shift then
|
|
YOffset := cDefaultScrollOffset * 2
|
|
else
|
|
YOffset := cDefaultScrollOffset;
|
|
if Key = VK_UP then
|
|
YOffset := -YOffset;
|
|
end;
|
|
|
|
VK_PRIOR, VK_NEXT:
|
|
begin
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_PAGE or SIF_RANGE or SIF_POS;
|
|
if AllowUserPageChange and (GetWindowLong(Handle, GWL_STYLE) and WS_VSCROLL = 0) then
|
|
begin
|
|
if Key = VK_NEXT then
|
|
GotoNextPage(True)
|
|
else
|
|
GotoPrevPage(True);
|
|
end
|
|
else if GetScrollInfo(Handle, SB_VERT, ScrollInfo) then
|
|
begin
|
|
if Key = VK_NEXT then
|
|
begin
|
|
if AllowUserPageChange and (ScrollInfo.nPos >= ScrollInfo.nMax - Integer(ScrollInfo.nPage)) then
|
|
GotoNextPage(True)
|
|
else
|
|
YOffset := ScrollInfo.nPage
|
|
end
|
|
else
|
|
begin
|
|
if AllowUserPageChange and (ScrollInfo.nPos = 0) then
|
|
GotoPrevPage(True)
|
|
else
|
|
YOffset := -ScrollInfo.nPage;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
VK_HOME, VK_END:
|
|
begin
|
|
if ssCtrl in Shift then
|
|
begin
|
|
if Key = VK_HOME then
|
|
InternSetPageIndex(0, True, True)
|
|
else
|
|
InternSetPageIndex(PageCount - 1, True, True);
|
|
end
|
|
else
|
|
begin
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_RANGE;
|
|
|
|
if ssShift in Shift then
|
|
begin
|
|
if GetScrollInfo(Handle, SB_HORZ, ScrollInfo) then
|
|
begin
|
|
if Key = VK_END then
|
|
XOffset := ScrollInfo.nMax
|
|
else
|
|
XOffset := -ScrollInfo.nMax;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if GetScrollInfo(Handle, SB_VERT, ScrollInfo) then
|
|
begin
|
|
if Key = VK_END then
|
|
YOffset := ScrollInfo.nMax
|
|
else
|
|
YOffset := -ScrollInfo.nMax;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if (XOffset <> 0) or (YOffset <> 0) then
|
|
begin
|
|
ScrollContent(XOffset, YOffset, SmoothScroll);
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.WMKeyDown(var Message: TWMKeyDown);
|
|
var
|
|
Shift: TShiftState;
|
|
begin
|
|
if AllowFormEvents and IsPageValid then
|
|
begin
|
|
Shift := KeyDataToShiftState(Message.KeyData);
|
|
if CurrentPage.FormEventKeyDown(Message.CharCode, Shift) then
|
|
begin
|
|
// PDFium doesn't handle Copy&Paste&Cut keyboard shortcuts in form fields
|
|
case Message.CharCode of
|
|
Ord('C'), Ord('X'), Ord('V'), VK_INSERT, VK_DELETE:
|
|
begin
|
|
if Shift = [ssCtrl] then
|
|
begin
|
|
case Message.CharCode of
|
|
Ord('C'), VK_INSERT:
|
|
CopyFormTextToClipboard;
|
|
Ord('X'):
|
|
CutFormTextToClipboard;
|
|
Ord('V'):
|
|
PasteFormTextFromClipboard;
|
|
end;
|
|
end
|
|
else if Shift = [ssShift] then
|
|
begin
|
|
case Message.CharCode of
|
|
VK_INSERT:
|
|
PasteFormTextFromClipboard;
|
|
VK_DELETE:
|
|
CutFormTextToClipboard;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
Exit;
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TPdfControl.WMKeyUp(var Message: TWMKeyUp);
|
|
begin
|
|
if AllowFormEvents and IsPageValid
|
|
and CurrentPage.FormEventKeyUp(Message.CharCode, KeyDataToShiftState(Message.KeyData)) then
|
|
Exit;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TPdfControl.WMChar(var Message: TWMChar);
|
|
begin
|
|
if AllowFormEvents and IsPageValid
|
|
and CurrentPage.FormEventKeyPress(Message.CharCode, KeyDataToShiftState(Message.KeyData)) then
|
|
Exit;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TPdfControl.WMKillFocus(var Message: TWMKillFocus);
|
|
begin
|
|
if AllowFormEvents and IsPageValid then
|
|
CurrentPage.FormEventKillFocus;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TPdfControl.GetPageWebLinks;
|
|
var
|
|
Page: TPdfPage;
|
|
begin
|
|
FreeAndNil(FWebLinkInfo);
|
|
Page := CurrentPage;
|
|
if Page <> nil then
|
|
FWebLinkInfo := TPdfPageWebLinksInfo.Create(Page);
|
|
end;
|
|
|
|
function TPdfControl.LinkHandlingNeeded: Boolean;
|
|
begin
|
|
// If an event handler is assigned, we need link handling
|
|
Result := Assigned(FOnAnnotationLinkClick) or Assigned(FOnWebLinkClick);
|
|
if not Result then
|
|
begin
|
|
// If no event handler is assigned, we may need link handling depending on the loAutoXXX options.
|
|
Result := LinkOptions * cPdfControlAllAutoLinkOptions <> [];
|
|
end;
|
|
end;
|
|
|
|
function TPdfControl.IsClickableLinkAt(X, Y: Integer): Boolean;
|
|
var
|
|
LinkAnnotation: TPdfAnnotation;
|
|
begin
|
|
Result := False;
|
|
if LinkHandlingNeeded then
|
|
begin
|
|
LinkAnnotation := GetAnnotationLinkAt(X, Y);
|
|
if LinkAnnotation <> nil then
|
|
begin
|
|
if Assigned(FOnAnnotationLinkClick) then
|
|
Result := True
|
|
else
|
|
begin
|
|
case LinkAnnotation.LinkType of
|
|
altGoto:
|
|
Result := loAutoGoto in LinkOptions;
|
|
altRemoteGoto:
|
|
Result := loAutoRemoteGotoReplaceDocument in LinkOptions;
|
|
altURI:
|
|
Result := (loAutoOpenURI in LinkOptions) or (loAlwaysDetectWebAndUriLink in LinkOptions) or Assigned(FOnWebLinkClick); // Fallback to OnWebLinkClick for URIs
|
|
altLaunch:
|
|
Result := loAutoLaunch in LinkOptions;
|
|
altEmbeddedGoto:
|
|
Result := loAutoEmbeddedGotoReplaceDocument in LinkOptions;
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
end
|
|
else if IsWebLinkAt(X, Y) then
|
|
begin
|
|
if Assigned(FOnWebLinkClick) or (loAlwaysDetectWebAndUriLink in LinkOptions) then
|
|
Result := True
|
|
else if Assigned(FOnAnnotationLinkClick) and (loTreatWebLinkAsUriAnnotationLink in LinkOptions) then
|
|
Result := True
|
|
else if not Assigned(FOnAnnotationLinkClick) and (loTreatWebLinkAsUriAnnotationLink in LinkOptions) and (loAutoOpenURI in LinkOptions) then
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TPdfControl.IsWebLinkAt(X, Y: Integer): Boolean;
|
|
var
|
|
PdfPt: TPdfPoint;
|
|
begin
|
|
if (FWebLinkInfo <> nil) and IsPageValid then
|
|
begin
|
|
PdfPt := DeviceToPage(X, Y);
|
|
Result := FWebLinkInfo.IsWebLinkAt(PdfPt.X, PdfPt.Y);
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function TPdfControl.IsWebLinkAt(X, Y: Integer; var Url: string): Boolean;
|
|
var
|
|
PdfPt: TPdfPoint;
|
|
begin
|
|
Url := '';
|
|
if (FWebLinkInfo <> nil) and IsPageValid then
|
|
begin
|
|
PdfPt := DeviceToPage(X, Y);
|
|
Result := FWebLinkInfo.IsWebLinkAt(PdfPt.X, PdfPt.Y, Url);
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function TPdfControl.IsUriAnnotationLinkAt(X, Y: Integer): Boolean;
|
|
var
|
|
PdfPt: TPdfPoint;
|
|
begin
|
|
if IsPageValid then
|
|
begin
|
|
PdfPt := DeviceToPage(X, Y);
|
|
Result := CurrentPage.IsUriLinkAtPoint(PdfPt.X, PdfPt.Y);
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function TPdfControl.IsAnnotationLinkAt(X, Y: Integer): Boolean;
|
|
begin
|
|
Result := GetAnnotationLinkAt(X, Y) <> nil;
|
|
end;
|
|
|
|
function TPdfControl.GetAnnotationLinkAt(X, Y: Integer): TPdfAnnotation;
|
|
var
|
|
PdfPt: TPdfPoint;
|
|
begin
|
|
if IsPageValid then
|
|
begin
|
|
PdfPt := DeviceToPage(X, Y);
|
|
Result := CurrentPage.GetLinkAtPoint(PdfPt.X, PdfPt.Y);
|
|
end
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TPdfControl.ShellOpenFileName(const FileName: string; Launch: Boolean): Boolean;
|
|
var
|
|
Info: TShellExecuteInfoW;
|
|
begin
|
|
FillChar(Info, SizeOf(Info), 0);
|
|
Info.cbSize := SizeOf(Info);
|
|
if HandleAllocated then
|
|
Info.Wnd := Handle;
|
|
if Launch then
|
|
Info.lpVerb := nil
|
|
else
|
|
Info.lpVerb := 'open';
|
|
Info.lpFile := PChar(FileName);
|
|
Info.lpDirectory := PChar(ExtractFileDir(Document.FileName));
|
|
Info.nShow := SW_NORMAL;
|
|
Result := ShellExecuteExW(@Info);
|
|
end;
|
|
|
|
procedure TPdfControl.WebLinkClick(const Url: string);
|
|
begin
|
|
if Assigned(FOnWebLinkClick) then
|
|
FOnWebLinkClick(Self, Url);
|
|
end;
|
|
|
|
function TPdfControl.GotoDestination(const LinkGotoDestination: TPdfLinkGotoDestination): Boolean;
|
|
var
|
|
X, Y: Double;
|
|
//Zoom: Integer;
|
|
Pt: TPoint;
|
|
begin
|
|
Result := False;
|
|
if Document.Active then
|
|
begin
|
|
X := 0;
|
|
Y := 0;
|
|
//Zoom := 100;
|
|
if LinkGotoDestination.XValid then
|
|
X := LinkGotoDestination.X;
|
|
if LinkGotoDestination.YValid then
|
|
Y := LinkGotoDestination.Y;
|
|
//if Dest.ZoomValid then
|
|
// Zoom := Int(Dest.Zoom);
|
|
|
|
if (LinkGotoDestination.PageIndex >= 0) and (LinkGotoDestination.PageIndex < Document.PageCount) then
|
|
begin
|
|
Pt := PageToDevice(X, Y);
|
|
|
|
PageIndex := LinkGotoDestination.PageIndex;
|
|
//ZoomPercentage := Zoom;
|
|
ScrollContentTo(Pt.X, Pt.Y);
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.AnnotationLinkClick(LinkInfo: TPdfLinkInfo);
|
|
var
|
|
Handled: Boolean;
|
|
Dest: TPdfLinkGotoDestination;
|
|
FileName: string;
|
|
RemoteDoc: TPdfDocument;
|
|
DestValid: Boolean;
|
|
AttachmentIndex: Integer;
|
|
begin
|
|
Handled := False;
|
|
if not Document.Active then
|
|
Exit;
|
|
|
|
if Assigned(FOnAnnotationLinkClick) then
|
|
FOnAnnotationLinkClick(Self, LinkInfo, Handled)
|
|
else if Assigned(FOnWebLinkClick) and (LinkInfo.LinkType = altURI) and not (loAutoOpenURI in LinkOptions) then
|
|
begin
|
|
WebLinkClick(LinkInfo.LinkUri);
|
|
Exit;
|
|
end;
|
|
|
|
if not Handled and Document.Active then
|
|
begin
|
|
case LinkInfo.LinkType of
|
|
altGoto:
|
|
if loAutoGoto in LinkOptions then
|
|
begin
|
|
if LinkInfo.GetLinkGotoDestination(Dest) then
|
|
GotoDestination(Dest);
|
|
end;
|
|
|
|
altRemoteGoto:
|
|
if loAutoRemoteGotoReplaceDocument in LinkOptions then
|
|
begin
|
|
Dest := nil;
|
|
RemoteDoc := TPdfDocument.Create;
|
|
try
|
|
// Open the remote document
|
|
RemoteDoc.LoadFromFile(LinkInfo.LinkFileName);
|
|
// Get the link destination from the remote document
|
|
DestValid := LinkInfo.GetLinkGotoDestination(Dest, RemoteDoc);
|
|
except
|
|
RemoteDoc.Free;
|
|
raise;
|
|
end;
|
|
if DestValid then
|
|
begin
|
|
// Replace the current document with the remote document
|
|
OpenWithDocument(RemoteDoc);
|
|
GotoDestination(Dest);
|
|
end;
|
|
end;
|
|
|
|
altURI:
|
|
if loAutoOpenURI in LinkOptions then
|
|
ShellOpenFileName(LinkInfo.LinkUri, False);
|
|
|
|
altLaunch:
|
|
if loAutoLaunch in LinkOptions then
|
|
ShellOpenFileName(LinkInfo.LinkFileName, True);
|
|
|
|
altEmbeddedGoto:
|
|
if loAutoEmbeddedGotoReplaceDocument in LinkOptions then
|
|
begin
|
|
FileName := LinkInfo.LinkFileName;
|
|
AttachmentIndex := Document.Attachments.IndexOf(FileName);
|
|
if AttachmentIndex <> -1 then
|
|
begin
|
|
// Same as RemoteGoto but with a byte array
|
|
Dest := nil;
|
|
RemoteDoc := TPdfDocument.Create;
|
|
try
|
|
// Open the embedded document
|
|
RemoteDoc.LoadFromBytes(Document.Attachments[AttachmentIndex].GetContentAsBytes);
|
|
// Get the link destination from the remote document
|
|
DestValid := LinkInfo.GetLinkGotoDestination(Dest, RemoteDoc);
|
|
except
|
|
RemoteDoc.Free;
|
|
raise;
|
|
end;
|
|
if DestValid then
|
|
begin
|
|
// Replace the current document with the remote document
|
|
OpenWithDocument(RemoteDoc);
|
|
GotoDestination(Dest);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.UpdatePageDrawInfo;
|
|
|
|
procedure GetWidthHeight(PageWidth, PageHeight: Double; DpiX, DpiY, MaxWidth, MaxHeight: Integer; var W, H: Integer);
|
|
begin
|
|
case ScaleMode of
|
|
smFitAuto:
|
|
begin
|
|
W := Round(MaxHeight * (PageWidth / PageHeight));
|
|
H := MaxHeight;
|
|
if W > MaxWidth then
|
|
begin
|
|
W := MaxWidth;
|
|
H := Round(MaxWidth * (PageHeight / PageWidth));
|
|
end;
|
|
end;
|
|
|
|
smFitWidth:
|
|
begin
|
|
W := MaxWidth;
|
|
H := Round(MaxWidth * (PageHeight / PageWidth));
|
|
end;
|
|
|
|
smFitHeight:
|
|
begin
|
|
W := Round(MaxHeight * (PageWidth / PageHeight));
|
|
H := MaxHeight;
|
|
end;
|
|
|
|
smZoom: // PDFium's 100% is not AcrobatReader's 100%
|
|
begin
|
|
W := Round(PageWidth / 72 * DpiX * (ZoomPercentage / 100));
|
|
H := Round(PageHeight / 72 * DpiY * (ZoomPercentage / 100));
|
|
end;
|
|
end;
|
|
|
|
if (PageShadowColor <> clNone) and (PageShadowSize > 0) and (PageShadowPadding > 0) then
|
|
begin
|
|
W := W - (PageShadowPadding + PageShadowSize);
|
|
H := H - (PageShadowPadding + PageShadowSize);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
Page: TPdfPage;
|
|
MaxWidth, MaxHeight: Integer;
|
|
W, H: Integer;
|
|
PageWidth, PageHeight: Double;
|
|
DpiX, DpiY: Integer;
|
|
ScrollInfo: TScrollInfo;
|
|
Style: NativeInt;
|
|
begin
|
|
Page := CurrentPage;
|
|
if (Page <> nil) and (Page.Width > 0) and (Page.Height > 0) and HandleAllocated then
|
|
begin
|
|
Style := GetWindowLong(Handle, GWL_STYLE);
|
|
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_RANGE or SIF_PAGE;
|
|
ScrollInfo.nMin := 0;
|
|
|
|
// Take "Rotation" into account
|
|
if Rotation in [prNormal, pr180] then
|
|
begin
|
|
PageWidth := Page.Width;
|
|
PageHeight := Page.Height;
|
|
DpiX := GetDeviceCaps(Canvas.Handle, LOGPIXELSX);
|
|
DpiY := GetDeviceCaps(Canvas.Handle, LOGPIXELSY);
|
|
end
|
|
else
|
|
begin
|
|
PageHeight := Page.Width;
|
|
PageWidth := Page.Height;
|
|
DpiY := GetDeviceCaps(Canvas.Handle, LOGPIXELSX);
|
|
DpiX := GetDeviceCaps(Canvas.Handle, LOGPIXELSY);
|
|
end;
|
|
|
|
|
|
MaxWidth := Width;
|
|
MaxHeight := Height;
|
|
GetWidthHeight(PageWidth, PageHeight, DpiX, DpiY, MaxWidth, MaxHeight, W, H);
|
|
if W > MaxWidth then
|
|
begin
|
|
MaxHeight := MaxHeight - GetSystemMetrics(SM_CYHSCROLL);
|
|
GetWidthHeight(PageWidth, PageHeight, DpiX, DpiY, MaxWidth, MaxHeight, W, H);
|
|
end;
|
|
if H > MaxHeight then
|
|
begin
|
|
MaxWidth := MaxWidth - GetSystemMetrics(SM_CXVSCROLL);
|
|
GetWidthHeight(PageWidth, PageHeight, DpiX, DpiY, MaxWidth, MaxHeight, W, H);
|
|
end;
|
|
|
|
if W > MaxWidth then
|
|
begin
|
|
ScrollInfo.nMax := W;
|
|
ScrollInfo.nPage := MaxWidth;
|
|
SetScrollInfo(Handle, SB_HORZ, ScrollInfo, True);
|
|
end
|
|
else
|
|
begin
|
|
if Style and WS_HSCROLL <> 0 then
|
|
begin
|
|
ShowScrollBar(Handle, SB_HORZ, False);
|
|
RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME);
|
|
InvalidateRect(Handle, nil, True);
|
|
end;
|
|
end;
|
|
|
|
if H > MaxHeight then
|
|
begin
|
|
ScrollInfo.nMax := H;
|
|
ScrollInfo.nPage := MaxHeight;
|
|
SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
|
|
ShowScrollBar(Handle, SB_VERT, True);
|
|
end
|
|
else
|
|
begin
|
|
if Style and WS_VSCROLL <> 0 then
|
|
begin
|
|
ShowScrollBar(Handle, SB_VERT, False);
|
|
RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME);
|
|
InvalidateRect(Handle, nil, True);
|
|
end;
|
|
end;
|
|
|
|
FDrawWidth := W;
|
|
FDrawHeight := H;
|
|
AdjustDrawPos;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.AdjustDrawPos;
|
|
var
|
|
ScrollInfo: TScrollInfo;
|
|
X, Y, HPos, VPos: Integer;
|
|
Style: NativeInt;
|
|
MaxWidth: Integer;
|
|
MaxHeight: Integer;
|
|
begin
|
|
Style := GetWindowLong(Handle, GWL_STYLE);
|
|
MaxWidth := Width;
|
|
MaxHeight := Height;
|
|
HPos := 0;
|
|
VPos := 0;
|
|
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_POS;
|
|
if (Style and WS_HSCROLL <> 0) then
|
|
begin
|
|
MaxHeight := MaxHeight - GetSystemMetrics(SM_CXHSCROLL);
|
|
if GetScrollInfo(Handle, SB_HORZ, ScrollInfo) then
|
|
HPos := ScrollInfo.nPos;
|
|
end;
|
|
if (Style and WS_VSCROLL <> 0) then
|
|
begin
|
|
MaxWidth := MaxWidth - GetSystemMetrics(SM_CXVSCROLL);
|
|
if GetScrollInfo(Handle, SB_VERT, ScrollInfo) then
|
|
VPos := ScrollInfo.nPos;
|
|
end;
|
|
|
|
X := (MaxWidth - FDrawWidth) div 2;
|
|
Y := (MaxHeight - FDrawHeight) div 2;
|
|
if X < 0 then
|
|
X := 0;
|
|
if Y < 0 then
|
|
Y := 0;
|
|
|
|
Dec(X, HPos);
|
|
Dec(Y, VPos);
|
|
if (FDrawX <> X) or (FDrawY <> Y) then
|
|
begin
|
|
FDrawX := X;
|
|
FDrawY := Y;
|
|
end;
|
|
end;
|
|
|
|
function TPdfControl.ScrollContent(XOffset, YOffset: Integer; Smooth: Boolean): Boolean;
|
|
var
|
|
ScrollInfo: TScrollInfo;
|
|
X, Y: Integer;
|
|
Style: NativeInt;
|
|
Flags: UINT;
|
|
begin
|
|
if Smooth then
|
|
Update;
|
|
|
|
Style := GetWindowLong(Handle, GWL_STYLE);
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_POS;
|
|
|
|
// Vertical scroll
|
|
if (YOffset <> 0) and (Style and WS_VSCROLL <> 0) and GetScrollInfo(Handle, SB_VERT, ScrollInfo) then
|
|
begin
|
|
Y := ScrollInfo.nPos;
|
|
ScrollInfo.nPos := Y + YOffset;
|
|
SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
|
|
GetScrollInfo(Handle, SB_VERT, ScrollInfo); // let Windows do the range checking
|
|
YOffset := Y - ScrollInfo.nPos;
|
|
end
|
|
else
|
|
YOffset := 0;
|
|
|
|
// Horizontal scroll
|
|
if (XOffset <> 0) and (Style and WS_HSCROLL <> 0) and GetScrollInfo(Handle, SB_HORZ, ScrollInfo) then
|
|
begin
|
|
X := ScrollInfo.nPos;
|
|
ScrollInfo.nPos := X + XOffset;
|
|
SetScrollInfo(Handle, SB_HORZ, ScrollInfo, True);
|
|
GetScrollInfo(Handle, SB_HORZ, ScrollInfo); // let Windows do the range checking
|
|
XOffset := X - ScrollInfo.nPos;
|
|
end
|
|
else
|
|
XOffset := 0;
|
|
|
|
if (XOffset <> 0) or (YOffset <> 0) then
|
|
begin
|
|
AdjustDrawPos; // adjust DrawX/DrawY for ScrollWindowEx
|
|
Flags := 0;
|
|
if Smooth then
|
|
Flags := Flags or SW_SMOOTHSCROLL or (150 shl 16);
|
|
ScrollWindowEx(Handle, XOffset, YOffset, nil, nil, 0, nil, SW_INVALIDATE or Flags);
|
|
UpdateWindow(Handle);
|
|
Result := True;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function TPdfControl.ScrollContentTo(X, Y: Integer; Smooth: Boolean = False): Boolean;
|
|
var
|
|
ScrollInfo: TScrollInfo;
|
|
XOffset, YOffset: Integer;
|
|
begin
|
|
XOffset := 0;
|
|
YOffset := 0;
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_POS;
|
|
if GetScrollInfo(Handle, SB_HORZ, ScrollInfo) then
|
|
XOffset := X - ScrollInfo.nPos;
|
|
if GetScrollInfo(Handle, SB_VERT, ScrollInfo) then
|
|
YOffset := Y - ScrollInfo.nPos;
|
|
Result := ScrollContent(XOffset, YOffset, Smooth);
|
|
end;
|
|
|
|
procedure TPdfControl.WMVScroll(var Message: TWMVScroll);
|
|
var
|
|
ScrollInfo: TScrollInfo;
|
|
Offset: Integer;
|
|
begin
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_ALL;
|
|
GetScrollInfo(Handle, SB_VERT, ScrollInfo);
|
|
Offset := 0;
|
|
case Message.ScrollCode of
|
|
SB_LINEUP:
|
|
Offset := -cDefaultScrollOffset;
|
|
SB_LINEDOWN:
|
|
Offset := cDefaultScrollOffset;
|
|
SB_PAGEUP:
|
|
Offset := -ScrollInfo.nPage;
|
|
SB_PAGEDOWN:
|
|
Offset := ScrollInfo.nPage;
|
|
SB_THUMBTRACK:
|
|
Offset := ScrollInfo.nTrackPos - ScrollInfo.nPos;
|
|
end;
|
|
ScrollContent(0, Offset, SmoothScroll);
|
|
Message.Result := 0;
|
|
end;
|
|
|
|
procedure TPdfControl.WMHScroll(var Message: TWMHScroll);
|
|
var
|
|
ScrollInfo: TScrollInfo;
|
|
Offset: Integer;
|
|
begin
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_ALL;
|
|
GetScrollInfo(Handle, SB_HORZ, ScrollInfo);
|
|
Offset := 0;
|
|
case Message.ScrollCode of
|
|
SB_LINELEFT:
|
|
Offset := -cDefaultScrollOffset;
|
|
SB_LINERIGHT:
|
|
Offset := cDefaultScrollOffset;
|
|
SB_PAGELEFT:
|
|
Offset := -ScrollInfo.nPage;
|
|
SB_PAGERIGHT:
|
|
Offset := ScrollInfo.nPage;
|
|
SB_THUMBTRACK:
|
|
Offset := ScrollInfo.nTrackPos - ScrollInfo.nPos;
|
|
end;
|
|
ScrollContent(Offset, 0, SmoothScroll);
|
|
Message.Result := 0;
|
|
end;
|
|
|
|
function TPdfControl.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
|
|
MousePos: TPoint): Boolean;
|
|
var
|
|
PagePt: TPdfPoint;
|
|
begin
|
|
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
|
|
|
|
if not Result then
|
|
begin
|
|
if IsPageValid and AllowFormEvents then
|
|
begin
|
|
PagePt := DeviceToPage(MousePos.X, MousePos.Y);
|
|
if CurrentPage.FormEventMouseWheel(Shift, WheelDelta, PagePt.X, PagePt.Y) then
|
|
Exit;
|
|
end;
|
|
|
|
if ssCtrl in Shift then
|
|
begin
|
|
if ScaleMode = smZoom then
|
|
begin
|
|
ZoomPercentage := ZoomPercentage + (WheelDelta div WHEEL_DELTA) * 5;
|
|
Result := True;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if ssShift in Shift then
|
|
Result := ScrollContent(-WheelDelta, 0, SmoothScroll)
|
|
else
|
|
Result := ScrollContent(0, -WheelDelta, SmoothScroll);
|
|
|
|
if not Result and FChangePageOnMouseScrolling then
|
|
begin
|
|
if WheelDelta < 0 then
|
|
GotoNextPage()
|
|
else if PageIndex > 0 then
|
|
begin
|
|
GotoPrevPage();
|
|
ScrollContentTo(0, MaxInt);
|
|
end;
|
|
end
|
|
else
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.WMTimer(var Message: TWMTimer);
|
|
var
|
|
XOffset, YOffset: Integer;
|
|
begin
|
|
case Message.TimerID of
|
|
cScrollTimerId:
|
|
begin
|
|
if FMousePressed and FScrollTimerActive then
|
|
begin
|
|
XOffset := 0;
|
|
YOffset := 0;
|
|
if FScrollMousePos.X < 0 then
|
|
XOffset := -cDefaultScrollOffset
|
|
else if FScrollMousePos.X >= Width then
|
|
XOffset := cDefaultScrollOffset
|
|
else if FScrollMousePos.Y < 0 then
|
|
YOffset := -cDefaultScrollOffset
|
|
else if FScrollMousePos.Y >= Height then
|
|
YOffset := cDefaultScrollOffset;
|
|
ScrollContent(XOffset, YOffset, SmoothScroll);
|
|
end
|
|
else
|
|
StopScrollTimer;
|
|
end;
|
|
|
|
cTrippleClickTimerId:
|
|
begin
|
|
FCheckForTrippleClick := False;
|
|
KillTimer(Handle, cTrippleClickTimerId);
|
|
end;
|
|
else
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.StopScrollTimer;
|
|
begin
|
|
if FScrollTimerActive then
|
|
begin
|
|
KillTimer(Handle, cScrollTimerId);
|
|
FScrollTimerActive := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.HightlightText(const SearchText: string; MatchCase, MatchWholeWord: Boolean);
|
|
begin
|
|
if FHighlightTexts <> nil then
|
|
FHighlightTexts.Clear;
|
|
AddHightlightText(SearchText, MatchCase, MatchWholeWord);
|
|
end;
|
|
|
|
procedure TPdfControl.AddHightlightText(const SearchText: string; MatchCase, MatchWholeWord: Boolean);
|
|
var
|
|
HLTextInfo: THighlightTextInfo;
|
|
I: Integer;
|
|
begin
|
|
if SearchText = '' then
|
|
Exit;
|
|
|
|
// Prevent duplicates
|
|
if FHighlightTexts <> nil then
|
|
for I := 0 to FHighlightTexts.Count - 1 do
|
|
if (FHighlightTexts[I] as THighlightTextInfo).IsSame(SearchText, MatchCase, MatchWholeWord) then
|
|
Exit;
|
|
|
|
if FHighlightTexts = nil then
|
|
FHighlightTexts := TObjectList.Create;
|
|
HLTextInfo := THighlightTextInfo.Create(SearchText, MatchCase, MatchWholeWord);
|
|
FHighlightTexts.Add(HLTextInfo);
|
|
|
|
CalcHighlightTextRects;
|
|
end;
|
|
|
|
procedure TPdfControl.CalcHighlightTextRects;
|
|
var
|
|
OldHighlightTextRects: TPdfRectArray;
|
|
HLTextInfo: THighlightTextInfo;
|
|
Page: TPdfPage;
|
|
CharIndex, CharCount, I, Count, TextsIndex: Integer;
|
|
Num: Integer;
|
|
begin
|
|
OldHighlightTextRects := FHighlightTextRects;
|
|
FHighlightTextRects := nil;
|
|
if (FHighlightTexts <> nil) and (FHighlightTexts.Count > 0) and IsPageValid then
|
|
begin
|
|
Page := CurrentPage;
|
|
Num := 0;
|
|
for TextsIndex := 0 to FHighlightTexts.Count - 1 do
|
|
begin
|
|
HLTextInfo := FHighlightTexts[TextsIndex] as THighlightTextInfo;
|
|
if HLTextInfo.Text <> '' then // prevent infinite loop in FPDFText_FindNext()
|
|
begin
|
|
if Page.BeginFind(HLTextInfo.Text, HLTextInfo.MatchCase, HLTextInfo.MatchWholeWord, False) then
|
|
begin
|
|
try
|
|
while Page.FindNext(CharIndex, CharCount) do
|
|
begin
|
|
Count := Page.GetTextRectCount(CharIndex, CharCount);
|
|
if Num + Count > Length(FHighlightTextRects) then
|
|
SetLength(FHighlightTextRects, (Num + Count) * 2);
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
FHighlightTextRects[Num] := Page.GetTextRect(I);
|
|
Inc(Num);
|
|
end;
|
|
end;
|
|
finally
|
|
Page.EndFind;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// truncate to the actual number
|
|
if Num <> Length(FHighlightTextRects) then
|
|
SetLength(FHighlightTextRects, Num);
|
|
end;
|
|
InvalidatePdfRectDiffs(OldHighlightTextRects, FHighlightTextRects);
|
|
end;
|
|
|
|
procedure TPdfControl.ClearHighlightText;
|
|
begin
|
|
FreeAndNil(FHighlightTexts);
|
|
InvalidatePdfRectDiffs(FHighlightTextRects, nil);
|
|
FHighlightTextRects := nil;
|
|
end;
|
|
|
|
procedure TPdfControl.FormInvalidate(Document: TPdfDocument; Page: TPdfPage;
|
|
const PageRect: TPdfRect);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
FRenderedPageIndex := -1; // content has changed => render into the background bitmap
|
|
FFormOutputSelectedRects := nil;
|
|
if HandleAllocated then
|
|
begin
|
|
R := InternPageToDevice(Page, PageRect, True);
|
|
InvalidateRect(Handle, @R, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.FormOutputSelectedRect(Document: TPdfDocument; Page: TPdfPage;
|
|
const PageRect: TPdfRect);
|
|
begin
|
|
if HandleAllocated then
|
|
begin
|
|
SetLength(FFormOutputSelectedRects, Length(FFormOutputSelectedRects) + 1);
|
|
FFormOutputSelectedRects[Length(FFormOutputSelectedRects) - 1] := PageRect;
|
|
end;
|
|
end;
|
|
|
|
procedure TPdfControl.FormGetCurrentPage(Document: TPdfDocument; var Page: TPdfPage);
|
|
begin
|
|
Page := CurrentPage;
|
|
end;
|
|
|
|
procedure TPdfControl.FormFieldFocus(Document: TPdfDocument; Value: PWideChar;
|
|
ValueLen: Integer; FieldFocused: Boolean);
|
|
begin
|
|
ClearSelection;
|
|
FFormFieldFocused := FieldFocused;
|
|
end;
|
|
|
|
procedure TPdfControl.ExecuteNamedAction(Document: TPdfDocument; NamedAction: TPdfNamedActionType);
|
|
begin
|
|
case NamedAction of
|
|
naPrint:
|
|
PrintDocument;
|
|
naNextPage:
|
|
PageIndex := PageIndex + 1;
|
|
naPrevPage:
|
|
PageIndex := PageIndex - 1;
|
|
naFirstPage:
|
|
PageIndex := 0;
|
|
naLastPage:
|
|
PageIndex := Document.PageCount - 1;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|