jvprvwdoc.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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鰎nqvist.
Portions created by Peter Th鰎nqvist are Copyright (c) 2003 by Peter Th鰎nqvist.
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,v 1.35 2005/02/18 14:17:29 ahuser Exp $

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;
  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: '$RCSfile: JvPrvwDoc.pas,v $';
    Revision: '$Revision: 1.35 $';
    Date: '$Date: 2005/02/18 14:17:29 $';
    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