Ce code est la réponse à la source de skyraider.
Je tiens à m'excuser auprès de Mr.X à qui j'ai volé sa fonction "Xwait", je dois avouer que je m'en sers tout le temps.
Pour ce qui est de la source, pour faciliter les changements, j'ai stocké toutes les informations dans des variables ( ce sont des tableaux de 3 colonnes, 1 par couleur rgb). Voilà. Ah oui, il vous faut créer un projet avec une feuille nommée Form1 et un bouton nommé Command1, pour un meilleur effet, mettez la valeur borderstyle de la feuille à 0. Double-cliquez n'importe où sur la feuille pour aficher en plein écran, allez avec la souris dans le coin inférieur droit pour afficher le bouton de sortie.
Puis mettez ce code dans le code de la feuille :
Source / Exemple :
Private Declare Function GetTickCount Lib "kernel32" () As Long
Option Explicit
'voilà les variables en question
Dim Sens(1 To 3) As Boolean ' pour savoir si il faut ajouter ou soustraire
Dim Valeur(1 To 3) As Integer
Dim Increment(1 To 3) As Integer
Dim Plage(1 To 3, 1 To 2) As Integer ' la plage : 1 to 3 pour les couleurs (R,V ou B) et 1 to 2 Pour le maximum et le Minimum de l'incrément
Dim MaxValeur(1 To 3) As Integer 'les valeurs minimales et maximales des couleurs
Dim MinValeur(1 To 3) As Integer
Sub XWait(ByVal MilsecToWait As Long)
Dim lngEndingTime As Long
lngEndingTime = GetTickCount() + (MilsecToWait)
Do While GetTickCount() < lngEndingTime
DoEvents
Loop
End Sub
Private Sub Command1_Click()
Unload Me
End
End Sub
Private Sub Form_DblClick()
Select Case Me.WindowState
Case vbMaximized
Me.BorderStyle = 2
Me.WindowState = vbNormal
Case vbNormal
Me.BorderStyle = 0
Me.WindowState = vbMaximized
End Select
Command1.Move Me.Width - Command1.Width, Me.Height - Command1.Height
End Sub
Private Sub Form_Load()
Me.Show 'ne pas oublier ça sinon la feuille ne s'affiche pas à cause de la boucle qui suit
Command1.Move Me.Width - Command1.Width, Me.Height - Command1.Height
Dim i
For i = 1 To 3
Plage(i, 1) = 0
Plage(i, 2) = 2
MaxValeur(i) = 255
MinValeur(i) = 0
Next
Do
Coloriser
XWait 10
DoEvents
Loop
End Sub
Sub Coloriser()
On Error GoTo erreur:
Me.BackColor = RGB(Valeur(1), Valeur(2), Valeur(3))
Randomize Timer
Dim i
For i = 1 To 3
Increment(i) = ((Plage(i, 2) - Plage(i, 1)) * Rnd) + Plage(i, 1)
Select Case Sens(i)
Case True
If Valeur(i) + Increment(i) <= MaxValeur(i) Then
Valeur(i) = Valeur(i) + Increment(i)
Else
Valeur(i) = MaxValeur(i)
Sens(i) = False
End If
Case False
If Valeur(i) - Increment(i) >= MinValeur(i) Then
Valeur(i) = Valeur(i) - Increment(i)
Else
Valeur(i) = MinValeur(i)
Sens(i) = True
End If
End Select
DoEvents
Next i
erreur: If Err.Number <> 0 Then
MsgBox "Une erreur de type " & Err.Number & " est apparue à " & Time & " dans le module " & Err.Source & vbCrLf & "Description : " & vbCrLf & " " & Err.Description & vbCrLf & vbCrLf & "Pour consulter l'aide relative à cette erreur, allez dans " & Err.HelpFile & " (ce chemin sera enregistré dans le presse-papier)" & vbCrLf & vbCrLf & "L'application va se terminer", vbCritical, "ERREUR"
Clipboard.Clear
Clipboard.SetText Err.HelpFile
If Err.Number = 5 Then MsgBox "Conseil : " & vbCrLf & "Il est probable que la Valeur Minimale d'une plage de couleur soit négative." & vbCrLf & "Ce qui entraînera systèmatiquement cette erreur (" & Err.Description & ")" & vbCrLf & "Pour remédier à ça, changez toutes les Valeurs Minimales en valeurs positives.", vbInformation, "Conseil"
End
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X >= Me.Width - Command1.Width And Y >= Me.Height - Command1.Height Then
Command1.Visible = True
Else
Command1.Visible = False
End If
End Sub
Private Sub Form_Terminate()
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Conclusion :
Ne pas mettre une valeur minimale de couleur négative. Celà entrainerait une erreur.
Bon, je sais que c'est laid, inutile et que ça rend épileptique mais bon... quand on a rien à faire...
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.