• Home
 · 
• Windows System Services
 · 
• Gives detailed information about your printer,taken from MSKB.

Gives detailed information about your printer,taken from MSKB.

Gives detailed information about your printer,taken from MSKB.

API Declarations



Private Const NULLPTR = 0&
' Constants for DEVMODE
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
' Constants for DocumentProperties
Private Const DM_MODIFY = 8
Private Const DM_COPY = 2
Private Const DM_IN_BUFFER = DM_MODIFY
Private Const DM_OUT_BUFFER = DM_COPY
' Constants for dmOrientation
Private Const DMORIENT_PORTRAIT = 1
Private Const DMORIENT_LANDSCAPE = 2
' Constants for dmPrintQuality
Private Const DMRES_DRAFT = (-1)
Private Const DMRES_HIGH = (-4)
Private Const DMRES_LOW = (-2)
Private Const DMRES_MEDIUM = (-3)
' Constants for dmTTOption
Private Const DMTT_BITMAP = 1
Private Const DMTT_DOWNLOAD = 2
Private Const DMTT_DOWNLOAD_OUTLINE = 4
Private Const DMTT_SUBDEV = 3
' Constants for dmColor
Private Const DMCOLOR_COLOR = 2
Private Const DMCOLOR_MONOCHROME = 1

Private Type DEVMODE
dmDeviceName(1 To CCHDEVICENAME) As Byte
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName(1 To CCHFORMNAME) As Byte
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type

Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
ByVal pDefault As Long) As Long

Private Declare Function DocumentProperties Lib "winspool.drv" _
Alias "DocumentPropertiesA" (ByVal hwnd As Long, _
ByVal hPrinter As Long, ByVal pDeviceName As String, _
pDevModeOutput As Any, pDevModeInput As Any, ByVal fMode As Long) _
As Long

Private Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)





Rate Gives detailed information about your printer,taken from MSKB.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = Trim(OriginalStr)
End Function

Function ByteToString(ByteArray() As Byte) As String
    Dim TempStr As String
    Dim I As Integer

    For I = 1 To CCHDEVICENAME
        TempStr = TempStr & Chr(ByteArray(I))
    Next I
    ByteToString = StripNulls(TempStr)
End Function

Function GetPrinterSettings(szPrinterName As String, hdc As Long) _
            As Boolean
    Dim hPrinter As Long
    Dim nSize As Long
    Dim pDevMode As DEVMODE
    Dim aDevMode() As Byte
    Dim TempStr As String

    If OpenPrinter(szPrinterName, hPrinter, NULLPTR) Then
        nSize = DocumentProperties(NULLPTR, hPrinter, szPrinterName, _
                NULLPTR, NULLPTR, 0)
        ReDim aDevMode(1 To nSize)
        nSize = DocumentProperties(NULLPTR, hPrinter, szPrinterName, _
                aDevMode(1), NULLPTR, DM_OUT_BUFFER)
        Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))

        List1.Clear   ' empty the ListBox
        List1.AddItem "Printer Name: " & _
                ByteToString(pDevMode.dmDeviceName)

        If pDevMode.dmOrientation = DMORIENT_PORTRAIT Then
            TempStr = "PORTRAIT"
        ElseIf pDevMode.dmOrientation = DMORIENT_LANDSCAPE Then
            TempStr = "LANDSCAPE"
        Else
            TempStr = "UNDEFINED"
        End If
        List1.AddItem "Orientation: " & TempStr

        Select Case pDevMode.dmPrintQuality
            Case DMRES_DRAFT
                TempStr = "DRAFT"
            Case DMRES_HIGH
                TempStr = "HIGH"
            Case DMRES_LOW
                TempStr = "LOW"
            Case DMRES_MEDIUM
                TempStr = "MEDIUM"
            Case Else   ' positive value
                TempStr = CStr(pDevMode.dmPrintQuality) & " dpi"
        End Select
        List1.AddItem "Print Quality: " & TempStr

        Select Case pDevMode.dmTTOption
            Case DMTT_BITMAP    ' default for dot-matrix printers
                TempStr = "TrueType fonts as graphics"
            Case DMTT_DOWNLOAD  ' default for HP printers that use PCL
                TempStr = "Downloads TrueType fonts as soft fonts"
            Case DMTT_SUBDEV    ' default for PostScript printers
                TempStr = "Substitute device fonts for TrueType fonts"
            Case Else
                TempStr = "UNDEFINED"
        End Select
        List1.AddItem "TrueType Option: " & TempStr

        ' Windows NT drivers often return COLOR from Monochrome printers
        If pDevMode.dmColor = DMCOLOR_MONOCHROME Then
            TempStr = "MONOCHROME"
        ElseIf pDevMode.dmColor = DMCOLOR_COLOR Then
            TempStr = "COLOR"
        Else
            TempStr = "UNDEFINED"
        End If
        List1.AddItem "Color or Monochrome: " & TempStr

        If pDevMode.dmScale = 0 Then
            TempStr = "NONE"
        Else
            TempStr = CStr(pDevMode.dmScale)
        End If
        List1.AddItem "Scale Factor: " & TempStr

        List1.AddItem "Y Resolution: " & pDevMode.dmYResolution & " dpi"
        List1.AddItem "Copies: " & CStr(pDevMode.dmCopies)
        ' Add any other items of interest ...

        Call ClosePrinter(hPrinter)
        GetPrinterSettings = True
    Else
        GetPrinterSettings = False
    End If
End Function

Private Sub Command1_Click()
    If GetPrinterSettings(Printer.DeviceName, Printer.hdc) = False Then
        List1.AddItem "No Settings Retrieved!"
    End If
End Sub


'Required one command button & one listbox