www.pudn.com > yrsCapture.zip > preview.pas

{******************************************************************************} 
{*                                                                            *} 
{*            Adirondack Software & Graphics Print Preview Unit               *} 
{*         (C) Copyright Adirondack Software & Graphics 1996-1998             *} 
{*                                                                            *} 
{******************************************************************************} 
 
unit Preview; 
 
interface 
 
uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, 
  ExtCtrls, Buttons, Printers, StdCtrls, Menus; 
 
type 
  TPreviewForm = class( TForm ) 
    Panel1: TPanel; 
    ScaleMinusButton: TSpeedButton; 
    PrintButton: TSpeedButton; 
    CancelButton: TSpeedButton; 
    Label1: TLabel; 
    Label2: TLabel; 
    ScrollBox1: TScrollBox; 
    Image1: TImage; 
    SetupSpeedButton: TSpeedButton; 
    PrinterSetupDialog1: TPrinterSetupDialog; 
    ScalePlusButton: TSpeedButton; 
    procedure ScalePlusButtonClick( Sender: TObject ); 
    procedure ScaleMinusButtonClick( Sender: TObject ); 
    procedure CancelButtonClick( Sender: TObject ); 
    procedure PrintButtonClick( Sender: TObject ); 
    procedure FormActivate( Sender: TObject ); 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure SetupSpeedButtonClick(Sender: TObject); 
    procedure Image1Click(Sender: TObject); 
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
  public 
    Scale: Integer; 
    Abort: Boolean; 
    Picture: TPicture; 
    procedure DrawPreview; 
    procedure SetPage; 
  end; 
 
var 
  PreviewForm: TPreviewForm; 
 
implementation 
 
Uses Main, Abort; 
 
{$R *.DFM} 
{$R Preview.Res} 
 
{==============================================================================} 
procedure TPreviewForm.SetPage; 
{==============================================================================} 
begin 
  // Set the image size to be proportional with the page size 
  Image1.Width := Printer.PageWidth div 5; 
  Image1.Height := Printer.PageHeight div 5; 
  // Output the scale to the toolbar 
  Label1.Caption := IntToStr ( Scale ); 
end; 
 
{==============================================================================} 
procedure TPreviewForm.ScalePlusButtonClick( Sender: TObject ); 
{==============================================================================} 
begin 
  // Increse the size of the bitmap 
  Scale := Scale * 2; 
  Label1.Caption := IntToStr ( Scale ); 
  DrawPreview; 
end; 
 
{==============================================================================} 
procedure TPreviewForm.DrawPreview; 
{==============================================================================} 
var 
  Rect: TRect; 
begin 
  // Compute the rectangle for the bitmap preview 
  Rect.Top := 10; 
  Rect.Left := 10; 
  Rect.Right := 10 + ( Picture.Graphic.Width * Scale ) div 5; 
  Rect.Bottom := 10 + ( Picture.Graphic.Height * Scale ) div 5; 
 
  // Remove the current image 
  Image1.Canvas.Pen.Mode := pmWhite; 
  Image1.Canvas.Rectangle ( 0, 0, Image1.Width, Image1.Height ); 
 
  // Stretch the bitmap into the rectangle 
  Image1.Canvas.StretchDraw ( Rect, Picture.Graphic ); 
end; 
 
{==============================================================================} 
procedure TPreviewForm.ScaleMinusButtonClick( Sender: TObject ); 
{==============================================================================} 
begin 
  // Decrease the size of the image 
  if Scale > 1 then 
  begin 
    Scale := Scale div 2; 
    Label1.Caption := IntToStr ( Scale ); 
    DrawPreview; 
  end; 
end; 
 
{==============================================================================} 
procedure TPreviewForm.CancelButtonClick( Sender: TObject ); 
{==============================================================================} 
begin 
  // Close ( hide ) the preview dialog 
  Close; 
end; 
 
{==============================================================================} 
procedure TPreviewForm.PrintButtonClick( Sender: TObject ); 
{==============================================================================} 
var 
  Rect: TRect; 
begin 
  // Compute the rectangle for the printer 
  Rect.Top := 10; 
  Rect.Left := 10; 
  Rect.Right := 10 + ( Picture.Graphic.Width * Scale ); 
  Rect.Bottom := 10 + ( Picture.Graphic.Height * Scale ); 
  AbortDlg.Show; 
  // Print the bitmap 
  Printer.BeginDoc; 
  Printer.Canvas.StretchDraw ( Rect, Picture.Graphic ); 
  Printer.EndDoc; 
  AbortDlg.Hide; 
end; 
 
{==============================================================================} 
procedure TPreviewForm.FormActivate( Sender: TObject ); 
{==============================================================================} 
const 
  crPreview = -20; 
begin 
  Screen.Cursors[crPreview] := LoadCursor( hInstance, pChar( 'PREVIEWCURSOR' ) ); 
  Cursor := crPreview; 
  Image1.Cursor := crPreview; 
  Abort := False; 
end; 
 
{==============================================================================} 
procedure TPreviewForm.FormCreate(Sender: TObject); 
{==============================================================================} 
var 
  aDC: HDC; 
const 
  crPreview = -20; 
begin 
  Screen.Cursors[crPreview] := LoadCursor( hInstance, pChar( 'PREVIEWCURSOR' ) ); 
  Cursor := crPreview; 
  Image1.Cursor := crPreview; 
  Picture := TPicture.Create; 
end; 
 
{==============================================================================} 
procedure TPreviewForm.FormDestroy(Sender: TObject); 
{==============================================================================} 
begin 
  Picture.Free; 
  Screen.Cursor := crDefault; 
end; 
 
{==============================================================================} 
procedure TPreviewForm.SetupSpeedButtonClick(Sender: TObject); 
{==============================================================================} 
begin 
   Screen.Cursor := crHourglass; 
   PrinterSetupDialog1.Execute; 
   Screen.Cursor := crDefault; 
end; 
 
procedure TPreviewForm.Image1Click(Sender: TObject); 
begin 
end; 
 
{==============================================================================} 
procedure TPreviewForm.Image1MouseDown(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
{==============================================================================} 
begin 
  case Button of 
    mbLeft: ScalePlusButtonClick(Sender); 
    mbRight: ScaleMinusButtonClick(Sender); 
  end; 
end; 
 
end.