How to use GetDeviceCaps within Visual Basic

ID: Q114709

The information in this article applies to:

Microsoft Visual Basic Standard and Professional Editions for Windows, versions 2.0, 3.0

SUMMARY

This article shows by example how to use the Windows API function GetDeviceCaps to return information about a particular screen or Printer.

MORE INFORMATION

A Device context usually refers to a physical display device such as a video display or a printer. You can get information about this device, including the size of the display and its color dimensions, by calling the Windows API GetDeviceCaps (get device capabilities) function.

Here is the Declare statement syntax:


   Declare Function GetDeviceCaps% Lib "GDI" (ByVal hDC% , ByVal nIndex%)

where:

hDC, an Integer, is the Device Context for the device for which Information is requested.

nIndex, an Integer, specifies the type of Information to retrieve based on the constants shown below.

The following example also uses the CreateIC and DeleteDC Windows API functions. The CreateIC function creates an Information context for the specified device. An information context can be used to quickly retrieve information about a device without the overhead of creating a device context.

Here is the Declare statement syntax:


   ' Enter the following Declare statement as one, single line:
   Declare Function CreateIC% Lib "GDI" (ByVal lpDriverName$,
      ByVal lpDeviceName$, ByVal lpOutput$, ByVal lpInitData&amp;)

where:

lpDriverName, a String, is the MS-DOS filename of the device driver to use (without the extension).

lpDeviceName, a String, is the name of the particular device to use. This parameter is used when a driver supports more than one device.

lpOutput, a String, is the name of the MS-DOS file or device to use for output.

lpInitData, a Long, is Zero.

The DeleteDC function must be used to delete the specified device or information context and free all associated windows resources.

Here is the Declare statement syntax:


  Declare Function DeleteDC% Lib "GDI" (ByVal hDC%)

where:

hDC, an Integer, is the device context to delete.

Step-by-Step Example

Start a new project in Visual Basic. Form1 is created by default.

Place three command buttons (Command1, Command2, and Command3) on the form.

Add the following code to the General Declarations section of Form1:


   ' Enter each of the following Declare statements as one, single line:
   Declare Function CreateIC% Lib "GDI" (ByVal lpDriverName$,
      ByVal lpDeviceName$, ByVal lpOutput$, ByVal lpInitData&)
   Declare Function GetProfileString% Lib "Kernel" (ByVal lpAppName$,
      ByVal lpKeyName$, ByVal lpDefault$, ByVal lpReturnedString$,
      ByVal nSize%)
   Declare Function GetDeviceCaps% Lib "GDI" (ByVal hDC%, ByVal nindex%)
   Declare Function DeleteDC% Lib "GDI" (ByVal hDC%)

   Function Get_Device_Information (hDC As Integer)
      a7% = GetDeviceCaps(hDC%, HORZSIZE)
      Print "(HORZSIZE)", , "Width in millimeters:", a7%
      a8% = GetDeviceCaps(hDC%, VERTSIZE)
      Print "(VERTSIZE)", , "Height in millimeters:", a8%
      a9% = GetDeviceCaps(hDC%, HORZRES)
      Print "(HORZRES)", , "Width in Pixels:", a9%
      a10% = GetDeviceCaps(hDC%, VERTREZ)
      Print "(VERTREZ)", , "Height in raster Lines:", a10%
      a11% = GetDeviceCaps(hDC%, BITSPIXEL)
      Print "(BITSPIXEL)", , "Color bits per Pixel:", a11%
      a12% = GetDeviceCaps(hDC%, PLANES)
      Print "(PLANES)", , "Number of Color Planes:", a12%
      a13% = GetDeviceCaps(hDC%, NUMBRUSHES)
      Print "(NUMBRUSHES)", "Number of device brushes:", a13%
      a14% = GetDeviceCaps(hDC%, NUMPENS)
      Print "(NUMPENS)", , "Number of device pens:", a14%
      a15% = GetDeviceCaps(hDC%, NUMMARKERS)
      Print "(NUMMARKERS)", "Number of device markers:", a15%
      a16% = GetDeviceCaps(hDC%, NUMFONTS)
      Print "(NUMFONTS)", "Number of device fonts:", a16%
      a17% = GetDeviceCaps(hDC%, NUMCOLORS)
      Print "(NUMCOLORS)", "Number of device colors:", a17%
      a18% = GetDeviceCaps(hDC%, PDEVICESIZE)
      Print "(PDEVICESIZE)", "Size of device structure:", a18%
      a19% = GetDeviceCaps(hDC%, ASPECTX)
      Print "(ASPECTX)", , "Relative width of pixel:", a19%
      a20% = GetDeviceCaps(hDC%, ASPECTY)
      Print "(ASPECTY)", , "Relative height of pixel:", a20%
      a21% = GetDeviceCaps(hDC%, ASPECTXY)
      Print "(ASPECTXY)", , "Relative diagonal of pixel:", a21%
      a22% = GetDeviceCaps(hDC%, LOGPIXELSX)
      Print "(LOGPIXELSX)", "Horizontal dots per inch:", a22%
      a23% = GetDeviceCaps(hDC%, LOGPIXELSY)
      Print "(LOGPIXELSY)", "Vertical dots per inch:", a23%
      a24% = GetDeviceCaps(hDC%, SIZEPALETTE)
      Print "(SIZEPALETTE)", "Number of palette entries:", a24%
      a25% = GetDeviceCaps(hDC%, NUMRESERVED)
      Print "(NUMRESERVED)", "Reserved palette entries:", a25%
      a26% = GetDeviceCaps(hDC%, SIZEPALETTE)
      Print "(SIZEPALETTE)", "Actual color resolution:", a26%
   End Function

Add the following code to the Load and Resize events of the form:


   Sub Form_Load ()

      Me.WindowState = 2  ' Maximize to fit all info on screen.

      command1.Caption = "Printer"    ' Set up command buttons.
      command2.Caption = "Screen"
      command3.Caption = "Other"
      command1.Top = 0
      command2.Top = 0
      command3.Top = 0

   End Sub

   Sub Form_Resize ()

      command3.Left = form1.ScaleWidth - command3.Width
      command2.Left = command3.Left - command2.Width
      command1.Left = command2.Left - command1.Width

   End Sub

Create a Module1.bas file within your project and paste the following constants into that file:

   
   Global Const DRIVERVERSION = 0
   Global Const TECHNOLOGY = 2
   Global Const HORZSIZE = 4
   Global Const VERTSIZE = 6
   Global Const HORZRES = 8
   Global Const VERTRES = 10
   Global Const BITSPIXEL = 12
   Global Const PLANES = 14
   Global Const NUMBRUSHES = 16
   Global Const NUMPENS = 18
   Global Const NUMMARKERS = 20
   Global Const NUMFONTS = 22
   Global Const NUMCOLORS = 24
   Global Const PDEVICESIZE = 26
   Global Const CURVECAPS = 28
   Global Const LINECAPS = 30
   Global Const POLYGONALCAPS = 32
   Global Const TEXTCAPS = 34
   Global Const CLIPCAPS = 36
   Global Const RASTERCAPS = 38
   Global Const ASPECTX = 40
   Global Const ASPECTY = 42
   Global Const ASPECTXY = 44
   Global Const LOGPIXELSX = 88
   Global Const LOGPIXELSY = 90
   Global Const SIZEPALETTE = 104
   Global Const NUMRESERVED = 106
   Global Const COLORRES = 108
   Global Const DT_PLOTTER = 0
   Global Const DT_RASDISPLAY = 1
   Global Const DT_RASPRINTER = 2
   Global Const DT_RASCAMERA = 3
   Global Const DT_CHARSTREAM = 4
   Global Const DT_METAFILE = 5
   Global Const DT_DISPFILE = 6
   Global Const CP_NONE = 0
   Global Const CP_RECTANGLE = 1
   Global Const RC_BITBLT = 1
   Global Const RC_BANDING = 2
   Global Const RC_SCALING = 4
   Global Const RC_BITMAP64 = 8
   Global Const RC_GDI20_OUTPUT = &H10
   Global Const RC_DI_BITMAP = &H80
   Global Const RC_PALETTE = &H100
   Global Const RC_DIBTODEV = &H200
   Global Const RC_BIGFONT = &H400
   Global Const RC_STRETCHBLT = &H800
   Global Const RC_FLOODFILL = &H1000
   Global Const RC_STRETCHDIB = &H2000

Add the following code to the command button click events:


   Sub Command1_Click ()
      Me.Show
      form1.Cls
      form1.Caption = "Printer Device Capabilities"

      Dim szprinter$
      ' Get printer information from WIN.INI:
      szprinter$ = Space$(128)
      a% = GetProfileString("windows", "device", "", szprinter$, 64)

      a1$ = Left$(szprinter$, a%) ' These lines find the commas in the text
      a2% = InStr(a1$, ",")       ' and strip them out.
      print_device$ = Left$(a1$, a2% - 1)  ' Hold printer device info
      Print "Printer = ", print_device$
      a3$ = Mid$(a1$, a2% + 1)
      a4% = InStr(a3$, ",")
      driver$ = Left$(a3$, a4% - 1)    ' Hold printer driver info.
      Print "Driver = ", driver$
      port$ = Mid$(a1$, a2% + a4% + 1) ' Hold printer port info.
      Print "Port = ", port$

      a5% = CreateIC(driver$, print_device$, port$, 0)
      a6% = GetDeviceCaps(a5%, 0)
      Print "Driver Version : "; Hex$(a6%)
      Print
      z1% = Get_Device_Information(a5%)
      finished% = DeleteDC(a5%)
   End Sub

   Sub Command2_Click ()
      Me.Show
      form1.Cls
      form1.Caption = "Screen Device Capabilities"
      a5% = CreateIC("DISPLAY", "", "", 0&)
      Print
      z1% = Get_Device_Information(a5%)
      finished% = DeleteDC(a5%)
   End Sub

   Sub Command3_Click ()
      Me.Show
      form1.Cls
      form1.Caption = " other info.."
      Dim szprinter$

      szprinter$ = Space$(128)
      a% = GetProfileString("windows", "device", "", szprinter$, 64)
      a1$ = Left$(szprinter$, a%): a2% = InStr(a1$, ",")
      print_device$ = Left$(a1$, a2% - 1)
      Print "Printer = ", print_device$
      a3$ = Mid$(a1$, a2% + 1): a4% = InStr(a3$, ",")
      driver$ = Left$(a3$, a4% - 1)
      Print "Driver = ", driver$
      port$ = Mid$(a1$, a2% + a4% + 1)
      Print "Port = ", port$
      Print
      a5% = CreateIC(driver$, print_device$, port$, 0)
      a6% = GetDeviceCaps(a5%, 0)
      Print "Driver Version : "; Hex$(a6%)
      a7% = GetDeviceCaps(a5%, TECHNOLOGY)
      If a7% And DT_RASPRINTER Then
         Print "Technology: ", "DT_RASPRINTER Raster Printer"
      End If
      Print
      Print "CLIPCAPS (Clipping Capabilities)"
      Print
      a8% = GetDeviceCaps(a5%, CLIPCAPS)
      If a8% And CP_RECTANGLE Then
         Print Space$(5) & "CP_RECTANGLE", "Can Clip To Rectangle:", "Yes"
      Else
         Print Space$(5) & "CP_RECTANGLE", "Can Clip To Rectangle:", "No"
      End If
      Print
      Print "RASTERCAPS (Raster Capabilities)"
      Print
      a9% = GetDeviceCaps(a5%, RASTERCAPS)
      If a9% And RC_BITBLT Then
         Print Space$(5) & "RC_BITBLT", "Capable of simple BitBlt:", "Yes"
      Else
         Print Space$(5) & "RC_BITBLT", "Capable of simple BitBlt:", "No"
      End If
      If a9% And RC_BANDING Then
         Print Space$(5) & "RC_BANDING", "Requires banding support:", "Yes"
      Else
         Print Space$(5) & "RC_BANDING", "Requires banding support:", "No"
      End If
      If a9% And RC_SCALING Then
         Print Space$(5) & "RC_SCALING", "Requires scaling support:", "Yes"
      Else
         Print Space$(5) & "RC_SCALING", "Requires scaling support:", "No"
      End If
      If a9% And RC_BITMAP64 Then
         Print Space$(5) & "RC_BITMAP64", "Supports bitmaps >64:", "Yes"
      Else
         Print Space$(5) & "RC_BITMAP64", "Supports bitmaps >64:", "No"
      End If
      If a9% And RC_GDI20_OUTPUT Then
        Print Space$(5) & "RC_GDI20_OUTPUT", "Has 2.0 output calls:", "Yes"
      Else
         Print Space$(5) & "RC_GDI20_OUTPUT", "Has 2.0 output calls:", "No"
      End If
      If a9% And RC_DI_BITMAP Then
         Print Space$(5) & "RC_DI_BITMAP", "Supports DIB to Memory:", "Yes"
      Else
         Print Space$(5) & "RC_DI_BITMAP", "Supports DIB to Memory:", "No"
      End If
      If a9% And RC_PALETTE Then
         Print Space$(5) & "RC_PALETTE", "Supports a palette:", "Yes"
      Else
         Print Space$(5) & "RC_PALETTE", "Supports a palette:", "No"
      End If
      If a9% And RC_DIBTODEV Then
         ' Enter the following two lines as one, single line of code:
         Print Space$(5) & "RC_DIBTODEV",
            "Supports bitmap conversion:", "Yes"
      Else
         ' Enter the following two lines as one, single line of code:
         Print Space$(5) & "RC_DIBTODEV",
            "Supports bitmap conversion:", "No"
      End If
      If a9% And RC_BIGFONT Then
         Print Space$(5) & "RC_BIGFONT", "Supports fonts >64K:", "Yes"
      Else
         Print Space$(5) & "RC_BIGFONT", "Supports fonts >64K:", "No"
      End If
      If a9% And RC_STRETCHBLT Then
         Print Space$(5) & "RC_STRETCHBLT", "Supports StretchBlt:", "Yes"
      Else
         Print Space$(5) & "RC_STRETCHBLT", "Supports StretchBlt:", "No"
      End If
      If a9% And RC_FLOODFILL Then
         Print Space$(5) & "RC_FLOODFILL", "Supports FloodFill:", "Yes"
      Else
         Print Space$(5) & "RC_FLOODFILL", "Supports FloodFill:", "No"
      End If
      If a9% And RC_STRETCHDIB Then
        Print Space$(5) & "RC_STRETCHDIB", "Supports StretchDIBits:", "Yes"
      Else
         Print Space$(5) & "RC_STRETCHDIB", "Supports StretchDIBits:", "No"
      End If
      finished% = DeleteDC(a5%)
   End Sub

Run the Program. You should be able to get information for the different device contexts.

REFERENCES

"Programming Windows: the Microsoft Guide to Writing Applications for Windows 3," Charles Petzold, Microsoft Press, 1990.

"Microsoft Windows Software Development Kit" Reference Manuals and Help menu.

WINSDK.HLP Help file shipped with the Microsoft Windows 3.0 Software Development Kit.

"Visual Basic Programmers Guide to the Windows API," Daniel Appleman, Ziff Davis Press, 1993.

Additional query words: 2.00 3.00


Keywords          : 
Version           : 
Platform          : 
Issue type        :

Last Reviewed: June 1, 1999