台灣最大程式設計社群網站
線上人數
2063
 
會員總數:245250
討論主題:189110
歡迎您免費加入會員
討論區列表 >> VB6 >> 求救~ 還原螢幕顏色數
[]  
[我要回覆]
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
求救~ 還原螢幕顏色數
價值 : 10 QP  點閱數:1597 回應數:0

樓主

小邦
門外漢
0 3
107 17
發送站內信

捐贈 VP 給 小邦
早前上網找了個變更螢幕解析度與顏色數
我試運行時 顏色數 減了不知多少. 就說溢位了
還沒有復原就結束了 -_-
但顏色數只有減. 沒有加~~
現在的螢幕黑漆漆的 -.-

一個Command1(CommandBox),VS1(VScrollBar),HS1(HScrollBar),Label1,Label2
表單:
Option Explicit
Dim Ramp1(0 To 255, 0 To 2) As Integer
Dim Ramp2(0 To 255, 0 To 2) As Integer
Dim ResCBData() As String
Dim nowResCBData As String
Dim ScreenHDC As Long

Private Sub Command1_Click()
Dim temp() As String
Dim ret As Long
Dim b As Boolean
Dim devm As DEVMODE
Dim scInfo As Long
Dim erg As Long
ret = MsgBox("確定要變更螢幕解析度與顏色數嗎?因為隨意改變將有可能導致螢幕燒毀!", vbQuestion + vbYesNo, "藍騎螢幕調整程式")
If ret = vbYes Then
temp() = Split(ResCBData(HS1.Value), "x")
b = EnumDisplaySettings(0, 0, devm)
devm.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
devm.dmPelsWidth = Val(temp(0))
devm.dmPelsHeight = Val(temp(1))
devm.dmBitsPerPel = Val(Replace(temp(2), "bits", ""))
erg = ChangeDisplaySettings(devm, CDS_TEST)
If erg = DISP_CHANGE_SUCCESSFUL Then
erg = ChangeDisplaySettings(devm, CDS_UPDATEREGISTRY)
scInfo = devm.dmPelsHeight * 2 ^ 16 + devm.dmPelsWidth
SendMessage HWND_BROADCAST, WM_DISPLAYCHANGE, ByVal devm.dmBitsPerPel, ByVal scInfo
End If
End If

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
Unload Me
End If
End Sub

Private Sub Form_Load()
Dim devm As DEVMODE
ScreenHDC = GetDC(0)
GetDeviceGammaRamp ScreenHDC, Ramp1(0, 0)
Call EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, devm)
nowResCBData = CStr(devm.dmPelsWidth) + "x" + CStr(devm.dmPelsHeight) + "x" + CStr(devm.dmBitsPerPel) + "bits"
Call EnumDisplay
End Sub

Private Sub Form_Unload(Cancel As Integer)
SetDeviceGammaRamp ScreenHDC, Ramp1(0, 0)
End Sub
Private Sub EnumDisplay()
Dim devm As DEVMODE
Dim ret As Boolean
Dim i As Integer, j As Integer
Do
ret = EnumDisplaySettings(0&, i, devm)
If ret = False Then Exit Do
ReDim Preserve ResCBData(i)
ResCBData(i) = CStr(devm.dmPelsWidth) + "x" + CStr(devm.dmPelsHeight) + "x" + CStr(devm.dmBitsPerPel) + "bits"
If ResCBData(i) = nowResCBData Then
j = i
End If
i = i + 1
Loop
HS1.Min = 0
HS1.Max = i - 1
HS1.Value = j
Label2.Caption = ResCBData(j)
End Sub

Private Sub HS1_Change()
Label2.Caption = ResCBData(HS1.Value)
End Sub

Private Sub VS1_Change()
Dim VSL As Integer, i As Integer
VSL = VS1.Value
intRed = -VSL
intGreen = -VSL
intBlue = -VSL

Label1.Caption = CStr(-VSL)
For i = 0 To 255
If intRed < 0 Then Ramp2(i, 0) = ConvToSignedValue(ConvToUnSignedValue(Ramp1(i, 0)) * (100 - Abs(intRed)) / 100)
If intRed = 0 Then Ramp2(i, 0) = Ramp1(i, 0)
If intRed > 0 Then Ramp2(i, 0) = ConvToSignedValue(65535 - ((65535 - ConvToUnSignedValue(Ramp1(i, 0))) * (100 - intRed) / 100))


If intGreen < 0 Then Ramp2(i, 1) = ConvToSignedValue(ConvToUnSignedValue(Ramp1(i, 1)) * (100 - Abs(intGreen)) / 100)
If intGreen = 0 Then Ramp2(i, 1) = Ramp1(i, 1)
If intGreen > 0 Then Ramp2(i, 1) = ConvToSignedValue(65535 - ((65535 - ConvToUnSignedValue(Ramp1(i, 1))) * (100 - intGreen) / 100))


If intBlue < 0 Then Ramp2(i, 2) = ConvToSignedValue(ConvToUnSignedValue(Ramp1(i, 2)) * (100 - Abs(intBlue)) / 100)
If intBlue = 0 Then Ramp2(i, 2) = Ramp1(i, 2)
If intBlue > 0 Then Ramp2(i, 2) = ConvToSignedValue(65535 - ((65535 - ConvToUnSignedValue(Ramp1(i, 2))) * (100 - intBlue) / 100))
Next i
SetDeviceGammaRamp ScreenHDC, Ramp2(0, 0)
End Sub
Private Function ConvToSignedValue(lngValue As Long) As Integer
'This was written by the same person who did the "updateGamma" code
If lngValue <= 32767 Then
ConvToSignedValue = CInt(lngValue)
Exit Function
End If
ConvToSignedValue = CInt(lngValue - 65535)
End Function
Private Function ConvToUnSignedValue(intValue As Integer) As Long
'This was written by the same person who did the "updateGamma" code
If intValue >= 0 Then
ConvToUnSignedValue = intValue
Exit Function
End If
ConvToUnSignedValue = intValue + 65535
End Function



模組:
Public Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Public Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long

Public Declare Function GetDeviceGammaRamp Lib "gdi32" (ByVal hdc As Long, lpv As Any) As Long
Public Declare Function SetDeviceGammaRamp Lib "gdi32" (ByVal hdc As Long, lpv As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public intRed As Integer
Public intGreen As Integer
Public intBlue As Integer
Public Const CCDEVICENAME = 32
Public Const CCFORMNAME = 32
Public Const ENUM_CURRENT_SETTINGS As Long = -1&
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const CDS_UPDATEREGISTRY = &H1
Public Const CDS_TEST = &H4
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1

Public 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 Const WM_DISPLAYCHANGE = &H7E
Public Const HWND_BROADCAST = &HFFFF&
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Function Int2Lng(IntVal As Integer) As Long
'----------------------------------------------------------------
CopyMemory Int2Lng, IntVal, 2
'----------------------------------------------------------------
End Function
Public Function Lng2Int(Value As Long) As Integer
'----------------------------------------------------------------
CopyMemory Lng2Int, Value, 2
'----------------------------------------------------------------
End Function

搜尋相關Tags的文章: [ 螢幕 ] , [ 顏色數 ] , [ 解析度 ] ,
本篇文章發表於2010-06-09 14:14
別忘捐VP感謝幫助你的人 新手會員瞧一瞧
目前尚無任何回覆
   

回覆
如要回應,請先登入.