Автор: Xavier Pacheco

{
Copyright © 1999 by Delphi 5 Developer's Guide - Xavier Pacheco and Steve Teixeira
}

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls;

type
  TMainForm = class(TForm)
    pgcPrinterInfo: TPageControl;
    tbsPaperTypes: TTabSheet;
    tbsGeneralData: TTabSheet;
    lbPaperTypes: TListBox;
    tbsDeviceCaps: TTabSheet;
    tbsRasterCaps: TTabSheet;
    tbsCurveCaps: TTabSheet;
    tbsLineCaps: TTabSheet;
    tbsPolygonalCaps: TTabSheet;
    tbsTextCaps: TTabSheet;
    lvGeneralData: TListView;
    lvCurveCaps: TListView;
    Splitter1: TSplitter;
    lvDeviceCaps: TListView;
    lvRasterCaps: TListView;
    pnlTop: TPanel;
    cbPrinters: TComboBox;
    lvLineCaps: TListView;
    lvPolyCaps: TListView;
    lvTextCaps: TListView;
    procedure FormCreate(Sender: TObject);
    procedure cbPrintersChange(Sender: TObject);
  private
    Device, Driver, Port: array[0..255] of char;
    ADevMode: THandle;
  public
    procedure GetBinNames;
    procedure GetDuplexSupport;
    procedure GetCopies;
    procedure GetEMFStatus;
    procedure GetResolutions;
    procedure GetTrueTypeInfo;
    procedure GetDevCapsPaperNames;
    procedure GetDevCaps;
    procedure GetRasterCaps;
    procedure GetCurveCaps;
    procedure GetLineCaps;
    procedure GetPolyCaps;
    procedure GetTextCaps;
  end;

var
  MainForm: TMainForm;

implementation
uses
  Printers, WinSpool;

const
  NoYesArray: array[Boolean] of string = ('No', 'Yes');
type

  // Types for holding bin names
  TBinName = array[0..23] of char;
  // Where used set $R- to prevent error
  TBinNames = array[0..0] of TBinName;

  // Types for holding paper names
  TPName = array[0..63] of char;

  // Where used set $R- to prevent error
  TPNames = array[0..0] of TPName;

  // Types for holding resolutions
  TResolution = array[0..1] of integer;
  // Where used set $R- to prevent error
  TResolutions = array[0..0] of TResolution;

  // Type for holding array of pages sizes (word types)
  TPageSizeArray = array[0..0] of word;

var
  Rslt: Integer;

{$R *.DFM}
  (*
  function BoolToYesNoStr(aVal: Boolean): String;
  // Returns the string "YES" or "NO" based on the boolean value
  begin
    if aVal then
      Result := 'Yes'
    else
      Result := 'No';
  end;
  *)

procedure AddListViewItem(const aCaption, aValue: string; aLV: TListView);
// This method is used to add a TListItem to the TListView, aLV
var
  NewItem: TListItem;
begin
  NewItem := aLV.Items.Add;
  NewItem.Caption := aCaption;
  NewItem.SubItems.Add(aValue);
end;

procedure TMainForm.GetBinNames;
var
  BinNames: Pointer;
  i: integer;
begin
{$R-} // Range checking must be turned off here.
  // First determine how many bin names are available.
  Rslt := DeviceCapabilitiesA(Device, Port, DC_BINNAMES, nil, nil);
  if Rslt > 0 then
  begin
    { Each bin name is 24 bytes long. Therefore, allocate Rslt*24 bytes to hold
      the bin names. }
    GetMem(BinNames, Rslt * 24);
    try
      // Now retrieve the bin names in the allocated block of memory.
      if DeviceCapabilitiesA(Device, Port, DC_BINNAMES, BinNames, nil) = -1 then
        raise Exception.Create('DevCap Error');
      //{ Add the information to the appropriate list box.
      AddListViewItem('BIN NAMES', EmptyStr, lvGeneralData);
      for i := 0 to Rslt - 1 do
      begin
        AddListViewItem(Format('   Bin Name %d', [i]),
          StrPas(TBinNames(BinNames^)[i]), lvGeneralData);
      end;
    finally
      FreeMem(BinNames, Rslt * 24);
    end;
  end;
{$R+} // Turn range checking back on.
end;

procedure TMainForm.GetDuplexSupport;
begin
  { This function uses DeviceCapabilitiesA to determine whether or not the
    printer device supports duplex printing. }
  Rslt := DeviceCapabilitiesA(Device, Port, DC_DUPLEX, nil, nil);
  AddListViewItem('Duplex Printing', NoYesArray[Rslt = 1], lvGeneralData);
end;

procedure TMainForm.GetCopies;
begin
  { This function determines how many copies the device can be set to print.
    If the result is not greater than 1 then the print logic must be
    executed multiple times }
  Rslt := DeviceCapabilitiesA(Device, Port, DC_COPIES, nil, nil);
  AddListViewItem('Copies that printer can print', InttoStr(Rslt),
    lvGeneralData);
end;

procedure TMainForm.GetEMFStatus;
begin
  // This function determines if the device supports the enhanced metafiles.
  Rslt := DeviceCapabilitiesA(Device, Port, DC_EMF_COMPLIANT, nil, nil);
  AddListViewItem('EMF Compliant', NoYesArray[Rslt = 1], lvGeneralData);
end;

procedure TMainForm.GetResolutions;
var
  Resolutions: Pointer;
  i: integer;
begin
{$R-} // Range checking must be turned off.
  // Determine how many resolutions are available.
  Rslt := DeviceCapabilitiesA(Device, Port, DC_ENUMRESOLUTIONS, nil, nil);
  if Rslt > 0 then
  begin
    { Allocate the memory to hold the different resolutions which are
      represented by integer pairs, ie: 300, 300 }
    GetMem(Resolutions, (SizeOf(Integer) * 2) * Rslt);
    try
      // Retrieve the different resolutions.
      if DeviceCapabilitiesA(Device, Port, DC_ENUMRESOLUTIONS,
        Resolutions, nil) = -1 then
        raise Exception.Create('DevCaps Error');
      // Add the resolution information to the appropriate list box.
      AddListViewItem('RESOLUTION CONFIGURATIONS', EmptyStr, lvGeneralData);

      for i := 0 to Rslt - 1 do
      begin
        AddListViewItem('   Resolution Configuration',
          IntToStr(TResolutions(Resolutions^)[i][0]) +
          ' ' + IntToStr(TResolutions(Resolutions^)[i][1]), lvGeneralData);
      end;
    finally
      FreeMem(Resolutions, SizeOf(Integer) * Rslt * 2);
    end;
  end;
{$R+} // Turn range checking back on.
end;

procedure TMainForm.GetTrueTypeInfo;
begin
  // Get the TrueType font capabilities of the device represented as bitmasks
  Rslt := DeviceCapabilitiesA(Device, Port, DC_TRUETYPE, nil, nil);
  if Rslt <> 0 then
    { Now mask out the individual TrueType capabilities and indicate the
      result in the appropriate list box. }
    AddListViewItem('TRUE TYPE FONTS', EmptyStr, lvGeneralData);
  with lvGeneralData.Items do
  begin
    AddListViewItem('   Prints TrueType fonts as graphics',
      NoYesArray[(Rslt and DCTT_BITMAP) = DCTT_BITMAP], lvGeneralData);

    AddListViewItem('   Downloads TrueType fonts',
      NoYesArray[(Rslt and DCTT_DOWNLOAD) = DCTT_DOWNLOAD], lvGeneralData);

    AddListViewItem('   Downloads outline TrueType fonts',
      NoYesArray[(Rslt and DCTT_DOWNLOAD_OUTLINE) = DCTT_DOWNLOAD_OUTLINE],
      lvGeneralData);

    AddListViewItem('   Substitutes device for TrueType fonts',
      NoYesArray[(Rslt and DCTT_SUBDEV) = DCTT_SUBDEV], lvGeneralData);
  end;
end;

procedure TMainForm.GetDevCapsPaperNames;
{ This method gets the paper types available on a selected printer from the
  DeviceCapabilitiesA function. }
var
  PaperNames: Pointer;
  i: integer;
begin
{$R-} // Range checking off.
  lbPaperTypes.Items.Clear;
  // First get the number of paper names available.
  Rslt := DeviceCapabilitiesA(Device, Port, DC_PAPERNAMES, nil, nil);
  if Rslt > 0 then
  begin
    { Now allocate the array of paper names. Each paper name is 64 bytes.
      Therefore, allocate Rslt*64 of memory. }
    GetMem(PaperNames, Rslt * 64);
    try
      // Retrieve the list of names into the allocated memory block.
      if DeviceCapabilitiesA(Device, Port, DC_PAPERNAMES,
        PaperNames, nil) = -1 then
        raise Exception.Create('DevCap Error');
      // Add the paper names to the appropriate list box.
      for i := 0 to Rslt - 1 do
        lbPaperTypes.Items.Add(StrPas(TPNames(PaperNames^)[i]));
    finally
      FreeMem(PaperNames, Rslt * 64);
    end;
  end;
{$R+} // Range checking back on.
end;

procedure TMainForm.GetDevCaps;
{ This method retrieves various capabilities of the selected printer device by
  using the GetDeviceCaps function. Refer to the Online API help for the
  meaning of each of these items. }
begin
  with lvDeviceCaps.Items do
  begin
    Clear;
    AddListViewItem('Width in millimeters',
      IntToStr(GetDeviceCaps(Printer.Handle, HORZSIZE)), lvDeviceCaps);
    AddListViewItem('Height in millimeter',
      IntToStr(GetDeviceCaps(Printer.Handle, VERTSIZE)), lvDeviceCaps);
    AddListViewItem('Width in pixels',
      IntToStr(GetDeviceCaps(Printer.Handle, HORZRES)), lvDeviceCaps);
    AddListViewItem('Height in pixels',
      IntToStr(GetDeviceCaps(Printer.Handle, VERTRES)), lvDeviceCaps);
    AddListViewItem('Pixels per horizontal inch',
      IntToStr(GetDeviceCaps(Printer.Handle, LOGPIXELSX)), lvDeviceCaps);
    AddListViewItem('Pixels per vertical inch',
      IntToStr(GetDeviceCaps(Printer.Handle, LOGPIXELSY)), lvDeviceCaps);
    AddListViewItem('Color bits per pixel',
      IntToStr(GetDeviceCaps(Printer.Handle, BITSPIXEL)), lvDeviceCaps);
    AddListViewItem('Number of color planes',
      IntToStr(GetDeviceCaps(Printer.Handle, PLANES)), lvDeviceCaps);
    AddListViewItem('Number of brushes',
      IntToStr(GetDeviceCaps(Printer.Handle, NUMBRUSHES)), lvDeviceCaps);
    AddListViewItem('Number of pens',
      IntToStr(GetDeviceCaps(Printer.Handle, NUMPENS)), lvDeviceCaps);
    AddListViewItem('Number of fonts',
      IntToStr(GetDeviceCaps(Printer.Handle, NUMFONTS)), lvDeviceCaps);
    Rslt := GetDeviceCaps(Printer.Handle, NUMCOLORS);
    if Rslt = -1 then
      AddListViewItem('Number of entries in color table', ' > 8', lvDeviceCaps)
    else
      AddListViewItem('Number of entries in color table',
        IntToStr(Rslt), lvDeviceCaps);
    AddListViewItem('Relative pixel drawing width',
      IntToStr(GetDeviceCaps(Printer.Handle, ASPECTX)), lvDeviceCaps);
    AddListViewItem('Relative pixel drawing height',
      IntToStr(GetDeviceCaps(Printer.Handle, ASPECTY)), lvDeviceCaps);
    AddListViewItem('Diagonal pixel drawing width',
      IntToStr(GetDeviceCaps(Printer.Handle, ASPECTXY)), lvDeviceCaps);
    if GetDeviceCaps(Printer.Handle, CLIPCAPS) = 1 then
      AddListViewItem('Clip to rectangle', 'Yes', lvDeviceCaps)
    else
      AddListViewItem('Clip to rectangle', 'No', lvDeviceCaps);
  end;
end;

procedure TMainForm.GetRasterCaps;
{ This method gets the various raster capabilities of the selected printer
  device by using the GetDeviceCaps function with the RASTERCAPS index. Refer
  to the online help for information on each capability. }
var
  RCaps: Integer;
begin
  with lvRasterCaps.Items do
  begin
    Clear;
    RCaps := GetDeviceCaps(Printer.Handle, RASTERCAPS);
    AddListViewItem('Banding',
      NoYesArray[(RCaps and RC_BANDING) = RC_BANDING], lvRasterCaps);
    AddListViewItem('BitBlt Capable',
      NoYesArray[(RCaps and RC_BITBLT) = RC_BITBLT], lvRasterCaps);
    AddListViewItem('Supports bitmaps > 64K',
      NoYesArray[(RCaps and RC_BITMAP64) = RC_BITMAP64], lvRasterCaps);
    AddListViewItem('DIB support',
      NoYesArray[(RCaps and RC_DI_BITMAP) = RC_DI_BITMAP], lvRasterCaps);
    AddListViewItem('Floodfill support',
      NoYesArray[(RCaps and RC_FLOODFILL) = RC_FLOODFILL], lvRasterCaps);
    AddListViewItem('Windows 2.0 support',
      NoYesArray[(RCaps and RC_GDI20_OUTPUT) = RC_GDI20_OUTPUT], lvRasterCaps);
    AddListViewItem('Palette based device',
      NoYesArray[(RCaps and RC_PALETTE) = RC_PALETTE], lvRasterCaps);
    AddListViewItem('Scaling support',
      NoYesArray[(RCaps and RC_SCALING) = RC_SCALING], lvRasterCaps);
    AddListViewItem('StretchBlt support',
      NoYesArray[(RCaps and RC_STRETCHBLT) = RC_STRETCHBLT], lvRasterCaps);
    AddListViewItem('StretchDIBits support',
      NoYesArray[(RCaps and RC_STRETCHDIB) = RC_STRETCHDIB], lvRasterCaps);
  end;
end;

procedure TMainForm.GetCurveCaps;
{ This method gets the various curve capabilities of the selected printer
  device by using the GetDeviceCaps function with the CURVECAPS index. Refer
  to the online help for information on each capability. }
var
  CCaps: Integer;
begin
  with lvCurveCaps.Items do
  begin
    Clear;
    CCaps := GetDeviceCaps(Printer.Handle, CURVECAPS);

    AddListViewItem('Curve support',
      NoYesArray[(CCaps and CC_NONE) = CC_NONE], lvCurveCaps);

    AddListViewItem('Circle support',
      NoYesArray[(CCaps and CC_CIRCLES) = CC_CIRCLES], lvCurveCaps);

    AddListViewItem('Pie support',
      NoYesArray[(CCaps and CC_PIE) = CC_PIE], lvCurveCaps);

    AddListViewItem('Chord arc support',
      NoYesArray[(CCaps and CC_CHORD) = CC_CHORD], lvCurveCaps);

    AddListViewItem('Ellipse support',
      NoYesArray[(CCaps and CC_ELLIPSES) = CC_ELLIPSES], lvCurveCaps);

    AddListViewItem('Wide border support',
      NoYesArray[(CCaps and CC_WIDE) = CC_WIDE], lvCurveCaps);

    AddListViewItem('Styled border support',
      NoYesArray[(CCaps and CC_STYLED) = CC_STYLED], lvCurveCaps);

    AddListViewItem('Round rectangle support',
      NoYesArray[(CCaps and CC_ROUNDRECT) = CC_ROUNDRECT], lvCurveCaps);

  end;
end;

procedure TMainForm.GetLineCaps;
{ This method gets the various line drawing capabilities of the selected printer
  device by using the GetDeviceCaps function with the LINECAPS index. Refer
  to the online help for information on each capability. }
var
  LCaps: Integer;
begin
  with lvLineCaps.Items do
  begin
    Clear;
    LCaps := GetDeviceCaps(Printer.Handle, LINECAPS);

    AddListViewItem('Line support',
      NoYesArray[(LCaps and LC_NONE) = LC_NONE], lvLineCaps);

    AddListViewItem('Polyline support',
      NoYesArray[(LCaps and LC_POLYLINE) = LC_POLYLINE], lvLineCaps);

    AddListViewItem('Marker support',
      NoYesArray[(LCaps and LC_MARKER) = LC_MARKER], lvLineCaps);

    AddListViewItem('Multiple marker support',
      NoYesArray[(LCaps and LC_POLYMARKER) = LC_POLYMARKER], lvLineCaps);

    AddListViewItem('Wide line support',
      NoYesArray[(LCaps and LC_WIDE) = LC_WIDE], lvLineCaps);

    AddListViewItem('Styled line support',
      NoYesArray[(LCaps and LC_STYLED) = LC_STYLED], lvLineCaps);

    AddListViewItem('Wide and styled line support',
      NoYesArray[(LCaps and LC_WIDESTYLED) = LC_WIDESTYLED], lvLineCaps);

    AddListViewItem('Interior support',
      NoYesArray[(LCaps and LC_INTERIORS) = LC_INTERIORS], lvLineCaps);
  end;
end;

procedure TMainForm.GetPolyCaps;
{ This method gets the various polygonal capabilities of the selected printer
  device by using the GetDeviceCaps function with the POLYGONALCAPS index. Refer
  to the online help for information on each capability. }
var
  PCaps: Integer;
begin
  with lvPolyCaps.Items do
  begin
    Clear;
    PCaps := GetDeviceCaps(Printer.Handle, POLYGONALCAPS);

    AddListViewItem('Polygon support',
      NoYesArray[(PCaps and PC_NONE) = PC_NONE], lvPolyCaps);

    AddListViewItem('Alternate fill polygon support',
      NoYesArray[(PCaps and PC_POLYGON) = PC_POLYGON], lvPolyCaps);

    AddListViewItem('Rectangle support',
      NoYesArray[(PCaps and PC_RECTANGLE) = PC_RECTANGLE], lvPolyCaps);

    AddListViewItem('Winding-fill polygon support',
      NoYesArray[(PCaps and PC_WINDPOLYGON) = PC_WINDPOLYGON], lvPolyCaps);

    AddListViewItem('Single scanline support',
      NoYesArray[(PCaps and PC_SCANLINE) = PC_SCANLINE], lvPolyCaps);

    AddListViewItem('Wide border support',
      NoYesArray[(PCaps and PC_WIDE) = PC_WIDE], lvPolyCaps);

    AddListViewItem('Styled border support',
      NoYesArray[(PCaps and PC_STYLED) = PC_STYLED], lvPolyCaps);

    AddListViewItem('Wide and styled border support',
      NoYesArray[(PCaps and PC_WIDESTYLED) = PC_WIDESTYLED], lvPolyCaps);

    AddListViewItem('Interior support',
      NoYesArray[(PCaps and PC_INTERIORS) = PC_INTERIORS], lvPolyCaps);
  end;
end;

procedure TMainForm.GetTextCaps;
{ This method gets the various text drawing capabilities of the selected printer
  device by using the GetDeviceCaps function with the TEXTCAPS index. Refer
  to the online help for information on each capability. }
var
  TCaps: Integer;
begin
  with lvTextCaps.Items do
  begin
    Clear;
    TCaps := GetDeviceCaps(Printer.Handle, TEXTCAPS);

    AddListViewItem('Character output precision',
      NoYesArray[(TCaps and TC_OP_CHARACTER) = TC_OP_CHARACTER], lvTextCaps);

    AddListViewItem('Stroke output precision',
      NoYesArray[(TCaps and TC_OP_STROKE) = TC_OP_STROKE], lvTextCaps);

    AddListViewItem('Stroke clip precision',
      NoYesArray[(TCaps and TC_CP_STROKE) = TC_CP_STROKE], lvTextCaps);

    AddListViewItem('90 degree character rotation',
      NoYesArray[(TCaps and TC_CR_90) = TC_CR_90], lvTextCaps);

    AddListViewItem('Any degree character rotation',
      NoYesArray[(TCaps and TC_CR_ANY) = TC_CR_ANY], lvTextCaps);

    AddListViewItem('Independent scale in X and Y direction',
      NoYesArray[(TCaps and TC_SF_X_YINDEP) = TC_SF_X_YINDEP], lvTextCaps);

    AddListViewItem('Doubled character for scaling',
      NoYesArray[(TCaps and TC_SA_DOUBLE) = TC_SA_DOUBLE], lvTextCaps);

    AddListViewItem('Integer multiples only for character scaling',
      NoYesArray[(TCaps and TC_SA_INTEGER) = TC_SA_INTEGER], lvTextCaps);

    AddListViewItem('Any multiples for exact character scaling',
      NoYesArray[(TCaps and TC_SA_CONTIN) = TC_SA_CONTIN], lvTextCaps);

    AddListViewItem('Double weight characters',
      NoYesArray[(TCaps and TC_EA_DOUBLE) = TC_EA_DOUBLE], lvTextCaps);

    AddListViewItem('Italicized characters',
      NoYesArray[(TCaps and TC_IA_ABLE) = TC_IA_ABLE], lvTextCaps);

    AddListViewItem('Underlined characters',
      NoYesArray[(TCaps and TC_UA_ABLE) = TC_UA_ABLE], lvTextCaps);

    AddListViewItem('Strikeout characters',
      NoYesArray[(TCaps and TC_SO_ABLE) = TC_SO_ABLE], lvTextCaps);

    AddListViewItem('Raster fonts',
      NoYesArray[(TCaps and TC_RA_ABLE) = TC_RA_ABLE], lvTextCaps);

    AddListViewItem('Vector fonts',
      NoYesArray[(TCaps and TC_VA_ABLE) = TC_VA_ABLE], lvTextCaps);

    AddListViewItem('Scrolling using bit-block transfer',
      NoYesArray[(TCaps and TC_SCROLLBLT) = TC_SCROLLBLT], lvTextCaps);
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  // Store the printer names in the combo box.
  cbPrinters.Items.Assign(Printer.Printers);
  // Display the default printer in the combo box.
  cbPrinters.ItemIndex := Printer.PrinterIndex;
  // Invoke the combo's OnChange event
  cbPrintersChange(nil);
end;

procedure TMainForm.cbPrintersChange(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  try
    // Populate combo with available printers
    Printer.PrinterIndex := cbPrinters.ItemIndex;
    with Printer do
      GetPrinter(Device, Driver, Port, ADevMode);
    // Fill the general page with printer information
    with lvGeneralData.Items do
    begin
      Clear;
      AddListViewItem('Port', Port, lvGeneralData);
      AddListViewItem('Device', Device, lvGeneralData);

      Rslt := DeviceCapabilitiesA(Device, Port, DC_DRIVER, nil, nil);
      AddListViewItem('Driver Version', IntToStr(Rslt), lvGeneralData);
    end;

    // The functions below make use of the GetDeviceCapabilitiesA function.
    GetBinNames;
    GetDuplexSupport;
    GetCopies;
    GetEMFStatus;
    GetResolutions;
    GetTrueTypeInfo;

    // The functions below make use of the GetDeviceCaps function.
    GetDevCapsPaperNames;
    GetDevCaps; // Fill Device Caps page.
    GetRasterCaps; // Fill Raster Caps page.
    GetCurveCaps; // Fill Curve Caps page.
    GetLineCaps; // Fill Line Caps page.
    GetPolyCaps; // Fill Polygonal Caps page.
    GetTextCaps; // Fill Text Caps page.
  finally
    Screen.Cursor := crDefault;
  end;
end;

end.