自定义纸张

时　间:2018-03-30 02:22:55
作　者:在水一方 AngelHis   ID：20576  城市：沈阳
摘　要:Private Sub Command1_Click()
    Dim FormName As String, RetValue As Integer
    '自定义打印纸张
    FormName = "广东省发票"
    RetValue = SelectForm(FormName, Me.hwnd)
    'If RetValue = 0 Then GoTo errPrint
'    PrintTest
End Sub
正　文:

Option Explicit

'模块modPrint
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
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) 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
    PrinterName = printer.DeviceName  ' Current printer
    hPrtDC = GetDC(MyhWnd)  '    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
        Else
            MsgBox "already get"
        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))
    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
        AddNewForm = "ok"
    End If
End Function
'
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 '