⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 prvieweh.pas

📁 很COOL的GRID控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{*******************************************************}
{                                                       }
{                       EhLib v1.54                     }
{                  TPreviewBox component                }
{                                                       }
{   Copyright (c) 1998, 2000 by Dmitry V. Bolshakov     }
{                                                       }
{*******************************************************}

unit PrViewEh;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, PrntsEh,
  ExtCtrls, Printers;

type

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

  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 = class(TScrollBox)
  private
    FPrinter: TPrinterPreview;
    FPageIndex: Integer;
    FPageCount: Integer;
    FViewMode: TViewMode;
    FDrawPanel: TDrawPanel;
    pnlShadow: TPanel;
    FOnPrinterPreviewChanged: TNotifyEvent;
//    FOnNeedOpenPreview: TNotifyEvent;
    FOnPrinterSetupDialog: TNotifyEvent;
    FOnPrinterSetupChanged: TNotifyEvent;
    FOnOpenPreviewer: TNotifyEvent;
    FPrinterSetupOwner: TComponent;
    procedure SetPrinter(const Value: TPrinterPreview);
    procedure SetPageIndex(Value: Integer);
    procedure SetViewMode(const Value: TViewMode);
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure SetPrinterSetupOwner(const Value: TComponent);
  protected
    FScalePercent:Integer;
    procedure CreateParams(var Params: TCreateParams); override;
{$IFDEF EH_LIB_4}
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
{$ENDIF}
    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 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;
    property OnPrinterSetupDialog: TNotifyEvent read FOnPrinterSetupDialog{ write FOnPrinterSetupDialog};
    property OnPrinterSetupChanged: TNotifyEvent read FOnPrinterSetupChanged{ write FOnPrinterSetupChanged};
  published
    property OnPrinterPreviewChanged:TNotifyEvent read FOnPrinterPreviewChanged write FOnPrinterPreviewChanged;
//    property OnNeedOpenPreview:TNotifyEvent read FOnNeedOpenPreview write FOnNeedOpenPreview;
    property OnOpenPreviewer: TNotifyEvent read FOnOpenPreviewer write FOnOpenPreviewer;
  end;

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

  TPrinterPreview = class(TVirtualPrinter)
  private
    FOnPrinterSetupDialog: TNotifyEvent;
    FMetafileList:TList;
    FMetafileCanvas:TMetafileCanvas;
    FPageNumber:Integer;
    FAborted:Boolean;
    FPrinting:Boolean;
    FPrinter:TPrinter;
//    FOnGetPreviewer: TGetPreviewerEvent;
//    FOnOpenPreviewer: TNotifyEvent;
    FPreviewer: TPreviewBox;
    FOnPrinterSetupChanged: TNotifyEvent;
    FPrinterSetupOwner: TComponent;
    procedure SetOnPrinterSetupDialog(const Value: TNotifyEvent);
    function GetPropPrinter: TPrinter;
    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 GetHandle: HDC; override;
    function GetNumCopies: Integer; override;
    function GetOrientation: TPrinterOrientation; override;
    function GetPageHeight: Integer; override;
    function GetPageWidth: Integer; override;
    function GetPageNumber: Integer; override;
    function GetPrinting: Boolean; override;
    function GetTitle: String; override;
    function GetFullPageWidth: Integer; override;
    function GetFullPageHeight: Integer; override;
    function GetPrinterIndex: Integer; override;
    function GetPrinters: TStrings; override;
    procedure SetPrinterIndex(const Value: Integer); override;
    procedure SetNumCopies(const Value: Integer); override;
    procedure SetOrientation(const Value: TPrinterOrientation); override;
    procedure SetTitle(const Value: string); override;

    procedure DrawPage(Sender: TObject; Canvas: TCanvas;
      PageNumber: Integer);
    procedure ShowProgress(Percent:Integer); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Abort; override;
    procedure BeginDoc; override;
    procedure EndDoc; override;
    procedure NewPage; override;
    procedure GetPrinter(ADevice, ADriver, APort: PChar; var ADeviceMode: THandle); override;
    procedure SetPrinter(ADevice, ADriver, APort: PChar; ADeviceMode: THandle); override;
    procedure OpenPreview;
    procedure Print;
    property Previewer:TPreviewBox read FPreviewer write SetPreviewer;
    property Printer:TPrinter read GetPropPrinter;
    property PrinterSetupOwner: TComponent read FPrinterSetupOwner write FPrinterSetupOwner;
    property OnPrinterSetupDialog:TNotifyEvent read FOnPrinterSetupDialog write SetOnPrinterSetupDialog;
    property OnPrinterSetupChanged: TNotifyEvent read FOnPrinterSetupChanged write FOnPrinterSetupChanged;
//    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;

const 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 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;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -