modprinter.bas

超经典的打印预览动态库源码 版权： 本资源版权归作者所有 说明： 本资源由源码天空搜集,仅提供学习参考

Attribute VB_Name = "ModPrinter"

Option Explicit

'****************************************************************
'*功能：提供打印机打印方向和纸张的函数
'*建议：
'*      调用函数前应该先保存当前设置
'*  　　在输出打印数据后应该恢复到先前的设置
'*备注：
'*      只对当前打印机操作
'*      对于打印机的指定将不在本功能模块中实现
'****************************************************************



'*Constants used in the DevMode structure
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32

'*Constants for NT security
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

'*Constants used to make changes to the values contained in the DevMode
Private Const DM_MODIFY = 8
Private Const DM_COPY = 2
Private Const DM_DUPLEX = &H1000&
Private Const DMDUP_SIMPLEX = 1
Private Const DMDUP_VERTICAL = 2
Private Const DMDUP_HORIZONTAL = 3

Private Const DM_IN_BUFFER As Long = 8
Private Const DM_OUT_BUFFER As Long = 2
Private Const DM_ORIENTATION As Long = &H1
Private Const DM_PAPERSIZE = &H2&
Private Const DM_PAPERWIDTH = &H8&
Private Const DM_PAPERLENGTH = &H4&

Private Type DEVMODE
    dmDeviceName        As String * 32
    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 * 32
    dmUnusedPadding     As Integer
    dmBitsPerPel        As Integer
    dmPelsWidth         As Long
    dmPelsHeight        As Long
    dmDisplayFlags      As Long
    dmDisplayFrequency  As Long
End Type

Private Type PRINTER_DEFAULTS
    pDataType           As String
    pDevMode            As Long
    DesiredAccess       As Long
End Type

Private Type PRINTER_INFO_2
    pServerName         As Long
    pPrinterName        As Long
    pShareName          As Long
    pPortName           As Long
    pDriverName         As Long
    pComment            As Long
    pLocation           As Long
    pDevMode            As Long
    pSepFile            As Long
    pPrintProcessor     As Long
    pDataType           As Long
    pParameters         As Long
    pSecurityDescriptor As Long
    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

'*------DECLARATIONS
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (hpvDest As Any, hpvSource As Any, _
        ByVal cbCopy As Long)

Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" _
        (ByVal pPrinterName As String, _
        phPrinter As Long, pDefault As Any) As Long

Private Declare Function ClosePrinter Lib "winspool.drv" _
        (ByVal hPrinter As Long) As Long

Private 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

Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" _
        (ByVal hPrinter As Long, ByVal level As Long, _
        pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long

Private Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" _
        (ByVal hPrinter As Long, ByVal level As Long, _
        pPrinter As Any, ByVal Command As Long) As Long


Private Function mySetPrinter(prnName As String, _
                              Optional eOrientation As typeOrient = 0, _
                              Optional iDmpaper As Integer = 0, _
                              Optional iDmpaperLength As Single = 0, _
                              Optional iDmpaperWidth As Single = 0) _
    As Boolean

Dim bDevMode()          As Byte
Dim bPrinterInfo2()     As Byte
Dim hPrinter            As Long
Dim lResult             As Long
Dim nSize               As Long
Dim sPrnName            As String

Dim dm          As DEVMODE
Dim olddm       As DEVMODE
Dim pd          As PRINTER_DEFAULTS
Dim pi2         As PRINTER_INFO_2

    On Error GoTo err_proc
    
    '*获取打印机的设备名称
    sPrnName = prnName
    '*由于要调用SetPrinter，所以
    '*如果是在NT下就要求PRINTER_ALL_ACCESS
    pd.DesiredAccess = PRINTER_ALL_ACCESS
    
    '*获取打印机句柄
    If OpenPrinter(sPrnName, hPrinter, pd) Then
    
    '*获取PRINTER_INFO_2结构要求的字节数
    
        Call GetPrinter(hPrinter, 2&, 0&, 0&, nSize)
        ReDim bPrinterInfo2(1 To nSize) As Byte
        lResult = GetPrinter(hPrinter, 2, bPrinterInfo2(1), nSize, nSize)
        Call CopyMemory(pi2, bPrinterInfo2(1), Len(pi2))
        nSize = DocumentProperties(0&, hPrinter, sPrnName, 0&, 0&, 0)
        ReDim bDevMode(1 To nSize)
        
        If pi2.pDevMode Then
            Call CopyMemory(bDevMode(1), ByVal pi2.pDevMode, Len(dm))
        Else
            Call DocumentProperties(0&, hPrinter, sPrnName, bDevMode(1), 0&, DM_OUT_BUFFER)
        End If
        
        Call CopyMemory(dm, bDevMode(1), Len(dm))
        Call CopyMemory(olddm, bDevMode(1), Len(olddm))
        
        With dm
            If eOrientation <> 0 Then       '*设置新的走向
                .dmOrientation = eOrientation
                .dmFields = DM_ORIENTATION
            End If
            If iDmpaper <> 0 And iDmpaper <> vbPRPSUser Then    '*设纸张大小
                .dmPaperSize = iDmpaper
                .dmFields = DM_PAPERSIZE
            End If
            If iDmpaper = vbPRPSUser Then   '*用户自定义
                .dmFields = DM_PAPERLENGTH Or DM_PAPERWIDTH
                .dmPaperLength = iDmpaperLength
                .dmPaperWidth = iDmpaperWidth
            End If
        End With
    
        Call CopyMemory(bDevMode(1), dm, Len(dm))
        
        Call DocumentProperties(0&, hPrinter, sPrnName, _
                                bDevMode(1), bDevMode(1), DM_IN_BUFFER Or _
                                DM_OUT_BUFFER)
    
        pi2.pDevMode = VarPtr(bDevMode(1))
        
        lResult = SetPrinter(hPrinter, 2, pi2, 0&)
        
        Call ClosePrinter(hPrinter)
        mySetPrinter = True
    Else
        mySetPrinter = False
    End If
    
    Exit Function
    
err_proc:
    mySetPrinter = False
End Function


'*****************************************************************
'*名称：ChgPrnOrient
'*功能：改变打印方向
'*输入参数：
'*      prnName     --要设置的打印机名称
'*      orient      --方向
'*输出参数：
'*      是否改变成功
'*****************************************************************
Public Function ChgPrnOrient(prnName As String, _
                             orient As typeOrient) _
    As Boolean
    
    ChgPrnOrient = mySetPrinter(prnName, orient)
End Function

'*****************************************************************
'*名称：ChgPageSize
'*功能：改变打印纸张的大小
'*输入参数：
'*      orient  --方向
'*输出参数：
'*      是否改变成功
'*****************************************************************
Public Function ChgPageSize(prnName As String, _
                            Optional pagesize As Integer = vbPRPSUser, _
                            Optional pagewidth As Single = 0, _
                            Optional pageheight As Single = 0) _
    As Boolean
    
    '*因为打印机以0.1mm单位，所以传过来的纸张大小应该 * 10
    On Error GoTo err_proc
    
    ChgPageSize = mySetPrinter(prnName, , pagesize, pagewidth * 10, pageheight * 10)
    
    Exit Function
err_proc:
    ChgPageSize = False
End Function