frmpreview.pas

Apprehend Screen Capture Component Version 4.2 A non-visible component to capture images. Freeware w

//------------------------------------------------------------------------------
//  Apprehend Demo
//  Copyright (c) 2000 : Copyright Adirondack Software & Graphics 1996-2000
//  Created            : 12-30-2000
//  Last Modification  : 12-30-2000
//  Description        : Print Preview Unit
//  Requires           : LMD Controls and Preview Components
//------------------------------------------------------------------------------

unit frmPreview;

interface

uses
   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   StdCtrls, ExtCtrls, Preview, Dialogs, PgSetup, Printers, lmdcompo,
   lmdclass, lmdnonvS, ImageENView, Buttons, LMDCustomComponent,
  LMDCustomHint, LMDCustomShapeHint, LMDShapeHint;

type
   TfrmPrintPreview = class(TForm)
      Panel1: TPanel;
      ComboBox1: TComboBox;
      Label1: TLabel;
      PrintPreview: TPrintPreview;
      dfsPageSetupDialog1: TdfsPageSetupDialog;
      LMDShapeHint1: TLMDShapeHint;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
      procedure FormCreate(Sender: TObject);
      procedure FormActivate(Sender: TObject);
      procedure ComboBox1Change(Sender: TObject);
      procedure PrintClick(Sender: TObject);
      procedure PrintPreviewNewPage(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure SetMarginsClick(Sender: TObject);
      procedure CloseClick(Sender: TObject);
      procedure PrintPreviewPrintProgress(Sender: TObject; PageNum,
         Progress: Integer; var AbortIt: Boolean);
   private
    { Private declarations }
      procedure CreatePages;
   public
    { Public declarations }
   end;

var
   frmPrintPreview: TfrmPrintPreview;

implementation

uses frmMain, frmAbortPrint;

{$R *.DFM}

procedure TfrmPrintPreview.FormCreate(Sender: TObject);
begin
   ComboBox1.ItemIndex := 2;
end;

procedure TfrmPrintPreview.FormActivate(Sender: TObject);
const
   FirstTime: Boolean = True;
begin
   if FirstTime then
   begin
      FirstTime := False;
      Update;
   end;
end;

procedure TfrmPrintPreview.ComboBox1Change(Sender: TObject);
begin
   case ComboBox1.ItemIndex of
      0: PrintPreview.Zoom := 50;
      1: PrintPreview.Zoom := 75;
      2: PrintPreview.Zoom := 100;
      3: PrintPreview.Zoom := 150;
      4: PrintPreview.Zoom := 200;
      5: PrintPreview.ZoomState := zsZoomToWidth;
      6: PrintPreview.ZoomState := zsZoomToFit;
   end;
   ActiveControl := PrintPreview;
end;

procedure TfrmPrintPreview.PrintClick(Sender: TObject);
begin
   if PrintPreview.State = psReady then begin
      if FormMain.fFilename = '' then
         PrintPreview.PrintJobTitle := 'Apprehend <Untitled>' else
         PrintPreview.PrintJobTitle := FormMain.fFilename;
      if FormMain.fFilename = '' then
         frmAbort.PrintStatus.Caption := 'Printing Apprehend <Untitled>' else
         frmAbort.PrintStatus.Caption := 'Printing ' + FormMain.FFilename;
      frmAbort.Show;
      PrintPreview.Print;
      frmAbort.Hide;
   end;
   ActiveControl := PrintPreview;
end;

procedure TfrmPrintPreview.PrintPreviewNewPage(Sender: TObject);
begin
   with PrintPreview do
   begin
      { The following line ensures one pixel pen width in any mapping mode. }
      Canvas.Pen.Width := 0;
      Canvas.Brush.Style := bsCLear;
      // enable this to draw a rect around page margins
      // with PageRect do Canvas.Rectangle(Left, Top, Right, Bottom);
   end;
end;

function ThousandthsToPixels(const ARect: TRect): TRect;
 // Conversion function to convert 1/1000" to pixels
var
   LogX, LogY: integer;
begin
   LogX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
   LogY := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
   Result.Left := (ARect.Left * LogX div 1000) -
      GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
   Result.Top := ARect.Top * LogY div 1000 -
      GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
   Result.Right := Printer.PageWidth - (ARect.Right * LogX div 1000) +
      GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
   Result.Bottom := Printer.PageHeight - (ARect.Bottom * LogY div 1000) +
      GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
end;

function HundredthsToPixels(ARect: TRect): TRect;
 // Conversion function to convert 1/100 mm to pixels
begin
   ARect.Left := Round(ARect.Left / 2.54);
   ARect.Top := Round(ARect.Top / 2.54);
   ARect.Right := Round(ARect.Right / 2.54);
   ARect.Bottom := Round(ARect.Bottom / 2.54);
   // No system api call to get the logical pixels in a metric unit.  Have to
   // get it per inch and then convert to metric.
   Result := ThousandthsToPixels(ARect);
end;

{ In this example, the code is independent of Units property of PrintPreview.
  If you use only one measuremnt unit for PrintPreview, you can
  easily use constant values instead of passing them to ConvertUnit method.
  Something else, precision of mmLoEnglish unit is not enough for choosing small
  font size (the smallest font can be 1/10") and then in this example I have used
  different code for mmLoEnglish to increase font size. }
procedure TfrmPrintPreview.CreatePages;
var
   R: TRect;
begin
   Randomize;
   with PrintPreview do
   begin
      Units := TUnits(0);
      BeginDoc;

      if dfsPageSetupDialog1.CurrentMeasurements = pmInches then
         R := ThousandthsToPixels(dfsPageSetupDialog1.Margins.Rect)
      else
         R := HundredthsToPixels(dfsPageSetupDialog1.Margins.Rect);

      { Finally, we draw the image here. }
      Canvas.StretchDraw(R, TImageENView(FormMain.PageControl1.ActivePage.Tag).Bitmap);

      Canvas.Font.Height := -ConvertUnit(14, mmHiEnglish, Units);

      if FormMain.FFilename = '' then FormMain.FFilename := 'Apprehend <Untitled>';

      { Draw the text. }
      Canvas.TextOut(R.Left, R.Bottom + ConvertUnit(14, mmHiEnglish, Units), 'Filename: ' + FormMain.FFilename);

      EndDoc;
   end;
    { If there's any installed printer on the system, we permit printing. }
   SpeedButton2.Enabled := PrintPreview.PrinterInstalled;
   ActiveControl := PrintPreview;
end;

procedure TfrmPrintPreview.FormShow(Sender: TObject);
begin
   CreatePages;
end;

procedure TfrmPrintPreview.SetMarginsClick(Sender: TObject);
begin
   if dfsPageSetupDialog1.Execute then begin
      PrintPreview.Orientation := Printer.Orientation;
      CreatePages;
   end;
end;

procedure TfrmPrintPreview.PrintPreviewPrintProgress(Sender: TObject;
   PageNum, Progress: Integer; var AbortIt: Boolean);
begin
   if frmAbort.Aborted then AbortIt := True;
end;

procedure TfrmPrintPreview.CloseClick(Sender: TObject);
begin
   Close;
end;



end.