commondialog 的打印机设置问题！

[leyonben]

代码如下：
cdlMain.PrinterDefault = True
cdlMain.DialogTitle = "Print Current Page"
cdlMain.Flags = cdlPDNoPageNums + cdlPDCollate + cdlPDNoSelection
cdlMain.ShowPrinter

Printer.Print ""
Printer.PaintPicture Picture1.Picture, 0, 0
Printer.EndDoc

在 win98 下面，上面的代码可以正常控制打印，比如彩色图片打印成灰度，
打印精度、打印份数等等都正常。
但是在 win2k 下面，虽然运行没有问题，可全部设置都没有用，
只能按系统的默认打印设置打印，就好像第一句是没有用一样。

请问哪位老大碰到过类似问题？怎么解决？
谢谢！谢谢！
//bow

[拿棵草]

将如下代码添加到一个MODEL里。然后调用最后一个函数就可以了。



Option Explicit

Private Const VER_PLATFORM_WIN32_WINDOWS = 1

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Type PRINTDLG
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
wDriverOffset As Integer
wDeviceOffset As Integer
wOutputOffset As Integer
wDefault As Integer
extra As String * 100
End Type

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 Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40

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

Private Const PD_PRINTSETUP = &H40

Private Const DMPAPER_USER = 256

Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG) 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

'在Win9x下显示打印机设置
Private Sub Win9xShowPrinter(CDlg1 As CommonDialog)
On Error GoTo ErrorHandle
CDlg1.PrinterDefault = True
CDlg1.CancelError = True
CDlg1.flags = cdlPDPrintSetup + cdlPDNoWarning
CDlg1.ShowPrinter
On Error GoTo 0
Exit Sub
ErrorHandle:
Select Case Err.Number
Case cdlCancel

Case Else
MsgBox Err.Description, vbOKOnly + vbExclamation, "打印设置"
End Select
On Error GoTo 0
End Sub

'在WinNT下显示打印机设置
Public Sub WinNTShowPrinter(frmOwner As Form)
Dim pdPrintDlg As PRINTDLG
Dim dmDevMode As DEVMODE
Dim dnDevName As DEVNAMES

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

Dim lngPaperWidth&, lngPaperHeight&

pdPrintDlg.lStructSize = Len(pdPrintDlg)
pdPrintDlg.hWndOwner = frmOwner.hwnd

pdPrintDlg.flags = PD_PRINTSETUP
On Error Resume Next
dmDevMode.dmDeviceName = Printer.DeviceName
dmDevMode.dmSize = Len(dmDevMode)
dmDevMode.dmFields = DM_ORIENTATION Or DM_PAPERSIZE
dmDevMode.dmOrientation = Printer.Orientation
dmDevMode.dmPaperSize = Printer.PaperSize
If dmDevMode.dmPaperSize = DMPAPER_USER Then
dmDevMode.dmPaperWidth = Printer.Width / 567 * 100
dmDevMode.dmPaperLength = Printer.Height / 567 * 100
End If
On Error GoTo 0

pdPrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(dmDevMode))
lpDevMode = GlobalLock(pdPrintDlg.hDevMode)
If lpDevMode > 0 Then
CopyMemory ByVal lpDevMode, dmDevMode, Len(dmDevMode)
bReturn = GlobalUnlock(pdPrintDlg.hDevMode)
End If

With dnDevName
.wDriverOffset = 8
.wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
.wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
.wDefault = 0
End With

With Printer
dnDevName.extra = .DriverName & Chr(0) & .DeviceName & Chr(0) & .Port & Chr(0)
End With

pdPrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(dnDevName))
lpDevName = GlobalLock(pdPrintDlg.hDevNames)
If lpDevName > 0 Then
CopyMemory ByVal lpDevName, dnDevName, Len(dnDevName)
bReturn = GlobalUnlock(lpDevName)
End If

If PrintDialog(pdPrintDlg) <> 0 Then

lpDevName = GlobalLock(pdPrintDlg.hDevNames)
CopyMemory dnDevName, ByVal lpDevName, 45
bReturn = GlobalUnlock(lpDevName)
GlobalFree pdPrintDlg.hDevNames

lpDevMode = GlobalLock(pdPrintDlg.hDevMode)
CopyMemory dmDevMode, ByVal lpDevMode, Len(dmDevMode)
bReturn = GlobalUnlock(pdPrintDlg.hDevMode)
GlobalFree pdPrintDlg.hDevMode
NewPrinterName = UCase$(Left(dmDevMode.dmDeviceName, InStr(dmDevMode.dmDeviceName, Chr$(0)) - 1))
If UCase$(Printer.DeviceName) <> NewPrinterName Then
For Each objPrinter In Printers
If UCase$(objPrinter.DeviceName) = NewPrinterName Then
Set Printer = objPrinter
Exit For
End If
Next
End If

On Error Resume Next
Printer.Orientation = dmDevMode.dmOrientation
Printer.PaperSize = dmDevMode.dmPaperSize
If Printer.PaperSize = DMPAPER_USER Then
lngPaperWidth = dmDevMode.dmPaperWidth / 100 * 567
Printer.Width = lngPaperWidth
If Printer.Width <> lngPaperWidth Then
Printer.Width = lngPaperWidth + (lngPaperWidth - Printer.Width)
End If
lngPaperHeight = dmDevMode.dmPaperLength / 100 * 567
Printer.Height = lngPaperHeight
If Printer.Height <> lngPaperHeight Then
Printer.Height = lngPaperHeight + (lngPaperHeight - Printer.Height)
End If
End If
On Error GoTo 0
End If
End Sub

'显示打印机设置
Public Sub ShowPrinter(frmOwner As Form, CDlg1 As CommonDialog)
Dim OsVInfo As OSVERSIONINFO
Dim lReturn&

If Printers.Count = 0 Then
MsgBox "系统中没有安装打印机！请安装后再试...", vbExclamation, "打印设置"
Exit Sub
End If

OsVInfo.dwOSVersionInfoSize = 148
OsVInfo.szCSDVersion = Space$(128)
lReturn = GetVersionEx(OsVInfo)
If OsVInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
Call Win9xShowPrinter(CDlg1)
Else
Call WinNTShowPrinter(frmOwner)
End If
End Sub

[leyonben]

老大，我按你说的，添加了一个模块以后，
把代码改成：
call ShowPrinter(me,cdlMain)

Printer.Print ""
Printer.PaintPicture Picture1.Picture, 0, 0
Printer.EndDoc

结果出来的打印机设置界面和 win98 下面的很象，
但是结果还是和原来的一样，就是比如 picturebox 里面放的彩色图，
我在打印机设置里面设成灰度打印，可结果打印出来的还是彩色图，
可是如果用 acdsee 来打的话，设成灰度打印，那打印出来的结果就是灰度图。
请问还有其他解决方法么？
拜谢！

[拿棵草]

是么？会有这种事？我再看看。