Changer le gamma de votre écran....

Soyez le premier à donner votre avis sur cette source.

Snippet vu 3 114 fois - Téléchargée 37 fois

Contenu du snippet

Bonjour à tous...
Voici une source pour changer le gamma de votre écran. Ne me demandez pas a quoi cela peut servir, je n'en sais rien. J'ai simplement essayé les apis.
Si vous trouvez une utilité, signalez moi.

Creez un form, avec 4 boutons ( command1, command2, command3, command4)
Nommez les respectivement "Augmenter gamma", "Diminuer gamma", "Restaurer" et "Quitter"

Voila, reste plus qua tester

Note : evitez de changer le gama, puis d'eteindre l'appli avec le "stop" de VB, mais par le bouton unload.

Source / Exemple :


Option Explicit         'Declaration de variales ( array ), et des apis pour avoir le gamma, le changer.
Private abc1(0 To 255, 0 To 2) As Integer
Private abc2(0 To 255, 0 To 2) As Integer
Dim a As Integer, b As Integer
Private Declare Function GetDeviceGammaRamp Lib "gdi32" (ByVal hdc As Long, lpv As Any) As Long
Private Declare Function SetDeviceGammaRamp Lib "gdi32" (ByVal hdc As Long, lpv As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub Command1_Click()  'Augmenter le gamma
    On Error Resume Next
    Dim iCtr As Integer
    Dim lVal As Long
    For iCtr = 0 To 255
        lVal = Int2Lng(abc1(iCtr, 0))
        abc2(iCtr, 0) = Lng2Int(Int2Lng(abc1(iCtr, 0)) * a)
        abc2(iCtr, 1) = Lng2Int(Int2Lng(abc1(iCtr, 1)) * a)
        abc2(iCtr, 2) = Lng2Int(Int2Lng(abc1(iCtr, 2)) * a)
    Next iCtr
    a = a + 2
    b = b - 2
    SetDeviceGammaRamp Me.hdc, abc2(0, 0)
End Sub

Private Sub Command2_Click()   'Le Diminuer...
    On Error Resume Next
    Dim iCtr As Integer
    Dim lVal As Long

    For iCtr = 0 To 255
        lVal = Int2Lng(abc1(iCtr, 0))
        abc2(iCtr, 0) = Lng2Int(Int2Lng(abc1(iCtr, 0)) / b)
        abc2(iCtr, 1) = Lng2Int(Int2Lng(abc1(iCtr, 1)) / b)
        abc2(iCtr, 2) = Lng2Int(Int2Lng(abc1(iCtr, 2)) / b)
    Next iCtr
    b = b + 2
    a = a - 2
    SetDeviceGammaRamp Me.hdc, abc2(0, 0)
End Sub

Private Sub Command3_Click()  'Restaurer
    SetDeviceGammaRamp Me.hdc, abc1(0, 0)
End Sub

Private Sub Command4_Click()  'Fermer
Unload Me
End Sub

Private Sub Form_Load()    'Restaurer avant de quitter completement...
    GetDeviceGammaRamp Me.hdc, abc1(0, 0)
    a = 2
    b = 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SetDeviceGammaRamp Me.hdc, abc1(0, 0)
End Sub

Public Function Int2Lng(IntVal As Integer) As Long  ' Convertir Integer en Long
    CopyMemory Int2Lng, IntVal, 2
End Function

Public Function Lng2Int(Value As Long) As Integer  ' Convertir Long en Integer
    CopyMemory Lng2Int, Value, 2
End Function

Conclusion :


N'hesitez pas a poster des commentaires, utilitées,...

A voir également

Ajouter un commentaire Commentaire
Messages postés
60
Date d'inscription
lundi 21 octobre 2002
Statut
Membre
Dernière intervention
7 octobre 2007

Merci pour ce bout de code ca marche tres bien :D

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.