看到一个VB打印模块,保存一下

看到一个VB打印模块,保存一下''''模块modPrintOption 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 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 beuseful.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 DEVMODEPublic Const CCHFORMNAME = 32Public Const CCHDEVICENAME = 32Public Const DM_FORMNAME As Long = &H10000 Public Const DM_ORIENTATION = &H1&'''' Constants for PRINTER_DEFAULTS.DesiredAccess Public Const PRINTER_ACCESS_ADMINISTER =&H4Public Const PRINTER_ACCESS_USE = &H8Public Const STANDARD_RIGHTS_REQUIRED = &HF0000Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _ PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)'''' Constants for DocumentProperties() callPublic Const DM_MODIFY = 8Public Const DM_IN_BUFFER = DM_MODIFY Public Const DM_COPY = 2Public Const DM_OUT_BUFFER = DM_COPY'''' Custom constants for this sample''''s SelectForm functionPublic Const FORM_NOT_SELECTED = 0Public Const FORM_SELECTED = 1Public Const FORM_ADDED = 2Public Type RECTLLeft As LongTop As LongRight As LongBottom As LongEnd TypePublic Type SIZELcx As Longcy As LongEnd TypePublic Type SECURITY_DESCRIPTORRevision As ByteSbz1 As ByteControl As LongOwner As LongGroup As LongSacl As Long '''' ACLDacl As Long '''' ACLEnd Type'''' The two definitions for FORM_INFO_1 make the coding easier.Public Type FORM_INFO_1Flags As LongpName As Long '''' StringSize As SIZELImageableArea As RECTLEnd TypePublic Type sFORM_INFO_1Flags As LongpName As StringSize As SIZELImageableArea As RECTLEnd TypePublic Type DEVMODEdmDeviceName As String * CCHDEVICENAMEdmSpecVersion As IntegerdmDriverVersion As IntegerdmSize As IntegerdmDriverExtra As IntegerdmFields As LongdmOrientation As IntegerdmPaperSize As IntegerdmPaperLength As IntegerdmPaperWidth As IntegerdmScale As IntegerdmCopies As IntegerdmDefaultSource As IntegerdmPrintQuality As IntegerdmColor As IntegerdmDuplex As IntegerdmYResolution As IntegerdmTTOption As IntegerdmCollate As IntegerdmFormName As String * CCHFORMNAMEdmUnusedPadding As IntegerdmBitsPerPel As LongdmPelsWidth As LongdmPelsHeight As LongdmDisplayFlags As LongdmDisplayFrequency As LongEnd TypePublic Type PRINTER_DEFAULTSpDatatype As StringpDevMode As Long '''' DEVMODEDesiredAccess As LongEnd TypePublic Type PRINTER_INFO_2pServerName As StringpPrinterName As StringpShareName As StringpPortName As StringpDriverName As StringpComment As StringpLocation As StringpDevMode As DEVMODEpSepFile As StringpPrintProcessor As StringpDatatype As StringpParameters As StringpSecurityDescriptor AsSECURITY_DESCRIPTORAttributes As LongPriority As LongDefaultPriority As LongStartTime As LongUntilTime As LongStatus As LongcJobs As LongAveragePPM As LongEnd Type''''判断系统是否为NT系统Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _(lpVersionInformation AsOSVERSIONINFO) As LongPublic Type OSVERSIONINFOdwOSVersionInfoSize As LongdwMajorVersion As LongdwMinorVersion As LongdwBuildNumber As LongdwPlatformId As LongszCSDVersion As String * 128 '''' Maintenance string for PSS usageEnd TypePublic Function SelectForm(FormName As String, ByVal MyhWnd As Long) _As IntegerDim nSize As Long '''' Size of DEVMODE Dim pDevMode As DEVMODEDim PrinterHandle As Long '''' Handle to printerDim hPrtDC As Long '''' Handle to Printer DC Dim PrinterName As StringDim aDevMode() As Byte '''' Working DEVMODE Dim FormSize As SIZELDim tmpFormName As StringDim isNT As BooleanDim PaperWidth As Long, PaperHeight As Long''''在这里统一添加自定义纸张Select Case FormNameCase "广东省发票"With FormSize '''' Desired page size.cx = 186000.cy = 102000End WithPaperWidth = 10544 ''''15.6cmPaperHeight = 5784 ''''10.2cmCase "80列报表"With FormSize '''' Desired page size.cx = 210000.cy = 280000End WithPaperWidth = 11904 ''''21cmPaperHeight = 15872 ''''28cmCase "40列报表"With FormSize '''' Desired page size.cx = 210000.cy = 140000End WithPaperWidth = 11904 ''''21cmPaperHeight = 7936 ''''14cmCase "20列报表"With FormSize '''' Desired page size.cx = 210000.cy = 70000End WithPaperWidth = 11904 ''''21cmPaperHeight = 4008 ''''7cmEnd Select''''不是NT直接给Printer赋值得了If Not IsNtOs ThenPrinter.Width = PaperWidthPrinter.Height = PaperHeight SelectForm = FORM_SELECTEDExit FunctionEnd IfPrinterName = Printer.DeviceName '''' Current printer hPrtDC = Printer.hdc '''' hDC for current PrinterSelectForm = 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 = FormNameIf 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, FormNameIf GetFormName(PrinterHandle, FormSize, FormName) = 0 ThenClosePrinter (PrinterHandle)SelectForm = FORM_NOT_SELECTED'''' Selection Failed!Exit FunctionElseSelectForm = FORM_ADDED '''' Form Added, Selection succeeded!End IfEnd 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_SELECTEDElseSelectForm = FORM_NOT_SELECTED '''' Selection Failed!End IfEnd FunctionPublic Function GetFormName(ByVal PrinterHandle As Long, _FormSize As SIZEL, FormName As String) As IntegerDim NumForms As Long, I As LongDim FI1 As FORM_INFO_1Dim aFI1() As FORM_INFO_1 '''' WorkingFI1 arrayDim Temp() As Byte '''' Temp FI1 arrayDim FormIndex As IntegerDim BytesNeeded As LongDim RetVal As LongFormName = vbNullStringFormIndex = 0ReDim 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 - 1With aFI1(I)If .Size.cx = FormSize.cx And .Size.cy = FormSize.cy Then'''' Found the desired formFormName = PtrCtoVbString(.pName)FormIndex = I + 1Exit ForEnd IfEnd WithNext IGetFormName = FormIndex '''' Returns non-zero when form is found.End FunctionPublic Function AddNewForm(PrinterHandle As Long, FormSize As SIZEL, _FormName As String) AsStringDim FI1 As sFORM_INFO_1Dim aFI1() As ByteDim RetVal As LongWith FI1.Flags = 0.pName = FormNameWith .Size.cx = FormSize.cx.cy = FormSize.cyEnd WithWith .ImageableArea.Left = 0.Top = 0.Right = FI1.Size.cx.Bottom = FI1.Size.cyEnd WithEnd WithReDim aFI1(Len(FI1))Call CopyMemory(aFI1(0), FI1, Len(FI1)) RetVal = AddForm(PrinterHandle, 1, aFI1(0))If RetVal = 0 ThenIf stDllError = 5 ThenMsgBox "You do not have permissions to add a form to " & _Printer.DeviceName, vbExclamation, "Access Denied!"ElseMsgBox "Error: " & stDllError, , "Error Adding Form"''''MsgBox "Error: " & stDllError, "Error Adding Form"End IfAddNewForm = "none"ElseAddNewForm = FI1.pNameEnd IfEnd FunctionPublic 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 pageheight.Printer.Print "Top of Page 2. - Check the page Height (Length.)"Printer.EndDocMsgBox "Check Printer " & Printer.DeviceName, vbInformation, "Done!"End SubPublic Function PtrCtoVbString(ByVal Add As Long) As StringDim sTemp As String * 512, X As LongX = lstrcpy(sTemp, ByVal Add)If (InStr(1, sTemp, Chr(0)) = 0) ThenPtrCtoVbString = ""ElsePtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)End IfEnd FunctionPublic Function IsNtOs() As BooleanDim ver As OSVERSIONINFOver.dwOSVersionInfoSize = 148GetVersionEx verWith verSelect Case .dwPlatformIdCase 0, 1IsNtOs = FalseCase 2IsNtOs = TrueEnd SelectEnd WithEnd FunctionPublic Function UseForm(FormName As String, sHwnd As Long) As IntegerDim RetVal As IntegerDim FormSize As SIZEL '''' Size of desired formRetVal = SelectForm(FormName, sHwnd) ''''选择纸张类型UseForm = RetValSelect Case RetValCase FORM_NOT_SELECTED '''' 0'''' 选择纸张失败!''''MsgBox "Unable to retrieve From name", vbExclamation, _''''"Operation halted!"Case FORM_SELECTED '''' 1'''' 选择成功!''''PrintTest '''' Comment this line to avoid printingCase FORM_ADDED '''' 2'''' 添加并选择成功.''''PrintTest '''' Comment this line to avoid printingEnd SelectEnd 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 errPrintPrintTestEnd SubPrivate Sub Command2_Click()Dim FormName As String, RetValue As Integer''''自定义打印纸张FormName = "80列报表"RetValue = UseForm(FormName, Me.hwnd)''''If RetValue = 0 Then GoTo errPrint PrintTestEnd SubPrivate Sub Form_Load()Command1.Caption = "打印发票"Command2.Caption = "打印报表"End Sub。