win2000下用vb改变 分辨率 的问题

Question

分辨率从现在的800 600  改到1024 768主要用了下面这个函数  返回值已经是0了 （0表示分辨率改变成功吧） 可屏幕分辨率没有变化   烦请各位帮忙看一下   万分感谢地说！！~  :)i = SetDisplayMode(1024, 768, 32)Public Function SetDisplayMode(Width As Integer, Height As Integer, Color
 As Integer) As Long
    Dim NewDevMode As DEVMODE
    Dim pDevmode As Long
    
    With NewDevMode
        
        If Color = -1 Then
            .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
        Else
            .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
        End If
        
        .dmPelsWidth = Width
        .dmPelsHeight = Height
        
        If Color <> -1 Then
            .dmBitsPerPel = Color
        End If
    End With
    
    pDevmode = lstrcpy(NewDevMode, NewDevMode)
    SetDisplayMode = ChangeDisplaySettings(pDevmode, CDS_UPDATEREGISTRY)
    
End Function其它的声明如下
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_BITSPERPEL = &H40000
Const CDS_UPDATEREGISTRY = &H1
Const CDS_TEST = &H4
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1
 As Any, lpString2 As Any) As LongPublic Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA
" (ByVal lpDevMode As Long, ByVal dwflags As Long) As LongType DEVMODE
    ……     '该类型中若干个定义  太长  不贴了
End Type

Answer 1

窗体：
Option Explicit
Private Sub Command1_Click()
    Dim DevM As DEVMODE '将取得的讯息存放在 DevM
    Dim erg As Long
    erg& = EnumDisplaySettings(0&, 0&, DevM)
    
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT 'Or DM_BITSPERPEL
    DevM.dmPelsWidth = 800 '想要设定的屏幕宽度
    DevM.dmPelsHeight = 600 '想要设定的屏幕高度
    '我们不更改色板，因为一旦更改色板就必须重新开机！
    'DevM.dmBitsPerPel = 32 (could be 8, 16, 32 or even 4) '此行可用于改变色板
    
    '以下这行指令会暂时更改屏幕的分辨率，是测试性的，不一定成功，
    '不过因为没将设定值写到注册表，所以虽然可能更改成功，
    '但是一旦重新开机后，会自动恢复成更改前的设定值
    erg& = ChangeDisplaySettings(DevM, CDS_TEST)
    
    '上面的指令若成功，而且您想永久性的更改使用者的屏幕分辨率，
    '您还必须使用下一行指令，将资料写到注册表
    'erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
    '但是如果您只是想暂时更改使用者的屏幕分辨率，就不需要了.
    
    '当然并不是您随便设定一个值，就一定会成功的更改屏幕分辨率,
    '所以还需要检查是否更改成功！下面的程序就是检查是否更改成功
    Dim an As Long
    Select Case erg&
    Case DISP_CHANGE_RESTART
        '通常如果有更改到色板，或者较老的板子，会要求重新开机
        an = MsgBox("您必须重新开机！", vbYesNo + vbSystemModal, "讯息")
        If an = vbYes Then
            '这里有问题，需要关机的权限，不过和本问题无关，就不写了
            erg& = ExitWindowsEx(EWX_REBOOT, 0&)
        End If
    Case DISP_CHANGE_SUCCESSFUL
        '如果更改成功且不需重新开机，您就可以将设定值写到注册表中
        erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
        MsgBox "分辨率更改成功！", vbOKOnly + vbSystemModal, "成功！"
    Case Else
        '更改不成功
        MsgBox "不支持此一模式！", vbOKOnly + vbSystemModal, "错误！"
    End Select
End Sub
模块：
Option ExplicitDeclare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As BooleanDeclare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As LongDeclare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, ByVal dwReserved As Long) As LongPublic Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const CCDEVICENAME = 32
Public Const CCFORMNAME = 32
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const CDS_UPDATEREGISTRY = &H1
Public Const CDS_TEST = &H4
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1Type DEVMODE
    dmDeviceName As String * CCDEVICENAME
    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 * CCFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type