VB调用系统的"打印机设置"和"页面设置".

VB调用系统的"打印机设置"和"页面设置".

Option Explicit Const FW_NORMAL = 400 Const DEFAULT_CHARSET = 1 Const OUT_DEFAULT_PRECIS = 0 Const CLIP_DEFAULT_PRECIS = 0 Const DEFAULT_QUALITY = 0 Const DEFAULT_PITCH = 0 Const FF_ROMAN = 16 Const CF_PRINTERFONTS = &H2 Const CF_SCREENFONTS = &H1 Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS) Const CF_EFFECTS = &H100& Const CF_FORCEFONTEXIST = &H10000 Const CF_INITTOLOGFONTSTRUCT = &H40& Const CF_LIMITSIZE = &H2000& Const REGULAR_FONTTYPE = &H400 Const LF_FACESIZE = 32 Const CCHDEVICENAME = 32 Const CCHFORMNAME = 32 Const GMEM_MOVEABLE = &H2 Const GMEM_ZEROINIT = &H40 Const DM_DUPLEX = &H1000& Const DM_ORIENTATION = &H1& Const PD_PRINTSETUP = &H40 Const PD_DISABLEPRINTTOFILE = &H80000 Private Type POINTAPI x As Long y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type PAGESETUPDLG 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 lpfnPagePaintHook As Long lpPageSetupTemplateName As String hPageSetupTemplate As Long End Type Private 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 Private Type DEVNAMES_TYPE wDriverOffset As Integer wDeviceOffset As Integer wOutputOffset As Integer wDefault As Integer extra As String * 100 End Type Private 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 Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long Private Sub Command1_Click() ShowPrinter Me End Sub Private Sub Command2_Click() ShowPageSetupDlg End Sub Private Sub Form_Load() Command1.Caption = "ShowPrinter" Command2.Caption = "ShowPageSetupDlg" End Sub Private Function ShowPageSetupDlg() As Long Dim m_PSD As PAGESETUPDLG m_PSD.lStructSize = Len(m_PSD) m_PSD.hwndOwner = Me.hWnd m_PSD.hInstance = App.hInstance m_PSD.flags = 0 If PAGESETUPDLG(m_PSD) Then ShowPageSetupDlg = 0 Else ShowPageSetupDlg = -1 End If End Function 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 PrintDlg.lStructSize = Len(PrintDlg) PrintDlg.hwndOwner = frmOwner.hWnd PrintDlg.flags = PrintFlags On Error Resume Next DevMode.dmDeviceName = Printer.DeviceName DevMode.dmSize = Len(DevMode) DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX DevMode.dmPaperWidth = Printer.Width DevMode.dmOrientation = Printer.Orientation DevMode.dmPaperSize = Printer.PaperSize DevMode.dmDuplex = Printer.Duplex On Error GoTo 0 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 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 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 If PrintDialog(PrintDlg) <> 0 Then lpDevName = GlobalLock(PrintDlg.hDevNames) CopyMemory DevName, ByVal lpDevName, 45 bReturn = GlobalUnlock(lpDevName) GlobalFree PrintDlg.hDevNames 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 Printer.Copies = DevMode.dmCopies Printer.Duplex = DevMode.dmDuplex Printer.Orientation = DevMode.dmOrientation Printer.PaperSize = DevMode.dmPaperSize Printer.PrintQuality = DevMode.dmPrintQuality Printer.ColorMode = DevMode.dmColor Printer.PaperBin = DevMode.dmDefaultSource On Error GoTo 0 End If End Sub