VB动态改变显示分辨率和色深

在vb.net中，我们很容易获得显示器的分辩率，但是，要改变显示器的分辩率就比较麻烦了。由于.net的类库没有将enumdisplaysettings 和ChangeDisplaySettings这两个API函数进行封装，但是我们得调用它们函数，相对于VB6来说，VB.NET调用API函数是有一些小的改动！

下面，我们就尝试一下在vb.net中，使用这两个api函数。

新建一个项目，在form1上添加两个按钮，一个名为btngetdisp，将其text属性设置为“得到分辩率”；另一个按钮名为btnsetdisp，text属性为“设置分辩率”。然后在代码窗口里添加以下代码：

private Const CCDEVICENAME As Short = 32

private Const CCFORMNAME As Short = 32

private Const DM_PELSWIDTH As Integer = &H80000

private Const DM_PELSHEIGHT As Integer = &H100000

'刷新频率常量

private Const DM_DISPLAYFREQUENCY As Integer = &H400000

'调用API函数

private Declare Function EnumDisplaySettings Lib "user32" Alias 
"EnumDisplaySettingsA" (ByVal lpszDeviceName As Integer, 
ByVal iModeNum As Integer, ByRef lpDevMode As DEVMODE) As Boolean

'调用api函数

private Declare Function ChangeDisplaySettings Lib "user32" Alias 
"ChangeDisplaySettingsA" (ByRef lpDevMode As DEVMODE, 
ByVal dwflags As Integer) As Integer

'定义结构

private Structure DEVMODE

Public dmDeviceName As String

dim dmSpecVersion As Short

dim dmDriverVersion As Short

dim dmSize As Short

dim dmDriverExtra As Short

dim dmFields As Integer

dim dmOrientation As Short

dim dmPaperSize As Short

dim dmPaperLength As Short

dim dmPaperWidth As Short

dim dmScale As Short

dim dmCopies As Short

dim dmDefaultSource As Short

dim dmPrintQuality As Short

dim dmColor As Short

dim dmDuplex As Short

dim dmYResolution As Short

dim dmTTOption As Short

dim dmCollate As Short

Public dmFormName As String

dim dmUnusedPadding As Short

dim dmBitsPerPel As Short

dim dmPelsWidth As Integer

dim dmPelsHeight As Integer

dim dmDisplayFlags As Integer

dim dmDisplayFrequency As Integer

end Structure

'改变分辩率过程，参数一宽度，参数二高度

private Sub ChangeDisp(ByRef iWidth As Single, ByRef iHeight As Single)

dim blnWorked As Boolean

dim i As Integer

dim DevM As Form1.DEVMODE

i = 0

do

blnworked = EnumDisplaySettings(0, i, DevM)

i = i + 1

loop Until (blnWorked = False)

with DevM

.dmfields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_DISPLAYFREQUENCY

.dmpelswidth = iWidth

.dmpelsheight = iHeight

'刷新频率为85
VB动态改变显示分辨率和色深
.dmdisplayfrequency = 85 

end With

call ChangeDisplaySettings(DevM, 0)

end Sub

private Sub btnGetDisp_Click(ByVal sender As System.Object, 
ByVal e As System.EventArgs) Handles btnGetDisp.Click

dim X As Short = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width

dim Y As Short = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height

msgbox("您的显示器分辨率是" & X & " X " & Y)

end Sub

private Sub btnSetDisp_Click(ByVal sender As System.Object, 
ByVal e As System.EventArgs) Handles btnSetDisp.Click

if MsgBox("您确认要将显示器分辨率改为1024x768吗？", MsgBoxStyle.OKCancel, 
"系统消息") = MsgBoxResult.OK Then

'调用改变分辩率过程

changedisp(1024, 768)

end If

end Sub

程序运行如下图所示，点击设置分辩率，将会把显示器分辨率改为1024x768，刷新频率为85，是不是很简单？

唉,看来还是得把代码写出来:  
   
  先打开孟子的那篇文章,  
  在声明常数那里加上:  
  public   const   int   DM_BITSPERPEL   =   0x40000;  
   
  在ChangeRes()方法里设置色深为32位,如果修改为16位自己改变:  
  dm.dmBitsPerPel   =   32;  
   
  还需要修改这一行:  
  dm.dmFields   =   DEVMODE.DM_PELSWIDTH   |   DEVMODE.DM_PELSHEIGHT   |   DEVMODE.DM_BITSPERPEL   |   DEVMODE.DM_DISPLAYFREQUENCY;  
   
  这样就可以了.如果楼主还搞不定再给我发短信息,我再把全部代码贴过来.

Private Declare Function lstrcpy _
Lib "kernel32" Alias "lstrcpyA" _
(lpString1 As Any, lpString2 As Any) _
As Long
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
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 Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Declare Function _
ChangeDisplaySettings Lib _
"User32" Alias "ChangeDisplaySettingsA" (_
ByVal lpDevMode As Long, _
ByVal dwflags As Long) As Long
'- 函数
Public Function SetDisplayMode(Width As _
Integer,Height As Integer, Color As _
Integer) As Long
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_BITSPERPEL = &H40000
Dim NewDevMode As DEVMODE
Dim pDevmode As Long
With NewDevMode
.dmSize = 122
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, 0)
End Function
例子调用：改变为 640x480x24位： VB动态改变显示分辨率和色深
i = SetDisplayMode(640, 480, 24)
如果成功返回 0 。