Private
Function
ShowPageSetupDlg(frmOwner
As
Form)
As
Long
Dim PSD As PRINTSETUPDLG_TYPE
Dim DevMode As DEVMODE_TYPE
Dim DevName As DEVNAMES_TYPE
Dim bReturn As Integer
Dim lpDevMode As Long
Dim lpDevNames As Long
PSD.lStructSize = Len (PSD)
PSD.hwndOwner = Me.hWnd
PSD.hInstance = App.hInstance
PSD.flags = PSD_MARGINS Or PSD_INHUNDREDTHSOFMILLIMETERS
' 设置初始的页边距
PSD.rtMargin.Bottom = (Printer.Height - Printer.ScaleTop - Printer.ScaleHeight) / 567 * 1000
PSD.rtMargin.Left = Printer.ScaleLeft / 567 * 1000
PSD.rtMargin.Right = (Printer.Width - Printer.ScaleLeft - Printer.ScaleWidth) / 567 * 1000
PSD.rtMargin.Top = Printer.ScaleTop / 567 * 1000
' 设置初始话对话框的纸张和打印方向
DevMode.dmDeviceName = Printer.DeviceName
DevMode.dmFields = DevMode.dmFields Or DM_ORIENTATION Or DM_PAPERSIZE Or DM_COPIES Or DM_DUPLEX Or DM_DEFAULTSOURCE Or DM_PAPERLENGTH Or DM_PAPERWIDTH
DevMode.dmSize = Len (DevMode)
DevMode.dmOrientation = Printer.Orientation
DevMode.dmPaperSize = Printer.PaperSize
If DevMode.dmPaperSize <= 0 Or DevMode.dmPaperSize >= 256 Then
DevMode.dmPaperLength = Printer.Height
DevMode.dmPaperWidth = Printer.Width
End If
DevMode.dmCopies = Printer.Copies
DevMode.dmDefaultSource = Printer.PaperBin
On Error GoTo 0
' 为初始的hDevMode分配内存
' 把上面的DevMode结构体内容拷贝入已经分配的内存中
On Error Resume Next
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
PSD.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len (DevName))
lpDevNames = GlobalLock(PSD.hDevNames)
If lpDevNames > 0 Then
CopyMemory ByVal lpDevNames, DevName, Len (DevName)
bReturn = GlobalUnlock(lpDevNames)
End If
PSD.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len (DevMode))
lpDevMode = GlobalLock(PSD.hDevMode)
If lpDevMode > 0 Then
CopyMemory ByVal lpDevMode, DevMode, Len (DevMode)
bReturn = GlobalUnlock(lpDevMode)
End If
' 显示打印页面设置对话框
If PageSetupDialog(PSD) Then
ShowPageSetupDlg = 0
lpDevNames = GlobalLock(PSD.hDevNames)
CopyMemory DevName, ByVal lpDevNames, Len (DevName)
bReturn = GlobalUnlock(lpDevNames)
GlobalFree PSD.hDevNames
lpDevMode = GlobalLock(PSD.hDevMode)
CopyMemory DevMode, ByVal lpDevMode, Len (DevMode)
bReturn = GlobalUnlock(lpDevMode)
GlobalFree PSD.hDevMode
On Error Resume Next
' 根据用户选择的值设置打印机的各项参数
Dim strNewPrinter As String
strNewPrinter = UCase ( Left (DevMode.dmDeviceName, InStr (DevMode.dmDeviceName, Chr ( 0 )) - 1 ))
Dim i As Integer
For i = 0 To Printers.Count - 1
If UCase (Printers(i).DeviceName) = strNewPrinter Then
Set Printer = Printers(i)
End If
Next i
Printer.PrintQuality = DevMode.dmPrintQuality
Printer.Orientation = DevMode.dmOrientation
Printer.PaperSize = DevMode.dmPaperSize
Printer.PaperBin = DevMode.dmDefaultSource
' 存储页面设置的参数
Printer.ScaleTop = PSD.rtMargin.Top / 1000 * 567
Printer.ScaleLeft = PSD.rtMargin.Left / 1000 * 567
Printer.ScaleWidth = Printer.Width - PSD.rtMargin.Right / 1000 * 567 - Printer.ScaleLeft
Printer.ScaleHeight = Printer.Height - PSD.rtMargin.Bottom / 1000 * 567 - Printer.ScaleTop
Else
ShowPageSetupDlg = - 1
End If
End Function
Dim PSD As PRINTSETUPDLG_TYPE
Dim DevMode As DEVMODE_TYPE
Dim DevName As DEVNAMES_TYPE
Dim bReturn As Integer
Dim lpDevMode As Long
Dim lpDevNames As Long
PSD.lStructSize = Len (PSD)
PSD.hwndOwner = Me.hWnd
PSD.hInstance = App.hInstance
PSD.flags = PSD_MARGINS Or PSD_INHUNDREDTHSOFMILLIMETERS
' 设置初始的页边距
PSD.rtMargin.Bottom = (Printer.Height - Printer.ScaleTop - Printer.ScaleHeight) / 567 * 1000
PSD.rtMargin.Left = Printer.ScaleLeft / 567 * 1000
PSD.rtMargin.Right = (Printer.Width - Printer.ScaleLeft - Printer.ScaleWidth) / 567 * 1000
PSD.rtMargin.Top = Printer.ScaleTop / 567 * 1000
' 设置初始话对话框的纸张和打印方向
DevMode.dmDeviceName = Printer.DeviceName
DevMode.dmFields = DevMode.dmFields Or DM_ORIENTATION Or DM_PAPERSIZE Or DM_COPIES Or DM_DUPLEX Or DM_DEFAULTSOURCE Or DM_PAPERLENGTH Or DM_PAPERWIDTH
DevMode.dmSize = Len (DevMode)
DevMode.dmOrientation = Printer.Orientation
DevMode.dmPaperSize = Printer.PaperSize
If DevMode.dmPaperSize <= 0 Or DevMode.dmPaperSize >= 256 Then
DevMode.dmPaperLength = Printer.Height
DevMode.dmPaperWidth = Printer.Width
End If
DevMode.dmCopies = Printer.Copies
DevMode.dmDefaultSource = Printer.PaperBin
On Error GoTo 0
' 为初始的hDevMode分配内存
' 把上面的DevMode结构体内容拷贝入已经分配的内存中
On Error Resume Next
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
PSD.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len (DevName))
lpDevNames = GlobalLock(PSD.hDevNames)
If lpDevNames > 0 Then
CopyMemory ByVal lpDevNames, DevName, Len (DevName)
bReturn = GlobalUnlock(lpDevNames)
End If
PSD.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len (DevMode))
lpDevMode = GlobalLock(PSD.hDevMode)
If lpDevMode > 0 Then
CopyMemory ByVal lpDevMode, DevMode, Len (DevMode)
bReturn = GlobalUnlock(lpDevMode)
End If
' 显示打印页面设置对话框
If PageSetupDialog(PSD) Then
ShowPageSetupDlg = 0
lpDevNames = GlobalLock(PSD.hDevNames)
CopyMemory DevName, ByVal lpDevNames, Len (DevName)
bReturn = GlobalUnlock(lpDevNames)
GlobalFree PSD.hDevNames
lpDevMode = GlobalLock(PSD.hDevMode)
CopyMemory DevMode, ByVal lpDevMode, Len (DevMode)
bReturn = GlobalUnlock(lpDevMode)
GlobalFree PSD.hDevMode
On Error Resume Next
' 根据用户选择的值设置打印机的各项参数
Dim strNewPrinter As String
strNewPrinter = UCase ( Left (DevMode.dmDeviceName, InStr (DevMode.dmDeviceName, Chr ( 0 )) - 1 ))
Dim i As Integer
For i = 0 To Printers.Count - 1
If UCase (Printers(i).DeviceName) = strNewPrinter Then
Set Printer = Printers(i)
End If
Next i
Printer.PrintQuality = DevMode.dmPrintQuality
Printer.Orientation = DevMode.dmOrientation
Printer.PaperSize = DevMode.dmPaperSize
Printer.PaperBin = DevMode.dmDefaultSource
' 存储页面设置的参数
Printer.ScaleTop = PSD.rtMargin.Top / 1000 * 567
Printer.ScaleLeft = PSD.rtMargin.Left / 1000 * 567
Printer.ScaleWidth = Printer.Width - PSD.rtMargin.Right / 1000 * 567 - Printer.ScaleLeft
Printer.ScaleHeight = Printer.Height - PSD.rtMargin.Bottom / 1000 * 567 - Printer.ScaleTop
Else
ShowPageSetupDlg = - 1
End If
End Function