判断打印机是否支持彩色/双面打印-danis专栏

判断打印机是否支持彩色/双面打印

Const NULLPTR = 0&
'Constants for DEVMODE
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
'Constants for DocumentProperties
Const DM_MODIFY = 8
Const DM_COPY = 2
Const DM_IN_BUFFER = DM_MODIFY
Const DM_OUT_BUFFER = DM_COPY


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

Declare Function OpenPrinterA Lib "winspool.drv" (ByVal pPrinterName As String, phPrinter As Long, _
        ByVal pDefault As Long) As Long
Declare Function DocumentPropertiesA Lib "winspool.drv" (ByVal hwnd As Long, ByVal hPrinter As Long, _
        ByVal pDeviceName As String, pDevModeOutput As Any, pDevModeInput As Any, ByVal fMode As Long) As Long
Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
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) As Boolean
  Dim hPrinter   As Long
  Dim nSize      As Long
  Dim pDevMode   As DEVMODE
  Dim aDevMode() As Byte
  Dim TempStr    As String

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

     Debug.Print "Printer Name: " & ByteToString(pDevMode.dmDeviceName)
     Debug.Print "PaperSize:" & pDevMode.dmPaperSize
  
     Select Case pDevMode.dmDuplex
     Case 1: TempStr = "None 单面打印"
     Case 2: TempStr = "Duplex on long edge (book) 长边翻页打印"
     Case 3: TempStr = "Duplex on short"
     End Select
     Debug.Print "Duplex:" & TempStr
   
     '获取打印机是否支持彩色打印
     Select Case pDevMode.dmColor
     Case 1: TempStr = "MONOCHROME"
     Case 2: TempStr = "COLOR"
     Case Else: TempStr = "UNDEFINED"
     End Select
     
     Debug.Print "Color or Monochrome: " & TempStr
     Call ClosePrinter(hPrinter)
     GetPrinterSettings = True
  Else
     GetPrinterSettings = False
  End If
End Function

Sub Test()
    GetPrinterSettings Left(Application.ActivePrinter, InStr(Application.ActivePrinter, "在") - 2)
End Sub