VB利用API函數設定屏幕顏色數

2019-11-17 05:07:05

字體：大中小

來源：轉載

供稿：網友

　　原則上，只改這一次，下一次開機會還原，但假如需重開機，才會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

　　

推薦文章：搞笑之可愛水果表情　　清新素潔水仙壁紙集

上一篇：水滴石穿C語言之正確使用const

下一篇：多層結構連接方式選擇的分析