?
Solved

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

Posted on 2005-03-26
14
Medium Priority
?
1,273 Views
Last Modified: 2008-01-09
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



0
Comment
Question by:gecko_au2003
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 4
  • 2
14 Comments
 
LVL 32

Assisted Solution

by:Erick37
Erick37 earned 800 total points
ID: 13636126
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
 
LVL 23

Author Comment

by:gecko_au2003
ID: 13636138
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
 
LVL 23

Author Comment

by:gecko_au2003
ID: 13636139
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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 23

Author Comment

by:gecko_au2003
ID: 13636147
sorry for all the posts ! However do you want me to post them as a new question :) And go from there ?
0
 
LVL 32

Expert Comment

by:Erick37
ID: 13636182
I've gotta run out for the weekend.  I'll take a look again on Monday.
0
 
LVL 23

Author Comment

by:gecko_au2003
ID: 13636195
ok Erick, np ! Thank you for the help !
0
 
LVL 1

Expert Comment

by:Lostie
ID: 13637684
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
 
LVL 23

Author Comment

by:gecko_au2003
ID: 13637727
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
 
LVL 1

Expert Comment

by:Lostie
ID: 13638076
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
 
LVL 23

Author Comment

by:gecko_au2003
ID: 13638516
Any chance you can give me the updated code so that I can do the same :) If that is ok :)
0
 
LVL 1

Accepted Solution

by:
Lostie earned 1200 total points
ID: 13638727
0
 
LVL 23

Author Comment

by:gecko_au2003
ID: 13638733
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
 
LVL 1

Expert Comment

by:Lostie
ID: 13638745
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
 
LVL 23

Author Comment

by:gecko_au2003
ID: 13638773
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

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses
Course of the Month9 days, 9 hours left to enroll

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question