prvieweh.pas

EhLib 4.2.16 中文汉化版 （Faceker.com 修改版） 1. DataServiceEhLibADO.pas 第40行

{*******************************************************}
{                                                       }
{                       EhLib v4.2                      }
{                  TPreviewBox component                }
{                                                       }
{   Copyright (c) 1998-2006 by Dmitry V. Bolshakov      }
{                                                       }
{*******************************************************}

unit PrViewEh {$IFDEF CIL} platform{$ENDIF};

{$I EhLib.Inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, PrntsEh,
{$IFDEF CIL}
  WinUtils,
{$ELSE}
{$ENDIF}
  ExtCtrls, Printers;

type

  TViewMode = (vm500, vm200, vm150, vm100, vm75, vm50, vm25, vm10, vmPageWidth, vmFullPage);

{ TDrawPanel }

  TDrawPanel = class(TPanel)
  private
    FOldMousePos: TPoint;
    procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Canvas;
  end;

  TPrinterPreview = class;

{ TPreviewBox }

  TPreviewBox = class(TScrollBox)
  private
    FDrawPanel: TDrawPanel;
    FOnOpenPreviewer: TNotifyEvent;
    FOnPrinterPreviewChanged: TNotifyEvent;
    FOnPrinterSetupChanged: TNotifyEvent;
    FOnPrinterSetupDialog: TNotifyEvent;
    FPageCount: Integer;
    FPageIndex: Integer;
    FPrinter: TPrinterPreview;
    FPrinterSetupOwner: TComponent;
    FViewMode: TViewMode;
    pnlShadow: TPanel;
//    FOnNeedOpenPreview: TNotifyEvent;
    procedure SetPageIndex(Value: Integer);
    procedure SetPrinter(const Value: TPrinterPreview);
    procedure SetPrinterSetupOwner(const Value: TComponent);
    procedure SetViewMode(const Value: TViewMode);
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    FScalePercent: Integer;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure PrintDialog;
    procedure PrinterSetupDialog;
    procedure UpdatePageSetup;
    procedure UpdatePreview;
    property OnPrinterSetupChanged: TNotifyEvent read FOnPrinterSetupChanged { write FOnPrinterSetupChanged};
    property OnPrinterSetupDialog: TNotifyEvent read FOnPrinterSetupDialog { write FOnPrinterSetupDialog};
    property PageCount: Integer read FPageCount;
    property PageIndex: Integer read FPageIndex write SetPageIndex;
    property Printer: TPrinterPreview read FPrinter write SetPrinter;
    property PrinterSetupOwner: TComponent read FPrinterSetupOwner write SetPrinterSetupOwner;
    property ViewMode: TViewMode read FViewMode write SetViewMode;
  published
    property OnOpenPreviewer: TNotifyEvent read FOnOpenPreviewer write FOnOpenPreviewer;
    property OnPrinterPreviewChanged: TNotifyEvent read FOnPrinterPreviewChanged write FOnPrinterPreviewChanged;
//    property OnNeedOpenPreview:TNotifyEvent read FOnNeedOpenPreview write FOnNeedOpenPreview;
  end;

//  TGetPreviewerEvent = function (Sender: TObject): TPreviewBox of object;

{ TPrinterPreview }

  TPrinterPreview = class(TVirtualPrinter)
  private
    FAborted: Boolean;
    FMetafileCanvas: TMetafileCanvas;
    FMetafileList: TList;
    FOnPrinterSetupChanged: TNotifyEvent;
    FOnPrinterSetupDialog: TNotifyEvent;
    FPageNumber: Integer;
    FPreviewer: TPreviewBox;
    FPrinter: TPrinter;
    FPrinterSetupOwner: TComponent;
    FPrinting: Boolean;
//    FOnGetPreviewer: TGetPreviewerEvent;
//    FOnOpenPreviewer: TNotifyEvent;
    function GetPropPrinter: TPrinter;
    procedure SetOnPrinterSetupDialog(const Value: TNotifyEvent);
    procedure SetPreviewer(const Value: TPreviewBox);
//    function Previewer: TPreviewBox;
  protected
    function GetAborted: Boolean; override;
    function GetCanvas: TCanvas; override;
    function GetCapabilities: TPrinterCapabilities; override;
    function GetFonts: TStrings; override;
    function GetFullPageHeight: Integer; override;
    function GetFullPageWidth: Integer; override;
    function GetHandle: HDC; override;
    function GetNumCopies: Integer; override;
    function GetOrientation: TPrinterOrientation; override;
    function GetPageHeight: Integer; override;
    function GetPageNumber: Integer; override;
    function GetPageWidth: Integer; override;
    function GetPrinterIndex: Integer; override;
    function GetPrinters: TStrings; override;
    function GetPrinting: Boolean; override;
    function GetTitle: String; override;
    function GetPixelsPerInchX: Integer; override;
    function GetPixelsPerInchY: Integer; override;
    procedure DrawPage(Sender: TObject; Canvas: TCanvas; PageNumber: Integer);
    procedure SetNumCopies(const Value: Integer); override;
    procedure SetOrientation(const Value: TPrinterOrientation); override;
    procedure SetPrinterIndex(const Value: Integer); override;
    procedure SetTitle(const Value: string); override;
    procedure ShowProgress(Percent: Integer); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Abort; override;
    procedure BeginDoc; override;
    procedure EndDoc; override;
{$IFDEF CIL}
    procedure GetPrinter(ADevice, ADriver, APort: String; var ADeviceMode: IntPtr); override;
    procedure SetPrinter(ADevice, ADriver, APort: String; ADeviceMode: IntPtr); override;
{$ELSE}
    procedure GetPrinter(ADevice, ADriver, APort: PChar; var ADeviceMode: THandle); override;
    procedure SetPrinter(ADevice, ADriver, APort: PChar; ADeviceMode: THandle); override;
{$ENDIF}
    procedure NewPage; override;
    procedure OpenPreview;
    procedure Print;
    property OnPrinterSetupChanged: TNotifyEvent read FOnPrinterSetupChanged write FOnPrinterSetupChanged;
    property OnPrinterSetupDialog: TNotifyEvent read FOnPrinterSetupDialog write SetOnPrinterSetupDialog;
    property Previewer: TPreviewBox read FPreviewer write SetPreviewer;
    property Printer: TPrinter read GetPropPrinter;
    property PrinterSetupOwner: TComponent read FPrinterSetupOwner write FPrinterSetupOwner;
    property PixelsPerInchX: Integer read GetPixelsPerInchX;
    property PixelsPerInchY: Integer read GetPixelsPerInchY;
//    property OnGetPreviewer: TGetPreviewerEvent read FOnGetPreviewer write FOnGetPreviewer;
//    property OnOpenPreviewer: TNotifyEvent read FOnOpenPreviewer write FOnOpenPreviewer;
  end;


function PrinterPreview: TPrinterPreview;
function SetPrinterPreview(NewPrinterPreview: TPrinterPreview): TPrinterPreview;

const
  DefaultPrinterPhysicalOffSetX: Integer = 130;
  DefaultPrinterPhysicalOffSetY: Integer = 150;
  DefaultPrinterPageWidth: Integer = 4676;
  DefaultPrinterPageHeight: Integer = 6744;
  DefaultPrinterPixelsPerInchX: Integer = 600;
  DefaultPrinterPixelsPerInchY: Integer = 600;
  DefaultPrinterVerticalSizeMM: Integer = 285;
  DefaultPrinterHorizontalSizeMM: Integer = 198;

implementation

{$R PrViewEh.RES}

uses PrvFrmEh {$IFDEF EH_LIB_6} ,Types {$ENDIF};

var crMagnifier: Integer = 0;
  crHand: Integer = 0;

var
  FPrinterPreview: TPrinterPreview = nil;

function PrintersSetPrinter(NewPrinter: TPrinter): TPrinter;
begin
  Result := SetPrinter(NewPrinter);
end;

function PrintersPrinter: TPrinter;
begin
  Result := Printer;
end;

{ TDrawPanel }

constructor TDrawPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Color := clWhite;
  //Visible:=False;
  Cursor := crMagnifier;
  ControlStyle := ControlStyle + [csCaptureMouse];
end;

procedure TDrawPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WindowClass.style := Params.WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;

procedure TDrawPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  FOldMousePos := Point(X, Y);
end;

procedure TDrawPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var Parent: TPreviewBox;
  oldScrollPos: TPoint;
begin
  inherited MouseMove(Shift, X, Y);
  Parent := TPreviewBox(Self.Parent);
  if (ssLeft in Shift) and
    ((FOldMousePos.x <> X) or (FOldMousePos.y <> Y) or (Cursor = crHand)) and
    MouseCapture then
  begin
    if (Cursor <> crHand) then
    begin
      Cursor := crHand;
      Perform(WM_SETCURSOR, Handle, HTCLIENT);
    end;
    oldScrollPos := Point(Parent.HorzScrollBar.Position, Parent.VertScrollBar.Position);
    Parent.VertScrollBar.Position := Parent.VertScrollBar.Position + FOldMousePos.y - Y;
    Parent.HorzScrollBar.Position := Parent.HorzScrollBar.Position + FOldMousePos.x - X;
    if oldScrollPos.x = Parent.HorzScrollBar.Position then FOldMousePos.x := X;
    if oldScrollPos.y = Parent.VertScrollBar.Position then FOldMousePos.y := Y;
  end;
end;

procedure TDrawPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var oldh, oldw, oldl, oldt: Integer;
  Parent: TPreviewBox;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if (Button = mbLeft) and (Cursor = crMagnifier) then
  begin
    Parent := TPreviewBox(Self.Parent);
    if Parent.ViewMode = vmFullPage then
    begin
      oldh := Height; oldw := Width;
      oldl := Left; oldt := Top;
      Parent.ViewMode := vm150;
      Parent.VertScrollBar.Position := Height * Y div oldh + 16 - oldt - Y;
      Parent.HorzScrollBar.Position := Width * X div oldw + 16 - oldl - X;
    end
    else Parent.ViewMode := vmFullPage;
  end
  else Cursor := crMagnifier;
end;

procedure TDrawPanel.Paint;
var
  FullWidth, FullHeight, XOffSet, YOffSet: Integer;
  Parent: TPreviewBox;
begin
  Parent := TPreviewBox(Self.Parent);
  if Parent.Printer.Printers.Count > 0 then
  begin
    XOffSet := GetDeviceCaps(Parent.Printer.Handle, PHYSICALOFFSETX);
    YOffSet := GetDeviceCaps(Parent.Printer.Handle, PHYSICALOFFSETY);
  end else
  begin
    XOffSet := DefaultPrinterPhysicalOffSetX;
    YOffSet := DefaultPrinterPhysicalOffSetY;
  end;
  FullWidth := Parent.Printer.PageWidth + XOffSet * 2;
  FullHeight := Parent.Printer.PageHeight + YOffSet * 2;
  with Canvas do
  begin
    Brush.Color := clWhite;
    Brush.Style := bsSolid;
    FillRect(ClientRect);
    SetMapMode(Canvas.Handle, mm_AnIsotropic);
    SetWindowExtEx(Canvas.Handle, FullWidth, FullHeight, nil);
    SetViewportExtEx(Canvas.Handle, Width, Height, nil);
    SetViewportOrgEx(Canvas.Handle, Trunc(XOffSet * Width / FullWidth),
      Trunc(YOffSet * Height / FullHeight), nil);

    if Parent.Printer.Printers.Count > 0 then
    begin
      Font.PixelsPerInch := GetDeviceCaps(Parent.Printer.Handle, LOGPIXELSX);
      if Font.PixelsPerInch > GetDeviceCaps(Parent.Printer.Handle, LOGPIXELSY) then
        Font.PixelsPerInch := GetDeviceCaps(Parent.Printer.Handle, LOGPIXELSY);
    end
    else
      Font.PixelsPerInch := DefaultPrinterPixelsPerInchX;

    if Assigned(Parent.Printer) and (Parent.PageCount > 0) then
      Parent.Printer.DrawPage(Self, Self.Canvas, Parent.PageIndex);
  end;
end;

procedure TDrawPanel.WMCancelMode(var Message: TWMCancelMode);
begin
  inherited;
  if Cursor = crHand then Cursor := crMagnifier;
end;

{ TPreviewBox }

constructor TPreviewBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls]; //clip_children
  FViewMode := vm100;
  FPageCount := 0;
  FPageIndex := 1;
  pnlShadow := TPanel.Create(Self {AOwner});
  with pnlShadow do
  begin
    ControlStyle := ControlStyle - [csAcceptsControls];
    Parent := Self;
    BevelOuter := bvNone;
    Color := 4210752;
    Enabled := False;
    TabOrder := 0;
    //Visible := False;
  end;
  FDrawPanel := TDrawPanel.Create(Self {AOwner});
  with FDrawPanel do
  begin
    ControlStyle := ControlStyle - [csAcceptsControls];
    Parent := Self;
    BevelOuter := bvNone;
    ParentCtl3D := False;
    Ctl3D := False;
    BorderStyle := bsSingle;
    Left := 8;
    Top := 8;
  end;
  FPrinter := TPrinterPreview.Create;
  FPrinter.Previewer := Self;