利用VB动态改变Windows显示模式的两种方法 在Windows系统中,系统提供了用于动态改变屏幕分辨率和显示颜色数的API函数。在这篇文章中,我将介绍 使用两种方法改变Windows的显示模式。 要改变显示模式,首先要获得显示系统支持的显示模式。显示系统支持的所有的显示模式是利用API函数 EnumDisplaySettings获得的。然后有两种方法切换显示模式,一种是利用Windows API函数ChangeDisplaySettings 另外一种方法是利用Windows附带的一个QuickRES库,通过调用QuickRES库实现显示模式的切换。 首先在VB中建立一个工程文件,然后在Form1中加入一个ListBox控件和两个CommandButton控件,然后在Form1 的代码窗口中加入以下代码: Option Explicit Private Type RECT Left As Long Top As Long Right As Long Bottom 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 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 Type Const DM_BITSPERPEL = &H40000 Const DM_PELSWIDTH = &H80000 Const DM_PELSHEIGHT = &H100000 Const DM_DISPLAYFLAGS = &H200000 Const DM_DISPLAYFREQUENCY = &H400000 Const 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 = -5 Const CDS_UPDATEREGISTRY = 1 Const CDS_FORCE As Long = &H80000000 Const CDS_RESET = &H40000000 Const HWND_BROADCAST = &HFFFF& Const WM_SYSCOLORCHANGE = &H15 Const WM_PALETTECHANGED = &H311 Const WM_DISPLAYCHANGE = &H7E Const WM_SETTINGCHANGE = &H1A Dim ModeCube(63) As DEVMODE Dim lproc As Long Sub EndApp() Icon_Del (Form1.Command1.hwnd) End End Sub Sub ShowIcon() Dim l As Long If (Icon_Add(Form1.Command1.hwnd, Form1.Picture)) Then lproc = SetWindowLong(Form1.Command1.hwnd, GWL_WNDPROC, AddressOf DialogProc) Else MsgBox ("无法建立程序图标!") End End If End Sub Sub LoadDisplayMode() Dim i As Long Dim l1 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)) '获得显示模式并保存到数组中 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 4 astr = astr + "16色" Case 8 astr = astr + "256色" Case 16 astr = astr + "16位高彩" Case 24 astr = astr + "24位真彩" Case Else astr = astr + Str$(ModeCube(i).dmBitsPerPel) End Select i = i + 1 End If List1.AddItem astr Loop Until (l1 = False) '获得最后一个显示模式之后EnumDisplaySettings会返回False End Sub Private Sub Command1_Click() Dim aDev As DEVMODE Dim b, xxa, xxb, xxc, xxd As Long If List1.ListIndex < 0 Then Exit Sub aDev = ModeCube(List1.ListIndex) 'CDS_FORCE在Microsoft的开发文档中没有说明 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 Command2_Click() Dim aDev As DEVMODE Dim tempVar As String Dim RetVal Dim shellString As String If List1.ListIndex < 0 Then Exit Sub aDev = ModeCube(List1.ListIndex) tempVar = LTrim$(Str(aDev.dmPelsWidth)) + "x" + LTrim$(Str(aDev.dmPelsHeight)) + _ "x" + LTrim$(Str(aDev.dmBitsPerPel)) Debug.Print tempVar shellString = "Rundll.exe DeskCp16.dll,QUICKRES_RUNDLLENTRY " shellString = shellString + tempVar '调用Windows中的QuickRes库来改变显示模式,如果你的系统中没有安装QuickRes '系统将会产生一个错误 RetVal = Shell(shellString, 1) End Sub Private Sub Form_Load() Command1.Caption = "使用API函数改变分辨率" Command2.Caption = "使用QuickRes库" LoadDisplayMode End Sub 运行程序,点击选择ListBox中的显示模式,然后按下“使用API函数改变分辨率”键或者“使用QuickRes库” 键,就可以切换显示模式到所需要的模式了。 需要说明的一点是,在程序中的改变显示模式的语句 b = ChangeDisplaySettings(aDev, CDS_FORCE) 中的常量 CDS_FORCE是一个未公开(UnDocument)的定义,在微软的帮助文档是没有有关的说明的。 以上的程序在Win98、VB6下运行通过。