Link to home
Start Free TrialLog in
Avatar of Shane Russell
Shane RussellFlag for United Kingdom of Great Britain and Northern Ireland

asked on

SetDeviceGammaRamp - I want to make an application like the one from code project without the errors !

I found this example here :

http://www.codeproject.com/miscctrl/gamma_manager.asp

but I get Run Time Error 6 - Over Flow on this function :

Private Sub SetGamma(Gamma As Double)
Dim Ramp(0 To 255, 0 To 2) As Integer
Dim nVal As Integer
Dim I As Integer

    For I = 0 To 255
        nVal = Lng2Int((((I + 1) / 256.01) ^ Gamma) * 65535 + 0.5)  '<-- It highlights this line of code
        Ramp(I, 0) = nVal
        Ramp(I, 1) = nVal
        Ramp(I, 2) = nVal
    Next I

    SetDeviceGammaRamp GetDC(0), Ramp(0, 0)
End Sub

Can someone either help me fix the error for SetDeviceGammaRamp in the code project example or help me make a new vb application to set the Gama Ramp using that API.

I WOULD REALLY Prefer help to start a new application so that I can use a slider control without the control that they have included in that project.

Unless someone knows a better way of altering the screens brightness  ??

Thanks and kind regards

Gecko



SOLUTION
Avatar of Erick37
Erick37
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Shane Russell

ASKER

ok that works but how do I get it to keep the setting that I set because as soon as I unload the form it restores it back to what it was ? Do I take that statement out of the Form_UnLoad or will that mess things up
also is there a way to take that visual basic class module aka the control out and still be able to achieve altering the gama ramp so that it alters the screens brightness ?
sorry for all the posts ! However do you want me to post them as a new question :) And go from there ?
I've gotta run out for the weekend.  I'll take a look again on Monday.
ok Erick, np ! Thank you for the help !
Avatar of Lostie
Lostie

I've modified the class quite a bit to remove dependancy on the slider control (so it can be used standalone), and made it a bit easier for you to understand (hopefully!).
It includes Erik37's excellent Integer fix, so be sure to give him points :)
Here is a quick example of how to use it - put this code on a form or something:

Dim oGamma As New clsGamma
oGamma.RESTORE_ON_EXIT = False '### This defaults to True, if you set it to False then it won't restore your original gamma on exit!!!
MsgBox oGamma.GetSavedGamma '### You can use this number if you want to save your current Gamma settings or something.
oGamma.SetGamma 37.5 '### Value ranges from 0 (darkest) to 37.5 (brightest)
MsgBox "OK!"
oGamma.RestoreGamma '### Restore your original gamma, not needed if RESTORE_ON_EXIT is set to True.
Set oGamma = Nothing

Now for the main class code, paste the following into a new class, and call it "clsGamma".

'### Begin clsGamma code ##################################
Option Explicit

Private Declare Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetDeviceGammaRamp Lib "GDI32.dll" (ByVal hDc As Long, lpV As Any) As Long
Private Declare Function SetDeviceGammaRamp Lib "GDI32.dll" (ByVal hDc As Long, lpV As Any) As Long
Private Declare Function GetDC Lib "User32.dll" (ByVal hWnd As Long) As Long

Private arrGammaSave(0 To 255, 0 To 2) As Integer
Private bGammaSaved As Boolean
Private bRestoreOnExit As Boolean
Private MIN_POS As Long
Private MAX_POS As Long
Private POS_FACTOR As Long

Public Property Let MIN(ByVal lValue As Long)
    MIN_POS = lValue
End Property
Public Property Let MAX(ByVal lValue As Long)
    MAX_POS = lValue
End Property
Public Property Let RESTORE_ON_EXIT(ByVal bValue As Boolean)
    bRestoreOnExit = bValue
End Property

Private Sub Class_Initialize()
    If Not GetDeviceGammaRamp(GetDC(0), arrGammaSave(0, 0)) = 0 Then
        bGammaSaved = True '### Safety check
        '### Set class defaults here ###
        MIN_POS = 0
        MAX_POS = 40
        POS_FACTOR = 10.01
        bRestoreOnExit = True
        '### End defaults ###
    Else
        bGammaSaved = False
    End If
End Sub
Private Sub Class_Terminate()
    If bRestoreOnExit = True And bGammaSaved = True Then SetDeviceGammaRamp GetDC(0), arrGammaSave(0, 0)
End Sub

Public Sub RestoreGamma()
    If bGammaSaved = True Then SetDeviceGammaRamp GetDC(0), arrGammaSave(0, 0)
End Sub
Public Function SetGamma(dValue As Double)
    If bGammaSaved = False Then Exit Function
    SetGammaPos ((MAX_POS - dValue) / POS_FACTOR)
End Function
Public Function GetSavedGamma() As Integer
    If bGammaSaved = False Then Exit Function
    GetSavedGamma = GetGammaPos()
End Function

Private Sub SetGammaPos(Gamma As Double)
    If bGammaSaved = False Then Exit Sub
    Dim arrRamp(0 To 255, 0 To 2) As Integer
    Dim dblTest As Double
    Dim l As Long
    Dim i As Integer
    For i = 0 To 255
        dblTest = (((i + 1) / 256.01) ^ Gamma) * 65535 + 0.5
        If dblTest > 65535 Then
            l = 65535
        Else
            l = CLng(dblTest)
        End If
        '### Set the Low Word (2 bytes).
        arrRamp(i, 0) = LOWORD(l)
        arrRamp(i, 1) = LOWORD(l)
        arrRamp(i, 2) = LOWORD(l)
    Next i
    SetDeviceGammaRamp GetDC(0), arrRamp(0, 0)
End Sub
Private Function GetGammaPos() As Integer
    If bGammaSaved = False Then Exit Function
    On Error Resume Next
    Dim rgb(2) As Double
    Dim i As Integer
    Dim j As Integer
    rgb(0) = 1.01
    rgb(1) = 1.01
    rgb(2) = 1.01
    For i = 0 To 2
        Dim Csum As Double
        Dim Ccount As Integer
        Csum = 0
        Ccount = 0
        For j = 0 To 255
            If j <> 0 And arrGammaSave(j, i) <> 0 And arrGammaSave(j, i) <> 65536 Then
                Dim a As Double
                Dim b As Double
                Dim c As Double
                b = (j Mod 256) / 256.01
                a = arrGammaSave(j, i) / 65536.01
                c = Log(a) / Log(b)
                Csum = Csum + c
                Ccount = Ccount + 1
            End If
        Next j
        rgb(i) = Csum / Ccount
    Next i
    GetGammaPos = Int(MAX_POS - (rgb(0) * POS_FACTOR))
End Function
Private Function LOWORD(ByVal lng As Long) As Integer
    CopyMemory LOWORD, lng, 2
End Function
'### End clsGamma code ####################################
It says on this line of code :

Dim oGamma As New clsGamma

User defined type Not Defined ? What am I missing, was I supposed to insert this into the code I already have or something ?

BTW I was going to either award Erick points or split them depending on what happend, and obviously you are helping me with this now so I will split points !

I really liked ericks integer fix, that was shear genius !
Sorry I should have made it more clear - the above code is for a *NEW* VB application project, has nothing to do with the previous code - it is standalone - and so does not depend on that slider control at all :) So do the following:

1) Open up VB6, -> new standard exe.
2) Add a new "class module" file, and ensure you name it "clsGamma" (the name property).
3) Paste my code above (ONLY the stuff below ### Begin clsGamma code ### !!) into that new class file.
4) You have a new form called Form1, add the following to it's "Form_Load()" sub:
'---
Dim oGamma As New clsGamma '### If you have trouble with Step 1, then change this to: Dim oGamma As New Class1
oGamma.RESTORE_ON_EXIT = True '### Feel free to experiment with this.
MsgBox oGamma.GetSavedGamma '### And this!
oGamma.SetGamma 37.5 '### Value ranges from 0 (darkest) to 37.5 (brightest).
MsgBox "Press OK to restore original gamma!"
'oGamma.RestoreGamma '### Restore your original gamma, not needed if RESTORE_ON_EXIT is set to True.
Set oGamma = Nothing
'---
5) Hit play in VB6, and watch your screen go very bright :-)

In fact I should thank YOU for bringing this code to my attention, I have just modified the code to bind to a windows "hot key", so I can change GAMMA in any game I'm playing with simple keyboard combination :-)
Any chance you can give me the updated code so that I can do the same :) If that is ok :)
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Is there anyway to make it lighter or darker or is 0 and 37.5 the lightest and darkest you can go with this gamma ? Other then that I will split points between you and Erick !!!
I don't think so, no (though I could be wrong).
I had a play with some values but could not get it any darker or brighter, no matter what values were used...
I just really want to say thanks to both of you for all the help ! Even though Erick had to go for the weekend I split points between you 2 :) Good job experts, keep it up !