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



LVL 23
gecko_au2003Asked:
Who is Participating?
 
LostieConnect With a Mentor Commented:
0
 
Erick37Connect With a Mentor Commented:
The code you pointed to uses MIN to mahe sure the value does not go above 65535.  I made the calculation using a Double, then converted to a Long, then used LOWORD to make it an Integer.  CInt() will not work because numbers are signed in VB and integers are limited to +32767.

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Function LOWORD(ByVal dw As Long) As Integer
    Call CopyMemory(LOWORD, dw, 2)
End Function


Private Sub SetGamma(Gamma As Double)
    Dim Ramp(0 To 255, 0 To 2) As Integer
    Dim dblTest As Double
    Dim nVal As Long
    Dim I As Integer
   
        For I = 0 To 255
            dblTest = (((I + 1) / 256.01) ^ Gamma) * 65535 + 0.5
           
            If dblTest > 65535 Then
                nVal = 65535
            Else
                nVal = CLng(dblTest)
            End If
           
            Debug.Print nVal
           
            'set the Low Word (2 bytes)
            Ramp(I, 0) = LOWORD(nVal)
            Ramp(I, 1) = LOWORD(nVal)
            Ramp(I, 2) = LOWORD(nVal)
        Next I
   
        'SetDeviceGammaRamp GetDC(0), Ramp(0, 0)
End Sub
0
 
gecko_au2003Author Commented:
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
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
gecko_au2003Author Commented:
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 ?
0
 
gecko_au2003Author Commented:
sorry for all the posts ! However do you want me to post them as a new question :) And go from there ?
0
 
Erick37Commented:
I've gotta run out for the weekend.  I'll take a look again on Monday.
0
 
gecko_au2003Author Commented:
ok Erick, np ! Thank you for the help !
0
 
LostieCommented:
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 ####################################
0
 
gecko_au2003Author Commented:
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 !
0
 
LostieCommented:
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 :-)
0
 
gecko_au2003Author Commented:
Any chance you can give me the updated code so that I can do the same :) If that is ok :)
0
 
gecko_au2003Author Commented:
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 !!!
0
 
LostieCommented:
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...
0
 
gecko_au2003Author Commented:
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 !
0
All Courses

From novice to tech pro — start learning today.