VB设定打印机

文件一:模块

代码:

   Option Explicit
  
   Dim TestOkButton As Boolean

   ' Global constants for Win32 API
   Public Const CCHDEVICENAME = 32
   Public Const CCHFORMNAME = 32
   Public Const GMEM_FIXED = &H0
   Public Const GMEM_MOVEABLE = &H2
   Public Const GMEM_ZEROINIT = &H40

   ' Add appripriate Constants for what you want to change
   Public Const DM_DUPLEX = &H1000&
   Public Const DM_ORIENTATION = &H1&
   Public Const DM_COPIES = &H100&
   Public Const DMDUP_HORIZONTAL = 3
   Public Const DMDUP_SIMPLEX = 1
   Public Const DMDUP_VERTICAL = 2

    ' Constants for PrintDialog
   Public Const PD_ALLPAGES = &H0
   Public Const PD_COLLATE = &H10
   Public Const PD_DISABLEPRINTTOFILE = &H80000
   Public Const PD_ENABLEPRINTHOOK = &H1000
   Public Const PD_ENABLEPRINTTEMPLATE = &H4000
   Public Const PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
   Public Const PD_ENABLESETUPHOOK = &H2000
   Public Const PD_ENABLESETUPTEMPLATE = &H8000
   Public Const PD_ENABLESETUPTEMPLATEHANDLE = &H20000
   Public Const PD_HIDEPRINTTOFILE = &H100000
   Public Const PD_NONETWORKBUTTON = &H200000
   Public Const PD_NOPAGENUMS = &H8
   Public Const PD_NOSELECTION = &H4
   Public Const PD_NOWARNING = &H80
   Public Const PD_PAGENUMS = &H2
   Public Const PD_PRINTSETUP = &H40
   Public Const PD_PRINTTOFILE = &H20
   Public Const PD_RETURNDC = &H100
   Public Const PD_RETURNDEFAULT = &H400
   Public Const PD_RETURNIC = &H200
   Public Const PD_SELECTION = &H1
   Public Const PD_SHOWHELP = &H800
   Public Const PD_USEDEVMODECOPIES = &H40000
   Public Const PD_USEDEVMODECOPIESANDCOLLATE = &H40000

   ' Constants for PAGESETUPDLG
   Public Const PSD_DEFAULTMINMARGINS = &H0
   Public Const PSD_DISABLEMARGINS = &H10
   Public Const PSD_DISABLEORIENTATION = &H100
   Public Const PSD_DISABLEPAGEPAINTING = &H80000
   Public Const PSD_DISABLEPAPER = &H200
   Public Const PSD_DISABLEPRINTER = &H20
   Public Const PSD_ENABLEPAGEPAINTHOOK = &H40000
   Public Const PSD_ENABLEPAGESETUPHOOK = &H2000
   Public Const PSD_ENABLEPAGESETUPTEMPLATE = &H8000
   Public Const PSD_ENABLEPAGESETUPTEMPLATEHANDLE = &H20000
   Public Const PSD_INHUNDREDTHSOFMILLIMETERS = &H8
   Public Const PSD_INTHOUSANDTHSOFINCHES = &H4
   Public Const PSD_INWININIINTLMEASURE = &H0
   Public Const PSD_MARGINS = &H2
   Public Const PSD_MINMARGINS = &H1
   Public Const PSD_NOWARNING = &H80
   Public Const PSD_RETURNDEFAULT = &H400
   Public Const PSD_SHOWHELP = &H800

   ' Custom Global Constants
   Public Const DLG_PRINT = 0
   Public Const DLG_PRINTSETUP = 1

   ' type definitions:
   Public Type RECT
         Left As Long
         Top As Long
         Right As Long
         Bottom As Long
   End Type
  
   Public Type POINTAPI
           x As Long
           y As Long
   End Type

   Type PRINTSETUPDLG_TYPE
           lStructSize As Long
           hwndOwner As Long
           hDevMode As Long
           hDevNames As Long
           flags As Long
           ptPaperSize As POINTAPI
           rtMinMargin As RECT
           rtMargin As RECT
           hInstance As Long
           lCustData As Long
           lpfnPageSetupHook As Long ' LPPAGESETUPHOOK
           lpfnPagePaintHook As Long ' LPPAGESETUPHOOK
           lpPageSetupTemplateName As String
           hPageSetupTemplate As Long ' HGLOBAL
   End Type

   Type PRINTDLG_TYPE
           lStructSize As Long
           hwndOwner As Long
           hDevMode As Long
           hDevNames As Long
           hdc As Long
           flags As Long
           nFromPage As Integer
           nToPage As Integer
           nMinPage As Integer
           nMaxPage As Integer
           nCopies As Integer
           hInstance As Long
           lCustData As Long
           lpfnPrintHook As Long
           lpfnSetupHook As Long
           lpPrintTemplateName As String
           lpSetupTemplateName As String
           hPrintTemplate As Long
           hSetupTemplate As Long
   End Type

   Type DEVNAMES_TYPE
           wDriverOffset As Integer
           wDeviceOffset As Integer
           wOutputOffset As Integer
           wDefault As Integer
           extra As String * 100
   End Type

   Type DEVMODE_TYPE
           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 Integer
           dmPelsWidth As Long
           dmPelsHeight As Long
           dmDisplayFlags As Long
           dmDisplayFrequency As Long
   End Type

   ' API declarations:
   Public Declare Function PrintDialog Lib "comdlg32.dll" _
     Alias "PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long

   Public Declare Function PageSetupDialog Lib "comdlg32.dll" _
      Alias "PageSetupDlgA" _
      (pSetupPrintdlg As PRINTSETUPDLG_TYPE) As Long

   Public Declare Sub CopyMemory Lib "kernel32" _
      Alias "RtlMoveMemory" _
      (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

   Public Declare Function GlobalLock Lib "kernel32" _
      (ByVal hMem As Long) As Long

   Public Declare Function GlobalUnlock Lib "kernel32" _
      (ByVal hMem As Long) As Long

   Public Declare Function GlobalAlloc Lib "kernel32" _
      (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

   Public Declare Function GlobalFree Lib "kernel32" _
      (ByVal hMem As Long) As Long

   ' Custom procedures:
      Public Sub ShowPrinter(frmOwner As Form, _
          Optional PrintFlags As Long)

       Dim PrintDlg As PRINTDLG_TYPE
       Dim DevMode As DEVMODE_TYPE
       Dim DevName As DEVNAMES_TYPE

       Dim lpDevMode As Long, lpDevName As Long
       Dim bReturn As Integer
       Dim objPrinter As Printer, NewPrinterName As String
       Dim strSetting As String

       ' Use PrintSetupDialog to get the handle to a memory
       ' block with a DevMode and DevName structures

       PrintDlg.lStructSize = Len(PrintDlg)
       PrintDlg.hwndOwner = frmOwner.hWnd

       PrintDlg.flags = PrintFlags

       ' Set the current orientation and duplex setting
       DevMode.dmDeviceName = Printer.DeviceName
       DevMode.dmSize = Len(DevMode)
       DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX _
          Or DM_COPIES
       DevMode.dmOrientation = Printer.Orientation
       DevMode.dmCopies = Printer.Copies
       On Error Resume Next
       DevMode.dmDuplex = Printer.Duplex
       On Error GoTo 0

       ' Allocate memory for the initialization hDevMode structure
       ' and copy the settings gathered above into this memory
       PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or _
          GMEM_ZEROINIT, Len(DevMode))
       lpDevMode = GlobalLock(PrintDlg.hDevMode)
       If lpDevMode > 0 Then
           CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
           bReturn = GlobalUnlock(PrintDlg.hDevMode)
       End If

       ' Set the current driver, device, and port name strings
       With DevName
           .wDriverOffset = 8
           .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
           .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
           .wDefault = 0
       End With
       With Printer
           DevName.extra = .DriverName & Chr(0) & _
           .DeviceName & Chr(0) & .Port & Chr(0)
       End With

       ' Allocate memory for the initial hDevName structure
       ' and copy the settings gathered above into this memory
       PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or _
           GMEM_ZEROINIT, Len(DevName))
       lpDevName = GlobalLock(PrintDlg.hDevNames)
       If lpDevName > 0 Then
           CopyMemory ByVal lpDevName, DevName, Len(DevName)
           bReturn = GlobalUnlock(lpDevName)
       End If

       ' Call the print dialog up and let the user make changes
       If PrintDialog(PrintDlg) Then

           ' First get the DevName structure.
           lpDevName = GlobalLock(PrintDlg.hDevNames)
               CopyMemory DevName, ByVal lpDevName, 45
           bReturn = GlobalUnlock(lpDevName)
           GlobalFree PrintDlg.hDevNames

           ' Next get the DevMode structure and set the printer
           ' properties appropriately
           lpDevMode = GlobalLock(PrintDlg.hDevMode)
               CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
           bReturn = GlobalUnlock(PrintDlg.hDevMode)
           GlobalFree PrintDlg.hDevMode
           NewPrinterName = UCase$(Left(DevMode.dmDeviceName, _
               InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
           If Printer.DeviceName <> NewPrinterName Then
               For Each objPrinter In Printers
                  If UCase$(objPrinter.DeviceName) = NewPrinterName Then
                       Set Printer = objPrinter
                  End If
               Next
           End If
           On Error Resume Next

           ' Set printer object properties according to selections made
           ' by user
           DoEvents
           With Printer
               .Copies = DevMode.dmCopies
               .Duplex = DevMode.dmDuplex
               .Orientation = DevMode.dmOrientation
           End With
           On Error GoTo 0
           MsgBox "OK"
       End If

       ' Display the results in the immediate (debug) window
       With Printer
           If .Orientation = 1 Then
               strSetting = "Portrait.  "
           Else
               strSetting = "Landscape. "
           End If
           Debug.Print "Copies = " & .Copies, "Orientation = " & _
              strSetting & GetDuplex(Printer.Duplex)
       End With
   End Sub

   Public Sub ShowPrinterSetup(frmOwner As Form)
       Dim PRINTSETUPDLG As PRINTSETUPDLG_TYPE
       Dim DevMode As DEVMODE_TYPE
       Dim DevName As DEVNAMES_TYPE
            
       Dim lpDevMode As Long, lpDevName As Long
       Dim bReturn As Integer
       Dim objPrinter As Printer, NewPrinterName As String
       Dim strSetting As String
  
       ' Use PrintDialog to get the handle to a memory
       ' block with a DevMode and DevName structures
  
       PRINTSETUPDLG.lStructSize = Len(PRINTSETUPDLG)
       PRINTSETUPDLG.hwndOwner = frmOwner.hWnd
  
       ' Set the current orientation and duplex setting
       DevMode.dmDeviceName = Printer.DeviceName
       DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX _
          Or DM_COPIES
       DevMode.dmOrientation = Printer.Orientation
       DevMode.dmCopies = Printer.Copies
       On Error Resume Next
       DevMode.dmDuplex = Printer.Duplex
       On Error GoTo 0
  
       ' Allocate memory for the initialization hDevMode structure
       ' and copy the settings gathered above into this memory
       PRINTSETUPDLG.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or _
          GMEM_ZEROINIT, Len(DevMode))
       lpDevMode = GlobalLock(PRINTSETUPDLG.hDevMode)
       If lpDevMode > 0 Then
          CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
           bReturn = GlobalUnlock(PRINTSETUPDLG.hDevMode)
       End If
  
       ' Set the current driver, device, and port name strings
       With DevName
           .wDriverOffset = 8
           .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
           .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
           .wDefault = 0
       End With
       With Printer
           DevName.extra = .DriverName & Chr(0) & _
           .DeviceName & Chr(0) & .Port & Chr(0)
       End With
  
       ' Allocate memory for the initial hDevName structure
       ' and copy the settings gathered above into this memory
       PRINTSETUPDLG.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or _
           GMEM_ZEROINIT, Len(DevName))
       lpDevName = GlobalLock(PRINTSETUPDLG.hDevNames)
       If lpDevName > 0 Then
           CopyMemory ByVal lpDevName, DevName, Len(DevName)
           bReturn = GlobalUnlock(lpDevName)
       End If
  
       ' Call the print dialog up and let the user make changes
       If PageSetupDialog(PRINTSETUPDLG) Then
  
           ' First get the DevName structure.
           lpDevName = GlobalLock(PRINTSETUPDLG.hDevNames)
               CopyMemory DevName, ByVal lpDevName, 45
           bReturn = GlobalUnlock(lpDevName)
           GlobalFree PRINTSETUPDLG.hDevNames
  
           ' Next get the DevMode structure and set the printer
           ' properties appropriately
           lpDevMode = GlobalLock(PRINTSETUPDLG.hDevMode)
               CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
           bReturn = GlobalUnlock(PRINTSETUPDLG.hDevMode)
           GlobalFree PRINTSETUPDLG.hDevMode
           NewPrinterName = UCase$(Left(DevMode.dmDeviceName, _
               InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
           If Printer.DeviceName <> NewPrinterName Then
               For Each objPrinter In Printers
                  If UCase$(objPrinter.DeviceName) = NewPrinterName Then
                       Set Printer = objPrinter
                  End If
               Next
           End If
           On Error Resume Next
  
           ' Set printer object properties according to selections made
          ' by user
           DoEvents
           With Printer
               .Copies = DevMode.dmCopies
               .Duplex = DevMode.dmDuplex
               .Orientation = DevMode.dmOrientation
           End With
           On Error GoTo 0
           TestOkButton = True
       End If
  
       ' Display the results in the immediate (debug) window
       With Printer
           If .Orientation = 1 Then
               strSetting = "Portrait.  "
           Else
               strSetting = "Landscape. "
           End If
           Debug.Print "Copies = " & .Copies, "Orientation = " & _
              strSetting & GetDuplex(Printer.Duplex)
       End With
   End Sub

   Function GetDuplex(lDuplex As Long) As String
        Dim TempStr As String
             
        If lDuplex = DMDUP_SIMPLEX Then
           TempStr = "Duplex is turned off (1)"
        ElseIf lDuplex = DMDUP_VERTICAL Then
           TempStr = "Duplex is set to VERTICAL (2)"
        ElseIf lDuplex = DMDUP_HORIZONTAL Then
           TempStr = "Duplex is set to HORIZONTAL (3)"
        Else
           TempStr = "Duplex is set to undefined value of " & lDuplex
        End If
        GetDuplex = TempStr   ' Return descriptive text
 End Function
 
 Public Sub PrinterSetupDlg(frmOwner As Form, _
          Optional PrintFlags As Long)

       Dim PrintDlg As PRINTDLG_TYPE
       Dim DevMode As DEVMODE_TYPE
       Dim DevName As DEVNAMES_TYPE

       Dim lpDevMode As Long, lpDevName As Long
       Dim bReturn As Integer
       Dim objPrinter As Printer, NewPrinterName As String
       Dim strSetting As String

       ' Use PrintSetupDialog to get the handle to a memory
       ' block with a DevMode and DevName structures

       PrintDlg.lStructSize = Len(PrintDlg)
       PrintDlg.hwndOwner = frmOwner.hWnd

       PrintDlg.flags = PrintFlags

       ' Set the current orientation and duplex setting
       DevMode.dmDeviceName = Printer.DeviceName
       DevMode.dmSize = Len(DevMode)
       DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX _
          Or DM_COPIES
       DevMode.dmOrientation = Printer.Orientation
       DevMode.dmCopies = Printer.Copies
       On Error Resume Next
       DevMode.dmDuplex = Printer.Duplex
       On Error GoTo 0

       ' Allocate memory for the initialization hDevMode structure
       ' and copy the settings gathered above into this memory
       PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or _
          GMEM_ZEROINIT, Len(DevMode))
       lpDevMode = GlobalLock(PrintDlg.hDevMode)
       If lpDevMode > 0 Then
           CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
           bReturn = GlobalUnlock(PrintDlg.hDevMode)
       End If

       ' Set the current driver, device, and port name strings
       With DevName
           .wDriverOffset = 8
           .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
           .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
           .wDefault = 0
       End With
       With Printer
           DevName.extra = .DriverName & Chr(0) & _
           .DeviceName & Chr(0) & .Port & Chr(0)
       End With

       ' Allocate memory for the initial hDevName structure
       ' and copy the settings gathered above into this memory
       PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or _
           GMEM_ZEROINIT, Len(DevName))
       lpDevName = GlobalLock(PrintDlg.hDevNames)
       If lpDevName > 0 Then
           CopyMemory ByVal lpDevName, DevName, Len(DevName)
           bReturn = GlobalUnlock(lpDevName)
       End If

       ' Call the print dialog up and let the user make changes
       If PrintDialog(PrintDlg) Then

           ' First get the DevName structure.
           lpDevName = GlobalLock(PrintDlg.hDevNames)
               CopyMemory DevName, ByVal lpDevName, 45
           bReturn = GlobalUnlock(lpDevName)
           GlobalFree PrintDlg.hDevNames

           ' Next get the DevMode structure and set the printer
           ' properties appropriately
           lpDevMode = GlobalLock(PrintDlg.hDevMode)
               CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
           bReturn = GlobalUnlock(PrintDlg.hDevMode)
           GlobalFree PrintDlg.hDevMode
           NewPrinterName = UCase$(Left(DevMode.dmDeviceName, _
               InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
           If Printer.DeviceName <> NewPrinterName Then
               For Each objPrinter In Printers
                  If UCase$(objPrinter.DeviceName) = NewPrinterName Then
                       Set Printer = objPrinter
                  End If
               Next
           End If
           On Error Resume Next

           ' Set printer object properties according to selections made
           ' by user
           DoEvents
           With Printer
               .Copies = DevMode.dmCopies
               .Duplex = DevMode.dmDuplex
               .Orientation = DevMode.dmOrientation
           End With
           On Error GoTo 0
       End If
 End Sub

文件二:窗体

控件,三个按钮

   Private Sub cmdPrint_Click()
      ShowPrinter Me                                        '弹出打印窗口.如果需要判断是否选择了打印,需要更改模块中对应的函数,返回一个BOOL值即可.
   End Sub

   Private Sub cmdPrintSetup_Click()
      ShowPrinter Me, PD_PRINTSETUP    '弹出打印机设置窗口
    End Sub

   Private Sub cmdPrtSetupDlg_Click()
       ShowPrinterSetup Me                           '弹出页面设置窗口
   End Sub