判断打印机是否支持彩色/双面打印
时 间: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选项卡示例】Ac...(09.09)
- 【Access源码示例】按输入...(09.02)
- 【Access日期区间段查询】...(08.29)
- 【Access日期区间段查询】...(08.27)
- Access怎样才能实现日期时...(08.21)
- 【Access定时打开查询】A...(08.19)
- Access生成固定数量的记录...(08.13)
- Access怎样才能实现日期时...(08.12)
- Access利用导航窗体控件对...(08.03)
学习心得
最新文章
- Access表中的字段名、字段标题...(09.19)
- Access快速开发平台--更改“...(09.18)
- 【中秋及国庆优惠】Access培训...(09.15)
- Access如何将日期型的数值转换...(09.14)
- 英文输入法输入数据中存在单引号引起...(09.11)
- 【Access选项卡示例】Acce...(09.09)
- 让Access光标停留在指定的控件...(09.07)
- 关于Access查询条件里使用通配...(09.06)
- Access报表偷懒制作法--Ac...(09.05)
- Access快速开发平台--窗体数...(09.04)