PureBasic

; Auteur : Le Soldat Inconnu
; Version de PB : 4.50
;
; Explication du programme :
; Changer la teinte d'une couleur

Procedure ColorTint2(Color, Level.d) ; Change color tint (-1 <= Level <= 1)
   Protected Rouge, Vert, Bleu, Alpha, a.d, Nuance_Blanc, Nuance_Noir, b.d, i, ii
 
   If Level > 0.5
      Level -1
   ElseIf Level < -0.5
      Level + 1
   EndIf
   If Level > 1
      Level = 1
   ElseIf Level < -1
      Level = -1
   EndIf
   
  Rouge = Color & $FF
  Vert = Color >> 8 & $FF
  Bleu = Color >> 16 & $FF
   Alpha = Color >> 24
   
   ; Recherche de la teinte
   If Bleu >= Vert And Bleu >= Rouge And Bleu > 0
    a = 255 / Bleu
    Nuance_Noir = 255 - Bleu
    Bleu = 255
    Vert = a * Vert
    Rouge = a * Rouge
   ElseIf Vert >= Bleu And Vert >= Rouge And Vert > 0
    a = 255 / Vert
    Nuance_Noir = 255 - Vert
    Bleu = a * Bleu
    Vert = 255
    Rouge = a * Rouge
   ElseIf Rouge >= Vert And Rouge >= Bleu And Rouge > 0
    a = 255 / Rouge
    Nuance_Noir = 255 - Rouge
    Bleu = a * Bleu
    Vert = a * Vert
    Rouge = 255
   Else
    Nuance_Noir = 255
    Bleu = 255
    Vert = 255
    Rouge = 255
   EndIf
 
  If Bleu < Vert And Bleu < Rouge
    a = 1 - (Bleu / 255)
    Nuance_Blanc = 255 - Bleu
    Vert = (Vert - Bleu) / a
    Rouge = (Rouge - Bleu) / a
    Bleu = 0
   ElseIf Vert < Bleu And Vert < Rouge
    a = 1 - (Vert / 255)
    Nuance_Blanc = 255 - Vert
    Bleu = (Bleu - Vert) / a
    Rouge = (Rouge - Vert) / a
    Vert = 0
   ElseIf Rouge < Bleu And Rouge < Vert
    a = 1 - (Rouge / 255)
    Nuance_Blanc = 255 - Rouge
    Bleu = (Bleu - Rouge) / a
    Vert = (Vert - Rouge) / a
    Rouge = 0
   Else
    Nuance_Blanc = 255
   EndIf
   
   ii = Level * 1530
   If ii > 0
      For i = 1 To ii
         If Rouge = 255 And Vert <> 255 And Bleu = 0
            Vert + 1
         ElseIf Vert = 255 And Rouge <> 0 And Bleu = 0
            Rouge - 1
         ElseIf Vert = 255 And Bleu <> 255 And Rouge = 0
            Bleu + 1
         ElseIf Bleu = 255 And Vert <> 0 And Rouge = 0
            Vert - 1
         ElseIf Bleu = 255 And Rouge <> 255 And Vert = 0
            Rouge + 1
         ElseIf Rouge = 255 And Bleu <> 0 And Vert = 0
            Bleu - 1
         EndIf
      Next
   Else
      ii = -ii
      For i = 1 To ii
         If Bleu = 255 And Vert <> 255 And Rouge = 0
            Vert + 1
         ElseIf Vert = 255 And Bleu <> 0 And Rouge = 0
            Bleu - 1
         ElseIf Vert = 255 And Rouge <> 255 And Bleu = 0
            Rouge + 1
         ElseIf Rouge = 255 And Vert <> 0 And Bleu = 0
            Vert - 1
         ElseIf Rouge = 255 And Bleu <> 255 And Vert = 0
            Bleu + 1
         ElseIf Bleu = 255 And Rouge <> 0 And Vert = 0
            Rouge - 1
         EndIf
      Next
   EndIf
   
  a = 1 - Nuance_Blanc / 255
  b = (255 - Nuance_Noir) / 255
  Rouge = (Rouge + (255 - Rouge) * a) * b
  If Rouge < 0
    Rouge = 0
   ElseIf Rouge > 255
    Rouge = 255
   EndIf
  Vert = (Vert + (255 - Vert) * a) * b
  If Vert < 0
    Vert = 0
   ElseIf Vert > 255
    Vert = 255
   EndIf
  Bleu = (Bleu + (255 - Bleu) * a) * b
  If Bleu < 0
    Bleu = 0
   ElseIf Bleu > 255
    Bleu = 255
   EndIf
   
   ProcedureReturn (Rouge | Vert <<8 | Bleu << 16 | Alpha << 24)
EndProcedure

CompilerIf #PB_Compiler_Debugger
   #NbIterationTestVitesse = 720
CompilerElse
   #NbIterationTestVitesse = 72000
CompilerEndIf

; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, 501, 320, "ColorTint", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0
  End
EndIf

CreateImage(0, 501, 300, 32 | #PB_Image_Transparent)

StartDrawing(ImageOutput(0))
   DrawingMode(#PB_2DDrawing_AlphaBlend)
   
   Line(100, 0, 1, 300, $FF000000)
   
   For i = 0 To 500
      
      Teinte.f = (i - 100) / 500
      
      y = 10
      
      Couleur = $FF00FF00
      Couleur2 = ColorTint2(Couleur, Teinte)
      Line(i, y, 1, 20, Couleur2)
      y + 30
      
      Couleur = $FF0000FF
      Couleur2 = ColorTint2(Couleur, Teinte)
      Line(i, y, 1, 20, Couleur2)
      y + 30
      
      Couleur = $FFFF0000
      Couleur2 = ColorTint2(Couleur, Teinte)
      Line(i, y, 1, 20, Couleur2)
      y + 30
      
      Couleur = $FFC0A137
      Couleur2 = ColorTint2(Couleur, Teinte)
      Line(i, y, 1, 20, Couleur2)
      y + 30
      
      Couleur = $FFD6FFAD
      Couleur2 = ColorTint2(Couleur, Teinte)
      Line(i, y, 1, 20, Couleur2)
      y + 30
      
      Couleur = $FFFFFDEC
      Couleur2 = ColorTint2(Couleur, Teinte)
      Line(i, y, 1, 20, Couleur2)
      y + 30
      
      Couleur = $FFFFFFFF
      Couleur2 = ColorTint2(Couleur, Teinte)
      Line(i, y, 1, 20, Couleur2)
      y + 30
      
      Couleur = $FF163205
      Couleur2 = ColorTint2(Couleur, Teinte)
      Line(i, y, 1, 20, Couleur2)
      y + 30
      
      Couleur = $FF000000
      Couleur2 = ColorTint2(Couleur, Teinte)
      Line(i, y, 1, 20, Couleur2)
      y + 30
      
   Next
   
   Couleur = $FFC0A137
   Temps = ElapsedMilliseconds()
   For i = 1 To #NbIterationTestVitesse
      Couleur2 = ColorTint2(Couleur, 0.5)
   Next
   Temps = ElapsedMilliseconds() - Temps
   
StopDrawing()


ImageGadget(0, 0, 0, 501, 300, ImageID(0))
TextGadget(1, 0, 300, 501, 20, "Temps de calcul = " + StrD(Temps * 1000 / #NbIterationTestVitesse, 1) + "µs")

Repeat
  Event = WaitWindowEvent()
 
  Select Event
      Case #PB_Event_Menu
      Select EventMenu() ; Menus
         
         EndSelect
     
      Case #PB_Event_Gadget
      Select EventGadget() ; Gadgets
         
         EndSelect
   EndSelect
 
Until Event = #PB_Event_CloseWindow