Dégradés de pleins de couleurs très rapides - maj1
Soyez le premier à donner votre avis sur cette source.
Vue 6 625 fois - Téléchargée 528 fois
Description
Dans une source postée par Yoman64 sur les dégradés de couleurs, il y a eu un commentaire de je sais
plus qui qui montré comment faire des dégradés avec l'api GradientFill. Grâce à cette api on peut réalisé
des dégradés d'une couleur à l'autre très rapidement.
J'ai adapté ça pour faire des dégradés de plusieurs couleurs...
En fait il existé déjà une source de lightness1028 je crois qui faisait plusieurs couleurs
mais c'était très lent ( chez moi en tout cas )
Avec ce programme c'est instantaté, puisque vous pouvez changer les couleurs ( jusqu'à 70 couleurs
après le picturebox est trop petit ) avec une scrollBar et ça chnage en même temps que la Scroolbar..
La nouvel version permet d'insérer une couleur entre deux autre ,alors que précédement on ne pouvait que les ajouter à la fin.
Voyez la capture pour le résultat...
Et soyez sympa de laisser des commentaires...
plus qui qui montré comment faire des dégradés avec l'api GradientFill. Grâce à cette api on peut réalisé
des dégradés d'une couleur à l'autre très rapidement.
J'ai adapté ça pour faire des dégradés de plusieurs couleurs...
En fait il existé déjà une source de lightness1028 je crois qui faisait plusieurs couleurs
mais c'était très lent ( chez moi en tout cas )
Avec ce programme c'est instantaté, puisque vous pouvez changer les couleurs ( jusqu'à 70 couleurs
après le picturebox est trop petit ) avec une scrollBar et ça chnage en même temps que la Scroolbar..
La nouvel version permet d'insérer une couleur entre deux autre ,alors que précédement on ne pouvait que les ajouter à la fin.
Voyez la capture pour le résultat...
Source / Exemple :
'Pour la source mais à cause des objets voici le source de la feuille
'Pour ceux qui aiment pas les zips ou la compile...
'Mais y a quand même le zip
'Copier ça dans un doc txt vide et renommer le en .frm
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmPrinc
BorderStyle = 1 'Fixed Single
Caption = "Dégradé"
ClientHeight = 6765
ClientLeft = 45
ClientTop = 330
ClientWidth = 4710
Icon = "frmPrinc.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 451
ScaleMode = 3 'Pixel
ScaleWidth = 314
StartUpPosition = 3 'Windows Default
Begin MSComDlg.CommonDialog cmDialPrinc
Left = 0
Top = 0
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.OptionButton optSens
Caption = "Horizontal"
Height = 195
Index = 0
Left = 0
TabIndex = 0
Top = 2400
Value = -1 'True
Width = 4575
End
Begin VB.OptionButton optSens
Caption = "Vertical"
Height = 195
Index = 1
Left = 0
TabIndex = 1
Top = 2640
Width = 4575
End
Begin VB.Frame framPrinc
Height = 3855
Left = 30
TabIndex = 10
Top = 2880
Width = 4635
Begin VB.CommandButton cmdInsert
Caption = "Insérer une couleur ici"
Height = 495
Left = 2400
TabIndex = 9
Top = 3240
Width = 2055
End
Begin VB.CommandButton cmdPlus
Caption = "+"
Height = 255
Left = 480
TabIndex = 4
Top = 360
Width = 255
End
Begin VB.CommandButton cmdMoins
Caption = "-"
Height = 255
Left = 240
TabIndex = 3
Top = 360
Width = 255
End
Begin VB.CommandButton cmdDelete
Caption = "Supprimer cette couleur"
Height = 495
Left = 120
TabIndex = 8
Top = 3240
Width = 2055
End
Begin VB.HScrollBar scrlHrzBlue
Height = 255
Left = 240
Max = 255
TabIndex = 7
Top = 2280
Width = 4095
End
Begin VB.HScrollBar scrlHrzGreen
Height = 255
Left = 240
Max = 255
TabIndex = 6
Top = 1680
Width = 4095
End
Begin VB.HScrollBar scrlHrzRed
Height = 255
Left = 240
Max = 255
TabIndex = 5
Top = 1080
Width = 4095
End
Begin VB.Label lblSample
Height = 495
Left = 240
TabIndex = 15
ToolTipText = "Cliquez ici pour choisir une couleur..."
Top = 2640
Width = 4095
End
Begin VB.Label lblColor
Height = 255
Left = 840
TabIndex = 14
Top = 405
Width = 1455
End
Begin VB.Label lblBlue
Caption = "Bleu"
Height = 255
Index = 0
Left = 240
TabIndex = 13
Top = 1980
Width = 1095
End
Begin VB.Label lblGreen
Caption = "Vert"
Height = 255
Left = 240
TabIndex = 12
Top = 1380
Width = 1095
End
Begin VB.Label lblRed
Caption = "Rouge"
Height = 255
Left = 240
TabIndex = 11
Top = 780
Width = 1215
End
End
Begin VB.PictureBox picPrinc
Height = 2295
Left = 0
ScaleHeight = 2235
ScaleWidth = 4635
TabIndex = 2
Top = 0
Width = 4695
End
End
Attribute VB_Name = "frmPrinc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GradientFill Lib "msimg32" (ByVal Desthdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As Any, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Boolean
Private Type TRIVERTEX
X As Long
Y As Long
Red As Integer
Green As Integer
Blue As Integer
Alpha As Integer
End Type
Private Type Couleur
Red As Integer
Green As Integer
Blue As Integer
End Type
Private Type GRADIENT_RECT
UpperLeft As Long
LowerRight As Long
End Type
Private Const GRADIENT_FILL_RECT_H = 0
Private Const GRADIENT_FILL_RECT_V = 1
Dim couleurActuelle As Integer
Dim Couleur() As Couleur
Dim couleurs() As TRIVERTEX
Private Sub colorisemoitoutca()
Dim gRect As GRADIENT_RECT
Dim sens As Integer
Dim i As Integer
Dim nbreTotalDeCouleurs As Integer
nbreTotalDeCouleurs = UBound(Couleur)
ReDim couleurs(nbreTotalDeCouleurs) As TRIVERTEX
gRect.UpperLeft = 0
gRect.LowerRight = 1
If optSens(1).Value = True Then
For i = 0 To nbreTotalDeCouleurs - 1
If i >= nbreTotalDeCouleurs - 1 Then Exit For
couleurs(i).X = 0
couleurs(i).Y = i * (picPrinc.Height / (nbreTotalDeCouleurs - 1))
couleurs(i).Alpha = 0
couleurs(i).Red = "&H" & Hex(Couleur(i).Red / 16 * 256 * 16)
couleurs(i).Green = "&H" & Hex(Couleur(i).Green / 16 * 256 * 16)
couleurs(i).Blue = "&H" & Hex(Couleur(i).Blue / 16 * 256 * 16)
couleurs(i + 1).X = picPrinc.Width
couleurs(i + 1).Y = (i + 1) * (picPrinc.Height / (nbreTotalDeCouleurs - 1))
couleurs(i + 1).Alpha = 0
couleurs(i + 1).Red = "&H" & Hex(Couleur(i + 1).Red / 16 * 256 * 16)
couleurs(i + 1).Green = "&H" & Hex(Couleur(i + 1).Green / 16 * 256 * 16)
couleurs(i + 1).Blue = "&H" & Hex(Couleur(i + 1).Blue / 16 * 256 * 16)
If GradientFill(picPrinc.hDC, couleurs(i), 2, gRect, 1, GRADIENT_FILL_RECT_V) = False Then MsgBox "Une erreur s'est produite...", vbCritical, "Oh..."
Next i
Else
For i = 0 To nbreTotalDeCouleurs - 1
If i >= nbreTotalDeCouleurs - 1 Then Exit For
couleurs(i).X = i * (picPrinc.Width / (nbreTotalDeCouleurs - 1))
couleurs(i).Y = 0
couleurs(i).Alpha = 0
couleurs(i).Red = "&H" & Hex(Couleur(i).Red / 16 * 256 * 16)
couleurs(i).Green = "&H" & Hex(Couleur(i).Green / 16 * 256 * 16)
couleurs(i).Blue = "&H" & Hex(Couleur(i).Blue / 16 * 256 * 16)
couleurs(i + 1).X = (i + 1) * (picPrinc.Width / (nbreTotalDeCouleurs - 1))
couleurs(i + 1).Y = picPrinc.Height
couleurs(i + 1).Alpha = 0
couleurs(i + 1).Red = "&H" & Hex(Couleur(i + 1).Red / 16 * 256 * 16)
couleurs(i + 1).Green = "&H" & Hex(Couleur(i + 1).Green / 16 * 256 * 16)
couleurs(i + 1).Blue = "&H" & Hex(Couleur(i + 1).Blue / 16 * 256 * 16)
If GradientFill(picPrinc.hDC, couleurs(i), 2, gRect, 1, GRADIENT_FILL_RECT_H) = False Then MsgBox "Une erreur s'est produite...", vbCritical, "Oh..."
Next i
End If
End Sub
Private Sub cmdDelete_Click()
Dim i As Integer
If UBound(Couleur) = 2 Then MsgBox "Vous ne pouvez pas supprimer une couleur lorsque seules deux couleurs sont définies.", vbInformation, "Erreur...": Exit Sub
For i = couleurActuelle To UBound(Couleur) - 1
Couleur(i).Red = Couleur(i + 1).Red
Couleur(i).Green = Couleur(i + 1).Green
Couleur(i).Blue = Couleur(i + 1).Blue
Next i
ReDim Preserve Couleur(UBound(Couleur) - 1)
If couleurActuelle = UBound(Couleur) Then couleurActuelle = couleurActuelle - 1
lblColor.Caption = "Couleur " & couleurActuelle + 1 & "/" & UBound(Couleur)
initScrl
End Sub
Private Sub cmdInsert_Click()
Dim i As Integer
ReDim Preserve Couleur(UBound(Couleur) + 1)
For i = UBound(Couleur) To couleurActuelle + 1 Step -1
Couleur(i).Red = Couleur(i - 1).Red
Couleur(i).Green = Couleur(i - 1).Green
Couleur(i).Blue = Couleur(i - 1).Blue
Next i
Couleur(couleurActuelle).Red = 0
Couleur(couleurActuelle).Green = 0
Couleur(couleurActuelle).Blue = 0
lblColor.Caption = "Couleur " & couleurActuelle + 1 & "/" & UBound(Couleur)
initScrl
End Sub
Private Sub cmdMoins_Click()
couleurActuelle = couleurActuelle - 1
If couleurActuelle < 0 Then couleurActuelle = 0
lblColor.Caption = "Couleur " & couleurActuelle + 1 & "/" & UBound(Couleur)
initScrl
End Sub
Private Sub cmdPlus_Click()
couleurActuelle = couleurActuelle + 1
If couleurActuelle > UBound(Couleur) - 1 Then
ReDim Preserve Couleur(UBound(Couleur) + 1)
Couleur(UBound(Couleur)).Red = 0
Couleur(UBound(Couleur)).Green = 0
Couleur(UBound(Couleur)).Blue = 0
lblColor.Caption = "Couleur " & couleurActuelle + 1 & "/" & UBound(Couleur)
Else
lblColor.Caption = "Couleur " & couleurActuelle + 1 & "/" & UBound(Couleur)
End If
initScrl
End Sub
Private Sub initScrl()
scrlHrzRed.Value = Couleur(couleurActuelle).Red
scrlHrzGreen = Couleur(couleurActuelle).Green
scrlHrzBlue = Couleur(couleurActuelle).Blue
lblSample.BackColor = RGB(scrlHrzRed.Value, scrlHrzGreen.Value, scrlHrzBlue.Value)
colorisemoitoutca
End Sub
Private Sub Form_Load()
ReDim Couleur(2) As Couleur
Couleur(0).Red = 0
Couleur(0).Green = 0
Couleur(0).Blue = 0
Couleur(1).Red = 255
Couleur(1).Green = 255
Couleur(1).Blue = 255
couleurActuelle = 0
lblColor.Caption = "Couleur " & couleurActuelle + 1 & "/" & UBound(Couleur)
initScrl
End Sub
Private Sub lblSample_Click()
Dim laCouleur As Long
cmDialPrinc.ShowColor
laCouleur = cmDialPrinc.Color
lblSample.BackColor = laCouleur
scrlHrzRed.Value = Int(laCouleur And &HFF)
scrlHrzGreen.Value = Int((laCouleur And &H100FF00) / &H100)
scrlHrzBlue.Value = Int((laCouleur And &HFF0000) / &H10000)
End Sub
Private Sub optSens_Click(index As Integer)
colorisemoitoutca
End Sub
Private Sub picPrinc_Paint()
colorisemoitoutca
End Sub
Private Sub scrlHrzBlue_Change()
Couleur(couleurActuelle).Blue = scrlHrzBlue.Value
lblSample.BackColor = RGB(scrlHrzRed.Value, scrlHrzGreen.Value, scrlHrzBlue.Value)
colorisemoitoutca
End Sub
Private Sub scrlHrzBlue_Scroll()
Couleur(couleurActuelle).Blue = scrlHrzBlue.Value
lblSample.BackColor = RGB(scrlHrzRed.Value, scrlHrzGreen.Value, scrlHrzBlue.Value)
colorisemoitoutca
End Sub
Private Sub scrlHrzGreen_Change()
Couleur(couleurActuelle).Green = scrlHrzGreen.Value
lblSample.BackColor = RGB(scrlHrzRed.Value, scrlHrzGreen.Value, scrlHrzBlue.Value)
colorisemoitoutca
End Sub
Private Sub scrlHrzGreen_Scroll()
Couleur(couleurActuelle).Green = scrlHrzGreen.Value
lblSample.BackColor = RGB(scrlHrzRed.Value, scrlHrzGreen.Value, scrlHrzBlue.Value)
colorisemoitoutca
End Sub
Private Sub scrlHrzRed_Change()
Couleur(couleurActuelle).Red = scrlHrzRed.Value
lblSample.BackColor = RGB(scrlHrzRed.Value, scrlHrzGreen.Value, scrlHrzBlue.Value)
colorisemoitoutca
End Sub
Private Sub scrlHrzRed_Scroll()
Couleur(couleurActuelle).Red = scrlHrzRed.Value
lblSample.BackColor = RGB(scrlHrzRed.Value, scrlHrzGreen.Value, scrlHrzBlue.Value)
colorisemoitoutca
End Sub
Conclusion :
Et soyez sympa de laisser des commentaires...
Codes Sources
A voir également
- Dégradés de pleins de couleurs très rapides - maj1
- Degrade de texte 2 couleurs - Codes sources - Javascript (Cookies)
- Dégradé de toutes les couleurs - Guide
- Delphi / Pascal : Dégradé de couleurs rapide et simple - CodeS SourceS - Guide
- Degrade de couleur dans l'evenement paint d'un form - Codes sources - Visual Basic / VB.NET (Formulaire)
- Visual Basic / VB.NET : Dégradé d'une couleur a une autre (amélioré) - C - Guide
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.