Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 综合其它

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

时 间:2008-10-13 19:22:30
作 者:danis   ID:3378  城市:广州
摘 要:判断打印机是否支持彩色/双面打印

正 文:

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

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


Access软件网官方交流QQ群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助