如题

解决方案 »

  1.   

    一个List1 两个按钮 改分变辩率
    Option ExplicitPrivate 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 LongPrivate Type RECT
            Left As Long
            Top As Long
            Right As Long
            Bottom As Long
    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(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          ' Windows 95 only
        dmICMIntent As Long          ' Windows 95 only
        dmMediaType As Long          ' Windows 95 only
        dmDitherType As Long         ' Windows 95 only
        dmReserved1 As Long          ' Windows 95 only
        dmReserved2 As Long          ' Windows 95 only
    End TypeConst DM_BITSPERPEL = &H40000
    Const DM_PELSWIDTH = &H80000
    Const DM_PELSHEIGHT = &H100000
    Const DM_DISPLAYFLAGS = &H200000
    Const DM_DISPLAYFREQUENCY = &H400000Const DISP_CHANGE_SUCCESSFUL = 0
    Const DISP_CHANGE_RESTART = 1
    Const DISP_CHANGE_FAILED = -1
    Const DISP_CHANGE_BADMODE = -2
    Const DISP_CHANGE_NOTUPDATED = -3
    Const DISP_CHANGE_BADFLAGS = -4
    Const DISP_CHANGE_BADPARAM = -5Const CDS_UPDATEREGISTRY = 1
    Const CDS_FORCE As Long = &H80000000
    Const CDS_RESET = &H40000000Const HWND_BROADCAST = &HFFFF&
    Const WM_SYSCOLORCHANGE = &H15
    Const WM_PALETTECHANGED = &H311
    Const WM_DISPLAYCHANGE = &H7E
    Const WM_SETTINGCHANGE = &H1ADim ModeCube(128) As DEVMODE
    Dim lproc As Long'  列出显示设备支持的显示模式
    Sub LoadDisplayMode()
        Dim i As Long
        Dim RS As Long
        Dim AStr As String
      
        i = 0
        ' 遍历所有的显示模式并在List1中显示出来
        Do
            ModeCube(i).dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_DISPLAYFLAGS Or DM_DISPLAYFREQUENCY
            ModeCube(i).dmSize = Len(ModeCube(i))
            '获得显示模式并保存到数组中
            RS = EnumDisplaySettings(vbNullString, i, ModeCube(i))
            If RS Then
                AStr = Str$(ModeCube(i).dmPelsWidth) + "*" + Trim$(Str$(ModeCube(i).dmPelsHeight)) + " "
                Select Case ModeCube(i).dmBitsPerPel
                    Case 4
                        AStr = AStr + "16色"
                    Case 8
                        AStr = AStr + "256色"
                    Case 16
                        AStr = AStr + "16位彩色"
                    Case 24
                        AStr = AStr + "24位彩色"
                    Case 32
                        AStr = AStr + "32位彩色"
                    Case Else
                        AStr = AStr + Str$(ModeCube(i).dmBitsPerPel)
                End Select
                AStr = AStr + "  刷新频率:" & CStr(ModeCube(i).dmDisplayFrequency) + "Hz"
                i = i + 1
            End If
            List1.AddItem AStr
        Loop Until (RS = 0)     '获得最后一个显示模式之后EnumDisplaySettings会返回0
    End Sub'  设置显示模式
    Private Sub Command1_Click()
        Dim aDev As DEVMODE
        Dim RS As Long
            
        If List1.ListIndex < 0 Then Exit Sub
        aDev = ModeCube(List1.ListIndex)
        
        RS = ChangeDisplaySettings(aDev, CDS_FORCE)
     
        '  改变完显示模式设置之后向所有的窗口发送显示模式改变消息
        RS = SendMessageByLong(HWND_BROADCAST, WM_SYSCOLORCHANGE, 0&, 0&)
        RS = SendMessageByLong(HWND_BROADCAST, WM_PALETTECHANGED, Me.hwnd, 0&)
        RS = PostMessage(HWND_BROADCAST, WM_SYSCOLORCHANGE, 0&, 0&)
        
        '  windows就会重画窗口
        RS = InvalidateRect(0&, ByVal 0, 1&)
    End Sub'  加载窗体时加载显示系统支持的显示模式
    Private Sub Form_Load()
        LoadDisplayMode
    End Sub