gmprinter.pas

GmPrintSuite 2.96.7] a

{******************************************************************************}
{                                                                              }
{                               GmPrinter.pas                                  }
{                                                                              }
{           Copyright (c) 2003 Graham Murt  - www.MurtSoft.co.uk               }
{                                                                              }
{   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
{                                                                              }
{                           [e-mail]                              }
{                                                                              }
{******************************************************************************}

unit GmPrinter;

interface

uses Windows, GmTypes, Forms, Graphics, Classes, GmClasses,
  GmConst, Dialogs;

type

  //----------------------------------------------------------------------------

  // *** TGmPrinterInfo ***

  TGmPrinterInfo = class
  private
    FDevice, FDriver, FPort: array[0..128] of Char;
    FDeviceMode: THandle;
    FDevMode: PDeviceMode;
    FPhysicalSize: TPoint;
    FPrintableSize: TPoint;
    FGutters: TRect;
    FOrientation: TGmOrientation;
    FPpi: TPoint;
    FRotationDirection: TGmPrinterRotation;
    FScreenPrinterScale: Extended;
    FIsUpdated: Boolean;
    FUseDefaultValues: Boolean;
    function GetAvailableHeight: integer;
    function GetAvailableWidth: integer;
    function GetGutters(AOrientation: TGmOrientation): TRect;
    function GetGuttersInch(AOrientation: TGmOrientation): TGmRect;
    function GetOrientation: TGmOrientation;
    function GetOrientationRotation: TGmPrinterRotation;
    function GetPhysicalSizeX: Extended;
    function GetPhysicalSizeY: Extended;
    function GetPpiX: integer;
    function GetPpiY: integer;
    function GetPrintableSizeX: Extended;
    function GetPrintableSizeY: Extended;
    function GmOpenPrinter: Boolean;
    function GetPrinterAvailable: HDC;
    procedure GmClosePrinter;
    procedure ResetPrinter;
    procedure UpdatePrinter;
    procedure UseDefaultValues;
  public
    constructor Create;
    //property MarginsPixels: TRect read GetGutters[Orientation: TGmOrientation];
    function PrinterAvailable: Boolean;
    property MarginsInches[Orientation: TGmOrientation]: TGmRect read GetGuttersInch;
    property Orientation: TGmOrientation read GetOrientation;
    property PhysicalSizeX: Extended read GetPhysicalSizeX;
    property PhysicalSizeY: Extended read GetPhysicalSizeY;
    property PpiX: integer read GetPpiX;
    property PpiY: integer read GetPpiY;
    property PrintableSizeX: Extended read GetPrintableSizeX;
    property PrintableSizeY: Extended read GetPrintableSizeY;

  end;

  //----------------------------------------------------------------------------

  // *** TGmPrinter ***

  TGmPrinter = class(TPersistent)
  private
    FAborted: Boolean;
    FFileName: string;
    FFont: TFont;
    FInitialized: Boolean;
    FOrientation: TGmOrientation;
    FPagesPerSheet: TGmPagesPerSheet;
    FPaperSizes: TStrings;
    FPrintCount: integer;
    FPrinterBins: TStrings;
    FPrinting: Boolean;
    FPrinterInfo: TGmPrinterInfo;
    FReversePrintOrder: Boolean;
    FTitle: string;
    // events...
    FOnAbortPrint: TNotifyEvent;
    FAfterPrint: TNotifyEvent;
    FBeforePrint: TNotifyEvent;
    FOnChangePrinter: TNotifyEvent;
    function GetAvailableHeight(Measurement: TGmMeasurement): Extended;
    function GetAvailableWidth(Measurement: TGmMeasurement): Extended;
    function GetCanvas: TCanvas;
    function GetCollate: Boolean;
    function GetDuplexType: TGmDuplexType;
    function GetPaperSize: TGmPaperSize;
    function GetPrintCopies: integer;
    function GetHandle: THandle;
    function GetIndexOf(Value: string): integer;
    function GetIsColorPrinter: Boolean;
    function GetPrinterBinIndex: integer;
    function GetPrinterBins: TStrings;
    function GetPrinterHeight(Measurement: TGmMeasurement): Extended;
    function GetPrinterIndex: integer;
    function GetPrinters: TStrings;
    function GetPrinterSelected: Boolean;
    function GetPrinterWidth(Measurement: TGmMeasurement): Extended;
    procedure AlterOrientation;
    procedure SetCollate(Value: Boolean);
    procedure SetDrawingArea(PageNum: integer);
    procedure SetDuplexType(Value: TGmDuplexType);
    procedure SetOrientation(Value: TGmOrientation);
    procedure SetGmPaperSize(Value: TGmPaperSize);
    procedure SetPrinterBinIndex(Value: integer);
    procedure SetPrintCopies(Value: integer);
    procedure SetPrinterIndex(Value: integer);
    function GetDitherType: TGmDitherType;
    function GetPrintColor: TGmPrintColor;
    function GetPrintQuality: TGmPrintQuality;
    procedure SetDitherType(Value: TGmDitherType);
    procedure SetPrintColor(Value: TGmPrintColor);
    procedure SetPrintQuality(Value: TGmPrintQuality);
  public
    constructor Create;
    destructor Destroy; override;
    function GetPaperDimensions(Measurement: TGmMeasurement): TGmSize;
    procedure Abort;
    procedure BeginDoc(FileName: string);
    procedure NewPage;
    procedure EndDoc;
    procedure SetDMPaperSize(APaperSize: integer);
    procedure GetPaperNames(const Papers: TStrings);
    property Aborted: Boolean read FAborted;
    property AvailableHeight[Measurement: TGmMeasurement]: Extended read GetAvailableHeight;
    property AvailableWidth[Measurement: TGmMeasurement]: Extended read GetAvailableWidth;
    property Canvas: TCanvas read GetCanvas;
    property Handle: THandle read GetHandle;
    property IndexOf[Printer: string]: integer read GetIndexOf;
    property IsColorPrinter: Boolean read GetIsColorPrinter;
    property Orientation: TGmOrientation read FOrientation write SetOrientation default gmPortrait;
    property PagesPerSheet: TGmPagesPerSheet read FPagesPerSheet write FPagesPerSheet default gmOnePage;
    property PrinterBinIndex: integer read GetPrinterBinIndex write SetPrinterBinIndex;
    property PrinterBins: TStrings read GetPrinterBins;
    property PrinterHeight[Measurement: TGmMeasurement]: Extended read GetPrinterHeight;
    property PrinterIndex: integer read GetPrinterIndex write SetPrinterIndex;
    property PrinterInfo: TGmPrinterInfo read FPrinterInfo;
    property PrinterPaperSize: TGmPaperSize read GetPaperSize write SetGmPaperSize;
    property Printers: TStrings read GetPrinters;
    property PrinterSelected: Boolean read GetPrinterSelected;
    property PrinterWidth[Measurement: TGmMeasurement]: Extended read GetPrinterWidth;
    property Printing: Boolean read FPrinting;
  published
    property Collate: Boolean read GetCollate write SetCollate;
    property Duplex: TGmDuplexType read GetDuplexType write SetDuplexType;
    property PrintCopies: integer read GetPrintCopies write SetPrintCopies default 1;
    property PrintColor: TGmPrintColor read GetPrintColor write SetPrintColor;
    property DitherType: TGmDitherType read GetDitherType write SetDitherType;
    property PrintQuality: TGmPrintQuality read GetPrintQuality write SetPrintQuality;
    property ReversePrintOrder: Boolean read FReversePrintOrder write FReversePrintOrder default False;
    property Title: string read FTitle write FTitle;
    // events...
    property AfterPrint: TNotifyEvent read FAfterPrint write FAfterPrint;
    property BeforePrint: TNotifyEvent read FBeforePrint write FBeforePrint;
    property OnAbortPrint: TNotifyEvent read FOnAbortPrint write FOnAbortPrint;
    property OnChangePrinter: TNotifyEvent read FOnChangePrinter write FOnChangePrinter;
  end;

  function AsGmPaperSize(dmPaperSize: SmallInt): TGmPaperSize;
  function AsDmPaperSize(APaperSize: TGmPaperSize): SmallInt;
  function IsPrinterCanvas(ACanvas: TCanvas): Boolean;

implementation

uses Printers, WinSpool, GmFuncs, SysUtils, GmErrors;

type
  TGmPrinterDevice = class
    Driver, Device, Port: String;
  end;

//------------------------------------------------------------------------------

function IsPrinterCanvas(ACanvas: TCanvas): Boolean;
begin
  Result := LowerCase(ACanvas.ClassName) = 'tprintercanvas';
end;

//------------------------------------------------------------------------------

function AsGmPaperSize(dmPaperSize: SmallInt): TGmPaperSize;
begin
  case dmPaperSize of
    DMPAPER_LETTER    : Result := Letter;
    DMPAPER_LEGAL     : Result := Legal;
    DMPAPER_A3        : Result := A3;
    DMPAPER_A4        : Result := A4;
    DMPAPER_A5        : Result := A5;
    DMPAPER_A6        : Result := A6;
    DMPAPER_B4        : Result := B4;
    DMPAPER_B5        : Result := B5;
    DMPAPER_ENV_C5    : Result := C5;
    DMPAPER_ENV_9     : Result := Envelope_09;
    DMPAPER_ENV_10    : Result := Envelope_10;
    DMPAPER_ENV_11    : Result := Envelope_11;
    DMPAPER_ENV_12    : Result := Envelope_12;
    DMPAPER_ENV_14    : Result := Envelope_14;
    DMPAPER_EXECUTIVE : Result := Executive;
    DMPAPER_LEDGER    : Result := Ledger;
    DMPAPER_TABLOID   : Result := Tabloid;
  else
    Result := Custom;
  end
end;

function AsDmPaperSize(APaperSize: TGmPaperSize): SmallInt;
begin
  Result := -1;
  case APaperSize of
    A3          : Result := DMPAPER_A3;
    A4          : Result := DMPAPER_A4;
    A5          : Result := DMPAPER_A5;
    A6          : Result := DMPAPER_A6;
    B4          : Result := DMPAPER_B4;
    B5          : Result := DMPAPER_B5;
    C5          : Result := DMPAPER_ENV_C5;
    Envelope_09 : Result := DMPAPER_ENV_9;
    Envelope_10 : Result := DMPAPER_ENV_10;
    Envelope_11 : Result := DMPAPER_ENV_11;
    Envelope_12 : Result := DMPAPER_ENV_12;
    Envelope_14 : Result := DMPAPER_ENV_14;
    Legal       : Result := DMPAPER_LEGAL;
    Letter      : Result := DMPAPER_LETTER;
    Executive   : Result := DMPAPER_EXECUTIVE;
    Ledger      : Result := DMPAPER_LEDGER;
    Tabloid     : Result := DMPAPER_TABLOID;
  end;
end;

function AsPrinterOrientation(GmOrientation: TGmOrientation): TPrinterOrientation;
begin
  Result := poPortrait;
  if GmOrientation = gmLandscape then Result := poLandscape;
end;

function AsGmOrientation(AOrientation: TPrinterOrientation): TGmOrientation;
begin
  Result := gmPortrait;
  if AOrientation = poLandscape then Result := gmLandscape;
end;

//------------------------------------------------------------------------------

// *** TGmPrinterInfo ***

constructor TGmPrinterInfo.Create;
begin
  inherited Create;
  FIsUpdated := False;
  FOrientation := gmPortrait;
  ResetPrinter;
  UpdatePrinter;
  FUseDefaultValues := False;
end;

function TGmPrinterInfo.PrinterAvailable: Boolean;
var
  TestCanvas: HDC;
begin
  TestCanvas := GetPrinterAvailable;
  try
    Result := TestCanvas <> 0;
  finally
    DeleteDC(TestCanvas);
  end;
end;

function TGmPrinterInfo.GetAvailableHeight: integer;
begin
  if not FIsUpdated then UpdatePrinter;
  Result := FPrintableSize.Y;
end;

function TGmPrinterInfo.GetAvailableWidth: integer;
begin
  if not FIsUpdated then UpdatePrinter;
  Result := FPrintableSize.X;
end;

function TGmPrinterInfo.GetGutters(AOrientation: TGmOrientation): TRect;
var
  ATempVal: integer;
begin
  if not FIsUpdated then
    UpdatePrinter;

  Result := FGutters;

  if (AOrientation = gmLandscape) then
  begin
    if FRotationDirection = gmRotate90 then
    begin
      ATempVal := Result.Top;
      Result.Top := Result.Right;
      Result.Right := Result.Bottom;
      Result.Bottom := Result.Left;
      Result.Left := ATempVal;
    end
    else
    begin
      ATempVal := Result.Top;
      Result.Top := Result.Right;
      Result.Right := Result.Bottom;
      Result.Bottom := Result.Left;
      Result.Left := ATempVal;
    end
  end;
end;

function TGmPrinterInfo.GetGuttersInch(AOrientation: TGmOrientation): TGmRect;
var
  AGutters: TRect;
begin
  if not FIsUpdated then
    UpdatePrinter;

  AGutters := GetGutters(AOrientation);
  Result.Left   := AGutters.Left / PpiX;
  Result.Top    := AGutters.Top / PpiY;
  Result.Right  := AGutters.Right / PpiX;
  Result.Bottom := AGutters.Bottom / PpiY;
end;

function TGmPrinterInfo.GetOrientation: TGmOrientation;
begin
  UpdatePrinter;
  Result := AsGmOrientation(Printer.Orientation);
end;

function TGmPrinterInfo.GetOrientationRotation: TGmPrinterRotation;
begin
  Result := gmRotate0;
  if not GmOpenPrinter then Exit;
  try
    case DeviceCapabilities(FDevice, FPort, DC_ORIENTATION, nil, nil) of
      90  : Result := gmRotate90;
      270 : Result := gmRotate270;
    end;
  finally
    GmClosePrinter;
  end;
end;

function TGmPrinterInfo.GetPhysicalSizeX: Extended;
begin
  if not FIsUpdated then UpdatePrinter;
  if Printer.Orientation = poPortrait then
    Result := FPhysicalSize.X / FPpi.X
  else
    Result := FPhysicalSize.Y / FPpi.Y;
end;

function TGmPrinterInfo.GetPhysicalSizeY: Extended;
begin
  if not FIsUpdated then UpdatePrinter;
  if Printer.Orientation = poPortrait then
    Result := FPhysicalSize.Y / FPpi.Y
  else
    Result := FPhysicalSize.X / FPpi.X;
end;

function TGmPrinterInfo.GetPpiX: integer;
begin
  if not FIsUpdated then UpdatePrinter;
  if Printer.Orientation = poPortrait then
    Result := FPpi.X
  else
    Result := FPpi.Y;
end;

function TGmPrinterInfo.GetPpiY: integer;
begin
  if not FIsUpdated then UpdatePrinter;
  if Printer.Orientation = poPortrait then
    Result := FPpi.Y
  else
    Result := FPpi.X;
end;

function TGmPrinterInfo.GetPrintableSizeX: Extended;
begin
  if not FIsUpdated then UpdatePrinter;
  Result := FPrintableSize.X / FPpi.X;