Teinte, saturation , luminosité, un équivalent du RGB

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Teinte, saturation , luminosité, un équivalent du RGB

Message par Gillou »

Quelques fonctions pour connaître la teinte, saturation et luminosité d'une couleur. Les fonctions sont très basiques et doivent être améliorées. Mais bon c déjà une base (faîte en 15 min ;).

donc en bref le rgb c l'identification système d'une couleur et le TSL (HSL en anglais) et une représentation plus humaine de la couleur.

désolé pour la couleur j'ai un bug avec mon colorer ;(

a la fin, vous trouverez un petit code pour changer la teinte d'une image

Code : Tout sélectionner

ProcedureDLL Round2(Number.f)
    x.f = Number-Round(Number,0)
    If x>=0.5
        ProcedureReturn Round(Number, 1)
    Else
        ProcedureReturn Round(Number, 0)
    EndIf
EndProcedure

ProcedureDLL Hue(Color) ; teinte
    R = Red(Color) : G = Green(Color) : B = Blue(Color)
    If R < G And R < B
        Min = R
        If G > B
            Max = G
        Else
            Max = B
        EndIf
    ElseIf G < B
        Min = G
        If R > B
            Max = R
        Else
            Max = B
        EndIf
    Else
        Min = B
        If R > G
            Max = R
        Else
            Max = G
        EndIf
    EndIf
    D = Max-Min
    If R = Max
        T.f = (G-B)/D
    ElseIf G = Max
        T.f = (B-R)/D + 2
    Else
        T.f = (R-G)/D + 4
    EndIf
    If T< 0
        ProcedureReturn 240+(Round2(1/6*(T*240)) % 240)
    EndIf
    ProcedureReturn Round2(1/6*(T*240)) % 240
EndProcedure

ProcedureDLL Luminance(Color) ; luminosité
    R = Red(Color) : G = Green(Color) : B = Blue(Color)
    If R < G And R < B
        Min = R
        If G > B
            Max = G
        Else
            Max = B
        EndIf
    ElseIf G < B
        Min = G
        If R > B
            Max = R
        Else
            Max = B
        EndIf
    Else
        Min = B
        If R > G
            Max = R
        Else
            Max = G
        EndIf
    EndIf
    ProcedureReturn Round2(240*(Max + Min)/510)
EndProcedure

ProcedureDLL Saturation(Color)
    R = Red(Color) : G = Green(Color) : B = Blue(Color)
    If R < G And R < B
        Min = R
        If G > B
            Max = G
        Else
            Max = B
        EndIf
    ElseIf G < B
        Min = G
        If R > B
            Max = R
        Else
            Max = B
        EndIf
    Else
        Min = B
        If R > G
            Max = R
        Else
            Max = G
        EndIf
    EndIf
    If Max+Min =< 255
        ProcedureReturn Round2((Max-Min)/(Max+Min)*240)
    Else
        ProcedureReturn Round2((Max-Min)/(510-(Max+Min))*240)
    EndIf
EndProcedure

ProcedureDLL HSL(Hue, Saturation, Luminance) ; TSL (Teinte, Saturation, Luminosité) ; renvoi la couleur sous format RGB
    T.f = 6*Hue/240
    If Luminance =< 120
        Max = Round2(255*Luminance*(1+Saturation/240)/240)
        Min = Round2(255*Luminance*(1-Saturation/240)/240)
    Else
        Max = Round2(255*(Luminance*(1-Saturation/240)/240+Saturation/240))
        Min = Round2(255*(Luminance*(1+Saturation/240)/240-Saturation/240))
    EndIf
    D = Max-Min
    i = Round(T, 0)
    If i = 0
        R = Max : G = Min+T*D : B = Min
    ElseIf i = 1
        R = Min + (2-T)*D : G = Max : B = Min
    ElseIf i = 2
        R = Min : G = Max : B = Min+(T-2)*D
    ElseIf i = 3
        R = Min : G = Min+(4-T)*D : B = Max
    ElseIf i = 4
        R = Min + (T-4)*D : G = Min : B = Max
    Else
        R = Max : G = Min : B = Min+(6-T)*D
    EndIf
    ProcedureReturn RGB(R,G,B)
EndProcedure

couleur = $FFDD00
Debug couleur
Debug "---"
Debug Hue(couleur)
Debug Saturation(couleur)
Debug Luminance(couleur)
Debug "---"
Debug HSL(125, 240, 120)
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Message par Gillou »

Code : Tout sélectionner

;_______________________________________
; Un petit test 
;_______________________________________

ProcedureDLL ChangeHueImage(Image, Hue) ; Permet de changer la teinte d'une image
     If Image >= 0
         ImageID = ImageID (Image)
        Hdc = CreateCompatibleDC_ (0) ; GetDC_(WindowID))
         If HDC
            bmi.BITMAPINFO
            bm.BITMAP
             GetObject_ ( ImageID , SizeOf(BITMAP), @bm.BITMAP)
            bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
            bmi\bmiheader\biWidth = bm\bmWidth
            bmi\bmiheader\biHeight = bm\bmHeight
            bmi\bmiheader\biPlanes = 1
            bmi\bmiheader\biBitCount = 32
            bmi\bmiheader\biCompression = #BI_RGB
            HList = AllocateMemory (bm\bmWidth * bm\bmHeight * 4)
             GetDIBits_ (hDC, ImageID , 0, bm\bmHeight, HList, bmi, #DIB_RGB_COLORS )
            
             For nn = 0 To bm\bmWidth - 1
                 For n = 0 To bm\bmHeight - 1
                    s = HList + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4
                     color = PeekL(s)
                     color = color >> 16 | (color >> 8 & $FF) << 8 | (color & $FF) << 16
                     color = HSL(Hue, Saturation(Color), Luminance(Color))
                     PokeL(s, color >> 16 | (color >> 8 & $FF) << 8 | (color & $FF) << 16)
                 Next n
                Table + 4
             Next nn
             
         HDC = StartDrawing ( ImageOutput (image))
             SetDIBits_ (HDC, ImageID , 0, ImageHeight (Image), HList, bmi, #DIB_RGB_COLORS )
         StopDrawing ()
         FreeMemory (HList)
         ProcedureReturn 1
         Else
             ProcedureReturn
         EndIf
         ProcedureReturn 1
     EndIf
EndProcedure

ProcedureDLL.s GetFileWithoutExt(File.s) ; Retourne l'adresse sans l'extension
    If Len(GetExtensionPart(File.s)) <> 0
        ProcedureReturn Left(File.s, Len(File.s) - Len(GetExtensionPart(File.s)) - 1)
    EndIf
    ProcedureReturn File.s
EndProcedure

UsePNGImageDecoder()
UsePNGImageEncoder()

Img$ = "Votre image.png"
Teinte  = 30 ; entre 0 et 255

If FileSize(Img$) >= 0
    If LoadImage(0, Img$)
        ChangeHueImage(0, Teinte)
        SaveImage(0, GetFileWithoutExt(Img$)+"2.png", #PB_ImagePlugin_PNG)
        FreeImage(0)
    EndIf
Else
    Debug "Image non trouvé"
EndIf
Avatar de l’utilisateur
Fortix
Messages : 559
Inscription : mar. 30/mai/2006 17:03

Message par Fortix »

Salut @Gillou :D , j'ais décelé un bug dans ta procedure HUE, quant on lui attribut la valeur "0 ou BLANC" il indique une autre valeur éronée égale à 112 - 115 et normalement pour la valeur 0 on devrait obtenir 160 (en touts cas s'est qu'indique le ColorRequester de Paint), pour ma part je n'ais pas réussit à reparer le bug, je pensais que la cause était le %Modulo(240) qui devrait être fixer à 360 (qui correspont à la rotation chromatique!) :lol:

c domage car je me sert très souvent de ta procedure

j'ais réalisé une autre version, mais totalement inférieur à la tienne :lol:

Code : Tout sélectionner

Procedure.f Hue(clr)
    r.f:v.f:b.f:max.f:min.f:neu.f:diff.f:v1.f:vf.f

    r = Red(clr) : g = Green(clr) : b = Blue(clr)
    
    If r>v And r>b
        max=r:max$="r"
        
        If v<b
            min=v:neu=b
            min$="v":neu$="b"
        Else
            min=b:neu=v
            min$="b":neu$="v"
        EndIf
    ElseIf v>r And v>b
        max=v:max$="v"
        
        If r<b
            min=r:neu=b
            min$="r":neu$="b"
        Else
            min=b:neu=r
            min$="b":neu$="r"
        EndIf
    ElseIf b>r And b>v
        max=b:max$="b"
        
        If v<r
            min=v:neu=r
            min$="v":neu$="r"
        Else
            min=r:neu=v
            min$="r":neu$="v"
        EndIf
    EndIf
    
    diff=max-min
    ;v1.f
    
    If max$="r"
        If neu$="v" Or neu=min
            v1=(v-b)/diff+0
        Else
            v1=(b-v)/diff+0
        EndIf
    ElseIf max$="v"
        If neu$="b" Or neu=min
            v1=(b-r)/diff+2
        Else
            v1=(r-b)/diff+2
        EndIf
    ElseIf max$="b"
        If neu$="r" Or neu=min
            v1=(r-v)/diff+4
        Else
            v1=(v-r)/diff+4
        EndIf
    EndIf
    
    Debug "V: "+Str(v1)
    
    vf=v1*360
    ;vf=1/6
;     If v1=0
;         ProcedureReturn 0
;     Else
        ProcedureReturn vf/6%360
        
        ;ProcedureReturn vf*v1*240% 240 
;     EndIf
    
EndProcedure
il y vrais qu'il faut que je révise mon algèbre :lol:
Répondre