setpaper.bas

guan yu pai ke xi tong de ruan jian

Attribute VB_Name = "SetPaper"
  Option Explicit
    
  Public Enum PrinterOrientationConstants
          OrientPortrait = 1
          OrientLandscape = 2
  End Enum
    
  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
    
  '*******************'
  '   iDmpaper值       纸张   '
  '   11                       A5       '
  '   13                       B5       '
  '*******************'
    
  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 PRINTER_ACCESS_ADMINISTER       As Long = &H4
  Private Const PRINTER_ACCESS_USE       As Long = &H8
  Private Const STANDARD_RIGHTS_REQUIRED       As Long = &HF0000
  Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED _
          Or _
          PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
    
  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
    
  '在打印或预览之前直接调用SetDefaultPrinterOrientation   打印走向常数。注意：红色注释部分用于改变纸张的大小。
  Function SetDefaultPrinterOrientation(ByVal eOrientation As _
          PrinterOrientationConstants, iDmpaper As Integer) 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
    
          '   获取默认打印机的设备名称
          sPrnName = Printer.DeviceName
          '   由于要调用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
                          '   设置新的走向
                          .dmOrientation = eOrientation
                          .dmFields = DM_ORIENTATION
                          .dmPaperSize = iDmpaper           '将纸张大小设为iDmpaper，请自行更改所需大小
                  '         .dmPaperLength   =   iDmpaperLength
                    '       .dmPaperWidth   =   iDmpaperWidth
                          .dmFields = DM_PAPERSIZE         '必须，否则无法设置纸张大小
                  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)
                  SetDefaultPrinterOrientation = True
          Else
                  SetDefaultPrinterOrientation = False
          End If
    
  End Function