小弟有一客户要求实现这样的要求:
客户安装了几台打印机,有些本地的,有些是网络上的,
有一台网络上的打印机专门用来打其中的几处很重要的报表.
而另外的打印机则打其他的报表.
现已知网络上的打印机存放在x02表里面的deli_port字段里.
要求:
点界面上的打印按钮,不弹出选择打印机对话框,
马上用x02表里的打印机来打印该报表.
并且纸张格式为:254000(宽:毫米),152400(长:毫米)
(此纸张为自定义纸张)
小弟开始实现了用默认打印机自动打印(没有用指定的打印机,我开始以为他的要求是这样).
后来才知道他要实现上面的要求,小弟开始怎么也指定不了用deli_port里的打印机来打印,
后来想到更改默认打印机,打完后再改回来.
然后看了李红根老大的回复后终于实现了用VB+API指定默认打印机的功能,
可是我结合上面的自动打印报表的代码以后,出现了一怪事,就是点预览是预览,
点打印也是预览.而且发现报表控件的action(rpt.action)属性为只读(难怪打不了).
最后一句一句跟踪调试的时候发现sendmessage要用很长时间,小弟初次接触API,
百思不得其解,小弟想知道为什么会出现不能打印的情况.为什么报表控件的ACTION属性
会为只读...
客户安装了几台打印机,有些本地的,有些是网络上的,
有一台网络上的打印机专门用来打其中的几处很重要的报表.
而另外的打印机则打其他的报表.
现已知网络上的打印机存放在x02表里面的deli_port字段里.
要求:
点界面上的打印按钮,不弹出选择打印机对话框,
马上用x02表里的打印机来打印该报表.
并且纸张格式为:254000(宽:毫米),152400(长:毫米)
(此纸张为自定义纸张)
小弟开始实现了用默认打印机自动打印(没有用指定的打印机,我开始以为他的要求是这样).
后来才知道他要实现上面的要求,小弟开始怎么也指定不了用deli_port里的打印机来打印,
后来想到更改默认打印机,打完后再改回来.
然后看了李红根老大的回复后终于实现了用VB+API指定默认打印机的功能,
可是我结合上面的自动打印报表的代码以后,出现了一怪事,就是点预览是预览,
点打印也是预览.而且发现报表控件的action(rpt.action)属性为只读(难怪打不了).
最后一句一句跟踪调试的时候发现sendmessage要用很长时间,小弟初次接触API,
百思不得其解,小弟想知道为什么会出现不能打印的情况.为什么报表控件的ACTION属性
会为只读...
Option ExplicitPublic Const HWND_BROADCAST = &HFFFF
Public Const WM_WININICHANGE = &H1A
Public Const PRINTER_ATTRIBUTE_DEFAULT = 4
Public Const VER_PLATFORM_WIN32_WINDOWS = 1'DEVMODE結構要用的常量
Public Const CCHFORMNAME = 32
Public Const CCHDEVICENAME = 32
Public Const DM_FORMNAME As Long = &H10000
Public Const DM_ORIENTATION = &H1&' Constants for PRINTER_DEFAULTS.DesiredAccess
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)'定義DocumentProperties()調用所需的常量
Public Const DM_MODIFY = 8
Public Const DM_IN_BUFFER = DM_MODIFY
Public Const DM_COPY = 2
Public Const DM_OUT_BUFFER = DM_COPY' 定義selectform()返回的結果常量
Public Const FORM_NOT_SELECTED = 0
Public Const FORM_SELECTED = 1'下面是這些API中所需要的自定義類型
Public Type RECTL
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypePublic Type SIZEL
cx As Long
cy As Long
End TypePublic Type SECURITY_DESCRIPTOR
Revision As Byte
Sbz1 As Byte
Control As Long
Owner As Long
Group As Long
Sacl As Long ' ACL
Dacl As Long ' ACL
End Type' The two definitions for FORM_INFO_1 make the coding easier.
'上面那句注釋是它原來的注釋,本人不甚理解,只知道大概意思,所以不敢譯成中文
'它的意思是說本來要用FORM_INFO_1,加一個sFORM_INFO_1是為了使編碼簡單一些
'FORM_INFO_1中pName表示指向頁形名的指針(Long),sFORM_INFO_1中則將它變為了string類型
Public Type FORM_INFO_1
flags As Long
pName As Long ' String
Size As SIZEL
ImageableArea As RECTL
End TypePublic Type sFORM_INFO_1
flags As Long
pName As String
Size As SIZEL
ImageableArea As RECTL
End Type
Public Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
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 As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long ' for Windows 95 only
dmICMIntent As Long ' for Windows 95 only
dmMediaType As Long ' for Windows 95 only
dmDitherType As Long ' for Windows 95 only
dmReserved1 As Long ' for Windows 95 only
dmReserved2 As Long ' for Windows 95 only
End TypePublic Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As Long ' DEVMODE
DesiredAccess As Long
End TypePublic Type PRINTER_INFO_2
pServerName As String
pPrinterName As String
pShareName As String
pPortName As String
pDriverName As String
pComment As String
pLocation As String
pDevMode As DEVMODE
pSepFile As String
pPrintProcessor As String
pDatatype As String
pParameters As String
pSecurityDescriptor As SECURITY_DESCRIPTOR
Attributes As Long
Priority As Long
DefaultPriority As Long
StartTime As Long
UntilTime As Long
Status As Long
cJobs As Long
AveragePPM As Long
End TypePublic Type PRINTER_INFO_5
pPrinterName As String
pPortName As String
Attributes As Long
DeviceNotSelectedTimeout As Long
TransmissionRetryTimeout As Long
End TypePublic Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End TypePublic Declare Function EnumForms Lib "winspool.drv" Alias "EnumFormsA" _
(ByVal hPrinter As Long, ByVal Level As Long, ByRef pForm As Any, _
ByVal cbBuf As Long, ByRef pcbNeeded As Long, _
ByRef pcReturned As Long) As Long '枚舉出當前打印機的所有頁形Public Declare Function AddForm Lib "winspool.drv" Alias "AddFormA" _
(ByVal hPrinter As Long, ByVal Level As Long, pForm As Byte) As Long
'添加一個頁形
Public Declare Function OpenPrinter Lib "winspool.drv" _
Alias "OpenPrinterA" (ByVal pPrinterName As String, _
phPrinter As Long, ByVal pDefault As Long) As Long
'打開一個打印機並獲得它的句柄
Public Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long '關閉打印機Public 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 '設置控制打印機的一些屬性和結構,可以取得打印機的Devmode結構
Public Declare Function ResetDC Lib "gdi32" Alias "ResetDCA" _
(ByVal hdc As Long, lpInitData As Any) As Long
'根據提供的Devmode結構,對一個設備場景進行重設(重新指定[**當前打印**]的頁形等),僅對當前打印進程有效!
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
'拷貝指定長度的內存,用於對一個有用數據的備份(一般用於結構(c語言用語,vb中叫自定義類型))
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
(ByVal lpString1 As String, ByRef lpString2 As Long) As Long '字符串拷貝,可以根據一個字符串的地址來獲得它的內容
Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
(ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long) As LongPublic Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" _
(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As String) As LongPublic Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As IntegerPublic Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" _
(ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As LongPublic Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" _
(ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long
'***查找指定頁形,若找到則將它指定給當前打印設備上下文,若成功則返回1,若找不到,則添加指定頁形,***
'***如果添加成功,則也將它指定給當前打印設備上下文,若成功則返回1.如果添加不成功,則返回0*********Public Function SelectForm(ByVal MyhWnd As Long, ByVal strprinter As String, FormSize As SIZEL, Formname As String) As Integer
Dim nSize As Long ' DEVMODE結構大小
Dim pDevMode As DEVMODE
Dim PrinterHandle As Long ' 打印機句柄
Dim hPrtDC As Long ' Printer DC的句柄
Dim PrinterName As String
Dim aDevMode() As Byte ' 用於拷貝DEVMODE結構,用數組取地址
Dim hprint As Long
Dim hdc As Long
PrinterName = strprinter 'Printer.DeviceName ' 當前打印機名稱
hPrtDC = Printer.hdc ' 當前打印機的hdc,用於resetdc()
hprint = OpenPrinter(PrinterName, PrinterHandle, 0&) '打開打印機並獲得打印機句柄
If hprint = 0 Then '打開打印機失敗
MsgBox "Open Printer Error,Please Check Your Printer.Make Sure" & vbCrLf & " The Printer Connecting The Computer And The Driver is OK!", vbCritical, "ERROR"
SelectForm = FORM_NOT_SELECTED
Exit Function
End If
' 獲得Devmode結構
nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, 0&, 0&, 0&)
' 獲得Devmode結構的實際大小
ReDim aDevMode(1 To nSize)
' 從打印機填充DEVMODE結構
nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, _
aDevMode(1), 0&, DM_OUT_BUFFER)
Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))
'如果找不到就添加
If GetFormName(PrinterHandle, FormSize, Formname) = 0 Then
If AddNewForm(PrinterHandle, FormSize, Formname) = 0 Then
'If GetFormName(PrinterHandle, FormSize, Formname) = 0 Then
'微軟的文檔中有這句,在下覺得微軟實在是太謹慎了,添加成功可以從函數
'返回值知道,可微軟還要再找指定頁形存不存在,搞不懂微軟這麼謹慎怎麼操作系統還是那麼多BUG
ClosePrinter (PrinterHandle)
SelectForm = FORM_NOT_SELECTED '添加頁形失敗返回
MsgBox "The PrintForm Not Exists,Please Add a Appropriate PrintForm For The Printer!", vbInformation + vbOKOnly, "INFORMATION!"
'您希望的頁形不存在,請您為打印機添加一個適合的頁形
Exit Function
End If
End If
pDevMode.dmFormName = Formname & Chr(0) '加上chr(0)字符,這是c需要的
pDevMode.dmFields = DM_FORMNAME
Call CopyMemory(aDevMode(1), pDevMode, Len(pDevMode))
nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, _
aDevMode(1), aDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)
hdc = ResetDC(hPrtDC, aDevMode(1)) '將該頁指定為當前打印設備上下文,僅對當前打印進程有效
ClosePrinter (PrinterHandle)
If hdc = 0 Then
SelectForm = FORM_NOT_SELECTED
Else
SelectForm = FORM_SELECTED
End If
End Function'--------------------------------------------------------------------
'***查找當前打印機的所有頁形中是否存在指定的頁形,***
'***若找到,則返回1,並且將頁形名賦值給Formname傳回,找不到返回0,******
'--------------------------------------------------------------------
Public Function GetFormName(ByVal PrinterHandle As Long, FormSize As SIZEL, Formname As String) As Integer
Dim NumForms As Long, i As Long
Dim FI1 As FORM_INFO_1
Dim aFI1() As FORM_INFO_1 ' 定義一個有關打印機信息類型的數組
Dim Temp() As Byte ' 字節數組,用於傳址
Dim BytesNeeded As Long
Dim RetVal As LongFormname = "NONE"
ReDim aFI1(1)
' 第一次調用來取得BytesNeeded(緩沖區的大小)
RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, NumForms)
ReDim Temp(BytesNeeded)
ReDim aFI1(BytesNeeded / Len(FI1))
' 第二次調用列舉出實際支持的所有頁形
RetVal = EnumForms(PrinterHandle, 1, Temp(0), BytesNeeded, BytesNeeded, _
NumForms)
Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)
For i = 0 To NumForms - 1
With aFI1(i)
'判斷頁形是否為所希望的格式(這里不是從名稱來找,因為擔心用戶定義的名稱可能不一樣)
If .Size.cx = FormSize.cx And .Size.cy = FormSize.cy Then
Formname = PtrCtoVbString(.pName)
GetFormName = 1 '若找到則返回1
Exit Function
End If
End With
Next i
GetFormName = 0 '如果找不到則返回0
End Function'***當找不到希望的頁形時,添加一個頁形,其中PrinterHandle為打印机句柄***
'***FormSize為頁形的大小(長,寬),FormName為頁形名稱,返回0表示添加頁****
'***形不成功,1表示成功***
Public Function AddNewForm(PrinterHandle As Long, FormSize As SIZEL, Formname As String) As Integer
Dim FI1 As sFORM_INFO_1 '定義打印機信息的結構
Dim aFI1() As Byte '字節數組用於得到結構的地址,以便於傳址
Dim RetVal As LongWith FI1
.flags = 0
.pName = Formname
With .Size
.cx = FormSize.cx
.cy = FormSize.cy
End With
With .ImageableArea
.Left = 0
.Top = 0
.Right = FI1.Size.cx
.Bottom = FI1.Size.cy
End With
End With
ReDim aFI1(Len(FI1))
Call CopyMemory(aFI1(0), FI1, Len(FI1))
RetVal = AddForm(PrinterHandle, 1, aFI1(0))
If RetVal = 0 Then '若增加不成功
AddNewForm = 0
Else
AddNewForm = 1
End If
End Function'***根據頁形名存放的地址來獲得頁形的名稱***
Public Function PtrCtoVbString(ByVal Addr As Long) As String
Dim sTemp As String * 512, X As Long
X = lstrcpy(sTemp, ByVal Addr) '拷貝地址所指向的字符串到stemp中
If (InStr(1, sTemp, Chr(0)) = 0) Then '找不到字符串結束符(判斷是否字符串)
PtrCtoVbString = ""
Else
PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1) '返回頁形名,去掉stemp后面的空白
End If
End Function'***若設置不成功則將該打印機設為當前打印機
Public Sub SelectPrinter(NewPrinter As String)
Dim Prt As Printer
For Each Prt In Printers
If Prt.DeviceName = NewPrinter Then
Set Printer = Prt
Exit For
End If
Next
End Sub
Dim DeviceLine As String
Dim r As Long
DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
r = WriteProfileString("windows", "Device", DeviceLine)
Call SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")
If r = 0 Then
SetDefaultPrinter = 0
Else
SetDefaultPrinter = 1
End If
End Function'***9x系統設置為默認的打印機
Public Function Win95SetDefaultPrinter(ByVal PrinterName As String) As Integer
Dim Handle As Long
Dim pd As PRINTER_DEFAULTS
Dim X As Long
Dim need As Long
Dim pi5 As PRINTER_INFO_5
Dim LastError As Long pd.pDatatype = 0&
pd.DesiredAccess = PRINTER_ALL_ACCESS Or pd.DesiredAccess X = OpenPrinter(PrinterName, Handle, pd)
If X = 0 Then
MsgBox "Open Printer Error,Please Check Your Printer.Make Sure" & vbCrLf & " The Printer Connecting The Computer And The Driver is OK!", vbCritical + vbOKOnly, "ERROR"
Win95SetDefaultPrinter = 0
Exit Function
End If X = GetPrinter(Handle, 5, ByVal 0&, 0, need)
ReDim T((need \ 4)) As Long X = GetPrinter(Handle, 5, T(0), need, need)
If X = 0 Then
MsgBox "Get The Printer Information Error!", vbCritical + vbOKOnly, "ERROR"
Win95SetDefaultPrinter = 0
Exit Function
End If
pi5.pPrinterName = PtrCtoVbString(T(0))
pi5.pPortName = PtrCtoVbString(T(1))
pi5.Attributes = T(2)
pi5.DeviceNotSelectedTimeout = T(3)
pi5.TransmissionRetryTimeout = T(4)
pi5.Attributes = PRINTER_ATTRIBUTE_DEFAULT
X = SetPrinter(Handle, 5, pi5, 0)
If X = 0 Then '設置打印機失敗
MsgBox "Set Printer Failed. Error code: " & Err.LastDllError
Win95SetDefaultPrinter = 0
Exit Function
Else
If Printer.DeviceName <> PrinterName Then
SelectPrinter (PrinterName)
Win95SetDefaultPrinter = 1
End If
End If
ClosePrinter (Handle)
Win95SetDefaultPrinter = 2
End FunctionPublic Sub GetDriverAndPort(ByVal Buffer As String, DriverName As String, PrinterPort As String)
Dim iDriver As Integer
Dim iPort As Integer
DriverName = ""
PrinterPort = "" iDriver = InStr(Buffer, ",")
If iDriver > 0 Then
DriverName = Left(Buffer, iDriver - 1)
iPort = InStr(iDriver + 1, Buffer, ",")
If iPort > 0 Then
PrinterPort = Mid(Buffer, iDriver + 1, iPort - iDriver - 1)
End If
End If
End Sub
'***NT架構系統設置為默認的打印機
Private Function WinNTSetDefaultPrinter(ByVal PrinterName As String) As Integer
Dim Buffer As String
Dim DeviceName As String
Dim DriverName As String
Dim PrinterPort As String
Dim p As Integer
Buffer = Space(1024)
Call GetProfileString("PrinterPorts", PrinterName, "", Buffer, Len(Buffer))
If Buffer = "" Then
MsgBox "Can't Not Find The Printer " & PrinterName & " !", vbCritical + vbOKOnly, sysMsgTitle
WinNTSetDefaultPrinter = 0
Exit Function
End If
Call GetDriverAndPort(Buffer, DriverName, PrinterPort)
If DriverName <> "" And PrinterPort <> "" Then
p = SetDefaultPrinter(PrinterName, DriverName, PrinterPort)
If p = 0 Then
WinNTSetDefaultPrinter = 0
Exit Function
End If
If Printer.DeviceName <> PrinterName Then
SelectPrinter (PrinterName)
WinNTSetDefaultPrinter = 1
End If
End If
WinNTSetDefaultPrinter = 2
End FunctionPublic Function SetPrint(ByVal PrinterName As String) As Integer
Dim Buffer As String '定義一個緩衝區用於接收打印機列表
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
Buffer = Space(8192)
Call GetProfileString("PrinterPorts", vbNullString, "", Buffer, Len(Buffer))
If Buffer = "" Then
MsgBox "Can't Not Find The Printer List!", vbCritical + vbOKOnly, sysMsgTitle
SetPrint = 0
Exit Function
End If
If InStr(Buffer, PrinterName) = 0 Then
MsgBox "Can't Not Find the Printer " & PrinterName & " !", vbCritical + vbOKOnly, sysMsgTitle
SetPrint = 0
Exit Function
End If
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo) If osinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
SetPrint = Win95SetDefaultPrinter(PrinterName)
Else
SetPrint = WinNTSetDefaultPrinter(PrinterName)
End If
End Function
Dim X As Printer
For Each X In Printers
If x.DriverName = "..." Then
x.PaperSize = vbPRPSUser
x.Width = ...
x.Height = ...
Set Printer = X
Exit For
End If
Next