通过此程序可以获取打印机的相关信息,例如默认打印机名称,打印方向,打印质量等等
首先建立一工程,然后添加一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下测试通过。