Crée un dégradé de couleur dans une fenêtre form
Soyez le premier à donner votre avis sur cette source.
Vue 4 419 fois - Téléchargée 431 fois
Description
Crée un dégradé de couleur dans une fenêtre Form
Je ne sais pas de qui est le code. Désoler.
Je ne sais pas de qui est le code. Désoler.
Source / Exemple :
' Form
'Les variables R1, G1 et B1 définissent les valeurs R, G et B de la couleur de départ
'Les variables R2, G2 et B2 définissent les valeurs R, G et B de la couleur d'arrivée
Dim R1 As Integer
Dim R2 As Integer
Dim G1 As Integer
Dim G2 As Integer
Dim B1 As Integer
Dim B2 As Integer
'La variable Comteur est la variable compteur des boucles For...Next
Dim Compteur As Integer
'Les variables CouleurR, CouleurG et CouleurB contiendront les valeurs R,G,B de la couleur des lines déssinées.
Dim CouleurR As Single
Dim CouleurG As Single
Dim CouleurB As Single
'Les variables difR, difG et difB représenteront la différence entre les valeurs R, G et B de la couleur du départ et celles de l'arrivé.
Dim difR As Integer
Dim difG As Integer
Dim difB As Integer
'La variable TotalTour représente le nombre total de tours à effectuer dans les boucles For...Next
Dim TotalTour As Integer
Sub Fade(obj As Object, Optional vRed As Variant, _
Optional vGreen As Variant, Optional vBlue As Variant, _
Optional vVert As Variant, Optional vHoriz As Variant, _
Optional vLightToDark As Variant, Optional vInverse As Variant)
' Donne des valeures par défaut aux paramètres optionnels
If IsMissing(vRed) Then vRed = False
If IsMissing(vBlue) Then vBlue = False
If IsMissing(vGreen) Then vGreen = False
If Not vRed And Not vGreen Then vBlue = True ' Une couleur est requise
If IsMissing(vVert) Then vVert = False
If IsMissing(vHoriz) Then vHoriz = Not vVert
If IsMissing(vInverse) Then vInverse = False
If Not vVert And Not vHoriz Then vHoriz = True ' Une orientation est
If IsMissing(vLightToDark) Then vLightToDark = True
' Gestion des erreurs
On Error Resume Next
With obj
'Sauve les propriétés
Dim fAutoRedraw As Boolean, ordDrawStyle As Integer
Dim ordDrawMode As Integer, iDrawWidth As Integer
Dim ordScaleMode As Integer
Dim rScaleWidth As Single, rScaleHeight As Single
fAutoRedraw = .AutoRedraw: iDrawWidth = .DrawWidth
ordDrawStyle = .DrawStyle: ordDrawMode = .DrawMode
rScaleWidth = .ScaleWidth: rScaleHeight = .ScaleHeight
ordScaleMode = .ScaleMode
' Une erreur est générée si une de ces propriété est manquante
If Err Then Exit Sub
On Error GoTo 0
fAutoRedraw = .AutoRedraw
' On fixe les paramètres pour le dégradé
.AutoRedraw = True
.DrawWidth = 2
.DrawStyle = vbInsideSolid: .DrawMode = vbCopyPen
.ScaleMode = vbPixels
.ScaleWidth = 256 * 2: .ScaleHeight = 256 * 2
Dim clr As Long, i As Integer, X As Integer, Y As Integer, X2 As Integer, Y2 As Integer
Dim iRed As Integer, iGreen As Integer, iBlue As Integer
X2 = .ScaleWidth
Y2 = .ScaleHeight
For i = 0 To 255
' Fixe les couleurs des lignes
If vLightToDark Then
If vRed Then iRed = 255 - i
If vBlue Then iBlue = 255 - i
If vGreen Then iGreen = 255 - i
Else
If vRed Then iRed = i
If vBlue Then iBlue = i
If vGreen Then iGreen = i
End If
clr = RGB(iRed, iGreen, iBlue)
' Dessine chaque ligne
If vHorizSpace > 0 Then
obj.Line (0, Y + vHorizSpace)-(.ScaleWidth, Y + 2 + vHorizSpace), clr, BF
Y = Y + 2
GoTo passe
End If
If vInverse Then
If vVert Then
obj.Line (.ScaleWidth, Y2 - 2)-(Y2, 0), clr, BF
Y2 = Y2 - 2
End If
If vHoriz Then
obj.Line (X2 - 2, .ScaleHeight)-(X2, 0), clr, BF
X2 = X2 - 2
End If
Else
If vVert Then
obj.Line (0, Y)-(.ScaleWidth, Y + 2), clr, BF
Y = Y + 2
End If
If vHoriz Then
obj.Line (X, 0)-(X + 2, .ScaleHeight), clr, BF
X = X + 2
End If
End If
passe:
Next
' Restore les propriétés précédentes
.AutoRedraw = fAutoRedraw: .DrawWidth = iDrawWidth
.DrawStyle = ordDrawStyle: .DrawMode = ordDrawMode
.ScaleMode = ordScaleMode
.ScaleWidth = rScaleWidth: .ScaleHeight = rScaleHeight
End With
End Sub
Private Sub Command1_Click()
Dim Rouge As Boolean, Vert As Boolean, Bleu As Boolean, Horizontal As Boolean, Vertical As Boolean, ClairVersFonce As Boolean, Inverse As Boolean
Rouge = False
Vert = False
Bleu = False
Vertical = False
Horizontal = False
ClairVersFonce = False
Inverse = False
If Check1 = 1 Then Rouge = True
If Check2 = 1 Then Vert = True
If Check3 = 1 Then Bleu = True
If Check4 = 1 Then Vertical = True
If Check5 = 1 Then Horizontal = True
If Check6 = 1 Then ClairVersFonce = True
If Check7 = 1 Then Inverse = True
Fade Me, Rouge, Vert, Bleu, Vertical, Horizontal, ClairVersFonce, Inverse
End Sub
Private Sub Command2_Click()
'Interception des erreurs:
On Error Resume Next
'Calcul des différences dentre les valeurs R, G et B des couleurs de départ et d'arriver.
difR = R2 - R1
difG = G2 - G1
difB = B2 - B1
'Initialisation des Variables:
CouleurR = R1
CouleurG = G1
CouleurB = B1
'Si le mode choisi est Horizontal:
If Horizontal.Value = True Then
'La boucle doit s'éxécuter au temps de fois qu'il y a de pixels sur la hauteur de la fenêtre;
'la propriété ScaleMode de la fenêtre doit être sur 3
TotalTour = Me.ScaleHeight
'Initialisation de la boucle; elle tracera suffisament de droite pour couvrir l'écran
For Compteur = 1 To TotalTour
'A chaque tour, la couleur doit être modifier; en partant de la couleur de départ, on doit
'arriver à la couleur de fin au bout de "TotalTour" boucles. à chaque tour, on augmente donc
'à chaque tour de (différence entre couleur de départ et couleur d'arriver) sur (Nombre de tours)
CouleurR = CouleurR + (difR / TotalTour)
CouleurG = CouleurG + (difG / TotalTour)
CouleurB = CouleurB + (difB / TotalTour)
'On trace une ligne touchant la précédente, et avec la couleur précédemment obtenue
Me.Line (0, Compteur)-(Me.ScaleWidth, Compteur), RGB(CouleurR, CouleurG, CouleurB)
'Retour de la boucle
Next
End If
'Si le mode choisi est Vertical:
If Vertical.Value = True Then
'La boucle doit s'éxécuter au temps de fois qu'il y a de pixels sur la largeure de la fenêtre;
'la propriété ScaleMode de la fenêtre doit être sur 3
TotalTour = Me.ScaleWidth
'Initialisation de la boucle; elle tracera suffisament de droite pour couvrir l'écran
For Compteur = 1 To TotalTour
'A chaque tour, la couleur doit être modifier; en partant de la couleur de départ, on doit
'arriver à la couleur de fin au bout de "TotalTour" boucles. On augmente donc
'à chaque tour de (différence entre couleur de départ et couleur d'arriver) sur (Nombre de tours)
CouleurR = CouleurR + (difR / TotalTour)
CouleurG = CouleurG + (difG / TotalTour)
CouleurB = CouleurB + (difB / TotalTour)
'On trace une ligne touchant la précédente, et avec la couleur précédemment obtenue
Me.Line (Compteur, 0)-(Compteur, Me.ScaleHeight), RGB(CouleurR, CouleurG, CouleurB)
'Retour de la boucle
Next
End If
'Si le mode choisi est Diagonale Gauche Droite:
If GaucheDroite.Value = True Then
'La boucle doit s'éxécuter au temps de fois qu'il y a de pixels sur la diagonale de la fenêtre;
'la propriété ScaleMode de la fenêtre doit être sur 3
'Pour avoir le nombre de pixels sur la diagonale, il faut passer pas Pythagore et par une propriété de la diagonale d'un carré: un carré de coté C à une diagonale de longueur racine de 2 * C
TotalTour = Sqr(2) * Sqr((Me.ScaleWidth * Me.ScaleWidth) + (Me.ScaleHeight * Me.ScaleHeight))
For Compteur = 1 To TotalTour
'A chaque tour, la couleur doit être modifier; en partant de la couleur de départ, on doit
'arriver à la couleur de fin au bout de "TotalTour" boucles. On augmente donc
'à chaque tour de (différence entre couleur de départ et couleur d'arriver) sur (Nombre de tours)
CouleurR = CouleurR + (difR / TotalTour)
CouleurG = CouleurG + (difG / TotalTour)
CouleurB = CouleurB + (difB / TotalTour)
'On trace une ligne touchant la précédente, et avec la couleur précédemment obtenue
Me.Line (Compteur, 0)-(0, Compteur), RGB(CouleurR, CouleurG, CouleurB)
Next
End If
'Si le mode choisi est Diagonale Droite Gauche:
If DroiteGauche.Value = True Then
'La boucle doit s'éxécuter au temps de fois qu'il y a de pixels sur la diagonale de la fenêtre;
'la propriété ScaleMode de la fenêtre doit être sur 3
'Pour avoir le nombre de pixels sur la diagonale, il faut passer pas Pythagore et par une propriété de la diagonale d'un carré: un carré de coté C à une diagonale de longueur racine de 2 * C
TotalTour = Sqr(2) * Sqr((Me.ScaleWidth * Me.ScaleWidth) + (Me.ScaleHeight * Me.ScaleHeight))
For Compteur = 1 To TotalTour
'A chaque tour, la couleur doit être modifier; en partant de la couleur de départ, on doit
'arriver à la couleur de fin au bout de "TotalTour" boucles. On augmente donc
'à chaque tour de (différence entre couleur de départ et couleur d'arriver) sur (Nombre de tours)
CouleurR = CouleurR + (difR / TotalTour)
CouleurG = CouleurG + (difG / TotalTour)
CouleurB = CouleurB + (difB / TotalTour)
'On trace une ligne touchant la précédente, et avec la couleur précédemment obtenue
Me.Line (Me.ScaleWidth - Compteur, 0)-(Me.ScaleWidth, Compteur), RGB(CouleurR, CouleurG, CouleurB)
'Retour de la boucle
Next
End If
End Sub
Private Sub Couleur_Depart_Click()
On Error GoTo Erreur
Me.CommonDialog1.ShowColor
'Cette algorithme transforme la valeur renvoyé par la boite de dialogue, en valeur RGB. en effet, la boite de dialogue
'Renvoit le numéro de la couleur, et nous aurons besoin, par la suite, d'en avoire le code RGB. Il faut d'abbord
'passer par le mode Héxadécimal en convertissant la valeur retourné en valeur héxadécimale, puis, en partant du principe
'qu'une valeur de couleur Héxadécimale est de type:&HBBGGRR, on peut trouver la valeur R1 représentant la valeur R de la
'Couleur, puis la valeur G1 représentant la valeur G de la Couleur, puis la valeur B1 représentant la valeur de G de la couleur.
'Celà permet de converir ce code en RGB.
R1 = Val("&H" & (Right(Hex(CommonDialog1.Color), 2)))
If Len(Hex(CommonDialog1.Color)) >= 4 Then G1 = Val("&H" & (Mid(Hex(CommonDialog1.Color), (Len(Hex(CommonDialog1.Color))) - 3, 2)))
If Len(Hex(CommonDialog1.Color)) = 6 Then B1 = Val("&H" & Left(Hex(CommonDialog1.Color), 2))
'l'arrière plan de l'image = la couleur renvoyé
Picture1.BackColor = CommonDialog1.Color
'Interception des erreurs: si l'utilisateur appuie, dans la boite de dialogue, sur Annuler, étant donné que la propriété CancelError
'de cette boite de dialogue est sur True, la boite de dialogue renvoie une erreur, qui est ici intercépté. si la prpriété CancelError
'est sur false, si l'utilisateur appuie sur Annuler, la couleur renvoyé par la boite de dialogue est le noire.
Erreur:
If Err.Number = 32755 Then Exit Sub
End Sub
Private Sub Couleur_Arrive_Click()
'détection d'erreur:
On Error GoTo Erreur
Me.CommonDialog1.ShowColor
'Cette algorithme transforme la valeur renvoyé par la boite de dialogue, en valeur RGB. en effet, la boite de dialogue
'Renvoit le numéro de la couleur, et nous aurons besoin, par la suite, d'en avoire le code RGB. Il faut d'abbord
'passer par le mode Héxadécimal en convertissant la valeur retourné en valeur héxadécimale, puis, en partant du principe
'qu'une valeur de couleur Héxadécimale est de type:&HBBGGRR, on peut trouver la valeur R1 représentant la valeur R de la
'Couleur, puis la valeur G1 représentant la valeur G de la Couleur, puis la valeur B1 représentant la valeur de G de la couleur.
'Celà permet de converir ce code en RGB.
R2 = Val("&H" & (Right(Hex(CommonDialog1.Color), 2)))
If Len(Hex(CommonDialog1.Color)) >= 4 Then G2 = Val("&H" & (Mid(Hex(CommonDialog1.Color), (Len(Hex(CommonDialog1.Color))) - 3, 2)))
If Len(Hex(CommonDialog1.Color)) = 6 Then B2 = Val("&H" & Left(Hex(CommonDialog1.Color), 2))
'l'arrière plan de l'image = la couleur renvoyé
Picture2.BackColor = CommonDialog1.Color
'Interception des erreurs: si l'utilisateur appuie, dans la boite de dialogue, sur Annuler, étant donné que la propriété CancelError
'de cette boite de dialogue est sur True, la boite de dialogue renvoie une erreur, qui est ici intercépté. si la prpriété CancelError
'est sur false, si l'utilisateur appuie sur Annuler, la couleur renvoyé par la boite de dialogue est le noire.
Erreur:
If Err.Number = 32755 Then Exit Sub
End Sub
Private Sub Form_Resize()
'Mettre ici le code de votre choix pour recréer le dégradé
'à chaque redimensionnement de la feuille
End SubCodes Sources
A voir également
- Vinverse
- Objet : gestion de couleur 1.0 : dll qui crée un dégradé de couleur - Codes sources - Visual Basic / VB.NET (Graphique)
- Graph : Créer un dégradé de couleur vers transparent avec illustrator - CodeS - Guide
- PHP : Conversion couleurs html2rgb, créer des dégradés - CodeS SourceS - Guide
- Dégradé de couleur python ✓ - Forum - C++ & C++ .NET
- Dégrader de couleur ✓ - Forum - Delphi / Pascal
Commentaires
- Messages postés
- 15815
- Date d'inscription
- jeudi 8 août 2002
- Statut
- Modérateur
- Dernière intervention
- 4 mars 2013
94DARK SIDIOUS
A partir d'un ocx que je livrerai bientot ici.
Sinon 9/10 car c'est bien pensé
Nisand-systems@wanadoo.fr
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.