VB利用API函数设定屏幕颜色数

　　原则上，只改这一次，下一次开机会还原，但假如需重开机，才会Update Registry中的设定，并重开机。

　　假如要永久设定其设定值，请将

　　

　　b = ChangeDisplaySettings(DevM, 0)

　　改成

　　

　　b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)

　　注：

　　DevM.dmBitsPerPel 便是设定颜色数，其实应说每个Pixel要多少Bits来显示

　　4 --> 16色

　　　　8 --> 256色

　　　　16 --> 65536色以此类推

　　

推荐文章：搞笑之可爱水果表情　　清新素洁水仙壁纸集

　　Option EXPlicit

　　Private Declare Function EnumDisplaySettings Lib "user32" Alias _

　　"EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, _

　　ByVal iModeNum As Long, lpDevMode As Any) As Long

　　

　　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

　　

　　Const EWX_REBOOT = 2 ’ 重开机

　　Const CCDEVICENAME = 32

　　Const CCFORMNAME = 32

　　

　　Const DM_BITSPERPEL = &H40000

　　Const DISP_CHANGE_SUCCESSFUL = 0

　　Const DISP_CHANGE_RESTART = 1

　　Const CDS_UPDATEREGISTRY = 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

　　Private DevM As DEVMODE

　　Private Sub Command1_Click()

　　Dim a As Boolean

　　Dim i As Long

　　Dim b As Long

　　Dim ans As Long

　　a = EnumDisplaySettings(0, 0, DevM) ’Initial Setting

　　DevM.dmBitsPerPel = 8 ’设定成256色

　　DevM.dmFields = DM_BITSPERPEL

　　b = ChangeDisplaySettings(DevM, 0)

　　If b = DISP_CHANGE_RESTART Then

　　　ans = MsgBox("要重开机设定才能完成，重开？", vbOKCancel)

　　　If ans = 1 Then

　　　　b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)

　　　　Call ExitWindowsEx(EWX_REBOOT, 0)

　　　End If

　　Else

　　　If b <> DISP_CHANGE_SUCCESSFUL Then

　　　　Call MsgBox("设定有误", vbCritical)

　　　End If

　　End If

　　End Sub

　　

推荐文章：搞笑之可爱水果表情　　清新素洁水仙壁纸集