Printerobject DeviceContext

[TopSat]

Hi there,

I'm looking for a way to determine the handle of the actual printer. Printer.hdc does not work in excel/vba, there is no printer object definition. Background: I want to know some printer properties like resolution using the GetDeviceCaps call, but there I have to pass the printer handle.

Thanks for any advice in advance,

TopSat

 

[HughLerwill]

TopSat,

Its not my code and its a bit of a mess but it appears to work in VB6 under XP SP2. Hope you can make sense of it.

Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long

Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Any) As Long

'CreateIC will not work; use CreateDC
'Private Declare Function CreateIC Lib "gdi32" Alias "CreateICA" (ByVal lpDriverName As String, _
ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc, ByVal nindex) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc)

Example code;
'unsuffixed variables are all longs
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) & Chr$(0) ' Hold printer device info
Print "Printer = ", print_device$
a3$ = Mid$(a1$, a2 + 1)
a4 = InStr(a3$, ",")
driver$ = Left$(a3$, a4 - 1) & Chr$(0) ' Hold printer driver info.
Print "Driver = ", driver$
Port$ = Mid$(a1$, a2 + a4 + 1) & Chr$(0) ' Hold printer port info.
Print "Port = ", Port$
a5 = CreateDC(driver$, print_device$, Port$, 0&)
a6 = GetDeviceCaps(a5, 0)
Print "Driver Version : "; Hex$(a6)
Print
z1 = Get_Device_Information(a5)
finished = DeleteDC(a5)

Function Get_Device_Information(hdc As Long)
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


regards Hugh

 

[HughLerwill]

and the constants;

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

and code for extended printer caps

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
Dim lpInitData As DEVMODE
'a5 = CreateIC(driver$, print_device$, Port$, 0&)
a5 = CreateDC(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)

 

[TopSat]

Hi HughLerwill,

the crucial tip was CreateDC.
Thank you for your support.

TopSat