Article ID: 114709
Article Last Modified on 12/9/2003
Declare Function GetDeviceCaps% Lib "GDI" (ByVal hDC% , ByVal nIndex%)
' Enter the following Declare statement as one, single line:
Declare Function CreateIC% Lib "GDI" (ByVal lpDriverName$,
ByVal lpDeviceName$, ByVal lpOutput$, ByVal lpInitData&)
Declare Function DeleteDC% Lib "GDI" (ByVal hDC%)
' 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
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
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
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
Additional query words: 2.00 3.00
Keywords: KB114709