急!!!再问.在98下如何改变显示分辨率?(搜索到的例子在XP/2003下可以用,在98下是改变不了的)

Question

如题.WIN2003+VB6SP6正常,98程序运行正常,只是改变不了分辨率.请高手帮忙.如解决了可以再给分.请看此贴:http://community.csdn.net/Expert/topic/3316/3316071.xml?temp=8.185977E-02

Answer 1

你试试
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const ENUM_CURRENT_SETTINGS = 1
Private Type DEVMODE
        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 Long
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
End TypePrivate Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (ByVal lpDevMode As Long, ByVal dwflags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, lpDevMode As Any) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As LongPrivate Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1Dim pNewMode As DEVMODE
Dim pOldMode As Long
Dim nOrgWidth As Integer, nOrgHeight As Integer
    
'设置显示器分辨率的执行函数
Private Function SetDisplayMode(Width As Integer, Height As Integer, Color As Integer) As Long ', Freq As Long) As Long
    On Error GoTo ErrorHandler
    Const DM_PELSWIDTH = &H80000
    Const DM_PELSHEIGHT = &H100000
    Const DM_BITSPERPEL = &H40000
    Const DM_DISPLAYFLAGS = &H200000
    Const DM_DISPLAYFREQUENCY = &H400000
    With pNewMode
        .dmSize = Len(pNewMode)
        If Color = 0 Then 'Color = 0 时不更改屏幕颜色
            .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
        Else
            .dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_DISPLAYFREQUENCY '属性率的更改还是没办法,不过,不加入此DM_DISPLAYFREQUENCY这个参数,只要系统支持,应该不会更改刷新率的
        End If
        .dmPelsWidth = Width
        .dmPelsHeight = Height
        '刷新频率为85
        .dmDisplayFrequency = 85
        If Color <> 0 Then
        .dmBitsPerPel = Color
        End If
    End With
    pOldMode = lstrcpy(pNewMode, pNewMode)
    SetDisplayMode = ChangeDisplaySettings(pOldMode, 1)
    Exit Function
ErrorHandler:
    MsgBox Err.Description
End FunctionPrivate Sub Command1_Click()
    Dim nWidth As Integer, nHeight As Integer, nColor As Integer
    Select Case Combo1.ListIndex
        Case 0
            nWidth = 640: nHeight = 480: nColor = 16  '640*480*16位真彩色,256色nColor = 8,16色nColor = 4,nColor = 0 表示不改变颜色
        Case 1
            nWidth = 640: nHeight = 480: nColor = 24
        Case 2
            nWidth = 640: nHeight = 480: nColor = 32
        Case 3
            nWidth = 800: nHeight = 600: nColor = 16
        Case 4
            nWidth = 800: nHeight = 600: nColor = 24
        Case 5
            nWidth = 800: nHeight = 600: nColor = 32
        Case 6
            nWidth = 1024: nHeight = 768: nColor = 16
        Case 7
            nWidth = 1024: nHeight = 768: nColor = 24
        Case 8
            nWidth = 1024: nHeight = 768: nColor = 32
        Case other
            nWidth = 800: nHeight = 600: nColor = 16
    End Select
    Call SetDisplayMode(nWidth, nHeight, nColor)  '注意,系统不支持的显示模式不能选,否则,准备用安全模式重启动吧.API函数EnumDisplaySettings可以选择系统支持的模式,
End SubPrivate Sub Form_Load()
    Combo1.AddItem "640*480*16位真彩色"
    Combo1.AddItem "640*480*24位真彩色"
    Combo1.AddItem "640*480*32位真彩色"
    Combo1.AddItem "800*600*16位真彩色"
    Combo1.AddItem "800*600*24位真彩色"
    Combo1.AddItem "800*600*32位真彩色"
    Combo1.AddItem "1024*768*16位真彩色"
    Combo1.AddItem "1024*768*24位真彩色"
    Combo1.AddItem "1024*768*32位真彩色"
    Combo1.Text = Combo1.List(0)
    nOrgWidth = GetDisplayWidth
    nOrgHeight = GetDisplayHeight
    'nOrgWidth = GetSystemMetrics(SM_CXSCREEN)'两种获取初始屏幕大小的方法均可
    'nOrgHeight = GetSystemMetrics(SM_CYSCREEN)
End SubPrivate Function GetDisplayWidth() As Integer
    GetDisplayWidth = Screen.Width \ Screen.TwipsPerPixelX
End FunctionPrivate Function GetDisplayHeight() As Integer
    GetDisplayHeight = Screen.Height \ Screen.TwipsPerPixelY
End FunctionPrivate Sub RestoreDisplayMode()
    Call SetDisplayMode(nOrgWidth, nOrgHeight, 0)
End SubPrivate Sub Form_Unload(Cancel As Integer)
    RestoreDisplayMode
End Sub

Answer 2

窗体上一个按钮（cmdSetMode）一个combobox（cboMode）：
Option Explicit
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, lpDevMode As DEVMODE) As Long
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
 
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const DM_DISPLAYFREQUENCY = &H400000
 
Private Const CDS_UPDATEREGISTRY = &H1
Private Const CDS_TEST = &H4
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1
Private Const ENUM_CURRENT_SETTINGS = -1
Private Const ENUM_REGISTRY_SETTINGS = -2
 
Private Type DEVMODE
       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 Long
       dmPelsWidth  As Long
       dmPelsHeight  As Long
       dmDisplayFlags  As Long
       dmDisplayFrequency  As Long
End Type
 
'  Return  the  caption  for  this  device  mode  information.
Private Function DevModeCaption(dev_mode As DEVMODE) As String
               DevModeCaption = _
               Format$(dev_mode.dmPelsWidth) & "  x  " & _
               Format$(dev_mode.dmPelsHeight) & "  (" & _
               Format$(dev_mode.dmBitsPerPel) & ")  " & _
               ",  Freq:  " & _
               Format$(dev_mode.dmDisplayFrequency) & _
               "  Flags:  " & _
               Format$(dev_mode.dmDisplayFlags)
End Function
'  Select  the  indicated  mode.
Private Sub cmdSetMode_Click()
       Dim dev_mode   As DEVMODE
       Dim mode_num   As Long
 
       '  Refetch  information  about  this  mode.
       mode_num = cboMode.ItemData(cboMode.ListIndex)
       If EnumDisplaySettings(ByVal vbNullString, _
               mode_num, dev_mode) = 0 _
       Then
               MsgBox "Error  refetching  mode  data."
               Exit Sub
       End If
 
       '  Confirm.
       If MsgBox("Do  you  want  to  select  the  mode  " & _
               DevModeCaption(dev_mode), vbYesNo) = vbNo _
                       Then Exit Sub
 
       '  Select  the  mode.
       dev_mode.dmFields = _
               DM_PELSWIDTH Or _
               DM_PELSHEIGHT Or _
               DM_BITSPERPEL Or _
               DM_DISPLAYFREQUENCY
                 
       dev_mode.dmSize = Len(dev_mode)
       dev_mode.dmDriverExtra = 0
 
       '  Test  the  change.
       Select Case ChangeDisplaySettings(dev_mode, CDS_TEST)
               Case DISP_CHANGE_RESTART
                       If MsgBox("The  system  must  reboot  to  make  this  change.  Do  you  want  to  reboot?", _
                               vbYesNo) = vbYes _
                       Then
                               If ChangeDisplaySettings(dev_mode, CDS_UPDATEREGISTRY) _
                                       <> DISP_CHANGE_SUCCESSFUL _
                               Then
                                       MsgBox "Error  setting  the  new  mode."
                               Else
                                       ExitWindowsEx EWX_REBOOT, 0
                               End If
                       End If
 
               Case DISP_CHANGE_SUCCESSFUL
                       If ChangeDisplaySettings(dev_mode, CDS_UPDATEREGISTRY) _
                               = DISP_CHANGE_SUCCESSFUL _
                       Then
                               MsgBox "Mode  changed."
                       Else
                               MsgBox "Error  setting  the  new  mode."
                       End If
               Case Else
                       MsgBox "Error  setting  the  new  mode."
       End Select
End Sub
'  Load  the  available  device  modes.
Private Sub Form_Load()
       cmdSetMode.Caption = "设置显示模式"
       Dim dev_mode   As DEVMODE
       Dim mode_num   As Long
               '  Get  the  available  modes.
               mode_num = 0
               Do
                       '  Stop  when  the  function  fails.
                       If EnumDisplaySettings(ByVal vbNullString, _
                               mode_num, dev_mode) = 0 _
                                       Then Exit Do
                       '  Add  this  choice  to  the  ComboBox.
                       cboMode.AddItem DevModeCaption(dev_mode)
                       cboMode.ItemData(cboMode.NewIndex) = mode_num
         
                       mode_num = mode_num + 1
               Loop
         
               '  Make  sure  we  got  some  modes.
               If mode_num = 0 Then
                       MsgBox "EnumDisplaySettings  returned  no  display  modes."
                       Exit Sub
               End If
         
               '  Get  the  current  mode.
               If EnumDisplaySettings(ByVal vbNullString, _
                       ENUM_CURRENT_SETTINGS, dev_mode) = 0 _
               Then
                       MsgBox "Unable  to  get  the  current  mode."
                       Exit Sub
               End If
               '  Select  the  current  mode.
               cboMode.Text = DevModeCaption(dev_mode)
End Sub

Answer 3

上面的程序使用了EnumDisplaySettings枚举显示模式