通过自定义打印纸张的大小，实现打印到哪里纸张就停止在哪里。
模块中
==================================================================
Option Explicit
Public 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 DeleteForm Lib "winspool.drv" Alias "DeleteFormA" _
(ByVal hPrinter As Long, ByVal pFormName As String) 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
Public Declare Function ResetDC Lib "gdi32" Alias "ResetDCA" _
(ByVal hdc As Long, lpInitData As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
(ByVal lpString1 As String, ByRef lpString2 As Long) As Long
' Optional functions not used in this sample, but may be useful.
Public Declare Function GetForm Lib "winspool.drv" Alias "GetFormA" _
(ByVal hPrinter As Long, ByVal pFormName As String, _
ByVal Level As Long, pForm As Byte, ByVal cbBuf As Long, _
pcbNeeded As Long) As Long
Public Declare Function SetForm Lib "winspool.drv" Alias "SetFormA" _
(ByVal hPrinter As Long, ByVal pFormName As String, _
ByVal Level As Long, pForm As Byte) As Long
' Constants for 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)
' Constants for DocumentProperties() call
Public Const DM_MODIFY = 8
Public Const DM_IN_BUFFER = DM_MODIFY
Public Const DM_COPY = 2
Public Const DM_OUT_BUFFER = DM_COPY
' Custom constants for this sample's SelectForm function
Public Const FORM_NOT_SELECTED = 0
Public Const FORM_SELECTED = 1
Public Const FORM_ADDED = 2
Public Type RECTL
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type SIZEL
cx As Long
cy As Long
End Type
Public 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.
Public Type FORM_INFO_1
Flags As Long
pName As Long ' String
Size As SIZEL
ImageableArea As RECTL
End Type
Public 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
End Type
Public Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As Long ' DEVMODE
DesiredAccess As Long
End Type
Public 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 Type
'判断系统是否为NT系统
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Public Function SelectForm(FormName As String, ByVal MyhWnd As Long, Optional ByVal dW As Double, Optional ByVal dH As Double) _
As Integer
Dim nSize As Long ' Size of DEVMODE
Dim pDevMode As DEVMODE
Dim PrinterHandle As Long ' Handle to printer
Dim hPrtDC As Long ' Handle to Printer DC
Dim PrinterName As String
Dim aDevMode() As Byte ' Working DEVMODE
Dim FormSize As SIZEL
Dim tmpFormName As String
Dim isNT As Boolean
Dim PaperWidth As Long, PaperHeight As Long
'在这里统一添加自定义纸张
Select Case FormName
Case "广东省发票"
With FormSize ' Desired page size
.cx = 186000
.cy = 102000
End With
PaperWidth = 10544 '15.6cm
PaperHeight = 5784 '10.2cm
Case "80列报表"
With FormSize ' Desired page size
.cx = 210000
.cy = 280000
End With
PaperWidth = 11904 '21cm
PaperHeight = 15872 '28cm
Case "40列报表"
With FormSize ' Desired page size
.cx = 210000
.cy = 140000
End With
PaperWidth = 11904 '21cm
PaperHeight = 7936 '14cm
Case "20列报表"
With FormSize ' Desired page size
.cx = 210000
.cy = 70000
End With
PaperWidth = 11904 '21cm
PaperHeight = 4008 '7cm
Case "根据打印内容设置的纸张大小"
With FormSize ' Desired page size
.cx = dW
.cy = dH
End With
' 这里需要换算一下
PaperWidth = 10544 '15.6cm
PaperHeight = 5784 '10.2cm
End Select
'不是NT直接给Printer赋值得了
If Not IsNtOs Then
Printer.Width = PaperWidth
Printer.Height = PaperHeight
SelectForm = FORM_SELECTED
Exit Function
End If
PrinterName = Printer.DeviceName ' Current printer
hPrtDC = Printer.hdc ' hDC for current Printer
SelectForm = FORM_NOT_SELECTED ' Set for failure unless reset in code.
' Get a handle to the printer.
If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
' Retrieve the size of the DEVMODE.
nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, 0&, _
0&, 0&)
' Reserve memory for the actual size of the DEVMODE.
ReDim aDevMode(1 To nSize)
' Fill the DEVMODE from the printer.
nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, _
aDevMode(1), 0&, DM_OUT_BUFFER)
' Copy the Public (predefined) portion of the DEVMODE.
Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))
' If FormName is "MyCustomForm", we must make sure it exists
' before using it. Otherwise, it came from our EnumForms list,
' and we do not need to check first. Note that we could have
' passed in a Flag instead of checking for a literal name.
tmpFormName = FormName
If GetFormName(PrinterHandle, FormSize, tmpFormName) = 0 Then
' Form not found - Either of the next 2 lines will work.
'FormName = AddNewForm(PrinterHandle, FormSize, "MyCustomForm")
AddNewForm PrinterHandle, FormSize, FormName
If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then
ClosePrinter (PrinterHandle)
SelectForm = FORM_NOT_SELECTED ' Selection Failed!
Exit Function
Else
SelectForm = FORM_ADDED ' Form Added, Selection succeeded!
End If
End If
' Change the appropriate member in the DevMode.
' In this case, you want to change the form name.
pDevMode.dmFormName = FormName & Chr(0) ' Must be NULL terminated!
' Set the dmFields bit flag to indicate what you are changing.
pDevMode.dmFields = DM_FORMNAME
' Copy your changes back, then update DEVMODE.
Call CopyMemory(aDevMode(1), pDevMode, Len(pDevMode))
nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, _
aDevMode(1), aDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)
nSize = ResetDC(hPrtDC, aDevMode(1)) ' Reset the DEVMODE for the DC.
' Close the handle when you are finished with it.
ClosePrinter (PrinterHandle)
' Selection Succeeded! But was Form Added?
If SelectForm <> FORM_ADDED Then SelectForm = FORM_SELECTED
Else
SelectForm = FORM_NOT_SELECTED ' Selection Failed!
End If
End Function
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 ' Working FI1 array
Dim Temp() As Byte ' Temp FI1 array
Dim FormIndex As Integer
Dim BytesNeeded As Long
Dim RetVal As Long
FormName = vbNullString
FormIndex = 0
ReDim aFI1(1)
' First call retrieves the BytesNeeded.
RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, NumForms)
ReDim Temp(BytesNeeded)
ReDim aFI1(BytesNeeded / Len(FI1))
' Second call actually enumerates the supported forms.
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
' Found the desired form
FormName = PtrCtoVbString(.pName)
FormIndex = I + 1
Exit For
End If
End With
Next I
GetFormName = FormIndex ' Returns non-zero when form is found.
End Function
Public Function AddNewForm(PrinterHandle As Long, FormSize As SIZEL, _
FormName As String) As String
Dim FI1 As sFORM_INFO_1
Dim aFI1() As Byte
Dim RetVal As Long
With 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))
DeleteForm PrinterHandle, "根据打印内容设置的纸张大小"
RetVal = AddForm(PrinterHandle, 1, aFI1(0))
If RetVal = 0 Then
If Err.LastDllError = 5 Then
MsgBox "You do not have permissions to add a form to " & _
Printer.DeviceName, vbExclamation, "Access Denied!"
Else
MsgBox "Error: " & Err.LastDllError, , "Error Adding Form"
'MsgBox "Error: " & Err.LastDllError, "Error Adding Form"
End If
AddNewForm = "none"
Else
AddNewForm = FI1.pName
End If
End Function
Public Sub PrintTest()
' Print two test pages to confirm the page size.
Printer.Print "Top of Page 1."
Printer.NewPage
' Spacing between lines should reflect the chosen page height.
Printer.Print "Top of Page 2. - Check the page Height (Length.)"
Printer.EndDoc
MsgBox "Check Printer " & Printer.DeviceName, vbInformation, "Done!"
End Sub
Public Function PtrCtoVbString(ByVal Add As Long) As String
Dim sTemp As String * 512, X As Long
X = lstrcpy(sTemp, ByVal Add)
If (InStr(1, sTemp, Chr(0)) = 0) Then
PtrCtoVbString = ""
Else
PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
End If
End Function
Public Function IsNtOs() As Boolean
Dim ver As OSVERSIONINFO
ver.dwOSVersionInfoSize = 148
GetVersionEx ver
With ver
Select Case .dwPlatformId
Case 0, 1
IsNtOs = False
Case 2
IsNtOs = True
End Select
End With
End Function
Public Function UseForm(FormName As String, sHwnd As Long, Optional ByVal dW As Double, Optional ByVal dH As Double) As Integer
Dim RetVal As Integer
Dim FormSize As SIZEL ' Size of desired form
If dW <> 0 And dH <> 0 Then
RetVal = SelectForm(FormName, sHwnd, dW, dH) '选择纸张类型
Else
RetVal = SelectForm(FormName, sHwnd)
End If
UseForm = RetVal
Select Case RetVal
Case FORM_NOT_SELECTED ' 0
' 选择纸张失败!
'MsgBox "Unable to retrieve From name", vbExclamation, _
'"Operation halted!"
Case FORM_SELECTED ' 1
' 选择成功!
'PrintTest ' Comment this line to avoid printing
Case FORM_ADDED ' 2
' 添加并选择成功.
'PrintTest ' Comment this line to avoid printing
End Select
End Function
=====================================================================
窗体中
======================================================================
Option Explicit
Private Sub Command1_Click()
Dim FormName As String, RetValue As Integer
'自定义打印纸张
FormName = "广东省发票"
RetValue = UseForm(FormName, Me.hwnd)
'If RetValue = 0 Then GoTo errPrint
PrintTest
End Sub
Private Sub Command2_Click()
Dim FormName As String, RetValue As Integer
'自定义打印纸张
FormName = "80列报表"
RetValue = UseForm(FormName, Me.hwnd)
'If RetValue = 0 Then GoTo errPrint
PrintTest
End Sub
Private Sub Command3_Click()
Dim FormName As String, RetValue As Integer
'自定义打印纸张
FormName = "根据打印内容设置的纸张大小"
RetValue = UseForm(FormName, Me.hwnd, 210000, 5000000)
'If RetValue = 0 Then GoTo errPrint
PrintTest
End Sub
Private Sub Form_Load()
Command1.Caption = "打印发票"
Command2.Caption = "打印报表"
Command3.Caption = "根据计算打印"
End Sub
=========================================================================
以上的代码是参考网上的一篇 《完美支持98、2000系统自定义打印纸张的VB代码》写的
因为没有打印机，我是在xp系统，使用Microsoft Office Document Image Writer测试的。
能否支持其他的打印机还请使用时自己测试一下吧。
通过自定义打印纸张的大小，实现打印到哪里纸张就停止在哪里。相关推荐
- 通过自定义打印纸张的大小，实现打印到哪里纸张就停止在哪里
模块中 ================================================================== Option Explicit Public Declar ...
- C++Builder编程中动态更改自定义打印纸张
C++Builder编程中动态更改自定义打印纸张 因网上只有Delphi例子本人在用CB编写时发现有一些例子不能用, 所以一生气就索性查了查资料自己写了,怕网友们在用编程时也遇见此类情况, 就马上传了 ...
- vue+ts在线文档编辑(类腾讯文档)多人在线编辑-自定义页眉和分页打印（三）
目录 前言 一.自定义页眉内容 二.分页文档打印 1.加入分页符 2.打印方法 3.打印模块完整代码 总结 前言 随着在线办公场景越来越多,同时需要各式各样办公软件,在开发时就用得到在线文档来内容指定 ...
- R语言ggplot2可视化：ggplot2可视化散点图并使用geom_mark_circle函数在数据簇或数据分组的数据点周围添加圆圈进行注释（自定义圆圈的大小）
R语言ggplot2可视化:ggplot2可视化散点图并使用geom_mark_circle函数在数据簇或数据分组的数据点周围添加圆圈进行注释(自定义圆圈的大小) 目录
- android 自定义dialog 定时关闭,Android编程实现自定义Dialog的大小自动控制方法示例...
本文实例讲述了Android编程实现自定义Dialog的大小自动控制方法.分享给大家供大家参考,具体如下: Android应用开发中,无论是出于功能还是增加用户体验,弹出对话框(Dialog)进行一些 ...
- 如何将图片调整为固定大小？怎么自定义压缩图片大小？
很多平台对用户发布的图片大小是有规定的.如果我们发布的图片太大的话,就需要对图片进行压缩处理了.想要缩小图片kb可以使用压缩图的图片压缩指定大小(图片压缩到指定大小 图片压缩大小至指定kb以下-压缩图 ...
- Speedoffice（PPT）怎么自定义设置幻灯片大小
我们有时在制作PPT时,新建的PPT大小不适合自己的文件内容,那怎么自定义设置幻灯片大小呢?下面来给大家分享具体的操作步骤. 首先,我们新建一个PPT文件打开,在菜单栏选择"主页" ...
- 图片不大于100kb怎么调？怎么自定义压缩图片大小？
在报名职称考试上传照片时通常会有100kb的大小限制,超过了就会导致图片无法上传,出现这种情况我们就需要把图片压缩到100kb以下,那么怎么去自定义压缩图片大小呢?想要把图片缩小到固定尺寸可以用图片压 ...
- 打印时的纸张大小尺寸
平时去打印室打印,经常打印的A4纸张,一直不知道具体尺寸,查了一下一般有下面几种: 大32开 14*20.3cm(以下单位都是毫米) 32开 130*184 16开 ...
最新文章
- [转帖]在SQL SERVER中实现RSA加密算法
- Batchsize不够大，如何发挥BN性能？探讨神经网络在小Batch下的训练方法
- [网络安全自学篇] 十五.Python攻防之多线程、C段扫描和数据库编程（二）
- XP MSTSC连接WIN7或WIN8问题
- 如何从ios酷我音乐盒中导出已下载的音乐文件(使用Java编程实现)
- 【物理/数学】—— 概念的理解 moment、momentum
- linux下 mysql 忘记root用户密码解决办法
- c语言中for优化,c – 在For循环中发生了什么GCC优化？
- Seafile 1.3 发布，文件同步和协作平台
- Function spec
- 父页面监听iframe路由变化_前端路由原理
- MySQL中查某一字段包含某一字符的个数
- linux中文件复的概念,诠释 Linux 中“一切都是文件”概念和相应的文件类型
- 那些让你爱不释手的 Spring 代码技巧
- 2018 Multi-University Training Contest 7 - GuGuFishtion
- 如何将视频设置为电脑动态壁纸？
- 从日本动漫看项目管理
- python破解加密压缩包
- 电脑上面的word文档被删除了怎么办？分享四种亲测恢复方法
- html文件关联异常怎么修复,在Win7系统中，如何修复exe文件关联错误?