关于VB6打印图片的一点心得,帮你解开打印尺寸偏小的问题
Visual Basic的Printer对象支持PaintPicture方法,可以支持打印位图。其语法为:
Printer.PaintPicture picture, x1, y1, width1, height1, x2, y2, width2, height2, opcode
参数Picture是必需的,指明要绘制到打印机上的图形的来源源,通常是对象的Picture或Image属性。
参数x1, y1也是必需的,均为单精度数值,指定参数picture所确定图形在打印机上绘制的坐标(x-轴和y-轴)。其值的单位是由Printer的 ScaleMode 属性决定的。
参数Width1和Height1是可选的,都是单精度数值,指示图象的目标宽度和高度。如果目标宽度/高度比源宽度 (width2)/高度(height2)大或者小,将适当地拉伸或压缩图形。如果省略这两个参数,则使用图形的原始尺寸。
参数x2, y2、Width2和Height2是可选的。它们指示参数picture确定的图象内剪贴区的坐标(x-轴和y-轴)和大小。利用这四个参数,我们可以打印图象的一部分。默认是打印整个图象。
参数Opcode是可选的,是长型数值。它用来定义在将图象绘制到打印机上时对图象执行的位操作(例如, vbMergeCopy 或 vbSrcAnd 操作符)。关于位操作符常数的完整列表,请参阅 Visual Basic帮助文件中的有关内容。对于打印机来说,这个参数较少使用;而在屏幕显示图象时往往利用这个参数实现一些特殊效果。
通过使用负的目标高度值 (height1)或目标宽度值 (width1) ,可以水平或垂直翻转位图。
下面是一个简单的例子:
Printer.PaintPicture Picture1.Image, 0, 0
以上是网上搜索的使用PictureBox控件时打印设置,我用的是Image控件,使用方法一样,用A4字打印结果始终图片尺寸偏小,在一次偶然打印大图的试验中发现四边有留白,因此,在设置ScaleWidth和ScaleHeight的值时,不能用设置成A4的实际大小,必须减去留边不能打印的部分。以实例说明:
If Image2.Visible = True And Image3.Visible = True Then
Call 选择打印机
Printer.ScaleMode = 6 '单位为毫米
Printer.ScaleWidth = 210 - 15 '纸张宽度为210,打印机的实际打印宽度只有210-15
Printer.ScaleHeight = 297 - 12 '纸张高度为297,打印机的实际打印高度只有297-12
Printer.ScaleLeft = 0
Printer.ScaleTop = 0
Printer.PaintPicture Image2.Picture, 62.5 - 7.5, 52 - 6, 85, 53 '打印身份证正面,设置X、Y轴起点位置、图片的宽、图片的高,并发送打印图片的数据
Printer.PaintPicture Image3.Picture, 62.5 - 7.5, 192 - 6, 85, 53 '打印身份证反面,设置X、Y轴起点位置、图片的宽、图片的高,并发送打印图片的数据
Printer.EndDoc '数据发送完毕,结束打印
End If
Image2控件加载的JPG格式的身份证扫描件大图(放大7倍),通过打印时固定打印尺寸为实际大小(85*53),这样打印出的效果比复印的效果差不了多少,如果哪位也遇到次问题的朋友不妨一试。
附上“选择打印机”(主要是选择打印机端口)子程序:
Sub 选择打印机()
'遍历打印机并选择
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const HKEY_CURRENT_USER As Long = &H80000001
Dim I As Integer
Dim lRC As Long
Dim sPath As String
Dim objRegistry As Object
Dim sKeyValue As String
Dim Dic As Object, Printer As Object, arr, N&
Set Dic = CreateObject("scripting.dictionary")
With GetObject("winmgmts:\\.\root\cimv2")
For Each Printer In .ExecQuery("Select * from Win32_Printer")
Dic.Add Printer.Name, ""
Next Printer
End With
If Dic.Count = 0 Then
'弹出提示并在3秒后自动关闭一()
MessageBoxTimeout Me.hWnd, "未找到安装的打印机!", "错误提示!", vbInformation, 0, 3000
Else
arr = Dic.keys
Set objRegistry = GetObject("winmgmts://./root/default:StdRegProv")
sPath = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
For N = LBound(arr) To UBound(arr)
lRC = objRegistry.GetStringValue(HKEY_CURRENT_USER, sPath, arr(N), sKeyValue)
If (lRC = 0) And (Err.Number = 0) Then
Dic(arr(N)) = Replace(sKeyValue, "winspool,", "")
End If
Next N
For N = LBound(arr) To UBound(arr)
'ActivePrinter = arr(N) & " 在 " & Dic(arr(N))
If arr(N) = "\\长丰001\Brother DCP-7060D Printer" Then ActivePrinter = arr(N) & " 在 " & Dic(arr(N)) '确定打印机
Next N
End If
Set Dic = Nothing
End Sub