判断打印机是否支持彩色/双面打印
时 间: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源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access源码示例】VBA...(10.12)
- Access累乘示例,Acce...(10.09)
- 数值8.88,把整数8去掉,转...(10.08)
- 【Access自定义函数】一个...(09.30)
- 【Access选项卡示例】Ac...(09.09)
- 【Access源码示例】按输入...(09.02)
- 【Access日期区间段查询】...(08.29)
- 【Access日期区间段查询】...(08.27)
- Access怎样才能实现日期时...(08.21)
学习心得
最新文章
- 获取文件修改日期的函数(10.18)
- Access快速开发平台--lis...(10.17)
- Access快速开发平台--普通用...(10.14)
- 【Access源码示例】VBA代码...(10.12)
- Access累乘示例,Access...(10.09)
- 数值8.88,把整数8去掉,转化成...(10.08)
- 用ACCESS开发的销售数据分析软...(10.06)
- 【中秋及国庆优惠】Access培训...(10.05)
- 2024欢度国庆--庆祝国庆华诞7...(10.01)
- 【Access自定义函数】一个繁简...(09.30)