请问如何在VB程序中修改分辨率？？

[LiaoCheng]

我现在的是1024*768,但是我的程序是在800*600下运行的，
我想在我的程序运行时自动将分辨率设为800*600
退出后自动还原成原来的分辨率。
请各位高手指教，多谢!!!

[dbcontrols]

Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, 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 CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const CDS_UPDATEREGISTRY = &H1
Private Const CDS_TEST = &H4
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1
Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
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 * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
'Example

Private Sub Form_Load()

'Changes the resolution to 640x480 with the current colordepth.

Dim DevM As DEVMODE '注释：Get the info into
DevMerg& = EnumDisplaySettings(0&, 0&, DevM) '注释：We don't change the colordepth, because a reboot will be necessary
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
DevM.dmPelsWidth = 800 'ScreenWidth
DevM.dmPelsHeight = 600 'ScreenHeight
DevM.dmBitsPerPel = 8 '(could be 8, 16, 32 or even 4)
'Now change the display and check if possible
erg& = ChangeDisplaySettings(DevM, CDS_TEST)
'Check if succesfull
Select Case erg&
Case DISP_CHANGE_RESTART
an = MsgBox("You：ve to reboot", vbYesNo + vbSystemModal, "Info")
If an = vbYes Then
erg& = ExitWindowsEx(EWX_REBOOT, 0&)
End If
Case DISP_CHANGE_SUCCESSFUL
erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
MsgBox "Everythings ok", vbOKOnly + vbSystemModal, "It worked!"
Case Else
MsgBox "Mode not supported", vbOKOnly + vbSystemModal, "Error"
End Select
End Sub

[LiaoCheng]

多谢dbcontrols(泰山)　
我先试试看

[LiaoCheng]

dbcontrols(泰山)　：
请说明一下具体的用法。

[LiaoCheng]

UPUPUPUP~~~~~~~~~~~

[Samurai]

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
(lpString1 As Any, _
lpString2 As Any _
) As Long
Private Declare Function ChangeDisplaySettings Lib "User32" Alias "ChangeDisplaySettingsA" _
(ByVal lpDevMode As Long, _
ByVal dwflags As Long _
) 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
' 动态改变屏幕设置的函数
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


Private Sub Command1_Click()
'例子调用：改变为 640x480x24位：
Dim i As Long
i = SetDisplayMode(640, 480, 24)
End Sub

setdisplaymode有3个参数，width为屏幕的宽度，height为屏幕的高度，color为屏幕的颜色，例如要改为640x480x24位则
Dim i As Long
i = SetDisplayMode(640, 480, 24)
调用后，不需重新启动计算机，屏幕的设置会自动改变！
ok！

[LiaoCheng]

to:
Samurai(魂
好像不会改变，我的系统是windows2000server,为什么？

[yuanxy]

好贴

[ByTheWay]

g~z

[LiaoCheng]

帮忙顶一下~~~~~~

[LiaoCheng]

to dbcontrols(泰山)　
难道你的程序从来不要 “Option Explicit ”这句嘛
这段程序把color改成256色了，本来是增强16位的
分等下给你

[LiaoCheng]

多谢
dbcontrols(泰山)
结账了!!!

[dbcontrols]

DevM.dmBitsPerPel = 8 '(could be 8, 16, 32 or even 4)
这句改变分辨率

[dbcontrols]

是颜色
Option Explicit 是强调声明变量的,我很少用.

[dbcontrols]

新建一个工程,窗体,把代码
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, 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 CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const CDS_UPDATEREGISTRY = &H1
Private Const CDS_TEST = &H4
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1
Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
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 * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
'Example


拷贝进去,在Form_Load里面
Dim DevM As DEVMODE '注释：Get the info into
DevMerg& = EnumDisplaySettings(0&, 0&, DevM) '注释：We don't change the colordepth, because a reboot will be necessary
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
DevM.dmPelsWidth = 800 'ScreenWidth
DevM.dmPelsHeight = 600 'ScreenHeight
DevM.dmBitsPerPel = 8 '(could be 8, 16, 32 or even 4)
'Now change the display and check if possible
erg& = ChangeDisplaySettings(DevM, CDS_TEST)
'Check if succesfull
Select Case erg&
Case DISP_CHANGE_RESTART
an = MsgBox("You：ve to reboot", vbYesNo + vbSystemModal, "Info")
If an = vbYes Then
erg& = ExitWindowsEx(EWX_REBOOT, 0&)
End If
Case DISP_CHANGE_SUCCESSFUL
erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
Case Else
End Select

在Form_UnLoad里面
Dim DevM As DEVMODE '注释：Get the info into
DevMerg& = EnumDisplaySettings(0&, 0&, DevM) '注释：We don't change the colordepth, because a reboot will be necessary
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
DevM.dmPelsWidth = 1024 'ScreenWidth
DevM.dmPelsHeight = 768 'ScreenHeight
DevM.dmBitsPerPel = 8 '(could be 8, 16, 32 or even 4)
'Now change the display and check if possible
erg& = ChangeDisplaySettings(DevM, CDS_TEST)
'Check if succesfull
Select Case erg&
Case DISP_CHANGE_RESTART
an = MsgBox("You：ve to reboot", vbYesNo + vbSystemModal, "Info")
If an = vbYes Then
erg& = ExitWindowsEx(EWX_REBOOT, 0&)
End If
Case DISP_CHANGE_SUCCESSFUL
erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
Case Else
End Select
可以结贴给分了,我要120