DESSINER UN HALO DE COULEUR

Messages postés
14552
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
15 septembre 2019
- - Dernière réponse :  N.Mercis Henry. - 23 mai 2015 à 14:27
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/52518-dessiner-un-halo-de-couleur

Afficher la suite 
michael59330
Messages postés
26
Date d'inscription
dimanche 27 janvier 2008
Statut
Contributeur
Dernière intervention
7 juillet 2019
-
Merci! je vais essayer de refaire cette fonction
NHenry
Messages postés
14552
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
15 septembre 2019
136 -
Bonsoir,

La partie de calcul de la couleur m'intrigue, je trouve que ta manière de préciser la couleur est plutôt rigide (on ne peut pas spécifier la couleur désirée, on est coincé par tes choix).

Je te propose un code, à toi de voir si ça te convient :

Il te faut une structure nommée tColor contenant 2 attributs :
- Position As Double : Distance de la couleur
- Color As Color : Couleur de la position

Ensuite, cette fonction te calcul la couleur adaptée par rapport à la liste et la distance :
Private Function GetColorForPosition(Byval pPosition as Double,Byval ptColors() as tColor) as Color
Dim lMinColor as tColor
Dim lMaxColor as tColor

lMinColor.Position=0
lMaxcolor.Position=0

'Recherche des 2 couleurs les plus proches
For Each llColor As tColor In ptColors
If lColor.Position>pPosition andalso lMaxColor.Position>lColor.Position Then
lMaxColor=lColor
elseif lColor.Position<pPosition andalso lMinColor.Position<lColor.Position Then
lMinColor=lColor
End If
Next

'Si il y a qu'une seule couleur, on la retourne
If lMinColor.Position=0 then
Return lMaxColor.Color
elseif lMaxColor.Position=0 Then
Return lMinColor.Color
End If

'Sinon, on fait le mélange
Dim lR as integer, lG as integer, lB as integer lA as integer, lRatio as Double

lRatio=(lMinColor.Position-pPosition)/(lMaxColor.Position-lMinColor.Position)

lR=CInt(lRatio*lMinColor.Color.R+(1-lRatio)*lMaxColor.Colo.R)
lG=CInt(lRatio*lMinColor.Color.G+(1-lRatio)*lMaxColor.Colo.G)
lB=CInt(lRatio*lMinColor.Color.B+(1-lRatio)*lMaxColor.Colo.B)
lA=CInt(lRatio*lMinColor.Color.A+(1-lRatio)*lMaxColor.Colo.A)

Return Color.FromArgb(lA,lR,lG,lB)
End Function

Paramètres :
pPosition : Distance du centre
ptcolors, tableau de tColor pour lister les couleurs et les distances

L'avantage, c'est plus souple, on peut mettre plus de couleurs que dans ta proposition et le fait d'avoir séparer ce traitement rend le code un peu plus clair, je trouve.
(Bonus, elle gère les 4 composantes, pas que 3)

Cordialement.
> NHenry
Messages postés
14552
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
15 septembre 2019
-
Cher NHenry, Merci.
Je me posais récemment la question (2015-2010)=5 ans.
Ce qui m'amène a penser:
Public Class Cloud 'Matrice de dispersion

    Dim L As Integer 'Lignes
    Dim C As Integer 'Colonnes 
    Friend Q As Integer 'Quantité d'éléments a disperser.

    Dim M As Integer 'Nombre de cellules disponibles par élément.
    Dim Surjection As Boolean = False ' ou d'éléments par cellule.

    'Linéaristion d'une matrice de dimensions finies.
    Friend Function Indice(Coordonnee() As Integer, Dimensions() As Integer) As Integer
        Dim T As Integer = 0
        For Each Position As Integer In Coordonnee
            'Par quoi on commence ?
        Next
        Return T
    End Function
    'Qu'on ait une, deux, ou plus de dimensions c'est pareil. Pourquoi ça perturbe ?
    Friend Function Coordonnee(Indice As Integer, Dimensions() As Integer) As Integer()
        'Vaut-il mieux donner la priorité aux dimensions (Pondérer les dimensions ou les distances ?)
    End Function

    'Retourne la position d'un élément. (Surjection supposée=False)
    Friend Function PositionBateau(indice As Integer) As Point
        Dim Drm As Integer = indice * M 'Distribution régulièrement moyenne
        Dim Y = Int(Drm / C)
        Dim X = Int(Drm Mod C)
        Return New Point(X, Y)
    End Function

    Sub Init(Lignes As Integer, Colonnes As Integer, Quantite As Integer)
        L = Lignes
        C = Colonnes
        Q = Quantite
        Dim TCells As Integer = L * C
        If TCells > Q Then
            M = TCells / Q
        Else
            Surjection = True
            M = Q / TCells
        End If
    End Sub

    Sub init(Map As Bitmap, S As String)
        Init(Map.Width, Map.Height, 8 * S.Length)
    End Sub

End Class


De quoi m'amuser.....

EDIT: Ajout de la coloration syntaxique.