2000 lines
59 KiB
ObjectPascal
2000 lines
59 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvPrvwDoc.pas, released on 2003-01-01.
|
|
|
|
The Initial Developer of the Original Code is Peter Thörnqvist.
|
|
Portions created by Peter Thörnqvist are Copyright (c) 2003 by Peter Thörnqvist.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.sourceforge.net
|
|
|
|
TODO :
|
|
* Adjust zoom when Cols or Rows change - DONE
|
|
* Adjust Cols and/or Rows when Zoom changes - DONE
|
|
* Center pages in view - DONE
|
|
* Only show horizontal scroll when page is too large (1 page), otherwise size Cols to fit - DONE
|
|
+ Draw to offscreen bitmap - DONE
|
|
* Handle wheel scroll (scroll: up-down / shift+scroll: left-right) - DONE
|
|
* Implement TopRow, First, Next, Prior, Last - DONE
|
|
* Page Number Hints when thumb scrolling - DONE
|
|
* User configurable margins (could use DeviceInfo.OffsetLeft etc but needs to
|
|
be available in inch/mm as well) - DONE
|
|
|
|
* Handle getting/setting SelectedPage (click on page -> select it)
|
|
* Draw "fake" text when page is small (like Word does)?
|
|
* Handle Home, End, PgUp, PgDn (w. Ctrl?)
|
|
|
|
KNOWN ISSUES:
|
|
* smScale doesn't work in all cases
|
|
* centering doesn't always work
|
|
* scrolling down and then changing properties (like Cols or Scale) doesn't always reposition the
|
|
view and the scrollbars correctly
|
|
* sometimes displays more pages (rows) than requested
|
|
|
|
Scrolling rules:
|
|
* if showing 1 page (page >= clientrect), show horz scrollbar, set scroll size ~ 1 line
|
|
* if showing more than one col/row, hide horz scroll and scale pages to fit
|
|
(i.e if Cols = 3, Rows = 2 -> scale to show 3x2 pages)
|
|
and scroll Rows pages on each click (i.e if Rows = 4 -> scroll 4 pages)
|
|
* if scaling would make pages too small, show as many pages as possible
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvPrvwDoc.pas 11057 2006-11-29 14:32:05Z marquardt $
|
|
|
|
unit JvPrvwDoc;
|
|
|
|
{$I jvcl.inc}
|
|
{$I windowsonly.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls,
|
|
Forms, Dialogs,
|
|
JvComponent, JvExControls;
|
|
|
|
type
|
|
TJvPreviewScaleMode = (
|
|
smFullPage, // always show 1 full page
|
|
smPageWidth, // always show max page width
|
|
smScale, // always use scale, don't change cols and rows
|
|
smAutoScale, // always use scale, change cols and rows to fit
|
|
smColsRows); // use cols and rows
|
|
|
|
TJvDrawPreviewEvent = procedure(Sender: TObject; PageIndex: Integer; Canvas: TCanvas;
|
|
PageRect, PrintRect: TRect) of object;
|
|
TJvDrawPageEvent = procedure(Sender: TObject; PageIndex: Integer; Canvas: TCanvas;
|
|
PageRect, PrintRect: TRect; var NeedMorePages: Boolean) of object;
|
|
TJvScrollHintEvent = procedure(Sender: TObject; AScrollPos: Integer; var AHint: string) of object;
|
|
TJvCustomPreviewControl = class;
|
|
|
|
IJvPrinter = interface
|
|
['{FDCCB7CD-8DF7-48B9-9924-CE439AE97999}']
|
|
procedure SetTitle(const Value: string);
|
|
function GetTitle: string;
|
|
procedure BeginDoc;
|
|
procedure EndDoc;
|
|
procedure NewPage;
|
|
procedure Abort;
|
|
function GetAborted: Boolean;
|
|
function GetCanvas: TCanvas;
|
|
function GetPageWidth: Integer;
|
|
function GetPageHeight: Integer;
|
|
function GetPrinting: Boolean;
|
|
function GetHandle: HDC;
|
|
end;
|
|
|
|
TJvDeviceInfo = class(TPersistent)
|
|
private
|
|
FPageHeight: Cardinal;
|
|
FOffsetTop: Cardinal;
|
|
FOffsetLeft: Cardinal;
|
|
FOffsetBottom: Cardinal;
|
|
FOffsetRight: Cardinal;
|
|
FLogPixelsY: Cardinal;
|
|
FPageWidth: Cardinal;
|
|
FLogPixelsX: Cardinal;
|
|
FOnChange: TNotifyEvent;
|
|
FScreenDC: Longword;
|
|
FReferenceHandle: Longword;
|
|
FPhysicalHeight: Cardinal;
|
|
FPhysicalWidth: Cardinal;
|
|
procedure SetLogPixelsY(const Value: Cardinal);
|
|
procedure SetLogPixesX(const Value: Cardinal);
|
|
procedure SetOffsetX(const Value: Cardinal);
|
|
procedure SetOffsetY(const Value: Cardinal);
|
|
procedure SetPageHeight(const Value: Cardinal);
|
|
procedure SetPageWidth(const Value: Cardinal);
|
|
procedure DefaultDeviceInfo;
|
|
procedure SetReferenceHandle(const Value: Longword);
|
|
procedure SetPhysicalHeight(const Value: Cardinal);
|
|
procedure SetPhysicalWidth(const Value: Cardinal);
|
|
procedure SetOffsetBottom(const Value: Cardinal);
|
|
procedure SetOffsetRight(const Value: Cardinal);
|
|
protected
|
|
function GetScreenDC: Longword;
|
|
procedure Change;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function XPxToInch(Pixels: Integer): Single;
|
|
function YPxToInch(Pixels: Integer): Single;
|
|
function XPxToMM(Pixels: Integer): Single;
|
|
function YPxToMM(Pixels: Integer): Single;
|
|
function InchToXPx(Inch: Single): Integer;
|
|
function InchToYPx(Inch: Single): Integer;
|
|
function MMToXPx(MM: Single): Integer;
|
|
function MMToYPx(MM: Single): Integer;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
published
|
|
property ReferenceHandle: Longword read FReferenceHandle write SetReferenceHandle;
|
|
property LogPixelsX: Cardinal read FLogPixelsX write SetLogPixesX;
|
|
property LogPixelsY: Cardinal read FLogPixelsY write SetLogPixelsY;
|
|
property PhysicalWidth: Cardinal read FPhysicalWidth write SetPhysicalWidth;
|
|
property PhysicalHeight: Cardinal read FPhysicalHeight write SetPhysicalHeight;
|
|
property PageWidth: Cardinal read FPageWidth write SetPageWidth;
|
|
property PageHeight: Cardinal read FPageHeight write SetPageHeight;
|
|
property OffsetLeft: Cardinal read FOffsetLeft write SetOffsetX;
|
|
property OffsetTop: Cardinal read FOffsetTop write SetOffsetY;
|
|
property OffsetRight: Cardinal read FOffsetRight write SetOffsetRight;
|
|
property OffsetBottom: Cardinal read FOffsetBottom write SetOffsetBottom;
|
|
end;
|
|
|
|
TJvPageShadow = class(TPersistent)
|
|
private
|
|
FOffset: Integer;
|
|
FColor: TColor;
|
|
FOnChange: TNotifyEvent;
|
|
procedure SetColor(const Value: TColor);
|
|
procedure SetOffset(const Value: Integer);
|
|
procedure Change;
|
|
public
|
|
constructor Create;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
published
|
|
property Color: TColor read FColor write SetColor default clBlack;
|
|
property Offset: Integer read FOffset write SetOffset default 4;
|
|
end;
|
|
|
|
TJvPreviewPageOptions = class(TPersistent)
|
|
private
|
|
FVertSpacing: Cardinal;
|
|
FHorzSpacing: Cardinal;
|
|
FColor: TColor;
|
|
FShadow: TJvPageShadow;
|
|
FOnChange: TNotifyEvent;
|
|
FDrawMargins: Boolean;
|
|
FCols: Cardinal;
|
|
FScale: Cardinal;
|
|
FRows: Cardinal;
|
|
FScaleMode: TJvPreviewScaleMode;
|
|
FOnScaleModeChange: TNotifyEvent;
|
|
procedure SetColor(const Value: TColor);
|
|
procedure SetHorzSpacing(const Value: Cardinal);
|
|
procedure SetVertSpacing(const Value: Cardinal);
|
|
procedure DoShadowChange(Sender: TObject);
|
|
procedure SetDrawMargins(const Value: Boolean);
|
|
procedure SetCols(const Value: Cardinal);
|
|
procedure SetShadow(const Value: TJvPageShadow);
|
|
procedure SetScale(const Value: Cardinal);
|
|
procedure SetRows(const Value: Cardinal);
|
|
procedure SetScaleMode(const Value: TJvPreviewScaleMode);
|
|
procedure Change;
|
|
procedure ScaleModeChange;
|
|
function GetCols: Cardinal;
|
|
function GetRows: Cardinal;
|
|
function GetHorzSpacing: Cardinal;
|
|
function GetVertSpacing: Cardinal;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnScaleModeChange: TNotifyEvent read FOnScaleModeChange write FOnScaleModeChange;
|
|
published
|
|
property Color: TColor read FColor write SetColor default clWhite;
|
|
property Cols: Cardinal read GetCols write SetCols default 1;
|
|
property DrawMargins: Boolean read FDrawMargins write SetDrawMargins default True;
|
|
property HorzSpacing: Cardinal read GetHorzSpacing write SetHorzSpacing default 8;
|
|
property Rows: Cardinal read GetRows write SetRows;
|
|
property Shadow: TJvPageShadow read FShadow write SetShadow;
|
|
property VertSpacing: Cardinal read GetVertSpacing write SetVertSpacing default 8;
|
|
property Scale: Cardinal read FScale write SetScale default 100;
|
|
property ScaleMode: TJvPreviewScaleMode read FScaleMode write SetScaleMode default smFullPage;
|
|
end;
|
|
|
|
// properties for the SelectedPage property
|
|
TJvPreviewSelection = class(TPersistent)
|
|
private
|
|
FVisible: Boolean;
|
|
FWidth: Integer;
|
|
FColor: TColor;
|
|
FOnChange: TNotifyEvent;
|
|
procedure SetColor(const Value: TColor);
|
|
procedure SetWidth(const Value: Integer);
|
|
procedure SetVisible(const Value: Boolean);
|
|
protected
|
|
procedure Change; virtual;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
public
|
|
constructor Create;
|
|
procedure Assign(Source: TPersistent); override;
|
|
published
|
|
// frame color
|
|
property Color: TColor read FColor write SetColor default clNavy;
|
|
// frame width
|
|
property Width: Integer read FWidth write SetWidth default 4;
|
|
// frame visibility
|
|
property Visible: Boolean read FVisible write SetVisible default True;
|
|
end;
|
|
|
|
TJvCustomPreviewControl = class(TJvCustomControl)
|
|
private
|
|
FBuffer: TBitmap;
|
|
FOptions: TJvPreviewPageOptions;
|
|
FPages: TList;
|
|
FScrollPos: TPoint;
|
|
FOnDrawPreviewPage: TJvDrawPreviewEvent;
|
|
FBorderStyle: TBorderStyle;
|
|
FDeviceInfo: TJvDeviceInfo;
|
|
FOnAddPage: TJvDrawPageEvent;
|
|
FSelectedPage: Integer;
|
|
FOnChange: TNotifyEvent;
|
|
FUpdateCount: Integer;
|
|
FPreviewRect: TRect;
|
|
FPrintRect: TRect;
|
|
FPageWidth: Integer;
|
|
FPageHeight: Integer;
|
|
FMaxHeight: Integer;
|
|
FMaxWidth: Integer;
|
|
FOffsetLeft: Integer;
|
|
FOffsetTop: Integer;
|
|
FOffsetRight: Integer;
|
|
FOffsetBottom: Integer;
|
|
FTotalCols: Integer;
|
|
FTotalRows: Integer;
|
|
FVisibleRows: Integer;
|
|
FOnHorzScroll: TScrollEvent;
|
|
FOnVertScroll: TScrollEvent;
|
|
FOnAfterScroll: TNotifyEvent;
|
|
FScrollBars: TScrollStyle;
|
|
FHideScrollBars: Boolean;
|
|
FOnDeviceInfoChange: TNotifyEvent;
|
|
FOnScaleModeChange: TNotifyEvent;
|
|
FOnOptionsChange: TNotifyEvent;
|
|
FOnScrollHint: TJvScrollHintEvent;
|
|
FSelection: TJvPreviewSelection;
|
|
procedure DoOptionsChange(Sender: TObject);
|
|
procedure DoDeviceInfoChange(Sender: TObject);
|
|
procedure DoScaleModeChange(Sender: TObject);
|
|
procedure DrawPreview(PageIndex: Integer; APageRect, APrintRect: TRect);
|
|
procedure SetBorderStyle(const Value: TBorderStyle);
|
|
function GetPage(Index: Integer): TMetafile;
|
|
function GetPageCount: Integer;
|
|
procedure SetDeviceInfo(const Value: TJvDeviceInfo);
|
|
procedure SetOptions(const Value: TJvPreviewPageOptions);
|
|
procedure SetSelectedPage(const Value: Integer);
|
|
procedure SetTopRow(Value: Integer);
|
|
procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED;
|
|
procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
|
|
procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
|
|
procedure CalcScrollRange;
|
|
// returns the optimal scale value using current cols and rows
|
|
function GetOptimalScale: Cardinal;
|
|
function GetLesserScale(AHeight, AWidth: Cardinal): Cardinal;
|
|
procedure UpdateSizes;
|
|
procedure UpdateScale;
|
|
function GetTopRow: Integer;
|
|
procedure SetScrollBars(const Value: TScrollStyle);
|
|
procedure SetHideScrollBars(const Value: Boolean);
|
|
function IsPageMode: Boolean;
|
|
procedure SetSelection(const Value: TJvPreviewSelection);
|
|
protected
|
|
procedure Change; dynamic;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure BoundsChanged; override;
|
|
procedure GetDlgCode(var Code: TDlgCodes); override;
|
|
function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; override;
|
|
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
|
|
procedure DoScrollHint(NewPos: Integer);
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure DrawPages(ACanvas: TCanvas; Offset: TPoint);
|
|
procedure DrawShadow(ACanvas: TCanvas; APageRect: TRect);
|
|
procedure Paint; override;
|
|
procedure DoDrawPreviewPage(PageIndex: Integer; Canvas: TCanvas;
|
|
PageRect, PrintRect: TRect); dynamic;
|
|
function DoAddPage(AMetaFile: TMetafile; PageIndex: Integer): Boolean; dynamic;
|
|
property TopRow: Integer read GetTopRow write SetTopRow;
|
|
property SelectedPage: Integer read FSelectedPage write SetSelectedPage;
|
|
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
|
|
property Color default clAppWorkSpace;
|
|
property DeviceInfo: TJvDeviceInfo read FDeviceInfo write SetDeviceInfo;
|
|
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
|
|
property HideScrollBars: Boolean read FHideScrollBars write SetHideScrollBars default False;
|
|
property Selection: TJvPreviewSelection read FSelection write SetSelection;
|
|
property Options: TJvPreviewPageOptions read FOptions write SetOptions;
|
|
property OnAddPage: TJvDrawPageEvent read FOnAddPage write FOnAddPage;
|
|
property OnVertScroll: TScrollEvent read FOnVertScroll write FOnVertScroll;
|
|
property OnHorzScroll: TScrollEvent read FOnHorzScroll write FOnHorzScroll;
|
|
property OnAfterScroll: TNotifyEvent read FOnAfterScroll write FOnAfterScroll;
|
|
property OnScrollHint: TJvScrollHintEvent read FOnScrollHint write FOnScrollHint;
|
|
property OnDrawPreviewPage: TJvDrawPreviewEvent read FOnDrawPreviewPage write FOnDrawPreviewPage;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnDeviceInfoChange: TNotifyEvent read FOnDeviceInfoChange write FOnDeviceInfoChange;
|
|
property OnOptionsChange: TNotifyEvent read FOnOptionsChange write FOnOptionsChange;
|
|
property OnScaleModeChange: TNotifyEvent read FOnScaleModeChange write FOnScaleModeChange;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
// if Existing is False, returns the page that should have been at Pos
|
|
function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
function IsUpdating: Boolean;
|
|
function Add: TMetafile;
|
|
procedure Delete(Index: Integer);
|
|
procedure Clear;
|
|
procedure PrintRange(const APrinter: IJvPrinter;
|
|
StartPage, EndPage, Copies: Integer; Collate: Boolean);
|
|
procedure First;
|
|
procedure Last;
|
|
procedure Next;
|
|
procedure Prior;
|
|
property TotalCols: Integer read FTotalCols;
|
|
property TotalRows: Integer read FTotalRows;
|
|
property VisibleRows: Integer read FVisibleRows;
|
|
property Pages[Index: Integer]: TMetafile read GetPage;
|
|
property PageCount: Integer read GetPageCount;
|
|
end;
|
|
|
|
TJvPreviewControl = class(TJvCustomPreviewControl)
|
|
published
|
|
property TopRow;
|
|
property ScrollBars;
|
|
property HideScrollBars;
|
|
property SelectedPage;
|
|
property BorderStyle;
|
|
property Color default clAppWorkSpace;
|
|
property DeviceInfo;
|
|
property Options;
|
|
property Selection;
|
|
property OnChange;
|
|
property OnDeviceInfoChange;
|
|
property OnOptionsChange;
|
|
property OnScaleModeChange;
|
|
property OnVertScroll;
|
|
property OnHorzScroll;
|
|
property OnAfterScroll;
|
|
property OnScrollHint;
|
|
property OnAddPage;
|
|
property OnDrawPreviewPage;
|
|
|
|
property Align;
|
|
property Anchors;
|
|
property AutoSize;
|
|
property BevelEdges;
|
|
property BevelInner;
|
|
property BevelOuter;
|
|
property BevelKind;
|
|
property BevelWidth;
|
|
property BiDiMode;
|
|
property Constraints;
|
|
property DockSite;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property ParentBiDiMode;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop default True;
|
|
property Visible;
|
|
property OnCanResize;
|
|
property OnClick;
|
|
property OnConstrainedResize;
|
|
property OnContextPopup;
|
|
property OnDblClick;
|
|
property OnDockDrop;
|
|
property OnDockOver;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetSiteInfo;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property OnUnDock;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvPrvwDoc.pas $';
|
|
Revision: '$Revision: 11057 $';
|
|
Date: '$Date: 2006-11-29 15:32:05 +0100 (mer., 29 nov. 2006) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math,
|
|
JvThemes;
|
|
|
|
var
|
|
HintWindow: THintWindow = nil;
|
|
|
|
function GetHintWindow: THintWindow;
|
|
begin
|
|
if HintWindow = nil then
|
|
begin
|
|
HintWindow := HintWindowClass.Create(Application);
|
|
HintWindow.Visible := False;
|
|
end;
|
|
Result := HintWindow;
|
|
end;
|
|
|
|
type
|
|
TDeactiveHintThread = class(TThread)
|
|
private
|
|
FHintWindow: THintWindow;
|
|
FDelay: Integer;
|
|
protected
|
|
procedure Execute; override;
|
|
public
|
|
constructor Create(Delay: Integer; HintWindow: THintWindow);
|
|
end;
|
|
|
|
// returns True if Inner is completely within Outer
|
|
|
|
function RectInRect(Inner, Outer: TRect): Boolean;
|
|
|
|
function InRange(const AValue, AMin, AMax: Integer): Boolean;
|
|
begin
|
|
Result := (AValue >= AMin) and (AValue <= AMax);
|
|
end;
|
|
|
|
begin
|
|
Result :=
|
|
InRange(Inner.Left, Outer.Left, Outer.Right) and
|
|
InRange(Inner.Top, Outer.Top, Outer.Bottom) and
|
|
InRange(Inner.Right, Outer.Left, Outer.Right) and
|
|
InRange(Inner.Bottom, Outer.Top, Outer.Bottom);
|
|
end;
|
|
|
|
// returns True if any part of Inner is "visible" inside Outer
|
|
// (any edge of Inner within Outer or Outer within Inner)
|
|
|
|
function PartialInRect(Inner, Outer: TRect): Boolean;
|
|
begin
|
|
Result :=
|
|
(Inner.Left < Outer.Right) and
|
|
(Inner.Top < Outer.Bottom) and
|
|
(Inner.Right > Outer.Left) and
|
|
(Inner.Bottom > Outer.Top);
|
|
end;
|
|
|
|
// use our own EnsureRange since D5 doesn't have it
|
|
|
|
function EnsureRange(const AValue, AMin, AMax: Integer): Integer;
|
|
begin
|
|
Result := AValue;
|
|
Assert(AMin <= AMax);
|
|
if Result < AMin then
|
|
Result := AMin;
|
|
if Result > AMax then
|
|
Result := AMax;
|
|
end;
|
|
|
|
//=== { TJvPreviewPageOptions } ==============================================
|
|
|
|
constructor TJvPreviewPageOptions.Create;
|
|
begin
|
|
inherited Create;
|
|
FShadow := TJvPageShadow.Create;
|
|
FShadow.OnChange := DoShadowChange;
|
|
FCols := 1;
|
|
FRows := 1;
|
|
FScale := 100;
|
|
FScaleMode := smFullPage;
|
|
FColor := clWhite;
|
|
FVertSpacing := 8;
|
|
FHorzSpacing := 8;
|
|
FDrawMargins := True;
|
|
end;
|
|
|
|
destructor TJvPreviewPageOptions.Destroy;
|
|
begin
|
|
FShadow.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.Change;
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.DoShadowChange(Sender: TObject);
|
|
begin
|
|
Change;
|
|
end;
|
|
|
|
function TJvPreviewPageOptions.GetCols: Cardinal;
|
|
begin
|
|
Result := Max(FCols, 1);
|
|
end;
|
|
|
|
function TJvPreviewPageOptions.GetHorzSpacing: Cardinal;
|
|
begin
|
|
Result := Max(FHorzSpacing, Abs(Shadow.Offset));
|
|
end;
|
|
|
|
function TJvPreviewPageOptions.GetRows: Cardinal;
|
|
begin
|
|
Result := Max(FRows, 1);
|
|
end;
|
|
|
|
function TJvPreviewPageOptions.GetVertSpacing: Cardinal;
|
|
begin
|
|
Result := Max(FVertSpacing, Abs(Shadow.Offset));
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.SetColor(const Value: TColor);
|
|
begin
|
|
if FColor <> Value then
|
|
begin
|
|
FColor := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.SetCols(const Value: Cardinal);
|
|
begin
|
|
if FCols <> Value then
|
|
begin
|
|
FCols := Value;
|
|
if FCols < 1 then
|
|
FCols := 1;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.SetDrawMargins(const Value: Boolean);
|
|
begin
|
|
if FDrawMargins <> Value then
|
|
begin
|
|
FDrawMargins := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.SetHorzSpacing(const Value: Cardinal);
|
|
begin
|
|
if FHorzSpacing <> Value then
|
|
begin
|
|
FHorzSpacing := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.SetRows(const Value: Cardinal);
|
|
begin
|
|
if FRows <> Value then
|
|
begin
|
|
FRows := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.SetShadow(const Value: TJvPageShadow);
|
|
begin
|
|
FShadow.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.SetVertSpacing(const Value: Cardinal);
|
|
begin
|
|
if FVertSpacing <> Value then
|
|
begin
|
|
FVertSpacing := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.SetScale(const Value: Cardinal);
|
|
begin
|
|
if FScale <> Value then
|
|
begin
|
|
FScale := Max(Value, 1);
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.SetScaleMode(
|
|
const Value: TJvPreviewScaleMode);
|
|
begin
|
|
if FScaleMode <> Value then
|
|
begin
|
|
FScaleMode := Value;
|
|
ScaleModeChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewPageOptions.ScaleModeChange;
|
|
begin
|
|
if Assigned(FOnScaleModeChange) then
|
|
FOnScaleModeChange(Self)
|
|
else
|
|
Change;
|
|
end;
|
|
|
|
//=== { TJvPageShadow } ======================================================
|
|
|
|
constructor TJvPageShadow.Create;
|
|
begin
|
|
inherited Create;
|
|
FColor := clBlack;
|
|
FOffset := 4;
|
|
end;
|
|
|
|
procedure TJvPageShadow.Change;
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
procedure TJvPageShadow.SetColor(const Value: TColor);
|
|
begin
|
|
if FColor <> Value then
|
|
begin
|
|
FColor := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPageShadow.SetOffset(const Value: Integer);
|
|
begin
|
|
if FOffset <> Value then
|
|
begin
|
|
FOffset := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvDeviceInfo } ======================================================
|
|
|
|
constructor TJvDeviceInfo.Create;
|
|
begin
|
|
inherited Create;
|
|
DefaultDeviceInfo;
|
|
end;
|
|
|
|
destructor TJvDeviceInfo.Destroy;
|
|
begin
|
|
if FScreenDC <> 0 then
|
|
ReleaseDC(HWND_DESKTOP, FScreenDC);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.Change;
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
function TJvDeviceInfo.GetScreenDC: Longword;
|
|
begin
|
|
if FScreenDC <> 0 then
|
|
ReleaseDC(HWND_DESKTOP, FScreenDC);
|
|
FScreenDC := GetDC(HWND_DESKTOP);
|
|
Result := FScreenDC;
|
|
end;
|
|
|
|
function TJvDeviceInfo.InchToXPx(Inch: Single): Integer;
|
|
begin
|
|
Result := Round(Inch * LogPixelsX);
|
|
end;
|
|
|
|
function TJvDeviceInfo.InchToYPx(Inch: Single): Integer;
|
|
begin
|
|
Result := Round(Inch * LogPixelsY);
|
|
end;
|
|
|
|
function TJvDeviceInfo.MMToXPx(MM: Single): Integer;
|
|
begin
|
|
Result := InchToXPx(MM / 25.4);
|
|
end;
|
|
|
|
function TJvDeviceInfo.MMToYPx(MM: Single): Integer;
|
|
begin
|
|
Result := InchToYPx(MM / 25.4);
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.SetLogPixelsY(const Value: Cardinal);
|
|
begin
|
|
if FLogPixelsY <> Value then
|
|
begin
|
|
FLogPixelsY := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.SetLogPixesX(const Value: Cardinal);
|
|
begin
|
|
if FLogPixelsX <> Value then
|
|
begin
|
|
FLogPixelsX := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.SetOffsetBottom(const Value: Cardinal);
|
|
begin
|
|
if FOffsetBottom <> Value then
|
|
begin
|
|
FOffsetBottom := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.SetOffsetRight(const Value: Cardinal);
|
|
begin
|
|
if FOffsetRight <> Value then
|
|
begin
|
|
FOffsetRight := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.SetOffsetX(const Value: Cardinal);
|
|
begin
|
|
if FOffsetLeft <> Value then
|
|
begin
|
|
FOffsetLeft := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.SetOffsetY(const Value: Cardinal);
|
|
begin
|
|
if FOffsetTop <> Value then
|
|
begin
|
|
FOffsetTop := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.SetPageHeight(const Value: Cardinal);
|
|
begin
|
|
if FPageHeight <> Value then
|
|
begin
|
|
FPageHeight := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.SetPageWidth(const Value: Cardinal);
|
|
begin
|
|
if FPageWidth <> Value then
|
|
begin
|
|
FPageWidth := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.SetPhysicalHeight(const Value: Cardinal);
|
|
begin
|
|
if FPhysicalHeight <> Value then
|
|
begin
|
|
FPhysicalHeight := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.SetPhysicalWidth(const Value: Cardinal);
|
|
begin
|
|
if FPhysicalWidth <> Value then
|
|
begin
|
|
FPhysicalWidth := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.SetReferenceHandle(const Value: Longword);
|
|
begin
|
|
FReferenceHandle := Value;
|
|
if FReferenceHandle = 0 then
|
|
begin
|
|
DefaultDeviceInfo;
|
|
Exit;
|
|
end;
|
|
FLogPixelsX := GetDeviceCaps(FReferenceHandle, Windows.LOGPIXELSX);
|
|
FLogPixelsY := GetDeviceCaps(FReferenceHandle, Windows.LOGPIXELSY);
|
|
FPageWidth := GetDeviceCaps(FReferenceHandle, HORZRES);
|
|
FPageHeight := GetDeviceCaps(FReferenceHandle, VERTRES);
|
|
FPhysicalWidth := Max(GetDeviceCaps(FReferenceHandle, Windows.PHYSICALWIDTH), FPageWidth);
|
|
FPhysicalHeight := Max(GetDeviceCaps(FReferenceHandle, Windows.PHYSICALHEIGHT), FPageHeight);
|
|
|
|
FOffsetLeft := GetDeviceCaps(FReferenceHandle, PHYSICALOFFSETX);
|
|
FOffsetTop := GetDeviceCaps(FReferenceHandle, PHYSICALOFFSETY);
|
|
if FPhysicalWidth <> FPageWidth then
|
|
FOffsetRight := Max(FPhysicalWidth - FPageWidth - FOffsetLeft, 0)
|
|
else
|
|
FOffsetRight := FOffsetLeft;
|
|
if FPhysicalHeight <> FPageHeight then
|
|
FOffsetBottom := Max(FPhysicalHeight - FPageHeight - FOffsetTop, 0)
|
|
else
|
|
FOffsetBottom := FOffsetTop;
|
|
Change;
|
|
end;
|
|
|
|
procedure TJvDeviceInfo.DefaultDeviceInfo;
|
|
begin
|
|
// default sizes using my current printer (HP DeskJet 690C)
|
|
FReferenceHandle := 0;
|
|
FLogPixelsX := 300;
|
|
FLogPixelsY := 300;
|
|
FPhysicalWidth := 2480;
|
|
FPhysicalHeight := 3507;
|
|
FPageWidth := 2400;
|
|
FPageHeight := 3281;
|
|
|
|
FOffsetLeft := 40;
|
|
FOffsetTop := 40;
|
|
FOffsetRight := 40;
|
|
FOffsetBottom := 40;
|
|
Change;
|
|
end;
|
|
|
|
function TJvDeviceInfo.XPxToInch(Pixels: Integer): Single;
|
|
begin
|
|
Result := Pixels / LogPixelsX;
|
|
end;
|
|
|
|
function TJvDeviceInfo.XPxToMM(Pixels: Integer): Single;
|
|
begin
|
|
Result := XPxToInch(Pixels) * 25.4;
|
|
end;
|
|
|
|
function TJvDeviceInfo.YPxToInch(Pixels: Integer): Single;
|
|
begin
|
|
Result := Pixels / LogPixelsY;
|
|
end;
|
|
|
|
function TJvDeviceInfo.YPxToMM(Pixels: Integer): Single;
|
|
begin
|
|
Result := YPxToInch(Pixels) * 25.4;
|
|
end;
|
|
|
|
//=== { TJvCustomPreviewControl } ============================================
|
|
|
|
constructor TJvCustomPreviewControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FSelectedPage := -1;
|
|
FPages := TList.Create;
|
|
FPages.Capacity := 64;
|
|
FBuffer := TBitmap.Create;
|
|
|
|
FOptions := TJvPreviewPageOptions.Create;
|
|
FOptions.OnChange := DoOptionsChange;
|
|
FOptions.OnScaleModeChange := DoScaleModeChange;
|
|
|
|
FDeviceInfo := TJvDeviceInfo.Create;
|
|
FDeviceInfo.OnChange := DoDeviceInfoChange;
|
|
|
|
FSelection := TJvPreviewSelection.Create;
|
|
FSelection.OnChange := DoOptionsChange;
|
|
|
|
Color := clAppWorkSpace;
|
|
ControlStyle := [csOpaque, csAcceptsControls, csCaptureMouse, csClickEvents, csDoubleClicks];
|
|
IncludeThemeStyle(Self, [csNeedsBorderPaint]);
|
|
Width := 150;
|
|
Height := 250;
|
|
FBorderStyle := bsSingle;
|
|
FScrollBars := ssBoth;
|
|
FHideScrollBars := False;
|
|
TabStop := True;
|
|
end;
|
|
|
|
destructor TJvCustomPreviewControl.Destroy;
|
|
begin
|
|
Clear;
|
|
FDeviceInfo.Free;
|
|
FSelection.Free;
|
|
FOptions.Free;
|
|
FPages.Free;
|
|
FBuffer.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.Add: TMetafile;
|
|
begin
|
|
repeat
|
|
Result := TMetafile.Create;
|
|
Result.Width := DeviceInfo.PhysicalWidth;
|
|
Result.Height := DeviceInfo.PhysicalHeight;
|
|
// keep adding pages until user says stop
|
|
until not DoAddPage(Result, FPages.Add(Result));
|
|
Change;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.CalcScrollRange;
|
|
var
|
|
SI: TScrollInfo;
|
|
begin
|
|
// HORIZONTAL SCROLLBAR
|
|
FillChar(SI, SizeOf(TScrollInfo), 0);
|
|
SI.cbSize := SizeOf(TScrollInfo);
|
|
SI.fMask := SIF_ALL;
|
|
if not HideScrollBars then
|
|
Inc(SI.fMask, SIF_DISABLENOSCROLL);
|
|
GetScrollInfo(Handle, SB_HORZ, SI);
|
|
|
|
SI.nMax := FMaxWidth - ClientWidth;
|
|
SI.nPage := 0;
|
|
ShowScrollBar(Handle, SB_HORZ, not HideScrollBars and (ScrollBars in [ssHorizontal, ssBoth]));
|
|
SetScrollInfo(Handle, SB_HORZ, SI, True);
|
|
// update scroll pos if it has changed
|
|
GetScrollInfo(Handle, SB_HORZ, SI);
|
|
if SI.nPos <> FScrollPos.X then
|
|
begin
|
|
ScrollBy(-FScrollPos.X + SI.nPos, 0);
|
|
FScrollPos.X := SI.nPos;
|
|
end;
|
|
|
|
// VERTICAL SCROLLBAR
|
|
FillChar(SI, SizeOf(TScrollInfo), 0);
|
|
SI.cbSize := SizeOf(TScrollInfo);
|
|
SI.fMask := SIF_ALL;
|
|
if not HideScrollBars then
|
|
Inc(SI.fMask, SIF_DISABLENOSCROLL);
|
|
GetScrollInfo(Handle, SB_VERT, SI);
|
|
if PageCount = 0 then
|
|
begin
|
|
SI.nMax := 0;
|
|
SI.nPage := 0;
|
|
end
|
|
else
|
|
begin
|
|
SI.nMax := FMaxHeight - ClientHeight;
|
|
SI.nPage := 0; // FMaxHeight div TotalRows;
|
|
end;
|
|
ShowScrollBar(Handle, SB_VERT, not HideScrollBars and (ScrollBars in [ssVertical, ssBoth]));
|
|
SetScrollInfo(Handle, SB_VERT, SI, True);
|
|
// update scroll pos if it has changed
|
|
GetScrollInfo(Handle, SB_VERT, SI);
|
|
if SI.nPos <> FScrollPos.Y then
|
|
begin
|
|
ScrollBy(0, -FScrollPos.Y + SI.nPos);
|
|
FScrollPos.Y := SI.nPos;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.Clear;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to FPages.Count - 1 do
|
|
TMetafile(FPages[I]).Free;
|
|
FPages.Count := 0;
|
|
if not (csDestroying in ComponentState) then
|
|
Change;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.CMCtl3DChanged(var Msg: TMessage);
|
|
begin
|
|
if NewStyleControls and (FBorderStyle = bsSingle) then
|
|
RecreateWnd;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.CreateParams(var Params: TCreateParams);
|
|
const
|
|
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
begin
|
|
Style := Style or BorderStyles[FBorderStyle];
|
|
if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
|
|
begin
|
|
Style := Style and not WS_BORDER;
|
|
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.Delete(Index: Integer);
|
|
begin
|
|
TMetafile(FPages[Index]).Free;
|
|
FPages.Delete(Index);
|
|
Change;
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.DoAddPage(AMetaFile: TMetafile; PageIndex: Integer): Boolean;
|
|
var
|
|
ACanvas: TMetaFileCanvas;
|
|
APageRect, APrintRect: TRect;
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
ACanvas := TMetaFileCanvas.Create(AMetaFile, DeviceInfo.ReferenceHandle);
|
|
SetMapMode(ACanvas.Handle, MM_ANISOTROPIC);
|
|
with DeviceInfo do
|
|
begin
|
|
SetWindowOrgEx(ACanvas.Handle, 0, 0, nil);
|
|
SetWindowExtEx(ACanvas.Handle, PhysicalWidth, PhysicalHeight, nil);
|
|
SetViewportExtEx(ACanvas.Handle, PhysicalWidth, PhysicalHeight, nil);
|
|
end;
|
|
// NB! Font.Size is changed when PPI is changed, so store and reset
|
|
I := ACanvas.Font.Size;
|
|
ACanvas.Font.PixelsPerInch := DeviceInfo.LogPixelsY;
|
|
ACanvas.Font.Size := I;
|
|
|
|
if Assigned(FOnAddPage) then
|
|
with DeviceInfo do
|
|
begin
|
|
APageRect := Rect(0, 0, PhysicalWidth, PhysicalHeight);
|
|
APrintRect := APageRect;
|
|
|
|
Inc(APrintRect.Left, OffsetLeft);
|
|
Inc(APrintRect.Top, OffsetTop);
|
|
Dec(APrintRect.Right, OffsetRight);
|
|
Dec(APrintRect.Bottom, OffsetBottom);
|
|
|
|
FOnAddPage(Self, PageIndex, ACanvas, APageRect, APrintRect, Result);
|
|
end;
|
|
// spool canvas to metafile
|
|
ACanvas.Free;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.DoDrawPreviewPage(PageIndex: Integer;
|
|
Canvas: TCanvas; PageRect, PrintRect: TRect);
|
|
begin
|
|
if Assigned(FOnDrawPreviewPage) then
|
|
FOnDrawPreviewPage(Self, PageIndex, Canvas, PageRect, PrintRect);
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.DoOptionsChange(Sender: TObject);
|
|
begin
|
|
Change;
|
|
if Assigned(FOnOptionsChange) then
|
|
FOnOptionsChange(Self);
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.DoScaleModeChange(Sender: TObject);
|
|
begin
|
|
Change;
|
|
if Assigned(FOnScaleModeChange) then
|
|
FOnScaleModeChange(Self);
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.DoDeviceInfoChange(Sender: TObject);
|
|
begin
|
|
Change;
|
|
if Assigned(FOnDeviceInfoChange) then
|
|
FOnDeviceInfoChange(Self);
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.DrawPages(ACanvas: TCanvas; Offset: TPoint);
|
|
var
|
|
I, J, K, M, AOffsetX, AOffsetY, APageIndex: Integer;
|
|
APageRect, APrintRect: TRect;
|
|
// SI: TScrollInfo;
|
|
Tmp: Boolean;
|
|
|
|
function CanDrawPage(APageIndex: Integer; APageRect: TRect): Boolean;
|
|
begin
|
|
Result := (APageIndex < PageCount) or (PageCount = 0);
|
|
if not Result then
|
|
Exit;
|
|
Result := not IsPageMode;
|
|
if not Result then
|
|
Result := RectInRect(APageRect, ClientRect)
|
|
else
|
|
Result := PartialInRect(APageRect, ClientRect);
|
|
end;
|
|
|
|
begin
|
|
APageRect := FPreviewRect;
|
|
APrintRect := FPrintRect;
|
|
|
|
// initial top/left offset
|
|
AOffsetX := -Offset.X + Max((ClientWidth - ((FPageWidth + Integer(Options.HorzSpacing)) * TotalCols)) div 2,
|
|
FOptions.HorzSpacing);
|
|
if IsPageMode then
|
|
AOffsetY := -Offset.Y + Max((ClientHeight - ((FPageHeight + Integer(Options.VertSpacing)) * VisibleRows)) div 2,
|
|
FOptions.VertSpacing)
|
|
else
|
|
AOffsetY := -Offset.Y + Integer(Options.VertSpacing);
|
|
K := 0;
|
|
with ACanvas do
|
|
begin
|
|
Brush.Color := Color;
|
|
FillRect(ClipRect);
|
|
Pen.Color := clBlack;
|
|
Pen.Style := psDot;
|
|
{ (rom) disabled
|
|
// $IFDEF DEBUG
|
|
Polyline([
|
|
Point(AOffsetX, AOffsetY),
|
|
Point(AOffsetX, AOffsetY + FMaxHeight),
|
|
Point(AOffsetX + FMaxWidth, AOffsetY + FMaxHeight),
|
|
Point(AOffsetX + FMaxWidth, AOffsetY),
|
|
Point(AOffsetX, AOffsetY)
|
|
]);
|
|
// $ENDIF DEBUG
|
|
}
|
|
Pen.Style := psSolid;
|
|
APageIndex := K * TotalCols;
|
|
M := Max(0, PageCount - 1);
|
|
// if not IsPageMode and (K > 0) then
|
|
// Dec(K);
|
|
for I := K to M do
|
|
begin
|
|
APrintRect := FPrintRect;
|
|
APageRect := FPreviewRect;
|
|
OffsetRect(APrintRect, AOffsetX, AOffsetY + (FPageHeight + Integer(Options.VertSpacing)) * I);
|
|
OffsetRect(APageRect, AOffsetX, AOffsetY + (FPageHeight + Integer(Options.VertSpacing)) * I);
|
|
for J := 0 to TotalCols - 1 do
|
|
begin
|
|
// avoid drawing partial pages when previewrect < clientrect
|
|
Tmp := CanDrawPage(APageIndex, APageRect);
|
|
if Tmp then
|
|
begin
|
|
DrawShadow(ACanvas, APageRect);
|
|
// draw background
|
|
Brush.Color := Options.Color;
|
|
FillRect(APageRect);
|
|
// draw preview content
|
|
if APageIndex < PageCount then
|
|
DrawPreview(APageIndex, APageRect, APrintRect);
|
|
// draw frame
|
|
Brush.Style := bsClear;
|
|
Pen.Color := clWindowText;
|
|
Rectangle(APageRect);
|
|
if (APageIndex = FSelectedPage) and Selection.Visible then
|
|
begin
|
|
Pen.Color := Selection.Color;
|
|
Pen.Width := Selection.Width;
|
|
Rectangle(APageRect);
|
|
Pen.Color := clWindowText;
|
|
Pen.Width := 1;
|
|
end;
|
|
// draw margins
|
|
if Options.DrawMargins and not EqualRect(APageRect, APrintRect) then
|
|
begin
|
|
Pen.Style := psDot;
|
|
Rectangle(APrintRect);
|
|
Pen.Style := psSolid;
|
|
end;
|
|
Brush.Style := bsSolid;
|
|
if PageCount = 0 then
|
|
Exit; // we've drawn one empty page, so let's skip the rest
|
|
end;
|
|
OffsetRect(APrintRect, FPageWidth + Integer(Options.HorzSpacing), 0);
|
|
OffsetRect(APageRect, FPageWidth + Integer(Options.HorzSpacing), 0);
|
|
Inc(APageIndex);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.DrawPreview(PageIndex: Integer;
|
|
APageRect, APrintRect: TRect);
|
|
begin
|
|
FBuffer.Canvas.StretchDraw(APageRect, Pages[PageIndex]);
|
|
DoDrawPreviewPage(PageIndex, FBuffer.Canvas, APageRect, APrintRect);
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.GetPage(Index: Integer): TMetafile;
|
|
begin
|
|
Result := TMetafile(FPages[Index]);
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.GetPageCount: Integer;
|
|
begin
|
|
Result := FPages.Count;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.Paint;
|
|
begin
|
|
if IsUpdating then
|
|
Exit;
|
|
FBuffer.Width := ClientWidth;
|
|
FBuffer.Height := ClientHeight;
|
|
// Canvas.Brush.Color := Color;
|
|
// Canvas.FillRect(ClientRect);
|
|
DrawPages(FBuffer.Canvas, Point(FScrollPos.X, FScrollPos.Y));
|
|
BitBlt(Canvas.Handle, 0, 0, FBuffer.Width, FBuffer.Height, FBuffer.Canvas.Handle,
|
|
0, 0, SRCCOPY);
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.SetBorderStyle(const Value: TBorderStyle);
|
|
begin
|
|
if FBorderStyle <> Value then
|
|
begin
|
|
FBorderStyle := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.SetSelectedPage(const Value: Integer);
|
|
begin
|
|
if FSelectedPage <> Value then
|
|
begin
|
|
FSelectedPage := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.SetDeviceInfo(const Value: TJvDeviceInfo);
|
|
begin
|
|
FDeviceInfo.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.SetOptions(const Value: TJvPreviewPageOptions);
|
|
begin
|
|
FOptions.Assign(Value);
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
|
|
begin
|
|
// inherited DoEraseBackground(Canvas, Param);
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.BoundsChanged;
|
|
var
|
|
TmpRow: Integer;
|
|
begin
|
|
inherited BoundsChanged;
|
|
TmpRow := TopRow; // workaround...
|
|
Change;
|
|
if IsPageMode then
|
|
TopRow := TmpRow; // workaround...
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.WMHScroll(var Msg: TWMHScroll);
|
|
var
|
|
SI: TScrollInfo;
|
|
NewPos, Increment: Integer;
|
|
begin
|
|
if IsPageMode then
|
|
Exit;
|
|
Increment := FPageWidth div 3;
|
|
FillChar(SI, SizeOf(TScrollInfo), 0);
|
|
SI.cbSize := SizeOf(TScrollInfo);
|
|
SI.fMask := SIF_ALL;
|
|
GetScrollInfo(Handle, SB_HORZ, SI);
|
|
case Msg.ScrollCode of
|
|
SB_TOP:
|
|
NewPos := 0;
|
|
SB_BOTTOM:
|
|
NewPos := FMaxWidth;
|
|
SB_LINEDOWN, SB_PAGEDOWN:
|
|
NewPos := FScrollPos.X + Increment;
|
|
SB_LINEUP, SB_PAGEUP:
|
|
NewPos := FScrollPos.X - Increment;
|
|
SB_THUMBPOSITION, SB_THUMBTRACK:
|
|
begin
|
|
NewPos := SI.nTrackPos;
|
|
if NewPos = FScrollPos.X then
|
|
Exit;
|
|
end;
|
|
SB_ENDSCROLL:
|
|
Exit;
|
|
end;
|
|
NewPos := EnsureRange(NewPos, SI.nMin, SI.nMax);
|
|
if Assigned(FOnHorzScroll) then
|
|
FOnHorzScroll(Self, TScrollCode(Msg.ScrollCode), NewPos);
|
|
NewPos := EnsureRange(NewPos, SI.nMin, SI.nMax);
|
|
ScrollBy(-FScrollPos.X + NewPos, 0);
|
|
FScrollPos.X := NewPos;
|
|
SI.nPos := NewPos;
|
|
SetScrollInfo(Handle, SB_HORZ, SI, True);
|
|
if Assigned(FOnAfterScroll) then
|
|
FOnAfterScroll(Self);
|
|
Refresh;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.WMVScroll(var Msg: TWMVScroll);
|
|
var
|
|
SI: TScrollInfo;
|
|
NewPos, Increment: Integer;
|
|
begin
|
|
Increment := FPageHeight + Integer(Options.VertSpacing);
|
|
if not IsPageMode then
|
|
Increment := Increment div 3;
|
|
if Increment < 1 then
|
|
Increment := 1;
|
|
|
|
FillChar(SI, SizeOf(TScrollInfo), 0);
|
|
SI.cbSize := SizeOf(TScrollInfo);
|
|
SI.fMask := SIF_ALL;
|
|
GetScrollInfo(Handle, SB_VERT, SI);
|
|
case Msg.ScrollCode of
|
|
SB_TOP:
|
|
NewPos := 0;
|
|
SB_BOTTOM:
|
|
NewPos := FMaxHeight;
|
|
SB_LINEDOWN, SB_PAGEDOWN:
|
|
NewPos := FScrollPos.Y + Increment;
|
|
SB_LINEUP, SB_PAGEUP:
|
|
NewPos := FScrollPos.Y - Increment;
|
|
SB_THUMBPOSITION, SB_THUMBTRACK:
|
|
begin
|
|
NewPos := SI.nTrackPos;
|
|
if IsPageMode then
|
|
NewPos := NewPos - SI.nTrackPos mod Increment;
|
|
if NewPos = FScrollPos.Y then
|
|
Exit;
|
|
end;
|
|
SB_ENDSCROLL:
|
|
begin
|
|
TDeactiveHintThread.Create(500, HintWindow);
|
|
HintWindow := nil;
|
|
Exit;
|
|
end;
|
|
end;
|
|
NewPos := EnsureRange(NewPos, SI.nMin, SI.nMax);
|
|
if Assigned(FOnVertScroll) then
|
|
FOnVertScroll(Self, TScrollCode(Msg.ScrollCode), NewPos);
|
|
NewPos := EnsureRange(NewPos, SI.nMin, SI.nMax);
|
|
ScrollBy(0, -FScrollPos.Y + NewPos);
|
|
FScrollPos.Y := NewPos;
|
|
SI.nPos := NewPos;
|
|
SetScrollInfo(Handle, SB_VERT, SI, True);
|
|
DoScrollHint(NewPos);
|
|
if Assigned(FOnAfterScroll) then
|
|
FOnAfterScroll(Self);
|
|
Refresh;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.GetDlgCode(var Code: TDlgCodes);
|
|
begin
|
|
Code := [dcWantAllKeys];
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.PrintRange(const APrinter: IJvPrinter;
|
|
StartPage, EndPage, Copies: Integer; Collate: Boolean);
|
|
var
|
|
I, J: Integer;
|
|
PrinterPhysicalOffsetX, PrinterPhysicalOffsetY: cardinal;
|
|
begin
|
|
if (APrinter = nil) or APrinter.GetPrinting then
|
|
Exit;
|
|
|
|
PrinterPhysicalOffsetX := GetDeviceCaps(APrinter.GetHandle, PHYSICALOFFSETX);
|
|
PrinterPhysicalOffsetY := GetDeviceCaps(APrinter.GetHandle, PHYSICALOFFSETY);
|
|
|
|
if StartPage < 0 then
|
|
StartPage := PageCount - 1;
|
|
if StartPage >= PageCount then
|
|
StartPage := PageCount - 1;
|
|
if EndPage < 0 then
|
|
EndPage := PageCount - 1;
|
|
if EndPage >= PageCount then
|
|
EndPage := PageCount - 1;
|
|
if Copies < 1 then
|
|
Copies := 1;
|
|
if (StartPage < 0) or (EndPage < 0) then
|
|
Exit;
|
|
if Collate then // Range * Copies
|
|
begin
|
|
if StartPage > EndPage then
|
|
begin
|
|
// print backwards
|
|
for I := 0 to Copies - 1 do
|
|
for J := StartPage downto EndPage do
|
|
begin
|
|
if APrinter.GetAborted then
|
|
begin
|
|
if APrinter.GetPrinting then
|
|
APrinter.EndDoc;
|
|
Exit;
|
|
end;
|
|
if (J = StartPage) and (I = 0) then
|
|
APrinter.BeginDoc
|
|
else
|
|
APrinter.NewPage;
|
|
APrinter.GetCanvas.Draw(-PrinterPhysicalOffsetX, -PrinterPhysicalOffsetY, Pages[J]);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
for I := 0 to Copies - 1 do
|
|
for J := StartPage to EndPage do
|
|
begin
|
|
if APrinter.GetAborted then
|
|
begin
|
|
if APrinter.GetPrinting then
|
|
APrinter.EndDoc;
|
|
Exit;
|
|
end;
|
|
if (J = StartPage) and (I = 0) then
|
|
APrinter.BeginDoc
|
|
else
|
|
APrinter.NewPage;
|
|
APrinter.GetCanvas.Draw(-PrinterPhysicalOffsetX, -PrinterPhysicalOffsetY, Pages[J]);
|
|
end;
|
|
end;
|
|
end
|
|
else // Page * Copies
|
|
begin
|
|
if StartPage > EndPage then
|
|
begin
|
|
// print backwards
|
|
for J := StartPage downto EndPage do
|
|
for I := 0 to Copies - 1 do
|
|
begin
|
|
if APrinter.GetAborted then
|
|
begin
|
|
if APrinter.GetPrinting then
|
|
APrinter.EndDoc;
|
|
Exit;
|
|
end;
|
|
if (J = StartPage) and (I = 0) then
|
|
APrinter.BeginDoc
|
|
else
|
|
APrinter.NewPage;
|
|
APrinter.GetCanvas.Draw(-PrinterPhysicalOffsetX, -PrinterPhysicalOffsetY, Pages[J]);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
for J := StartPage to EndPage do
|
|
for I := 0 to Copies - 1 do
|
|
begin
|
|
if APrinter.GetAborted then
|
|
begin
|
|
if APrinter.GetPrinting then
|
|
APrinter.EndDoc;
|
|
Exit;
|
|
end;
|
|
if (J = StartPage) and (I = 0) then
|
|
APrinter.BeginDoc
|
|
else
|
|
APrinter.NewPage;
|
|
APrinter.GetCanvas.Draw(-PrinterPhysicalOffsetX, -PrinterPhysicalOffsetY, Pages[J]);
|
|
end;
|
|
end;
|
|
end;
|
|
if APrinter.GetPrinting then
|
|
APrinter.EndDoc;
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.GetOptimalScale: Cardinal;
|
|
var
|
|
Val1, Val2: Integer;
|
|
begin
|
|
Val1 := (ClientHeight - Integer(Options.VertSpacing)) div VisibleRows - Integer(Options.VertSpacing) * 2;
|
|
Val2 := (ClientWidth - Integer(Options.HorzSpacing)) div TotalCols - Integer(Options.HorzSpacing) * 2;
|
|
Result := GetLesserScale(Val1, Val2);
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.Change;
|
|
begin
|
|
// TopRow := 0; // DONE: make this unnecessary...
|
|
UpdateSizes;
|
|
UpdateScale;
|
|
// call again since some values might have changed (like scale):
|
|
UpdateSizes;
|
|
CalcScrollRange;
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
Refresh;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.BeginUpdate;
|
|
begin
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.EndUpdate;
|
|
begin
|
|
Dec(FUpdateCount);
|
|
if FUpdateCount = 0 then
|
|
Change;
|
|
if FUpdateCount < 0 then
|
|
FUpdateCount := 0;
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.GetLesserScale(AHeight, AWidth: Cardinal): Cardinal;
|
|
var
|
|
DC: HDC;
|
|
begin
|
|
// determine scale factor for both sides, choose lesser
|
|
// this is the opposite of setting FPageWidth/FPageHeight
|
|
DC := GetDC(HWND_DESKTOP);
|
|
try
|
|
if AWidth > 0 then
|
|
AWidth := MulDiv(AWidth, 100, MulDiv(DeviceInfo.PhysicalWidth,
|
|
GetDeviceCaps(DC, LOGPIXELSX), DeviceInfo.LogPixelsX));
|
|
if AHeight > 0 then
|
|
AHeight := MulDiv(AHeight, 100, MulDiv(DeviceInfo.PhysicalHeight,
|
|
GetDeviceCaps(DC, LOGPIXELSY), DeviceInfo.LogPixelsY));
|
|
if (AHeight > 0) and (AWidth > 0) then
|
|
Result := Min(AWidth, AHeight)
|
|
else
|
|
if AHeight > 0 then
|
|
Result := AHeight
|
|
else
|
|
Result := AWidth;
|
|
finally
|
|
ReleaseDC(HWND_DESKTOP, DC);
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.IsUpdating: Boolean;
|
|
begin
|
|
Result := FUpdateCount <> 0;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.SetTopRow(Value: Integer);
|
|
var
|
|
ARow, Tmp: Integer;
|
|
// SI: TScrollInfo;
|
|
begin
|
|
ARow := Max(Min(Value, TotalRows - 1), 0);
|
|
Tmp := (FPageHeight + Integer(Options.VertSpacing)) * ARow;
|
|
ScrollBy(0, -FScrollPos.Y + Tmp);
|
|
FScrollPos.Y := Tmp;
|
|
SetScrollPos(Handle, SB_VERT, FScrollPos.Y, True);
|
|
Refresh;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.UpdateSizes;
|
|
var
|
|
DC: HDC;
|
|
begin
|
|
// precalc as much as possible to speed up rendering
|
|
DC := GetDC(HWND_DESKTOP);
|
|
try
|
|
FPageWidth := MulDiv(MulDiv(DeviceInfo.PhysicalWidth, GetDeviceCaps(DC, LOGPIXELSX),
|
|
DeviceInfo.LogPixelsX), Options.Scale, 100);
|
|
FPageHeight := MulDiv(MulDiv(DeviceInfo.PhysicalHeight, GetDeviceCaps(DC, LOGPIXELSY),
|
|
DeviceInfo.LogPixelsY), Options.Scale, 100);
|
|
|
|
FOffsetLeft := MulDiv(MulDiv(DeviceInfo.OffsetLeft, GetDeviceCaps(DC, LOGPIXELSX),
|
|
DeviceInfo.LogPixelsX), Options.Scale, 100);
|
|
FOffsetTop := MulDiv(MulDiv(DeviceInfo.OffsetTop, GetDeviceCaps(DC, LOGPIXELSY),
|
|
DeviceInfo.LogPixelsY), Options.Scale, 100);
|
|
FOffsetRight := MulDiv(MulDiv(DeviceInfo.OffsetRight, GetDeviceCaps(DC, LOGPIXELSX),
|
|
DeviceInfo.LogPixelsX), Options.Scale, 100);
|
|
FOffsetBottom := MulDiv(MulDiv(DeviceInfo.OffsetBottom, GetDeviceCaps(DC, LOGPIXELSY),
|
|
DeviceInfo.LogPixelsY), Options.Scale, 100);
|
|
|
|
FPreviewRect := Rect(0, 0, FPageWidth, FPageHeight);
|
|
FPrintRect := FPreviewRect;
|
|
with FPrintRect do
|
|
begin
|
|
Inc(Left, FOffsetLeft);
|
|
Inc(Top, FOffsetTop);
|
|
Dec(Right, FOffsetRight);
|
|
Dec(Bottom, FOffsetBottom);
|
|
end;
|
|
|
|
if (Options.ScaleMode in [smFullPage, smPageWidth]) or
|
|
(FPageWidth >= ClientWidth) or (FPageHeight >= ClientHeight) and
|
|
not (Options.ScaleMode in [smScale, smAutoScale]) then
|
|
begin
|
|
FTotalCols := 1;
|
|
FVisibleRows := 1;
|
|
end
|
|
else
|
|
case Options.ScaleMode of
|
|
smAutoScale:
|
|
begin
|
|
FTotalCols := Max(Min(PageCount, Max((ClientWidth - Integer(Options.HorzSpacing)) div (FPageWidth +
|
|
Integer(Options.HorzSpacing)), 1)), 1);
|
|
FVisibleRows := Min(Max((ClientHeight - Integer(Options.VertSpacing)) div (FPageHeight +
|
|
Integer(Options.VertSpacing)), 1), TotalRows);
|
|
if (VisibleRows > 1) and (VisibleRows * TotalCols > PageCount) then
|
|
FVisibleRows := Min((PageCount div TotalCols) + Ord(PageCount mod TotalCols <> 0), TotalRows);
|
|
if (FPageWidth + Integer(Options.HorzSpacing) * 2 >= ClientWidth) or
|
|
(FPageHeight + Integer(Options.VertSpacing) * 2 >= ClientHeight) then
|
|
begin
|
|
FTotalCols := 1;
|
|
FVisibleRows := 1;
|
|
Options.FScale := GetOptimalScale;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
FTotalCols := Max(Min(PageCount, Options.Cols), 1);
|
|
FVisibleRows := Max(Min(PageCount div Integer(Options.Cols) + Ord(PageCount mod Integer(Options.Cols) <> 0),
|
|
Options.Rows), 1);
|
|
end;
|
|
end;
|
|
|
|
FTotalRows := Max((PageCount div TotalCols) + Ord(PageCount mod TotalCols <> 0), 1);
|
|
|
|
// TODO: this just isn't right...
|
|
FMaxHeight := TotalRows * (FPageHeight + Integer(Options.VertSpacing)) + Integer(Options.VertSpacing);
|
|
// if (FMaxHeight > ClientHeight) and (TotalRows > 1) then
|
|
// Dec(FMaxHeight,FPageHeight - Integer(Options.VertSpacing));
|
|
FMaxWidth := TotalCols * (FPageWidth + Integer(Options.HorzSpacing)) + Integer(Options.HorzSpacing);
|
|
finally
|
|
ReleaseDC(HWND_DESKTOP, DC);
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.GetTopRow: Integer;
|
|
begin
|
|
Result := FScrollPos.Y div (FPageHeight + Integer(Options.VertSpacing));
|
|
Inc(Result, Ord(FScrollPos.Y mod (FPageHeight + Integer(Options.VertSpacing)) <> 0));
|
|
Result := Min(Result, TotalRows - 1);
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.First;
|
|
begin
|
|
TopRow := 0;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.Last;
|
|
begin
|
|
TopRow := TotalRows;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.Next;
|
|
begin
|
|
TopRow := TopRow + 1;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.Prior;
|
|
begin
|
|
TopRow := TopRow - 1;
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
|
|
var
|
|
APageRect: TRect;
|
|
ARow, ACol, AOffsetX, AOffsetY: Integer;
|
|
begin
|
|
Result := -1;
|
|
// initial top/left offset
|
|
AOffsetX := -FScrollPos.X + Max((ClientWidth - ((FPageWidth + Integer(Options.HorzSpacing)) * TotalCols)) div 2, FOptions.HorzSpacing);
|
|
if IsPageMode then
|
|
AOffsetY := -FScrollPos.Y + Max((ClientHeight - ((FPageHeight + Integer(Options.VertSpacing)) * VisibleRows)) div 2,
|
|
FOptions.VertSpacing)
|
|
else
|
|
AOffsetY := -FScrollPos.Y + Integer(Options.VertSpacing);
|
|
ARow := 0;
|
|
// walk the pages, comparing as we go along
|
|
while True do
|
|
begin
|
|
APageRect := FPreviewRect;
|
|
OffsetRect(APageRect, AOffsetX, AOffsetY + (FPageHeight + Integer(Options.VertSpacing)) * ARow);
|
|
for ACol := 0 to TotalCols - 1 do
|
|
begin
|
|
if PtInRect(APageRect, Pos) then
|
|
begin
|
|
Result := ARow * TotalCols + ACol;
|
|
if Existing and (Result >= PageCount) then
|
|
Result := -1;
|
|
Exit;
|
|
end;
|
|
OffsetRect(APageRect, FPageWidth + Integer(Options.HorzSpacing), 0);
|
|
end;
|
|
Inc(ARow);
|
|
if (APageRect.Left > ClientWidth) or (APageRect.Top > ClientHeight) then
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.SetScrollBars(const Value: TScrollStyle);
|
|
begin
|
|
if FScrollBars <> Value then
|
|
begin
|
|
FScrollBars := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.SetHideScrollBars(const Value: Boolean);
|
|
begin
|
|
if FHideScrollBars <> Value then
|
|
begin
|
|
FHideScrollBars := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.DoMouseWheel(Shift: TShiftState;
|
|
WheelDelta: Integer; MousePos: TPoint): Boolean;
|
|
var
|
|
Msg: TWMScroll;
|
|
SI: TScrollInfo;
|
|
begin
|
|
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
|
|
if not Result then
|
|
begin
|
|
FillChar(SI, SizeOf(TScrollInfo), 0);
|
|
SI.cbSize := SizeOf(TScrollInfo);
|
|
SI.fMask := SIF_ALL;
|
|
GetScrollInfo(Handle, SB_VERT, SI);
|
|
if SI.nMax = 0 then
|
|
Exit;
|
|
Msg.Msg := WM_VSCROLL;
|
|
if WheelDelta > 0 then
|
|
Msg.ScrollCode := SB_PAGEUP
|
|
else
|
|
Msg.ScrollCode := SB_PAGEDOWN;
|
|
Msg.Pos := FScrollPos.Y;
|
|
Msg.Result := 0;
|
|
WMVScroll(Msg);
|
|
Refresh;
|
|
TDeactiveHintThread.Create(500, HintWindow);
|
|
HintWindow := nil;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if CanFocus then
|
|
SetFocus;
|
|
I := ItemAtPos(Point(X, Y), True);
|
|
if I >= 0 then
|
|
SelectedPage := I;
|
|
end;
|
|
|
|
function TJvCustomPreviewControl.IsPageMode: Boolean;
|
|
begin
|
|
Result := (Options.ScaleMode in [smFullPage, smAutoScale, smColsRows]) or
|
|
((Options.ScaleMode = smScale) and (FPageHeight + Integer(Options.VertSpacing) * 2 <= ClientHeight));
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.UpdateScale;
|
|
begin
|
|
case Options.ScaleMode of
|
|
smFullPage:
|
|
begin
|
|
Options.FCols := 1;
|
|
Options.FRows := 1;
|
|
FTotalRows := PageCount - 1;
|
|
Options.FScale := GetOptimalScale;
|
|
end;
|
|
smPageWidth:
|
|
begin
|
|
Options.FCols := 1;
|
|
Options.FRows := 1;
|
|
FTotalRows := PageCount - 1;
|
|
Options.FScale := GetLesserScale(0, ClientWidth - Integer(Options.HorzSpacing) * 2 -
|
|
GetSystemMetrics(SM_CYHSCROLL));
|
|
end;
|
|
smScale:
|
|
begin
|
|
FTotalCols := Min(Options.Cols, TotalCols);
|
|
FVisibleRows := Min(Options.Rows, VisibleRows);
|
|
// Options.FScale := GetOptimalScale;
|
|
end;
|
|
smAutoScale:
|
|
begin
|
|
Options.FCols := TotalCols;
|
|
Options.FRows := VisibleRows;
|
|
FTotalRows := Max((PageCount div TotalCols) + Ord(PageCount mod TotalCols <> 0), 1);
|
|
end;
|
|
smColsRows:
|
|
Options.FScale := GetOptimalScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.DoScrollHint(NewPos: Integer);
|
|
var
|
|
S: string;
|
|
HW: THintWindow;
|
|
Pt: TPoint;
|
|
R: TRect;
|
|
begin
|
|
// stolen from SynEdit, thanks guys!
|
|
if Assigned(FOnScrollHint) then
|
|
begin
|
|
S := '';
|
|
FOnScrollHint(Self, NewPos, S);
|
|
if S <> '' then
|
|
begin
|
|
HW := GetHintWindow;
|
|
if not HW.Visible then
|
|
begin
|
|
HW.Color := Application.HintColor;
|
|
HW.Visible := True;
|
|
end;
|
|
R := Rect(0, 0, HW.Canvas.TextWidth(S) + 6,
|
|
HW.Canvas.TextHeight(S) + 4);
|
|
GetCursorPos(Pt);
|
|
Pt := ScreenToClient(Pt);
|
|
Pt.X := ClientWidth - HW.Canvas.TextWidth(S) - 12;
|
|
Pt := ClientToScreen(Pt);
|
|
OffsetRect(R, Pt.X, Pt.Y - 4);
|
|
HW.ActivateHint(R, S);
|
|
HW.Invalidate;
|
|
HW.Update;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.DrawShadow(ACanvas: TCanvas; APageRect: TRect);
|
|
var
|
|
TmpRect: TRect;
|
|
TmpColor: TColor;
|
|
begin
|
|
TmpColor := ACanvas.Brush.Color;
|
|
try
|
|
ACanvas.Brush.Color := Options.Shadow.Color;
|
|
if Options.Shadow.Offset <> 0 then
|
|
begin
|
|
// draw full background shadow if necessary
|
|
if (Abs(Options.Shadow.Offset) >= (APageRect.Left - APageRect.Right)) or
|
|
(Abs(Options.Shadow.Offset) >= (APageRect.Bottom - APageRect.Top)) then
|
|
begin
|
|
TmpRect := APageRect;
|
|
OffsetRect(TmpRect, Options.Shadow.Offset, Options.Shadow.Offset);
|
|
ACanvas.FillRect(TmpRect);
|
|
end
|
|
// draw two smaller rects (does this *really* reduce flicker?)
|
|
else
|
|
if Options.Shadow.Offset < 0 then
|
|
begin
|
|
// left side
|
|
TmpRect := APageRect;
|
|
TmpRect.Right := TmpRect.Left - Options.Shadow.Offset;
|
|
OffsetRect(TmpRect, Options.Shadow.Offset, Options.Shadow.Offset);
|
|
ACanvas.FillRect(TmpRect);
|
|
// top side
|
|
TmpRect := APageRect;
|
|
TmpRect.Bottom := TmpRect.Top - Options.Shadow.Offset;
|
|
OffsetRect(TmpRect, Options.Shadow.Offset, Options.Shadow.Offset);
|
|
ACanvas.FillRect(TmpRect);
|
|
end
|
|
else
|
|
begin
|
|
// right side
|
|
TmpRect := APageRect;
|
|
TmpRect.Left := TmpRect.Right - Options.Shadow.Offset;
|
|
OffsetRect(TmpRect, Options.Shadow.Offset, Options.Shadow.Offset);
|
|
ACanvas.FillRect(TmpRect);
|
|
// bottom side
|
|
TmpRect := APageRect;
|
|
TmpRect.Top := TmpRect.Bottom - Options.Shadow.Offset;
|
|
OffsetRect(TmpRect, Options.Shadow.Offset, Options.Shadow.Offset);
|
|
ACanvas.FillRect(TmpRect);
|
|
end;
|
|
end;
|
|
finally
|
|
ACanvas.Brush.Color := TmpColor;
|
|
end;
|
|
end;
|
|
|
|
//=== { TDeactiveHintThread } ================================================
|
|
|
|
constructor TDeactiveHintThread.Create(Delay: Integer; HintWindow: THintWindow);
|
|
begin
|
|
inherited Create(True);
|
|
FreeOnTerminate := True;
|
|
FHintWindow := HintWindow;
|
|
FDelay := Delay;
|
|
if FDelay = 0 then
|
|
FDelay := Application.HintHidePause;
|
|
Resume;
|
|
end;
|
|
|
|
procedure TDeactiveHintThread.Execute;
|
|
begin
|
|
Sleep(FDelay);
|
|
if FHintWindow <> nil then
|
|
begin
|
|
FHintWindow.Visible := False;
|
|
FHintWindow.ActivateHint(Rect(0, 0, 0, 0), '');
|
|
FHintWindow := nil;
|
|
end;
|
|
Terminate;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewControl.SetSelection(const Value: TJvPreviewSelection);
|
|
begin
|
|
FSelection.Assign(Value);
|
|
end;
|
|
|
|
//=== { TJvPreviewSelection } ================================================
|
|
|
|
constructor TJvPreviewSelection.Create;
|
|
begin
|
|
inherited Create;
|
|
FColor := clNavy;
|
|
FWidth := 4;
|
|
FVisible := True;
|
|
end;
|
|
|
|
procedure TJvPreviewSelection.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TJvPreviewSelection then
|
|
begin
|
|
if Source = Self then
|
|
Exit;
|
|
FColor := TJvPreviewSelection(Source).Color;
|
|
FWidth := TJvPreviewSelection(Source).Width;
|
|
FVisible := TJvPreviewSelection(Source).Visible;
|
|
Change;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TJvPreviewSelection.Change;
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
procedure TJvPreviewSelection.SetColor(const Value: TColor);
|
|
begin
|
|
if FColor <> Value then
|
|
begin
|
|
FColor := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewSelection.SetWidth(const Value: Integer);
|
|
begin
|
|
if FWidth <> Value then
|
|
begin
|
|
FWidth := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewSelection.SetVisible(const Value: Boolean);
|
|
begin
|
|
if FVisible <> Value then
|
|
begin
|
|
FVisible := Value;
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|
|
|