使用GetDeviceCaps()和DeviceCapabilities()函数: unit MainFrm;interfaceuses 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 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 Rslt := DeviceCapabilitiesA(Device, Port, DC_ENUMRESOLUTIONS, nil, nil); if Rslt > 0 then begin GetMem(Resolutions, (SizeOf(Integer)*2)*Rslt); try if DeviceCapabilitiesA(Device, Port, DC_ENUMRESOLUTIONS, Resolutions, nil) = -1 then Raise Exception.Create('DevCaps Error'); 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; end;procedure TMainForm.GetTrueTypeInfo; begin as bitmasks Rslt := DeviceCapabilitiesA(Device, Port, DC_TRUETYPE, nil, nil); if Rslt <> 0 then 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; var PaperNames: Pointer; i: integer; begin lbPaperTypes.Items.Clear; Rslt := DeviceCapabilitiesA(Device, Port, DC_PAPERNAMES, nil, nil); if Rslt > 0 then begin GetMem(PaperNames, Rslt*64); try if DeviceCapabilitiesA(Device, Port, DC_PAPERNAMES, PaperNames, nil) = - 1 then raise Exception.Create('DevCap Error'); 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 er 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.
用Printer.后面加属性就行了
unit MainFrm;interfaceuses
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;
begin
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
Rslt := DeviceCapabilitiesA(Device, Port, DC_ENUMRESOLUTIONS, nil, nil);
if Rslt > 0 then begin
GetMem(Resolutions, (SizeOf(Integer)*2)*Rslt);
try
if DeviceCapabilitiesA(Device, Port, DC_ENUMRESOLUTIONS,
Resolutions, nil) = -1 then
Raise Exception.Create('DevCaps Error');
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;
end;procedure TMainForm.GetTrueTypeInfo;
begin
as bitmasks
Rslt := DeviceCapabilitiesA(Device, Port, DC_TRUETYPE, nil, nil);
if Rslt <> 0 then
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;
var
PaperNames: Pointer;
i: integer;
begin
lbPaperTypes.Items.Clear;
Rslt := DeviceCapabilitiesA(Device, Port, DC_PAPERNAMES, nil, nil);
if Rslt > 0 then begin
GetMem(PaperNames, Rslt*64);
try
if DeviceCapabilitiesA(Device, Port, DC_PAPERNAMES,
PaperNames, nil) = - 1 then
raise Exception.Create('DevCap Error');
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;
{ 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 er 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.