求助，win7下设置颜色黑屏
网上找的设置显示颜色等，现在只设置到16位色，xp及vista下通过，win7下黑屏、重启，求win7如何通过？
注：调用change()即设置至16位,返回1成功，0失败
-------------------------------------------------------------------------
'设置屏幕分辨率、颜色位数、刷新率
'////////////////////////////////
'//
'//griefforyou收集整理
'//
'////////////////////////////////
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
Private Const CCDEVICENAME As Long = 32
Private Const CCFORMNAME As Long = 32
Private Const DM_BITSPERPEL As Long = &H40000
Private Const DM_PELSWIDTH As Long = &H80000
Private Const DM_PELSHEIGHT As Long = &H100000
Private Const DM_DISPLAYFLAGS As Long = &H200000
Private Const DM_DISPLAYFREQUENCY = &H400000
Private Const CDS_FORCE As Long = &H80000000
Private Const BITSPIXEL As Long = 12
Private Const HORZRES As Long = 8
Private Const VERTRES As Long = 10
Private Const VREFRESH = 116
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
Public Function change() As Integer
On Error GoTo aaa
Dim DM As DEVMODE
With DM
'.dmPelsWidth = CInt(txtNewWidth.Text)
'.dmPelsHeight = CInt(txtNewHeight.Text)
.dmBitsPerPel = CInt(16)
'.dmDisplayFrequency = CInt(txtNewFreq.Text)
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL Or DM_DISPLAYFREQUENCY
.dmSize = LenB(DM)
End With
If ChangeDisplaySettings(DM, CDS_FORCE) <> 0 Then
change = 0
Else
change = 1
End If
Exit Function
aaa:
change = 0
End Function
' txtOldWidth.Text = GetDeviceCaps(Me.hdc, HORZRES)
' txtOldHeight.Text = GetDeviceCaps(Me.hdc, VERTRES)
' txtOldColor.Text = GetDeviceCaps(Me.hdc, BITSPIXEL)
' txtOldFreq.Text = GetDeviceCaps(Me.hdc, VREFRESH)
[解决办法]
有bug
[解决办法]
。。。
如何修改？
[解决办法]
坐等答案