完美支持98、2000系统自定义打印纸张的VB代码

主要代码取自微软网站上的一篇文章，只做少许改动。98、2000系统下已测试通过（打印机LQ－300K）

　　'模块modPrint

　　Option EXPlicitPublic 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 LongPublic Declare Function AddForm Lib "winspool.drv" Alias "AddFormA" _

　　 (ByVal hPrinter As Long, ByVal Level As Long, pForm As Byte) As LongPublic Declare Function DeleteForm Lib "winspool.drv" Alias "DeleteFormA" _

　　 (ByVal hPrinter As Long, ByVal pFormName As String) As LongPublic Declare Function OpenPrinter Lib "winspool.drv" _

　　 Alias "OpenPrinterA" (ByVal pPrinterName As String, _

　　 PHPrinter As Long, ByVal pDefault As Long) As LongPublic Declare Function ClosePrinter Lib "winspool.drv" _

　　 (ByVal hPrinter As Long) As LongPublic 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 LongPublic Declare Function ResetDC Lib "gdi32" Alias "ResetDCA" _

　　 (ByVal hdc As Long, lpInitData As Any) As LongPublic 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 LongPublic 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 = 2Public 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.

　　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 TypePublic 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 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 Type

　　'判定系统是否为NT系统

　　Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _

　　 (lpVersionInformation As OSVERSIONINFO) As LongPublic 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) _

　　 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

　　 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 FunctionPublic 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))

　　 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) As Integer

　　 Dim RetVal As Integer

　　 Dim FormSize As SIZEL ' Size of desired form

　　 RetVal = SelectForm(FormName, sHwnd) '选择纸张类型

　　 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

'调用，在Form1上放置Command1、Command2，复制下列代码：

　　Option ExplicitPrivate Sub Command1_Click()

　　 Dim FormName As String, RetValue As Integer '自定义打印纸张

　　 FormName = "广东省发票"

　　 RetValue = UseForm(FormName, Me.hwnd)

　　 'If RetValue = 0 Then GoTo errPrint

　　 PrintTest

　　End SubPrivate 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 SubPrivate Sub Form_Load()

　　 Command1.Caption = "打印发票"

　　 Command2.Caption = "打印报表"

　　End Sub