Вывести список установленных принтеров и подробную информацию о каждом

{ 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

.

Другое по теме:

• Escape код PASSTHROUGH
• Вместо печати графики использовать резидентный шрифт принтера
• Вывести все способы подачи бумаги для печати