pspreview.pas

GREATIS Print Suite Pro for Delphi (3-7,2005,2006,2007) and C++ Builder (3-6) Set of components for

(*  GREATIS PRINT SUITE                              *)
(*  unit version 1.85.076                            *)
(*  Copyright (C) 2001-2007 Greatis Software         *)
(*  http://www.greatis.com/delphicb/printsuite/      *)
(*  http://www.greatis.com/delphicb/printsuite/faq/  *)
(*  http://www.greatis.com/bteam.html                *)

unit PSPreview;

interface

{$IFDEF VER100}
  {$DEFINE VERSION3}
{$ENDIF}
{$IFDEF VER110}
  {$DEFINE VERSION3}
{$ENDIF}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PSJob, ExtCtrls, Printers, PSCommon, Clipbrd;

type

  TCustomPreview = class;

  TSpecialScrollBox = class(TScrollBox)
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TDrawPanel = class(TPanel)
  private
    Drag: TPoint;
    FMetafile: TMetafile;
    function GetPreview: TCustomPreview;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure Click; 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;
    procedure WMLMouseDoubleClk(var Msg: TMessage); message WM_LBUTTONDBLCLK;
    procedure WMRMouseDoubleClk(var Msg: TMessage); message WM_RBUTTONDBLCLK;
    property Preview: TCustomPreview read GetPreview;
    property Canvas;
  end;

  TViewMode = (vmWholePage,vmPageWidth,vmCustom);

  TCustomPreview = class(TWinControl)
  private
    { Private declarations }
    FPrintJob: TCustomPrintJob;
    FControls: TList;
    FScrollBox: TSpecialScrollBox;
    FPage: TDrawPanel;
    FColor: TColor;
    FShadowColor: TColor;
    FShadowSize: Integer;
    FViewMode: TViewMode;
    FViewScale: Integer;
    FPageIndex: Integer;
    FScrollTracking: Boolean;
    FDragScroll: Boolean;
    FOnUpdate: TNotifyEvent;
    FOnPageChanged: TNotifyEvent;
    procedure SetPrintJob(const Value: TCustomPrintJob);
    function GetBorderStyle: TBorderStyle;
    procedure SetBorderStyle(const Value: TBorderStyle);
    function GetCtl3D: Boolean;
    procedure SetCtl3D(const Value: Boolean);
    function GetParentCtl3D: Boolean;
    procedure SetParentCtl3D(const Value: Boolean);
    procedure SetColor(const Value: TColor);
    procedure SetShadowColor(const Value: TColor);
    procedure SetShadowSize(const Value: Integer);
    procedure SetViewMode(const Value: TViewMode);
    procedure SetViewScale(const Value: Integer);
    procedure SetPageIndex(const Value: Integer);
    procedure SetScrollTracking(const Value: Boolean);
    function GetCursor: TCursor;
    procedure SetCursor(const Value: TCursor);
    function GetScaleText: string;
    function GetPageText: string;
  protected
    { Protected declarations }
    procedure WndProc(var Msg: TMessage); override;
    procedure CMChildKey(var Msg: TCMChildKey); message CM_CHILDKEY;
    {$IFNDEF VERSION3}
    procedure CMMouseWheel(var Msg: TCMMouseWheel); message CM_MOUSEWHEEL;
    {$ENDIF}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Update; override;
    procedure Repaint; override;
    procedure AddControlNotification(Control: TControl);
    procedure DeleteControlNotification(Control: TControl);
    procedure ZoomIn;
    procedure ZoomOut;
    function DPIX: Integer;
    function DPIY: Integer;
    procedure GetBitmap(BMP: TBitmap);
    procedure GetContentBitmap(BMP: TBitmap);
    procedure CopyToClipboard;
    procedure SaveToFile(const FileName: string);
    property ScaleText: string read GetScaleText;
    property PageText: string read GetPageText;
    property PrintJob: TCustomPrintJob read FPrintJob write SetPrintJob;
    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsSingle;
    property Cursor: TCursor read GetCursor write SetCursor default crdefault;
    property Ctl3D: Boolean read GetCtl3D write SetCtl3D default True;
    property ParentCtl3D: Boolean read GetParentCtl3D write SetParentCtl3D default True;
    property Color: TColor read FColor write SetColor default clGray;
    property ShadowColor: TColor read FShadowColor write SetShadowColor default $00404040;
    property ShadowSize: Integer read FShadowSize write SetShadowSize default 8;
    property ViewMode: TViewMode read FViewMode write SetViewMode default vmWholePage;
    property ViewScale: Integer read FViewScale write SetViewScale default 0;
    property PageIndex: Integer read FPageIndex write SetPageIndex default 1;
    property ScrollTracking: Boolean read FScrollTracking write SetScrollTracking default False;
    property DragScroll: Boolean read FDragScroll write FDragScroll default False;
    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
    property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged;
  end;

  TPreview = class(TCustomPreview)
  published
    { Published declarations }
    property PrintJob;
    property BorderStyle;
    property Cursor;
    property Ctl3D;
    property ParentCtl3D;
    property Color;
    property ShadowColor;
    property ShadowSize;
    property ViewMode;
    property ViewScale;
    property PageIndex;
    property ScrollTracking;
    property DragScroll;
    property OnUpdate;
    property OnPageChanged;
    property Align;
    property TabStop;
    property TabOrder;
    property Visible;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
  end;

procedure Register;

implementation

{ TSpecialScrollBox }

constructor TSpecialScrollBox.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle:=ControlStyle-[csAcceptsControls];
end;

{ TDrawPanel }

function TDrawPanel.GetPreview: TCustomPreview;
begin
  Result:=Owner as TCustomPreview;
end;

constructor TDrawPanel.Create(AOwner: TComponent);
begin
  inherited;
  FMetafile:=TMetafile.Create;
  ControlStyle:=ControlStyle+[csCaptureMouse]-[csAcceptsControls];
  ParentCtl3D:=False;
  Ctl3D:=False;
  Left:=8;
  Top:=8;
end;

destructor TDrawPanel.Destroy;
begin
  FMetafile.Free;
  inherited;
end;

procedure TDrawPanel.Paint;
var
  PageRgn: HRGN;
  R,PageRect,PrintableRect: TRect;
begin
  if Assigned(Preview) and Assigned(Preview.PrintJob) then
    with Preview,PrintJob.ActiveInstance(PageIndex),Self,Canvas,R do
    begin
      ResetToDefaultPage;
      R:=ClientRect;
      PageRect:=Rect(Left,Top,Right-ShadowSize,Bottom-ShadowSize);
      PrintableRect:=PageRect;
      InflateRect(PrintableRect,-1,-1);
      Inc(PrintableRect.Left,GetDeviceCaps(Printer.Handle,PHYSICALOFFSETX)*(PageRect.Right-PageRect.Left) div GetDeviceCaps(Printer.Handle,PHYSICALWIDTH));
      Inc(PrintableRect.Top,GetDeviceCaps(Printer.Handle,PHYSICALOFFSETY)*(PageRect.Bottom-PageRect.Top) div GetDeviceCaps(Printer.Handle,PHYSICALHEIGHT));
      PrintableRect.Right:=PrintableRect.Left+Printer.PageWidth*(PageRect.Right-PageRect.Left) div GetDeviceCaps(Printer.Handle,PHYSICALWIDTH);
      PrintableRect.Bottom:=PrintableRect.Top+Printer.PageHeight*(PageRect.Bottom-PageRect.Top) div GetDeviceCaps(Printer.Handle,PHYSICALHEIGHT);
      if ShadowSize>0 then
      begin
        Brush.Color:=ShadowColor;
        with PageRect do ExcludeClipRect(Handle,Left,Top,Right,Bottom);
        try
          FillRect(Rect(Left+ShadowSize,Top+ShadowSize,Right,Bottom));
        finally
          SelectClipRgn(Handle,0);
        end;
      end;
      if not (csDesigning in ComponentState) then
      begin
        R:=PageRect;
        InflateRect(R,-1,-1);
        with PrintableRect do
          PageRgn:=CreateRectRgn(Left,Top,Right,Bottom);
        try
          SelectClipRgn(Handle,PageRgn);
          try
            StretchDraw(R,FMetafile);
          finally
            SelectClipRgn(Handle,0);
          end;
        finally
          DeleteObject(PageRgn);
        end;
        Brush.Style:=bsSolid;
        Brush.Color:=ShadowColor;
        with PrintableRect do ExcludeClipRect(Handle,Left,Top,Right,Bottom);
        try
          Pen.Color:=clBlack;
          Brush.Color:=clWhite;
          with PageRect do Rectangle(Left,Top,Right,Bottom);
        finally
          SelectClipRgn(Handle,0);
        end;
      end
      else
      begin
        Pen.Color:=clBlack;
        Brush.Color:=clWhite;
        with PageRect do Rectangle(Left,Top,Right,Bottom);
      end;
    end
  else
    with Canvas do
    begin
      Brush.Color:=Color;
      Brush.Style:=bsSolid;
      FillRect(ClientRect);
    end;
end;

procedure TDrawPanel.Click;
begin
  if Assigned(Preview) then Preview.SetFocus;
end;

procedure TDrawPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
  inherited;
  if Assigned(Preview) and Preview.FDragScroll then
  begin
    SetCapture(Handle);
    SetCursor(LoadCursor(0,IDC_SIZEALL));
    Drag:=Point(X,Y);
  end;
end;

procedure TDrawPanel.MouseMove(Shift: TShiftState; X,Y: Integer);
begin
  inherited;
  if (GetCapture=Handle) and Assigned(Preview) then
    with Preview,FScrollBox do
    begin
      with HorzScrollBar do Position:=Position-X+Drag.X;
      with VertScrollBar do Position:=Position-Y+Drag.Y;
    end;
end;

procedure TDrawPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
  if GetCapture=Handle then
  begin
    SetCursor(Screen.Cursors[crDefault]);
    ReleaseCapture;
  end;
  inherited;
end;

procedure TDrawPanel.WMLMouseDoubleClk(var Msg: TMessage);
begin
  if Assigned(Preview) then
    with Preview do
      ZoomIn;
end;

procedure TDrawPanel.WMRMouseDoubleClk(var Msg: TMessage);
begin
  if Assigned(Preview) then
    with Preview do
      ZoomOut;
end;

{ TCustomPreview }

constructor TCustomPreview.Create(AOwner: TComponent);
begin
  inherited;
  FControls:=TList.Create;
  ControlStyle:=ControlStyle-[csAcceptsControls];
  Width:=100;
  Height:=150;
  TabStop:=True;
  FPageIndex:=1;
  FColor:=clGray;
  FShadowColor:=$00404040;
  FShadowSize:=8;
  FScrollBox:=TSpecialScrollBox.Create(Self);
  with FScrollBox do
  begin
    Align:=alClient;
    Color:=clGray;
    Ctl3D:=False;
    ParentCtl3D:=True;
    HorzScrollBar.Increment:=8;
    VertScrollBar.Increment:=8;
    Parent:=Self;
  end;
  FPage:=TDrawPanel.Create(Self);
  with FPage do
  begin
    Left:=8;
    Top:=8;
    Width:=46;
    Height:=67;
    Color:=Self.Color;
    Parent:=FScrollBox;
  end;
  Update;
end;

destructor TCustomPreview.Destroy;
begin
  FControls.Free;
  if Assigned(FPrintJob) then FPrintJob.DeleteControlNotification(Self);
  inherited;
end;

procedure TCustomPreview.Update;
var
  i: Integer;
  TheCanvas: TCanvas;
begin
  if Assigned(PrintJob) and PrintJob.PrinterOK then
  begin
    if FPageIndex>PrintJob.PageCount then FPageIndex:=PrintJob.PageCount;
    with FPage do
    begin
      Color:=Self.Color;
      try
        if not (csLoading in Self.ComponentState) then
        begin
          case FViewMode of
            vmPageWidth:
            begin
              Left:=8;
              Top:=8;
              Width:=FScrollBox.Width-20-GetSystemMetrics(SM_CXVSCROLL);
              with PrintJob.ActiveInstance(FPageIndex) do
                ClientHeight:=
                  ShadowSize+2+
                  Round(
                    (ClientWidth-ShadowSize-2)*
                    ConvertUnits(PageHeight,PageUnits,unPixels,dirVertical,PhysicalPageHeight)/
                    ConvertUnits(PageWidth,PageUnits,unPixels,dirHorizontal,PhysicalPageWidth));
              with FScrollBox do
              begin
                VertScrollBar.Range:=FPage.Height+16;
                HorzScrollBar.Range:=0;
              end;
            end;
            vmWholePage:
            begin
              with FScrollBox do
              begin
                VertScrollBar.Range:=0;
                HorzScrollBar.Range:=0;
                VertScrollBar.Position:=0;
                HorzScrollBar.Position:=0;
              end;
              Height:=FScrollBox.ClientHeight-16-ShadowSize;
              with PrintJob.ActiveInstance(FPageIndex) do
                ClientWidth:=
                  ShadowSize+2+
                  Round(
                    (ClientHeight-ShadowSize-2)*
                    ConvertUnits(PageWidth,PageUnits,unPixels,dirHorizontal,PhysicalPageWidth)/
                    ConvertUnits(PageHeight,PageUnits,unPixels,dirVertical,PhysicalPageHeight));
              if Width>FScrollBox.ClientWidth-16 then
              begin
                Width:=FSCrollBox.ClientWidth-16;
                with PrintJob.ActiveInstance(FPageIndex) do
                  ClientHeight:=
                    Round(
                      ClientWidth*
                      ConvertUnits(PageHeight,PageUnits,unPixels,dirVertical,PhysicalPageHeight)/
                      ConvertUnits(PageWidth,PageUnits,unPixels,dirHorizontal,PhysicalPageWidth));
              end;
              Left:=(FScrollBox.ClientWidth-Width) div 2;
              Top:=(FScrollBox.ClientHeight-Height) div 2;
            end;
            vmCustom:
            begin
              with FScrollBox do
              begin
                VertScrollBar.Position:=0;
                HorzScrollBar.Position:=0;
              end;
              with PrintJob.ActiveInstance(FPageIndex) do
              begin
                ClientWidth:=
                  Round(
                    ViewScale*
                    ConvertUnits(
                      PageWidth,
                      PageUnits,
                      unPixels,
                      dirHorizontal,
                      PhysicalPageWidth)*
                    Screen.PixelsPerInch/
                    GetDeviceCaps(Printer.Handle,LOGPIXELSX)/100)+2;
                ClientHeight:=
                  ShadowSize+2+
                  Round(
                    (ClientWidth-ShadowSize-2)*
                    ConvertUnits(
                      PageHeight,
                      PageUnits,
                      unPixels,
                      dirHorizontal,
                      PhysicalPageHeight)/
                    ConvertUnits(
                      PageWidth,
                      PageUnits,
                      unPixels,