acepset.pas

suite component ace report

type
  BinName = array[0..23] of Char;
  BinArray = array[0..255] of BinName;
  BinNumArray = array[0..255] of Word;
var
  Count: Integer;

  BinNameList: BinArray;
  BinNumList: BinNumArray;
  Spot: Integer;
  bininfo: TAceBinInfo;
begin
  ClearList(FBinList);
  {$ifdef WIN32}
  Count := DeviceCapabilities(Device, Port, DC_BINS, nil, DeviceMode);
  if Count > 0 then
  begin
    DeviceCapabilities(Device, Port, DC_BINS, @BinNumList, DeviceMode);
    DeviceCapabilities(Device, Port, DC_BINNAMES, @BinNameList, DeviceMode);
  end;
  {$else}
  Count := TMyDevCaps(DeviceCaps)(Device, Port, DC_BINS, nil, DeviceMode);
  if Count > 0 then
  begin
    TMyDevCaps(DeviceCaps)(Device, Port, DC_BINS, PChar(@BinNumList), DeviceMode);
    TMyDevCaps(DeviceCaps)(Device, Port, DC_BINNAMES, PChar(@BinNameList), DeviceMode);
  end;
  {$endif}

  for Spot := 0 to Count - 1 do
  begin
    bininfo := TAceBinInfo.Create;
    bininfo.binNumber := BinNumList[Spot];
    bininfo.binName := StrPas(BinNameList[Spot]);
    FBinList.Add(bininfo);
  end;

end;


procedure TAcePrinterInfo.SetCopies;
begin
  try
    {$ifdef WIN32}
    FCopies := DeviceCapabilities(Device, Port, DC_COPIES, nil, DeviceMode);
    {$else}
    FCopies := TMyDevCaps(DeviceCaps)(Device, Port, DC_COPIES, nil, DeviceMode);
    {$endif}
  except
    FCopies := 0;
  end;
end;
procedure TAcePrinterInfo.SetDuplex;
begin
  {$ifdef WIN32}
  FDuplex := DeviceCapabilities(Device, Port, DC_DUPLEX, nil, DeviceMode) = 1;
  {$else}
  FDuplex := TMyDevCaps(DeviceCaps)(Device, Port, DC_DUPLEX, nil, DeviceMode) = 1;
  {$endif}
end;
{$ifdef CommentOut}
procedure TAcePrinterInfo.SetTrueType;
begin
  {$ifdef WIN32}
  FTrueType := DeviceCapabilities(Device, Port, DC_TRUETYPE, nil, DeviceMode);
  {$else}
  FTrueType := TMyDevCaps(DeviceCaps)(Device, Port, DC_TRUETYPE, nil, DeviceMode);
  {$endif}
end;
{$endif}

procedure TAcePrinterInfo.SetResolutions;
type
  TMyPoint = record
    x: LongInt;
    y: LongInt;
  end;

  PointList = array[0..0] of TMyPoint;
  PPointList = ^PointList;
var
  Count: Integer;
  PList: PPointList;
  Spot: Integer;
  Res: TAceResolution;
begin
  ClearList(FResolutions);
  {$ifdef WIN32}
  Count := DeviceCapabilities(Device, Port, DC_ENUMRESOLUTIONS, nil, DeviceMode);
  {$else}
  Count := TMyDevCaps(DeviceCaps)(Device, Port, DC_ENUMRESOLUTIONS, nil, DeviceMode);
  {$endif}

  if Count > 0 then
  begin
    GetMem(PList, Count * SizeOf(TMyPoint));
    {$ifdef WIN32}
    DeviceCapabilities(Device, Port, DC_ENUMRESOLUTIONS, PChar(PList), DeviceMode);
    {$else}
    TMyDevCaps(DeviceCaps)(Device, Port, DC_ENUMRESOLUTIONS, PChar(PList), DeviceMode);
    {$endif}
    for Spot := 0 to Count - 1 do
    begin
      Res := TAceResolution.Create;
      Res.HorzRes := Plist^[Spot].x;
      Res.VertRes := Plist^[Spot].y;
      FResolutions.Add(Res);
    end;

    FreeMem(PList, Count * SizeOf(TMyPoint));
  end;
end;

{$ifdef CommentingOut }
procedure TAcePrinterInfo.SetExtents;
type
  TMyPoints = record
    X: ShortInt;
    Y: ShortInt;
  end;
var
  Ret: TMyPoints;
begin
  {$ifdef WIN32}
  Ret := DeviceCapabilities(Device, Port, DC_MAXEXTENT, nil, DeviceMode);
  {$else}
  Ret := TMyDevCaps(DeviceCaps)(Device, Port, DC_MAXEXTENT, nil, DeviceMode);
  {$endif}
  if Ret = 0 then FMaxExtent := Point(0, 0)
  else FMaxExtent := Point(Ret.x, Ret.y);

  {$ifdef WIN32}
  Ret := DeviceCapabilities(Device, Port, DC_MINEXTENT, nil, DeviceMode);
  {$else}
  Ret := TMyDevCaps(DeviceCaps)(Device, Port, DC_MINEXTENT, nil, DeviceMode);
  {$endif}
  if Ret = 0 then FMinExtent := Point(0, 0)
  else FMinExtent := Point(Ret.x, Ret.y);

end;
{$endif}

procedure TAcePrinterInfo.SetPapers;
type
  PNames = array[0..63] of Char;

  SizeList = array[0..0] of TPoint;
  NameList = array[0..0] of PNames;
  NumList = array[0..0] of Word;

  PSizeList = ^SizeList;
  PNameList = ^NameList;
  PNumList = ^NumList;
var
  Count: Integer;
  PSList: PSizeList;
  PNList: PNameList;
  PaperNumList: PNumList;

  Spot: Integer;
  Paper: TAcePaper;
begin
  ClearList(FPaperList);
  {$ifdef WIN32}
  Count := DeviceCapabilities(Device, Port, DC_PAPERNAMES, nil, DeviceMode);
  {$else}
  Count := TMyDevCaps(DeviceCaps)(Device, Port, DC_PAPERNAMES, nil, DeviceMode);
  {$endif}
  if Count > 0 then
  begin
    GetMem(PSList, Count * SizeOf(TPoint));
    GetMem(PNList, Count * SizeOf(PNames));
    GetMem(PaperNumList, Count * SizeOf(Word));

    {$ifdef WIN32}
    DeviceCapabilities(Device, Port, DC_PAPERNAMES, PChar(PNList), DeviceMode);
    DeviceCapabilities(Device, Port, DC_PAPERS, PChar(PaperNumList), DeviceMode);
    DeviceCapabilities(Device, Port, DC_PAPERSIZE, PChar(PSList), DeviceMode);
    {$else}
    TMyDevCaps(DeviceCaps)(Device, Port, DC_PAPERNAMES, PChar(PNList), DeviceMode);
    TMyDevCaps(DeviceCaps)(Device, Port, DC_PAPERS, PChar(PaperNumList), DeviceMode);
    TMyDevCaps(DeviceCaps)(Device, Port, DC_PAPERSIZE, PChar(PSList), DeviceMode);
    {$endif}
    for Spot := 0 to Count - 1 do
    begin
      Paper := TAcePaper.Create;
      Paper.PaperName := PNList^[Spot];
      Paper.PaperNum := PaperNumList^[Spot];
      Paper.PaperSize := PSList^[Spot];
      FPaperList.Add(Paper);
    end;

    FreeMem(PSList, Count * SizeOf(TPoint));
    FreeMem(PNList, Count * SizeOf(PNames));
    FreeMem(PaperNumList, Count * SizeOf(Word));

  end;
end;

procedure TAcePrinterInfo.Update;
begin
  GetDeviceMode(False);
  if DeviceMode <> nil then
  begin
    { have options that won't query these }
    SetCopies;
    FillBinList;
    SetDuplex;
    SetResolutions;
{      SetExtents;}
    SetPapers;
{      SetTrueType; }
    { save the printer name so I don't requery this when I don't have to }
    FPrinterName := Printers.Printer.Printers[Printers.Printer.PrinterIndex];
  end;
  ReleaseDeviceMode;
end;

procedure TAcePrinterInfo.GetDeviceMode(Reset: Boolean);
begin
  if DeviceMode = nil then
  begin
    if AceGetPrinterCount > 0 then
    begin
      GetPrinter(Reset);
      if DevHandle <> 0 then
      begin
        {$ifdef WIN32}
          DeviceMode := GlobalLock(DevHandle);
        {$else}

          DeviceMode := Ptr(DevHandle, 0);

          StrCopy(TempDriver, Driver);
          if StrPos( StrUpper(TempDriver), '.DRV') = nil then StrCat(Driver, '.DRV');

          LibraryHandle := LoadLibrary(Driver);

          if LibraryHandle <> 0 then
          begin
            DeviceCaps := GetProcAddress(LibraryHandle, 'DeviceCapabilities');
            if DeviceCaps = nil then ReleaseDeviceMode;
          end else ReleaseDeviceMode;
        {$endif}
      end;
    end;
  end;
end;

function TAcePrinterInfo.PrinterChanged: Boolean;
begin
  if AceGetPrinterCount > 0 then
    Result := FPrinterName <> Printers.Printer.Printers[Printers.Printer.PrinterIndex]
  else Result := False;
end;

procedure TAcePrinterInfo.ReleaseDeviceMode;
begin
  if DeviceMode <> nil then
  begin
    {$ifdef WIN32}
      if DevHandle <> 0 then GlobalUnLock(DevHandle);
    {$else}
      if LibraryHandle <> 0 then FreeLibrary (LibraryHandle);
      LibraryHandle := 0;
    {$endif}
    DeviceMode := nil;
    Handle := 0;
    DevHandle := 0;
  end;
end;

function TAcePrinterInfo.GetPaperByNum(Value: Integer): TAcePaper;
var
  Spot: Integer;
begin
  Result := nil;
  Spot := 0;
  while (Result = nil) And (Spot < FPaperList.Count) do
  begin
    if TAcePaper(FPaperList.Items[Spot]).PaperNum = Value then
      Result := TAcePaper(FPaperList.Items[Spot]);
    Inc(Spot);
  end;
end;

function TAcePrinterInfo.GetPaperByName(FormName: String): TAcePaper;
var
  Spot: Integer;
begin
  Result := nil;
  Spot := 0;
  FormName := UpperCase(FormName);
  while (Result = nil) And (Spot < FPaperList.Count) do
  begin
    if UpperCase(TAcePaper(FPaperList.Items[Spot]).PaperName) = FormName then
      Result := TAcePaper(FPaperList.Items[Spot]);
    Inc(Spot);
  end;
end;
function TAcePrinterInfo.FindPaperByName(FormName: String): TAcePaper;
var
  Spot: Integer;
  Paper: TAcePaper;
begin
  Result := nil;
  Spot := 0;
  while (Result = nil) And (Spot < FPaperList.Count) do
  begin
    Paper := TAcePaper(FPaperList.Items[Spot]);
    if CompareStrings(FormName, Paper.PaperName) then Result := Paper
    else Inc(Spot);
  end;
end;
function TAcePrinterInfo.GetPaperName(Value: Integer): String;
begin
  case Value of
    DMPAPER_LETTER              : result := 'Letter';
    DMPAPER_EXECUTIVE           : result := 'Executive';
    DMPAPER_LEGAL               : result := 'Legal';
    DMPAPER_A4                  : result := 'A4';
    DMPAPER_USER                : result := 'Custom';
    DMPAPER_LETTERSMALL         : result := 'LETTER SMALL';
    DMPAPER_TABLOID             : result := 'TABLOID';
    DMPAPER_LEDGER              : result := 'LEDGER';
    DMPAPER_STATEMENT           : result := 'STATEMENT';
    DMPAPER_A3                  : result := 'A3';
    DMPAPER_A4SMALL             : result := 'A4 SMALL';
    DMPAPER_A5                  : result := 'A5';
    DMPAPER_B4                  : result := 'B4';
    DMPAPER_B5                  : result := 'B5';
    DMPAPER_FOLIO               : result := 'FOLIO';
    DMPAPER_QUARTO              : result := 'QUARTO';
    DMPAPER_10X14               : result := '10 14';
    DMPAPER_11X17               : result := '11 17';
    DMPAPER_NOTE                : result := 'NOTE';
    DMPAPER_ENV_9               : result := 'ENV 9';
    DMPAPER_ENV_10              : result := 'ENV 10';
    DMPAPER_ENV_11              : result := 'ENV 11';
    DMPAPER_ENV_12              : result := 'ENV 12';
    DMPAPER_ENV_14              : result := 'ENV 14';
    DMPAPER_CSHEET              : result := 'C SHEET';
    DMPAPER_DSHEET              : result := 'D SHEET';
    DMPAPER_ESHEET              : result := 'E SHEET';
  else result := 'Letter';
  end;
end;



function TAcePrinterInfo.GetResolution(HorzRes, VertRes: LongInt): TAceResolution;
var
  Spot: Integer;
  Res: TAceResolution;
begin
  Result := nil;
  for Spot := 0 to FResolutions.Count - 1 do
  begin
    Res := TAceResolution(FResolutions.Items[Spot]);
    if Result = nil then Result := Res
    else if (VertRes <= Res.VertRes) And (HorzRes <= Res.HorzRes) then Result := Res;
  end;
end;


function TAcePrinterInfo.GetBinName(Source: Integer): String;
begin
  case Source of
    DMBIN_UPPER: Result := 'Upper';
    DMBIN_LOWER: Result := 'Lower';
    DMBIN_MIDDLE: Result := 'Middle';
    DMBIN_MANUAL: Result := 'Manual';
    DMBIN_ENVELOPE: Result := 'Envelope';
    DMBIN_ENVMANUAL: Result := 'Envelope Manual';
    DMBIN_AUTO: Result := 'Auto';
    DMBIN_TRACTOR: Result := 'Tractor';
    DMBIN_SMALLFMT: Result := 'Small Format';
    DMBIN_LARGEFMT: Result := 'Large Format';
    DMBIN_LARGECAPACITY: Result := 'Large Capacity';
    DMBIN_CASSETTE: Result := 'Cassette';
    {$ifdef WIN32}
    DMBIN_FORMSOURCE: Result := 'Form Source';
    {$endif}
  else Result := '';
  end;
end;

function TAcePrinterInfo.CompareStrings(source, dest: String): Boolean;
var
  find: String;
  spot: Integer;
begin
  Result := True;

  Source := UpperCase(Source);
  Dest := UpperCase(Dest);
  while True do
  begin
    spot := Pos(' ', Source);
    if spot > 0 then
    begin
      Find := Copy(Source, 1, Spot - 1);
      Source := Copy(Source, Spot + 1, Length(Source) - Spot);
    end else
    begin
      Find := Source;
      Source := '';
    end;

    if Pos(Find, Dest) = 0 then
    begin
      result := False;
      Break;
    end;
    if Source = '' then Break;
  end;

end;

function TAcePrinterInfo.GetBinByNum(BinNum: Integer): TAceBinInfo;
var