PureBasic

Salut à tous.

Voilà, pour des barre de progression ou autre, je veux faire un dégradé de couleur. Pour l'instant je fais cela comme dans le code ci dessous. Mais c'est un peu de la bidouille. J'aimerais vraiment jouer sur la luminosité de ma couleur. Pour mieux comprendre, sous Japbe, dans outils, insérer une couleur, vous avez le paramêtre Lum.

Merci et bonne journée.

Stef

Code : Tout sélectionner

UseJPEGImageDecoder()
OpenWindow(0, 0, 0, 200, 300, "Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
CreateGadgetList(WindowID( 0))

StartDrawing(  WindowOutput(0))  
For i=0 To 10
   LineXY(0,100+i,200,100+i,RGB(145-i*8,169-i*8,240-i*3))
   LineXY(0,100-i,200,100-i,RGB(145-i*8,169-i*8,240-i*3))
Next

For i=0 To 20
   LineXY(0,200+i,200,200+i,RGB(145-i*8,169-i*8,240-i*3))
   LineXY(0,200-i,200,200-i,RGB(145-i*8,169-i*8,240-i*3))
Next
StopDrawing()

Repeat
     event = WaitWindowEvent()
     Select event
          Case #PB_Event_Gadget
     EndSelect
     
Until event = #WM_CLOSE

J'ai fait ça un peu a l'arrache avec des fonctions que j'avais fait. Si ça peut t'aider

(Les deux premières fonction serve juste à gérer les images de tableux plus simplement ça n'a rien a voir) la fonction importante comme tu l'auras compris c EnlightenImage

ProcedureDLL ImageToTable(Image, Table) ; Retourne 1 si l'image a été chargée dans le tableau ImageID=#Image : Table=@Tableau(), ex : Dim Tableau(ImageWidth(), ImageHeight()) -> @Tableau()
     If Image >= 0 And Table
         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
                    d = Table + n * 4 + nn * bm\bmHeight * 4
                     CopyMemory (s + 2, d, 1)
                     CopyMemory (s + 1, d + 1, 1)
                     CopyMemory (s, d + 2, 1)
                 Next n
                Table + 4
             Next nn
             FreeMemory (HList)
         Else
             ProcedureReturn
         EndIf
         ProcedureReturn 1
     EndIf
EndProcedure

ProcedureDLL TableToImage(Image, Table) ; Crée une image à partir du tableau Image=#Image, Table=@Tableau(), ex : Dim Tableau(ImageWidth(),ImageHeight()) -> @Tableau()
     If IsImage (Image) And Table
         ImageID = ImageID (Image)
        bm.BITMAP
         GetObject_ ( ImageID , SizeOf(BITMAP), @bm.BITMAP)
        bmi.BITMAPINFO
        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
        pixel = AllocateMemory (bm\bmHeight * bm\bmWidth * 4)
         For nn = 0 To bm\bmwidth - 1
             For n = 0 To bm\bmheight - 1
                s = Table + n * 4 + nn * bm\bmHeight * 4
                d = pixel + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4
                 CopyMemory (s, d + 2, 1)
                 CopyMemory (s + 1, d + 1, 1)
                 CopyMemory (s + 2, d, 1)
             Next
            table + 4
         Next
        HDC = StartDrawing ( ImageOutput (image))
             SetDIBits_ (HDC, ImageID , 0, ImageHeight (Image), pixel, bmi, #DIB_RGB_COLORS )
         StopDrawing ()
         FreeMemory (pixel)
         ProcedureReturn 1
     EndIf
EndProcedure

ProcedureDLL EnlightenImage(Image, Level.f) ; Eclairci l'image, Level doit être compris entre 0 et 1
     If IsImage (Image) And Level >= 0 And Level = < 1
         ImageID (Image)
        WI = ImageWidth (Image)
        HI = ImageHeight (Image)
         Dim Image(WI, HI)
        ImageToTable(Image, Image())
         For y = 0 To HI - 1
             For x = 0 To WI - 1
                color = Image(x, y)
                r = Int ((255 - Red (color)) * level + Red (color))
                v = Int ((255 - Green (color)) * level + Green (color))
                b = Int ((255 - Blue (color)) * level + Blue (color))
                Image(x, y) = RGB (r, v, b)
             Next
         Next
        TableToImage(Image, Image())
         ProcedureReturn 1
     EndIf
EndProcedure

OpenWindow (0, 0, 0, 200, 100, "Test" , #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget )
CreateGadgetList ( WindowID ( 0))

TrackBarGadget (1, 0,20, 200, 25, 0, 100)
CreateImage (2, 200, 40)
StartDrawing ( ImageOutput (2))

For i=0 To 20
    LineXY (0,20+i,200,20+i, RGB (145-i*8,169-i*8,240-i*3))
    LineXY (0,20-i,200,20-i, RGB (145-i*8,169-i*8,240-i*3))
Next
StopDrawing ()
CopyImage (2,3)
ImageGadget (2, 0, 60, 200, 40, ImageID (2))

Repeat
     event = WaitWindowEvent ()
      Select event
           Case #PB_Event_Gadget
               Select EventGadget()
                   Case 1
                     CopyImage (3,2)
                    EnlightenImage(2, GetGadgetState (1)/100)
                     SetGadgetState (2, ImageID (2))
               EndSelect
      EndSelect

Until event = #WM_CLOSE

nikel ton code ^^. Sa peut se révéler très pratique

Merci bien c'est ce que je cherchais !

Oula un revenant Polonais

En direct de Pologne

Pour travailler plus vite, on peut se passer des fonction Red, Green, Blue, et RGB

Le gain est d'environ 30, 50% suivant le cas de figure

Code : Tout sélectionner

ProcedureDLL.l ColorLuminosity(Couleur, Echelle.f) ; Eclaicir ou foncer une couleur
  Protected Rouge, Vert, Bleu
  
  Rouge = Couleur & $FF
  Vert = Couleur >> 8 & $FF
  Bleu = Couleur >> 16
  Rouge * Echelle
  Vert * Echelle
  Bleu * Echelle
  
  If Rouge > 255 : Rouge = 255 : EndIf
  If Vert > 255 : Vert = 255 : EndIf
  If Bleu > 255 : Bleu = 255 : EndIf
  
  ProcedureReturn (Rouge | Vert <<8 | Bleu << 16)
EndProcedure

et pour le contraste si ca t'intéresse

Code : Tout sélectionner

ProcedureDLL.l ColorContrast(Couleur, Echelle.f) ; Constrater la couleur, échelle négative pour diminuer et positive pour augmenter.
  Protected Rouge, Vert, Bleu
  
  Rouge = Couleur & $FF
  Vert = Couleur >> 8 & $FF
  Bleu = Couleur >> 16
  Rouge * Echelle + 127 * (1 - Echelle)
  Vert * Echelle + 127 * (1 - Echelle)
  Bleu * Echelle + 127 * (1 - Echelle)
  
  If Rouge > 255 : Rouge = 255
  ElseIf Rouge < 0 : Rouge = 0 : EndIf
  If Vert > 255 : Vert = 255
  ElseIf Vert < 0 : Vert = 0 : EndIf
  If Bleu > 255 : Bleu = 255
  ElseIf Bleu < 0 : Bleu = 0 : EndIf
  
  ProcedureReturn (Rouge | Vert <<8 | Bleu << 16)
EndProcedure

et tu n'avais pas aussi un code similaire pour melanger 2 couleurs ?

Code : Tout sélectionner

ProcedureDLL.l ColorBlending(Couleur1.l, Couleur2.l, Echelle.f) ; Mélanger 2 couleurs
  Protected Rouge, Vert, Bleu, Rouge2, Vert2, Bleu2
  
  Rouge = Couleur1 & $FF
  Vert = Couleur1 >> 8 & $FF
  Bleu = Couleur1 >> 16
  Rouge2 = Couleur2 & $FF
  Vert2 = Couleur2 >> 8 & $FF
  Bleu2 = Couleur2 >> 16
  
  Rouge = Sqr(Rouge * Rouge * Echelle + Rouge2 * Rouge2 * (1 - Echelle))
  Vert = Sqr(Vert * Vert * Echelle + Vert2 * Vert2 * (1 - Echelle))
  Bleu = Sqr(Bleu * Bleu * Echelle + Bleu2 * Bleu2 * (1 - Echelle))
  
  ProcedureReturn (Rouge | Vert <<8 | Bleu << 16)
EndProcedure

J'ai ce code pas trop rapide car il utilise des carré et sqr mais c'est celui que je trouve le plus réaliste au niveau rendu.

sinon tu utilises ceci

Code : Tout sélectionner

Rouge = Red(Couleur1) * Echelle + Red(Couleur2) * (1-Echelle)
Vert = Green(Couleur1) * Echelle + Green(Couleur2) * (1-Echelle)
Bleu = Blue(Couleur1) * Echelle + Blue(Couleur2) * (1-Echelle)

a la place de

Code : Tout sélectionner

  Rouge = Sqr(Rouge * Rouge * Echelle + Rouge2 * Rouge2 * (1 - Echelle))
  Vert = Sqr(Vert * Vert * Echelle + Vert2 * Vert2 * (1 - Echelle))
  Bleu = Sqr(Bleu * Bleu * Echelle + Bleu2 * Bleu2 * (1 - Echelle))

Le Soldat Inconnu a écrit :

Code : Tout sélectionner

ProcedureDLL.l ColorBlending(Couleur1.l, Couleur2.l, Echelle.f) ; Mélanger 2 couleurs
  Protected Rouge, Vert, Bleu, Rouge2, Vert2, Bleu2
  
  Rouge = Couleur1 & $FF
  Vert = Couleur1 >> 8 & $FF
  Bleu = Couleur1 >> 16
  Rouge2 = Couleur2 & $FF
  Vert2 = Couleur2 >> 8 & $FF
  Bleu2 = Couleur2 >> 16
  
  Rouge = Sqr(Rouge * Rouge * Echelle + Rouge2 * Rouge2 * (1 - Echelle))
  Vert = Sqr(Vert * Vert * Echelle + Vert2 * Vert2 * (1 - Echelle))
  Bleu = Sqr(Bleu * Bleu * Echelle + Bleu2 * Bleu2 * (1 - Echelle))
  
  ProcedureReturn (Rouge | Vert <<8 | Bleu << 16)
EndProcedure

J'ai ce code pas trop rapide car il utilise des carré et sqr mais c'est celui que je trouve le plus réaliste au niveau rendu.

sinon tu utilises ceci

Code : Tout sélectionner

Rouge = Red(Couleur1) * Echelle + Red(Couleur2) * (1-Echelle)
Vert = Green(Couleur1) * Echelle + Green(Couleur2) * (1-Echelle)
Bleu = Blue(Couleur1) * Echelle + Blue(Couleur2) * (1-Echelle)

a la place de

Code : Tout sélectionner

  Rouge = Sqr(Rouge * Rouge * Echelle + Rouge2 * Rouge2 * (1 - Echelle))
  Vert = Sqr(Vert * Vert * Echelle + Vert2 * Vert2 * (1 - Echelle))
  Bleu = Sqr(Bleu * Bleu * Echelle + Bleu2 * Bleu2 * (1 - Echelle))

Merci

@Régis,

Les gains que tu proposes ont été mesurés avec pb4?

En tout cas ma fonction pour application direct à une image corrigée

(Merci Régis, amuse toi bien avec les polonaises

)

ProcedureDLL EnlightenImage(Image, Level.f) ; Eclairci l'image, Level doit être compris entre 0 et 1
      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)
                     t = color & $FF : b = Int ((255 - t) * level + t)
                     t = color >> 8 & $FF : v = Int ((255 - t) * level + t)
                     t = color >> 16 : r = Int ((255 - t) * level + t)
                      PokeL (s, b | v << 8 | r << 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

Les gains sont ceux obtenu avec PB3.94. c'est des calcul fait lors de l'optimisation de ma lib Effect

PureBasic

Connaitre l'opération pour éclaircir une couleur

Connaitre l'opération pour éclaircir une couleur