打印机信息的获取

通过此程序可以获取打印机的相关信息，例如默认打印机名称，打印方向，打印质量等等

首先建立一工程，然后添加一ListBox和一Command，代码如下：

Option Explicit
Private Const NULLPTR = 0&
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const DM_MODIFY = 8
Private Const DM_COPY = 2
Private Const DM_IN_BUFFER = DM_MODIFY
Private Const DM_OUT_BUFFER = DM_COPY
Private Const DMORIENT_PORTRAIT = 1
Private Const DMORIENT_LANDSCAPE = 2
Private Const DMRES_DRAFT = (-1)
Private Const DMRES_HIGH = (-4)
Private Const DMRES_LOW = (-2)
Private Const DMRES_MEDIUM = (-3)
Private Const DMTT_BITMAP = 1
Private Const DMTT_DOWNLOAD = 2
Private Const DMTT_DOWNLOAD_OUTLINE = 4
Private Const DMTT_SUBDEV = 3
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)

Function StripNulls(OriginalStr As String) As String
    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
        List1.AddItem "打印机名称: " & ByteToString(pDevMode.dmDeviceName)
        If pDevMode.dmOrientation = DMORIENT_PORTRAIT Then
            TempStr = "纵向"
        ElseIf pDevMode.dmOrientation = DMORIENT_LANDSCAPE Then
            TempStr = "横向"
        Else
            TempStr = "未定义"
        End If
        List1.AddItem "方向: " & TempStr
        Select Case pDevMode.dmPrintQuality
            Case DMRES_DRAFT
                TempStr = "默认"
            Case DMRES_HIGH
                TempStr = "高"
            Case DMRES_LOW
                TempStr = "低"
            Case DMRES_MEDIUM
                TempStr = "中"
            Case Else
                TempStr = CStr(pDevMode.dmPrintQuality) & " dpi"
        End Select
        List1.AddItem "打印质量: " & TempStr
        Select Case pDevMode.dmTTOption
            Case DMTT_BITMAP
                TempStr = "图形字体"
            Case DMTT_DOWNLOAD
                TempStr = "下载为软字体"
            Case DMTT_SUBDEV
                TempStr = "用设备字体替换"
            Case Else
                TempStr = "未定义"
        End Select
        List1.AddItem "TrueType 字体: " & TempStr
        If pDevMode.dmColor = DMCOLOR_MONOCHROME Then
            TempStr = "单色"
        ElseIf pDevMode.dmColor = DMCOLOR_COLOR Then
            TempStr = "彩色"
        Else
            TempStr = "未定义"
        End If
        List1.AddItem "单色或彩色: " & TempStr
        If pDevMode.dmScale = 0 Then
            TempStr = "NONE"
        Else
            TempStr = CStr(pDevMode.dmScale)
        End If
        List1.AddItem "缩放比例: " & TempStr
        List1.AddItem "Y 分辨度: " & pDevMode.dmYResolution & " dpi"
        List1.AddItem "份数: " & CStr(pDevMode.dmCopies)
        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 "不能获得打印设置!"
        MsgBox "不能获得打印设置.", , "失败"
    End If
End Sub

本程序在VB6.0+Windows2000下测试通过。