rm_prntr.pas

report machine 2.3 功能强大

{*****************************************}
{                                         }
{           Report Machine v2.0           }
{           Printer controlling           }
{                                         }
{*****************************************}

unit RM_prntr;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Printers, WinSpool, RM_Class, RM_Const;

const
  rmpgLetter = 1;
  rmpgLetterSmall = 2;
  rmpgTabloid = 3;
  rmpgLedger = 4;
  Legal = 5;
  rmpgStatement = 6;
  rmpgExecutive = 7;
  rmpgA3 = 8;
  rmpgA4 = 9;
  rmpgA4Small = 10;
  rmpgA5 = 11;
  rmpgB4 = 12;
  rmpgB5 = 13;
  rmpgFolio = 14;
  rmpgQuarto = 15;
  qr10X14 = 16;
  rmpgqr11X17 = 17;
  rmpgNote = 18;
  rmpgEnv9 = 19;
  rmpgEnv10 = 20;
  rmpgEnv11 = 21;
  rmpgEnv12 = 22;
  rmpgEnv14 = 23;
  rmpgCSheet = 24;
  rmpgDSheet = 25;
  rmpgESheet = 26;
  rmpg16K = 800;
  rmpg32K = 801;
  rmpg32KBIG = 802;
  rmpgKh = 803;
  rmpgZh = 804;
  rmpgCustom = 256;

type
  TRMPrinterCapType = (pcPaperNames, pcPapers, pcPaperWidths, pcPaperHeights,
    pcBinNames, pcBins);

 { TRMPrinterInfo }
  TRMPrinterInfo = class(TObject)
  private
    FDriver: PChar;
    FDevice: PChar;
    FPort: PChar;
    FIsValid: Boolean;
    FAlreadlyGetInfo: Boolean;
    FDeviceHandle: THandle;
    FAddinPaperSizeIndex: Integer;
    FCustomPageSize: Integer;

    FPaperNames: TStringList;
    FBinNames: TStringList;
    FBins: TStringList;
    FPaperWidths: TStringList;
    FPaperHeights: TStringList;
    FPaperSizes: TStringList;
    function GetPaperWidth(index: Integer): Integer;
    function GetPaperHeight(index: Integer): Integer;
    procedure SetPaperWidth(index: Integer; Value: Integer);
    procedure SetPaperHeight(index: Integer; Value: Integer);
    function GetPaperSize(index: Integer): Integer;
    function GetBin(index: Integer): Integer;
    procedure GetDeviceCapability(aPrinterCap: TRMPrinterCapType; sl: TStrings);
    procedure ValidatePaperSizes;
    procedure ValidatePaperBins;
    procedure GetPrinterCaps(aVirtualPrinter: Boolean);
    function GetCustomPaperSize: Integer;
  protected
  public
    constructor Create(aDriver, aDevice, aPort: PChar);
    destructor Destroy; override;

    function PaperSizesCount: Integer;
    function GetPaperSizeIndex(pgSize: Integer): Integer;
    function GetBinIndex(pgBin: Integer): Integer;

    property Device: PChar read FDevice;
    property Driver: PChar read FDriver;
    property Port: PChar read FPort;
    property IsValid: Boolean read FIsValid write FIsValid;
    property AddinPaperSizeIndex: Integer read FAddinPaperSizeIndex;
    property PaperNames: TStringList read FPaperNames;
    property BinNames: TStringList read FBinNames;
    property PaperWidths[index: Integer]: Integer read GetPaperWidth write SetPaperWidth;
    property PaperHeights[index: Integer]: Integer read GetPaperHeight write SetPaperHeight;
    property PaperSizes[index: Integer]: Integer read GetPaperSize;
    property Bins[index: Integer]: Integer read GetBin;
    property CustomPaperSize: Integer read GetCustomPaperSize;
  end;

  { TRMPrinterList }
  TRMPrinterList = class(TObject)
  private
    FDefaultPrinterIndex: Integer;
    FPrinters: TStrings;

    procedure BuildPrinterList;
    procedure FreePrinterList;
    function GetCount: Integer;
    function GetPrinterInfo(index: Integer): TRMPrinterInfo;
    procedure GetDefaultPrinter;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Refresh;

    property Count: Integer read GetCount;
    property Printers: TStrings read FPrinters;
    property PrinterInfo[index: Integer]: TRMPrinterInfo read GetPrinterInfo;
  end;

 { TRMCustomPrinter }
  TRMCustomPrinter = class(TObject)
  private
    FAborted: Boolean;
    FCanGrayScale: Boolean;
    FCanvas: TCanvas;
    FDC: HDC;
    FCurrentInfo: TRMPrinterInfo;
    FDefaultBin: Integer;
    FDocumentName: string;
    FFileName: string;
    FPageNumber: Longint;
    FPrinting: Boolean;
    FPrinterHandle: THandle;
    FPrinterIndex: Integer;
    FResetDC: Boolean;
    FStartPage: Boolean;
    FDevMode: THandle;
    FOnSetupChange: TNotifyEvent;
    FPDevMode: PDeviceMode;
    FPageGutters: TRect;
    FPixelsPerInch: TPoint;
    FPaperWidth: Longint;
    FPaperHeight: Longint;
    FPrintableHeight: Longint;
    FPrintableWidth: Longint;

    procedure FreeDC;
    procedure FreeDevMode;
    procedure FreePrinterHandle;
    procedure FreePrinterResources;
    function GetCanGrayScale: Boolean;
    function GetCanvas: TCanvas;
    function GetDC: HDC;
    function GetDocumentProperties: THandle;
    function GetPrinterHandle: THandle;
    function GetPrinterInfo: TRMPrinterInfo;
    function GetPDevMode: PDevMode;
    function GetPageGutters: TRect;
    function GetPaperWidth: Longint;
    function GetPaperHeight: Longint;
    function GetPixelsPerInch: TPoint;
    function GetPrintableHeight: LongInt;
    function GetPrintableWidth: LongInt;
    procedure ResetDC;
    procedure SetPrinterIndex(Value: Integer);
  protected
    procedure DeviceContextChanged;
    property PDevMode: PDevMode read GetPDevMode;
    property CurrentInfo: TRMPrinterInfo read FCurrentInfo;
    property DefaultBin: Integer read FDefaultBin;
  public
    PaperSize: Integer;
    Orientation: TPrinterOrientation;
    Bin: Integer;
    DefaultPaper: Integer;
    constructor Create; virtual;
    destructor Destroy; override;

    procedure BeginDoc;
    procedure Abort;
    procedure EndDoc;
    procedure EndPage;
    procedure NewPage;
    procedure GetDevMode(var aDevMode: THandle);
    procedure SetDevMode(aDevMode: THandle);
    function HasColor: Boolean;
    procedure UpdateForm(const aFormName: string; aDimensions: TPoint; aPrintArea: TRect);

    property PrinterHandle: THandle read GetPrinterHandle;
    property Aborted: Boolean read FAborted;
    property Canvas: TCanvas read GetCanvas;
    property DC: HDC read GetDC;
    property Title: string read FDocumentName write FDocumentName;
    property FileName: string read FFileName write FFileName;
    property PageNumber: Longint read FPageNumber;
    property Printing: Boolean read FPrinting;
    property PrinterIndex: Integer read FPrinterIndex write SetPrinterIndex;
    property PrinterInfo: TRMPrinterInfo read GetPrinterInfo;

    property CanGrayScale: Boolean read GetCanGrayScale;
    property PageGutters: TRect read GetPageGutters;
    property PixelsPerInch: TPoint read GetPixelsPerInch;
    property PrintableHeight: Longint read GetPrintableHeight;
    property PrintableWidth: Longint read GetPrintableWidth;
    property PaperWidth: Longint read GetPaperWidth;
    property PaperHeight: Longint read GetPaperHeight;
    property OnChange: TNotifyEvent read FOnSetupChange write FOnSetupChange;
  end;

  { TRMPrinter }
  TRMPrinter = class(TRMCustomPrinter)
  private
    FCopies: Integer;
    procedure GetSettings;
    procedure SetSettings(aPgWidth, aPgHeight: Integer);
  public
    constructor Create; override;
    destructor Destroy; override;

    procedure FillPrnInfo(var p: TRMPrnInfo);
    procedure SetPrinterInfo(pgSize, pgWidth, pgHeight, pgBin: Integer; pgOr: TPrinterOrientation; SetImmediately: Boolean);
    function IsEqual(pgSize, pgWidth, pgHeight, pgBin: Integer; pgOr: TPrinterOrientation): Boolean;
    procedure PropertiesDlg;
    procedure Update;
    property Copies: Integer read FCopies write FCopies default 1;
  end;

 { TRMPageSetting }
  TRMPageSetting = class(TPersistent)
  private
    FPageName: string;
    FPageSize: Word;
    FPageWidth, FPageHeight: Integer;
    FPageOr: TPrinterOrientation;
    FPageBin: Integer;
    FUseMargins: Boolean;
    FTaoda: Boolean;
    FMarginLeft, FMarginTop, FMarginRight, FMarginBottom: Double;
    FPrintToPrevPage: Boolean;
    FPrintToDefault: Boolean;
    FScaleFrameWidth: Boolean;
    FUnlimitedHeight: Boolean;
    FDoublePass: Boolean;
    FColCount: Integer;
    FColGap: Double;
    FPrinterName: string;
    procedure SetColCount(Value: Integer);
    procedure SetValue(Index: integer; Value: Double);
    procedure SetPageOr(Value: TPrinterOrientation);
  protected
  public
    property PageName: string read FPageName write FPageName;
    property PageSize: Word read FPageSize write FPageSize;
    property PageWidth: Integer read FPageWidth write FPageWidth;
    property PageHeight: Integer read FPageHeight write FPageHeight;
    property PageOr: TPrinterOrientation read FPageOr write SetPageOr;
    property PageBin: Integer read FPageBin write FPageBin;
    property PrintToPrevPage: Boolean read FPrintToPrevPage write FPrintToPrevPage;
    property PrintToDefault: Boolean read FPrintToDefault write FPrintToDefault;
    property DoublePass: Boolean read FDoublePass write FDoublePass;
    property Taoda: Boolean read FTaoda write FTaoda;
    property ScaleFrameWidth: Boolean read FScaleFrameWidth write FScaleFrameWidth;
    property UnlimitedHeight: Boolean read FUnlimitedHeight write FUnlimitedHeight;
    property UseMargins: Boolean read FUseMargins write FUseMargins;
    property ColCount: Integer read FColCount write SetColCount;
    property ColGap: Double index 4 read FColGap write SetValue;
    property MarginLeft: Double index 0 read FMarginLeft write SetValue;
    property MarginTop: Double index 1 read FMarginTop write SetValue;
    property MarginRight: Double index 2 read FMarginRight write SetValue;
    property MarginBottom: Double index 3 read FMarginBottom write SetValue;
    property PrinterName: string read FPrinterName write FPrinterName;
  published
  end;

function RMPrinters: TRMPrinterList;
function RMPrinter: TRMPrinter;

implementation

uses Consts, RM_Utils;

const
  cUnknown = 'Unknown';
  RMAddInPaperPos = 800;

type
  TPaperInfo = record
    Typ: Integer;
    Name: string;
    X, Y: Integer;
  end;

const
  PAPERCOUNT = 67;
  RMAddInPaperInfo: array[0..4] of TPaperInfo = (
    (Typ: 800; Name: ''; X: 1840; Y: 2600), //16开(18.4 x 26 厘米)
    (Typ: 801; Name: ''; X: 1300; Y: 1840), //32开(13 x 18.4 厘米)
    (Typ: 802; Name: ''; X: 1400; Y: 2030), //大32开(14 x 20.3 厘米)
    (Typ: 803; Name: ''; X: 3778; Y: 2794), //宽行连续纸
    (Typ: 804; Name: ''; X: 2159 {2420}; Y: 2794) //窄行连续纸
    );

  PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = (
    (Typ: 1; Name: ''; X: 2159; Y: 2794),
    (Typ: 2; Name: ''; X: 2159; Y: 2794),
    (Typ: 3; Name: ''; X: 2794; Y: 4318),
    (Typ: 4; Name: ''; X: 4318; Y: 2794),
    (Typ: 5; Name: ''; X: 2159; Y: 3556),
    (Typ: 6; Name: ''; X: 1397; Y: 2159),
    (Typ: 7; Name: ''; X: 1842; Y: 2667),
    (Typ: 8; Name: ''; X: 2970; Y: 4200),
    (Typ: 9; Name: ''; X: 2100; Y: 2970),
    (Typ: 10; Name: ''; X: 2100; Y: 2970),
    (Typ: 11; Name: ''; X: 1480; Y: 2100),
    (Typ: 12; Name: ''; X: 2500; Y: 3540),
    (Typ: 13; Name: ''; X: 1820; Y: 2570),
    (Typ: 14; Name: ''; X: 2159; Y: 3302),
    (Typ: 15; Name: ''; X: 2150; Y: 2750),
    (Typ: 16; Name: ''; X: 2540; Y: 3556),
    (Typ: 17; Name: ''; X: 2794; Y: 4318),
    (Typ: 18; Name: ''; X: 2159; Y: 2794),
    (Typ: 19; Name: ''; X: 984; Y: 2254),
    (Typ: 20; Name: ''; X: 1048; Y: 2413),
    (Typ: 21; Name: ''; X: 1143; Y: 2635),
    (Typ: 22; Name: ''; X: 1207; Y: 2794),
    (Typ: 23; Name: ''; X: 1270; Y: 2921),
    (Typ: 24; Name: ''; X: 4318; Y: 5588),
    (Typ: 25; Name: ''; X: 5588; Y: 8636),
    (Typ: 26; Name: ''; X: 8636; Y: 11176),
    (Typ: 27; Name: ''; X: 1100; Y: 2200),
    (Typ: 28; Name: ''; X: 1620; Y: 2290),
    (Typ: 29; Name: ''; X: 3240; Y: 4580),
    (Typ: 30; Name: ''; X: 2290; Y: 3240),
    (Typ: 31; Name: ''; X: 1140; Y: 1620),
    (Typ: 32; Name: ''; X: 1140; Y: 2290),
    (Typ: 33; Name: ''; X: 2500; Y: 3530),
    (Typ: 34; Name: ''; X: 1760; Y: 2500),
    (Typ: 35; Name: ''; X: 1760; Y: 1250),
    (Typ: 36; Name: ''; X: 1100; Y: 2300),
    (Typ: 37; Name: ''; X: 984; Y: 1905),
    (Typ: 38; Name: ''; X: 920; Y: 1651),
    (Typ: 39; Name: ''; X: 3778; Y: 2794),
    (Typ: 40; Name: ''; X: 2159; Y: 3048),
    (Typ: 41; Name: ''; X: 2159; Y: 3302),
    (Typ: 42; Name: ''; X: 2500; Y: 3530),
    (Typ: 43; Name: ''; X: 1000; Y: 1480),
    (Typ: 44; Name: ''; X: 2286; Y: 2794),
    (Typ: 45; Name: ''; X: 2540; Y: 2794),
    (Typ: 46; Name: ''; X: 3810; Y: 2794),
    (Typ: 47; Name: ''; X: 2200; Y: 2200),
    (Typ: 50; Name: ''; X: 2355; Y: 3048),
    (Typ: 51; Name: ''; X: 2355; Y: 3810),
    (Typ: 52; Name: ''; X: 2969; Y: 4572),
    (Typ: 53; Name: ''; X: 2354; Y: 3223),
    (Typ: 54; Name: ''; X: 2101; Y: 2794),
    (Typ: 55; Name: ''; X: 2100; Y: 2970),
    (Typ: 56; Name: ''; X: 2355; Y: 3048),
    (Typ: 57; Name: ''; X: 2270; Y: 3560),
    (Typ: 58; Name: ''; X: 3050; Y: 4870),
    (Typ: 59; Name: ''; X: 2159; Y: 3223),
    (Typ: 60; Name: ''; X: 2100; Y: 3300),
    (Typ: 61; Name: ''; X: 1480; Y: 2100),
    (Typ: 62; Name: ''; X: 1820; Y: 2570),
    (Typ: 63; Name: ''; X: 3220; Y: 4450),
    (Typ: 64; Name: ''; X: 1740; Y: 2350),
    (Typ: 65; Name: ''; X: 2010; Y: 2760),
    (Typ: 66; Name: ''; X: 4200; Y: 5940),
    (Typ: 67; Name: ''; X: 2970; Y: 4200),
    (Typ: 68; Name: ''; X: 3220; Y: 4450),
    (Typ: DMPAPER_USER; Name: ''; X: 0; Y: 0));

var
  FRMPrinters: TRMPrinterList = nil;
  FRMPrinter: TRMPrinter;

function DeviceCapabilities(pDevice, pPort: PChar; fwCapability: Word;
  pOutput: PChar; DevMode: PDeviceMode): Integer; stdcall; external winspl name 'DeviceCapabilitiesA';

function RMPrinters: TRMPrinterList;
begin
  if FRMPrinters = nil then
  begin
    FRMPrinters := TRMPrinterList.Create;
  end;
  Result := FRMPrinters;
end;

function RMPrinter: TRMPrinter;
begin
  if FRMPrinter = nil then
  begin
    FRMPrinter := TRMPrinter.Create;
    FRMPrinter.PrinterIndex := 0;
    FRMPrinter.GetSettings;
    FRMPrinter.DefaultPaper := FRMPrinter.PaperSize;
  end;
  Result := FRMPrinter;
end;

function FetchStr(var Str: PChar): PChar;
var
  P: PChar;
begin
  Result := Str;
  if Str = nil then Exit;
  P := Str;
  while P^ = ' ' do Inc(P);
  Result := P;
  while (P^ <> #0) and (P^ <> ',') do Inc(P);
  if P^ = ',' then
  begin
    P^ := #0;
    Inc(P);
  end;
  Str := P;
end;

function RMCopyHandle(aHandle: THandle): THandle;
var
  lpSource, lpDest: PChar;
  llSize: LongInt;
  lHandle: THandle;
begin
  Result := 0;
  if aHandle = 0 then Exit;
  llSize := GlobalSize(aHandle);
  lHandle := GlobalAlloc(GHND, llSize);
  if lHandle <> 0 then
  begin
    try
      lpSource := GlobalLock(aHandle);
      lpDest := GlobalLock(lHandle);
      if (lpSource <> nil) and (lpDest <> nil) then
        Move(lpSource^, lpDest^, llSize);
    finally
      GlobalUnlock(aHandle);
      GlobalUnlock(lHandle);
    end;
  end;
  Result := lHandle;
end;

{------------------------------------------------------------------------------}