acepset.pas

suite component ace report

unit AcePSet;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}

{$ifdef WIN32}
uses winspool, windows, classes, CommDlg, dialogs, graphics ;
{$else}
uses WinProcs, WinTypes, Print, classes, dialogs, graphics;
{$endif}


type
  TAcePrinterSettings = class;


  TAceBinInfo = class(TObject)
  public
    binName: String;
    binNumber: Word;
  end;

  TAceResolution = class(TObject)
  public
    HorzRes: LongInt;
    VertRes: LongInt;
  end;

  TAcePaper = class(TObject)
  public
    PaperName: String;
    PaperNum: Word;
    PaperSize: TPoint;
  end;


  TAcePrinterInfo = class(TObject)
  private
    FBinList: TList;
    FCopies: LongInt;
    FDuplex: Boolean;
    FResolutions: TList;
    FMaxExtent, FMinExtent: TPoint;
    FPaperList: TList;
    FPrinterName: String;
    FTrueType: LongInt;

    Device, Driver, Port: array[0..79] of Char;

    Handle, DevHandle: THandle;

    {$ifdef WIN32}
    DeviceMode: PDeviceModeA;
    {$else}
    DeviceMode: PDevMode;
    LibraryHandle: THandle;
    DeviceCaps: TFarProc;
    TempDriver: array[0..79] of Char;
    {$endif}
    FPrinterSettings: TAcePrinterSettings;

    procedure GetPrinter(Reset: Boolean);
    procedure FillBinList;
    procedure SetCopies;
    procedure SetDuplex;
    procedure SetResolutions;
{    procedure SetExtents;}
    procedure SetPapers;
{    procedure SetTrueType;}

    function GetBinName(Source: Integer): String;
    function CompareStrings(source, dest: String): Boolean;
    function GetBinByNum(BinNum: Integer): TAceBinInfo;
{    function GetBinByName(BinName: String): TAceBinInfo;}

    { These are not used and because of a bug (see web page) in
      hp870cxi driver with retrieving extents from DeviceCapabilities
      under windows 95, doesn't happen under NT4.0 }

{    property MaxExtent: TPoint read FMaxExtent write FMaxExtent;
    property MinExtent: TPoint read FMinExtent write FMinExtent;}

  protected
    function PrinterChanged: Boolean;
    procedure GetDeviceMode(Reset: Boolean);
    procedure ReleaseDeviceMode;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure Assign( Source: TObject); virtual;

    procedure Update;
    property PrinterSettings: TAcePrinterSettings read FPrinterSettings write FPrinterSettings;

    property BinList: TList read FBinList write FBinList;
    property Copies: LongInt read FCopies write FCopies;
    property Duplex: Boolean read FDuplex write FDuplex;
    property Resolutions: TList read FResolutions write FResolutions;
    property PaperList: TList read FPaperList write FPaperList;
    property TrueType: LongInt read FTrueType write FTrueType;

{    property PrinterName: String read FPrinterName write FPrinterName;}

    function GetPaperByNum(Value: Integer): TAcePaper;
    function GetPaperByName(FormName: String): TAcePaper;
    function FindPaperByName(FormName: String): TAcePaper;
    function GetPaperName(Value: Integer): String;
    function GetResolution(HorzRes, VertRes: LongInt): TAceResolution;

    function FindBinByNum(BinNum: Integer): TAceBinInfo;
    function FindBinByName(BinName: String): TAceBinInfo;
  end;


  TAcePrintSettings = (apsOrientation, apsPaperSize, apsPaperLength, apsPaperWidth,
        apsScale, apsCopies, apsDefaultSource, apsPrintQuality, apsColor, apsDuplex,
        apsYResolution, apsTTOption, apsCollate, apsFormName);

  TAcePrinterSettings = class(TObject)
  private
    { don't include formname because thats not a small int }
    FPSProperties: array[0..12] of Integer;
    FFormName: String;
    FPrintSet: array[0..13] of Boolean;
    FPropCount: Integer;
    FCustomPaperSize: Boolean;
  protected
    function GetPSProperty(Index: Integer): Integer;
    procedure SetPSProperty(Index: Integer; Value: Integer);
    procedure SetFormName(Value: String);
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Assign( Source: TObject); virtual;

    procedure GetValues;
    procedure SetValues;

    property Orientation: Integer index 0 read GetPSProperty write SetPSProperty;
    property PaperSize: Integer index 1 read GetPSProperty write SetPSProperty;
    property PaperLength: Integer index 2 read GetPSProperty write SetPSProperty;
    property PaperWidth: Integer index 3 read GetPSProperty write SetPSProperty;
    property Scale: Integer index 4 read GetPSProperty write SetPSProperty;
    property Copies: Integer index 5 read GetPSProperty write SetPSProperty;
    property DefaultSource: Integer index 6 read GetPSProperty write SetPSProperty;
    property PrintQuality: Integer index 7 read GetPSProperty write SetPSProperty;
    property Color: Integer index 8 read GetPSProperty write SetPSProperty;
    property Duplex: Integer index 9 read GetPSProperty write SetPSProperty;
    property YResolution: Integer index 10 read GetPSProperty write SetPSProperty;
    property TTOption: Integer index 11 read GetPSProperty write SetPSProperty;
    property Collate: Integer index 12 read GetPSProperty write SetPSProperty;
    property FormName: String read FFormName write SetFormName;
    property CustomPaperSize: Boolean read FCustomPaperSize write FCustomPaperSize;
  end;

  procedure AceResetPrinter;
  function AceGetPrinterCount: Integer;


{$ifdef Win32}
{ I believe this is fixed in Delphi 3.0 }
function DeviceCapabilitiesA(pDevice, pPort: PAnsiChar; fwCapability: Word;
  pOutput: PAnsiChar; DevMode: PDeviceModeA): Integer; stdcall;
function DeviceCapabilitiesW(pDevice, pPort: PWideChar; fwCapability: Word;
  pOutput: PWideChar; DevMode: PDeviceModeW): Integer; stdcall;
function DeviceCapabilities(pDevice, pPort: PChar; fwCapability: Word;
  pOutput: PChar; DevMode: PDeviceMode): Integer; stdcall;
{$endif}

type
  TAceWinVersion = (awvWin31, awvWin95, awvWinNT);
  function AceWinVersion: TAceWinVersion;


implementation

uses printers, sysutils, messages, forms, controls;



{$ifdef WIN32}
{ this is picking up the gdi32 if I don't declare it here.  It should be
  winspl as declared below and in winspool }
function DeviceCapabilitiesA; external winspl name 'DeviceCapabilitiesA';
function DeviceCapabilitiesW; external winspl name 'DeviceCapabilitiesW';
function DeviceCapabilities; external winspl name 'DeviceCapabilitiesA';

{$else}
type
  { don't know what was going on with this so I declared it myself }
  TMyDevCaps = function(DeviceName, Port: PChar; index: Word;
    OutPut: PChar; DevMode: PDevMode): Longint;
{$ENDIF}

var
  PrinterList: TList;
  InAssignInfo: Boolean;

procedure AceResetPrinter;
var
  Index :Integer;
  Driver, Device, Port: array[0..79] of Char;
  Mode: THandle;
begin
  if AceGetPrinterCount > 0 then
  begin
    if Not Printers.Printer.Printing then
    begin
      Index := Printers.Printer.PrinterIndex;
      Printers.Printer.PrinterIndex := -1;
      Printers.Printer.PrinterIndex := Index;

      { These next two lines where added because without them Delph's
        printer setup dialog doesn't show the correct printer in
        its list box when then printer has changed 8/18/98}
      Printer.GetPrinter(Driver, Device, Port, Mode);
      Printer.SetPrinter(Driver, Device, Port, 0);

    end;
  end;
end;


function RetrievePrinter(PrinterName: String): TAcePrinterInfo;
var
  Spot: Integer;
  PInfo: TAcePrinterInfo;
begin
  Spot := 0;
  Result := nil;
  while Spot < PrinterList.Count do
  begin
    PInfo := PrinterList.Items[Spot];
    if PInfo.FPrinterName = PrinterName then
    begin
      Result := PInfo;
      Spot := PrinterList.Count;
    end;
    Inc(Spot);
  end;
end;

procedure AssignInfo(PrinterInfo: TAcePrinterInfo);
var
  PInfo: TAcePrinterInfo;
begin
  if Not InAssignInfo then
  begin
    InAssignInfo := True;
    PInfo := RetrievePrinter(Printers.Printer.Printers[Printers.Printer.PrinterIndex]);
    if PInfo = nil then
    begin
      PInfo := TAcePrinterInfo.Create;
      PInfo.Update;
      PrinterList.Add(PInfo);
      PInfo.FPrinterSettings.GetValues;
    end;
    PrinterInfo.Assign(PInfo);
    InAssignInfo := False;
  end;
end;


procedure ClearList(List: TList);
var
  Spot: Integer;
begin
  if List <> nil then
  begin
    for Spot := 0 to List.Count - 1 do TObject(List.Items[Spot]).Free;
    List.Clear;
  end;
end;

{$ifdef WIN32}
function AceWinVersion: TAceWinVersion;
var
  version: TOSVERSIONINFO;
begin
  Result := awvWin31;
  version.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
  if GetVersionEx(version) then
  begin
    if version.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then Result := awvWin95
    else if version.dwPlatformId = VER_PLATFORM_WIN32_NT then Result := awvWinNT;
  end;
end;
{$else}
function AceWinVersion: TAceWinVersion;
begin
  Result := awvWin31;
end;
{$endif}

function AceGetPrinterCount: Integer;
var
  DefaultPrinter: array[0..79] of Char;
begin
  Result := Printers.Printer.Printers.Count;
  { under win95 there was some unknown printer always coming
    up when there really was none.  I made the asumption that
    if there isn't a default printer then there are no printers
    defined.  This wasn't tested under NT or win3.1 so I don't
    know if it was needed under that. }
  GetProfileString('windows', 'device', '', DefaultPrinter,
    SizeOf(DefaultPrinter) - 1);
  if DefaultPrinter[0] = #0 then Result := 0;
end;

{ TAcePrinterInfo }
procedure TAcePrinterInfo.GetPrinter(Reset: Boolean);
begin
  if Reset then AceResetPrinter;

  DevHandle := Printers.Printer.Handle;
  Printers.Printer.GetPrinter(Device, Driver, Port, DevHandle);

  { sometimes getting the printer fails }
  if DevHandle = 0 then
  begin
    Printers.Printer.PrinterIndex := Printer.PrinterIndex;
    Printers.Printer.GetPrinter(Device, Driver, Port, DevHandle);

  end;
  if DevHandle <> 0 then Handle := Printers.Printer.Handle;

end;

constructor TAcePrinterInfo.Create;
begin
  FBinList := TList.Create;
  FCopies := 0;
  FDuplex := False;
  FResolutions := TList.Create;
  FMaxExtent.x := 0;
  FMaxExtent.y := 0;
  FMinExtent.x := 0;
  FMinExtent.y := 0;
  FPaperList := TList.Create;
  FPrinterName := '';
  FTrueType := 0;
  FPrinterSettings := TAcePrinterSettings.Create;

  AssignInfo(Self);
end;

destructor TAcePrinterInfo.Destroy;
begin
  ClearList(FBinList);
  if FBinList <> nil then FBinList.Free;
  ClearList(FResolutions);
  if FResolutions <> nil then FResolutions.Free;
  ClearList(FPaperList);
  if FPaperList <> nil then FPaperList.Free;
  if FPrinterSettings <> nil then FPrinterSettings.Free;
  inherited Destroy;
end;

procedure TAcePrinterInfo.Assign( Source: TObject);
var
  PInfo: TAcePrinterInfo;
  Spot: Integer;
  bin, bin2: TAceBinInfo;
  res, res2: TAceResolution;
  paper, paper2: TAcePaper;
begin
  if Source is TAcePrinterInfo then
  begin
    PInfo := TAcePrinterInfo(Source);
    ClearList(FBinList);
    for Spot := 0 to PInfo.BinList.Count - 1 do
    begin
      bin := PInfo.BinList.Items[Spot];
      bin2 := TAceBinInfo.Create;
      bin2.BinName := bin.BinName;
      bin2.BinNumber := bin.BinNumber;
      FBinList.Add(bin2);
    end;

    FCopies := PInfo.Copies;
    FDuplex := PInfo.Duplex;

    ClearList(FResolutions);
    for Spot := 0 to PInfo.Resolutions.Count - 1 do
    begin
      res := PInfo.Resolutions.Items[Spot];
      res2 := TAceResolution.Create;
      res2.HorzRes := res.HorzRes;
      res2.VertRes := res.VertRes;
      FResolutions.Add(res2);
    end;

    { not used to many problems }
    { FMaxExtent, FMinExtent: TPoint;}

    ClearList(FPaperList);
    for Spot := 0 to PInfo.PaperList.Count - 1 do
    begin
      paper := PInfo.PaperList.Items[Spot];
      paper2 := TAcePaper.Create;
      paper2.PaperName := paper.PaperName;
      paper2.PaperNum := paper.PaperNum;
      paper2.PaperSize := paper.PaperSize;
      FPaperList.Add(paper2);
    end;

    FPrinterName := PInfo.FPrinterName;
    FTrueType := PInfo.TrueType;

    FPrinterSettings.Assign(PInfo.FPrinterSettings);
  end;
end;

procedure TAcePrinterInfo.FillBinList;