设置屏幕分辨率

此程序通过EnumDisplaySettings获取当前显示设备支持的所有显示设置，然后通过ChangeDisplaySettings改变当前显示设备的分辨率。

在窗体上首先添加Combo和一Command，窗体代码如下：

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(1 To 32) As Byte
    dmLogPixels As Integer
    dmBitsPerPel As Long
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    dmICMMethod As Long
    dmICMIntent As Long
    dmMediaType As Long
    dmDitherType As Long
    dmReserved1 As Long
    dmReserved2 As Long
End Type
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, 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 SendMessageByLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lprect As Any, ByVal bErase As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const CDS_FORCE As Long = &H80000000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const DM_BITSPERPEL = &H40000
Private Const DM_DISPLAYFLAGS = &H200000
Private Const DM_DISPLAYFREQUENCY = &H400000
Dim ModeCube(138) As DEVMODE
Sub LoadDisplayMode()
    Dim i As Long
    Dim l1 As Long
    Dim astr As String
    i = 0
    Do
        ModeCube(i).dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT Or _
        DM_DISPLAYFLAGS Or DM_DISPLAYFREQUENCY
        ModeCube(i).dmSize = Len(ModeCube(i))
        l1 = EnumDisplaySettings(vbNullString, i, ModeCube(i))
        If l1 Then
            astr = Str$(ModeCube(i).dmPelsWidth) + "£ª" + Trim$(Str$(ModeCube(i).dmPelsHeight)) + " "
            Select Case ModeCube(i).dmBitsPerPel
            Case 8
                astr = astr + " 256É« " + CStr(ModeCube(i).dmDisplayFrequency) + "Hz"
            Case 16
                astr = astr + " 16λ¸ß²Ê " + CStr(ModeCube(i).dmDisplayFrequency) + "Hz"
            Case 24
                astr = astr + " 24λÕæ²Ê " + CStr(ModeCube(i).dmDisplayFrequency) + "Hz"
            Case 32
                astr = astr + " 32λÕæ²Ê " + CStr(ModeCube(i).dmDisplayFrequency) + "Hz"
            Case Else
                Exit Sub
            End Select
            i = i + 1
            Combo1.AddItem astr
        End If
    Loop Until (l1 = False)
End Sub
Private Sub Command1_Click()
    Dim aDev As DEVMODE
    Dim b, xxa, xxb, xxc, xxd As Long
    If Combo1.ListIndex < 0 Then Exit Sub
    aDev = ModeCube(Combo1.ListIndex)
    b = ChangeDisplaySettings(aDev, CDS_FORCE)
    xxc = SendMessageByLong(HWND_BROADCAST, WM_SYSCOLORCHANGE, 0&, 0&)
    xxa = SendMessageByLong(HWND_BROADCAST, WM_PALETTECHANGED, Me.hwnd, 0&)
    xxb = PostMessage(HWND_BROADCAST, WM_SYSCOLORCHANGE, 0&, 0&)
    xxd = InvalidateRect(0&, ByVal 0, 1&)
End Sub

Private Sub Form_Load()
    LoadDisplayMode
End Sub

本程序在VB6.0+Windows2000下测试通过。