PureBasic

Forums PureBasic
Nous sommes le Dim 18/Nov/2018 1:33

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 3 messages ] 
Auteur Message
 Sujet du message: Teinte, saturation , luminosité, un équivalent du RGB
MessagePosté: Jeu 31/Aoû/2006 21:21 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 28/Aoû/2004 17:35
Messages: 373
Localisation: Bretagne, 22
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:
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)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message:
MessagePosté: Jeu 31/Aoû/2006 21:26 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 28/Aoû/2004 17:35
Messages: 373
Localisation: Bretagne, 22
Code:
;_______________________________________
; 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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message:
MessagePosté: Sam 01/Aoû/2009 12:49 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 30/Mai/2006 17:03
Messages: 559
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:
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:


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 3 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 4 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye