image .. reduction des couleurs

[Ar-S]

Ajout de pathimage$ pour retrouver la photo sauvée au même endroit que l'originale

Code : Tout sélectionner

 If NomFichier$<>""
     Resultat = LoadImage(#Image, NomFichier$ ) ; on charge une image
     pathImage$ = GetPathPart(NomFichier$) ; Ici
      Global format$=GetExtensionPart(NomFichier$)
   EndIf

et évidement dns la sauvegarde

Code : Tout sélectionner

SaveImage(#image,pathimage$+"resultat_en_"+str(couleur)+".bmp",#PB_ImagePlugin_BMP)

J'ai fait des essais en 512, le resultat est vraiment pas très beau. Il faudrait trouver un bon algo de conversion.

J'ai fait ça mais j'ai du me piner quelque part. ^^

Code : Tout sélectionner

Procedure FloydSteinberg(nb_image)
  ; by Ar-S // Pseudo code ici : https://fr.wikipedia.org/wiki/Algorithme_de_Floyd-Steinberg
  largeur_image=ImageWidth(nb_image)
  Hauteur_image=ImageHeight(nb_image)
  
  ; mise en tableau
  Global Dim TAB(largeur_image,Hauteur_image)
  StartDrawing(ImageOutput(nb_image))
  For y=0 To Hauteur_image-1
    For x=0 To largeur_image-1
      TAB(x,y)=Point(x,y)
    Next x
  Next y
  
  ; PSEUDO CODE
  ; ancien_pixel := pixel[x][y]
  ; nouveau_pixel  := couleur_la_plus_proche(ancien_pixel)
  ; pixel[x][y]  := nouveau_pixel
  ; erreur_quantification  := ancien_pixel - nouveau_pixel
  ; pixel[x+1][y  ] := pixel[x+1][y  ] + 7/16 * erreur_quantification
  ; pixel[x-1][y+1] := pixel[x-1][y+1] + 3/16 * erreur_quantification
  ; pixel[x  ][y+1] := pixel[x  ][y+1] + 5/16 * erreur_quantification
  ; pixel[x+1][y+1] := pixel[x+1][y+1] + 1/16 * erreur_quantification
  
  ;Traitement
  For y=0 To Hauteur_image-1
    For x=0 To largeur_image-1
      
      If y>0 And X > 1
        Debug "ok"
        
      OldPix = TAB(x,y)
      I1 = TAB(x+1,y+1)
      I2 = TAB(x-1,y+2)
      I3 = Tab(x,y+1)
      I4 = Tab(x+1,y+2)
      
      If OldPix+I1 < OldPix+I2 And OldPix+I1 < OldPix+I3 And OldPix+I1 < OldPix+I4
        NewPix = I1
      ElseIf OldPix+I2 < OldPix+I1 And OldPix+I2 < OldPix+I3 And OldPix+I2 < OldPix+I4
         NewPix = I2
      ElseIf OldPix+I3 < OldPix+I1 And OldPix+I3 < OldPix+I2 And OldPix+I3 < OldPix+I4
        NewPix = I3
      Else
        NewPix = I4
      EndIf

      
      TAB(x,y)    = NewPix
      Err = OldPix-NewPix
      TAB(x+1,y)   = TAB(x+1,y)   + 7/16 * Err
      TAB(x-1,y+1) = TAB(x-1,y+1) + 3/16 * Err
      TAB(x,y+1)   = TAB(x,y+1)   + 5/16 * Err
      TAB(x+1,y+1) = TAB(x+1,y+1) + 1/16 * Err
    EndIf
    
    Next x
  Next y   
  
  ;Creation image tramée
  For y=0 To Hauteur_image-1
    For x=0 To largeur_image-1
      Coul = Tab(x,y)
      Plot(x,y,coul)
    Next x
  Next y   
  
  StopDrawing()
  
  MessageRequester("terminé","Terminé",0)
EndProcedure

[Ar-S]

C'est pas mal mais sur une photo d'humain avec decort c'est pas encore ça.

Voilà une capture :
Original - photoshop 256c - ton prog 256c

Si ça peu t'orienter.



On voit clairement que photoshop utilise le tramage pour adapter la palette.

[Micoute]

Merci Spock pour ce très travail partagé, ça le fait mieux comme ça.

[Ar-S]

Y'a du mieux
Je trouve que cet algo contrastre trop les différentes pixels et assombrit un poil trop l'image.
Je vais faire des essayes de mon coté
J'ai mis la photo à jour plus haut pour que tu vois le résultat de ton nouveau code.

[Ar-S]

Bien j'arrête là mes recherches...
Vu que PB sait tout faire ^^


Le modele

2bits - 4bits (16c)

8bits (256c) - 24bits

Et il utilise bien Floyd..
Voilà voilà

Code : Tout sélectionner

UsePNGImageDecoder():UseJPEGImageDecoder()
UsePNGImageEncoder()

Global fichier$   ; Chemin image
Global Path$ = GetCurrentDirectory()
fichier$ = OpenFileRequester("Charge une image", path$+"tete_modele.png", "image|*.bmp;*.jpg;*.png", 0) ; on choisit un ficher
If fichier$
  LoadImage(0,fichier$)
Else
  MessageRequester("image","choisir un fichier !",0)
  End
EndIf


Procedure Encode(name.s, bits=8) ; (bits 2,4,8,24,32)
*Buffer = EncodeImage(0,#PB_ImagePlugin_PNG,#PB_Image_FloydSteinberg,bits)
CatchImage(1,*Buffer)
OpenWindow(0,0,0,ImageWidth(0),ImageHeight(0),"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ImageGadget(0,0,0,ImageWidth(0),ImageHeight(0),ImageID(1))
SaveImage(1,path$+name.s,#PB_ImagePlugin_PNG)
EndProcedure

Encode("tete_modele_2bits.png",2)
Encode("tete_modele_4bits.png",4)
Encode("tete_modele_8bits.png",8)
Encode("tete_modele_24bits.png",24)


Repeat
  Select WaitWindowEvent()
     
       Case #PB_Event_CloseWindow
            Quit = 1
           
  EndSelect

Until Quit = 1
End

[Ar-S]

Et Encode c'est pour la démonstration pour l'affichage,

Le Floyd et la diminution de couleur peuvent s'appliquer lors de la sauvegarde. Le Floyd étant applicable sur une image 1,2,4,8 bits
La Doc à ce propos à oublié le 2 bits (alors que sur 1bit le resultat n'est pas probant)

Voilà une démo d'avec et sans Floyd de 1 à 24bits comme ça tu es paré pour tes progs

Code : Tout sélectionner

UsePNGImageDecoder():UseJPEGImageDecoder()
UsePNGImageEncoder()

Global fichier$   ; Chemin image
Global Path$ = GetCurrentDirectory()
fichier$ = OpenFileRequester("Charge une image", path$+"tete_modele.png", "image|*.bmp;*.jpg;*.png", 0) ; on choisi un ficher
If fichier$
  LoadImage(0,fichier$)
Else
  MessageRequester("image","choisir un fichier !",0)
  End
EndIf


Procedure SaveImageBits(Name.s,bits=24,FILTER=0)
  Protected.b ok
  
  Select Bits
      Case 1,2,4,8
        If FILTER = 1
          FILTER = #PB_Image_FloydSteinberg
          else
         FILTER = 0
        EndIf
      Case 24,32
        FILTER = 0
  EndSelect
  
  If SaveImage(0,path$+name.s,#PB_ImagePlugin_PNG,FILTER,bits)  
    ok=1
    Else
  ok=0
  EndIf        
            
  ProcedureReturn OK
EndProcedure

OpenWindow(0,0,0,ImageWidth(0),ImageHeight(0),"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

SaveImageBits("tete_modele_1bits.png",1,0)
SaveImageBits("tete_modele_1bits_FLOYD.png",1,1)
ImageGadget(0,0,0,ImageWidth(0),ImageHeight(0),ImageID(0))

SaveImageBits("tete_modele_2bits.png",2,0)
SaveImageBits("tete_modele_2bits_FLOYD.png",2,1)
ImageGadget(0,0,0,ImageWidth(0),ImageHeight(0),ImageID(0))

SaveImageBits("tete_modele_4bits.png",4,0)
SaveImageBits("tete_modele_4bits_FLOYD.png",4,1)
ImageGadget(0,0,0,ImageWidth(0),ImageHeight(0),ImageID(0))

SaveImageBits("tete_modele_8bits.png",8,0)
SaveImageBits("tete_modele_8bits_FLOYD.png",8,1)
ImageGadget(0,0,0,ImageWidth(0),ImageHeight(0),ImageID(0))


Repeat
  Select WaitWindowEvent()
     
       Case #PB_Event_CloseWindow
            Quit = 1
           
  EndSelect

Until Quit = 1
End

Ce qui donne :



Le modele

1bit Floyd - 1bit sans Floyd
2bits Floyd - 2bits Sans Floyd -
4bits Floyd (16c) - 4bits sans Floyd
8bits Floyd (256c) - 8bits sans Floyd (256c)
24bits

Je trouve que l'avantage du Floyd est surtout pour du 256 couleurs (8bits), on voit dans l'exemple que le dégradé est mieux rend avec lui.

Voilà la boucle est bouclée

[Shadow]

Voici mon code à moi, rien de mieux en soit:

Code : Tout sélectionner

; Code crée par Monsieur Dieppedalle David le 14/03/2016.

Global NomFichierImage$

; Procedure de chargement d'une image
Procedure.l ChargementImage(NumeroImage.i, NumeroFiltreDefaut.i)
  
  Filtre$ = "Image Bmp (*.Bmp)|*.Bmp|Image Png (*.Png)|*.Png|Image Jpg (*.Jpg)|*.Jpg|Image Tga (*.Tga)|*.Tga|Image Tiff (*.Tiff)|*.Tiff"
  FichierImage$ = OpenFileRequester("Choisissez un fichier à charger...", GetHomeDirectory() + "Bureau\", Filtre$, NumeroFiltreDefaut.i)
  NomFichierImage$ = GetFilePart(FichierImage$, #PB_FileSystem_NoExtension)
  
  If FichierImage$
    
    If FindString(LCase(GetFilePart(FichierImage$)), ".bmp", 1)
      ; Ok
      
    ElseIf FindString(LCase(GetFilePart(FichierImage$)), ".png", 1)
      UsePNGImageDecoder()
      
    ElseIf FindString(LCase(GetFilePart(FichierImage$)), ".jpg", 1)
      UseJPEGImageDecoder()
      
    ElseIf FindString(LCase(GetFilePart(FichierImage$)), ".tga", 1)
      UseTGAImageDecoder()
      
    ElseIf FindString(LCase(GetFilePart(FichierImage$)), ".tiff", 1)
      UseTIFFImageDecoder()
      
    Else
      MessageRequester("Fichier invalide !", "      Veuillez choisir un fichier d'image invalide !", 48)
      End
      
    EndIf
    
    If LoadImage(NumeroImage.i, FichierImage$) <> 0
      ProcedureReturn LoadImage(NumeroImage.i, FichierImage$)
      
    Else
      MessageRequester("Erreur de chargement !", "      Impossible de charger le fichier " + Chr(34) + GetFilePart(FichierImage$) + Chr(34) + " !", 16)
      End
      
    EndIf
    
  EndIf
  
EndProcedure

; Procedure d'enregistrement d'une image
Procedure.l EnregsitrerImage(NumeroImage.i, NumeroFiltreDefaut.i, QualiterEnregistrementImage.i, FloydSteinberg.i)
  
  ; Si l'image est initialisé.
  If Not IsImage(NumeroImage.i)
    MessageRequester("Enregistrement de l'image interompue !", "      Numéro de l'image invalide ! -> Non initialisé.", 48)
    End
    
  EndIf
  
  If NumeroFiltreDefaut.i < 0
    NumeroFiltreDefaut.i = 0
    
  ElseIf NumeroFiltreDefaut.i > 2
    NumeroFiltreDefaut.i = 2
    
  EndIf
  
  If QualiterEnregistrementImage.i < 0
    QualiterEnregistrementImage.i = 0
    
  ElseIf QualiterEnregistrementImage.i > 10
    QualiterEnregistrementImage.i = 10
    
  EndIf
  
  Filtre$ = "Image Bmp (*.Bmp)|*.Bmp|Image Png (*.Png)|*.Png|Image Jpg (*.Jpg)|*.Jpg"
  CheminEnregistrementFichierImage$ = SaveFileRequester("Choisissez le nom du fichier à enregistrer...", GetHomeDirectory() + "Bureau\", Filtre$, NumeroFiltreDefaut.i)
  ExtentionFichier$ = LCase(GetExtensionPart(CheminEnregistrementFichierImage$))
  
  If (Not ExtentionFichier$ = "bmp" And Not ExtentionFichier$ = "png" And Not ExtentionFichier$ = "jpg")
    
    If SelectedFilePattern() = 0
      CheminEnregistrementFichierImage$ + ".bmp"
      
    ElseIf SelectedFilePattern() = 1
      CheminEnregistrementFichierImage$ + ".png"
      
    ElseIf SelectedFilePattern() = 2
      CheminEnregistrementFichierImage$ + ".jpg"
      
    EndIf
    
  EndIf

  If CheminEnregistrementFichierImage$
    
    If FindString(LCase(GetFilePart(CheminEnregistrementFichierImage$)), ".bmp", 1)
      FormatSortie.i = #PB_ImagePlugin_BMP
      
    ElseIf FindString(LCase(GetFilePart(CheminEnregistrementFichierImage$)), ".png", 1)
      UsePNGImageEncoder()
      FormatSortie.i = #PB_ImagePlugin_PNG
      
    ElseIf FindString(LCase(GetFilePart(CheminEnregistrementFichierImage$)), ".jpg", 1)
      UseJPEGImageEncoder()
      FormatSortie.i = #PB_ImagePlugin_JPEG
      
    EndIf
    
    If FloydSteinberg.i = #False
      FloydSteinberg = 0
      
    ElseIf FloydSteinberg.i = #True
      FloydSteinberg.i = #PB_Image_FloydSteinberg
      
    EndIf
    
    If SaveImage(NumeroImage.i, CheminEnregistrementFichierImage$, FormatSortie.i, QualiterEnregistrementImage.i | FloydSteinberg.i)
      ProcedureReturn 1
      
    Else
      MessageRequester("Erreur de d'enregistrement !", "      Impossible d'enregistrer l'image !", 16)
      End
      
    EndIf
    
  EndIf
  
EndProcedure

Procedure EncoderImage(NumeroImageSource.i, NumeroImageDestination.i, Profondeur.i = 24)
  
  Select Profondeur.i
      
    Case 1, 2, 4, 8, 24, 32
      
    Default
      MessageRequester("Profondeur invalide !", "      Veuillez choisir une Profondeur valide ! -> 1, 2, 4, 8, 24, 32.", 48)
      End
      
  EndSelect
  
  ; Si l'image est initialisé.
  If IsImage(NumeroImageSource.i)
    
    *MemoryIDImage = EncodeImage(NumeroImageSource.i, #PB_ImagePlugin_PNG,#PB_Image_FloydSteinberg, Profondeur.i)
    
    If *MemoryIDImage
      CatchImage(NumeroImageDestination.i, *MemoryIDImage)
      ProcedureReturn 1
      
    Else
      MessageRequester("Encodage de l'image impossible !", "      Impossible d'encoder l'image ! -> *MemoryIDImage = 0", 48)
      End
      
    EndIf
    
  Else
    MessageRequester("Encodage de l'image interompue !", "      Numéro de l'image invalide ! -> Non initialisé.", 48)
    End
    
  EndIf
  
EndProcedure

#ImageSource = 1
#ImageDestination = 2
#ImageEncodageProfondeur = 24

; Choix de l'image à charger.
NumeroImageSource.i = ChargementImage(#ImageSource, 1)

; Si le chargement de l'image a réussi.
If NumeroImageSource.i 
  
  ; Si l'image est initialisé.
  If IsImage(#ImageSource)
    
    EncoderImage(#ImageSource, #ImageDestination, #ImageEncodageProfondeur)
    EnregsitrerImage(#ImageDestination, 1, 10, #True)

  Else
    MessageRequester("Erreur !", "      Image non initialisé !", 16)
    End
    
  EndIf
  
EndIf

[Ar-S]

C'est peut-être pour ça qu'ils on mis

Pour l'instant, seuls les encodeurs BMP et PNG supportent le mode palettisé (1, 4 ou 8 bits).

(et que le 2bits est absent)...
Faudrait clarifier un poil la doc coté SaveImage()
Mais dans l'idéal reste de sauvegarder en png .. Y'a pas trop d'inéteret à sauver du 4 couleurs en BMP.
D'ailleurs même sous photoshop, tu ne peux jouer a réduire le nombre de couleurs qu'en png lors du "enregistrer pour le web" (qui est d'ailleurs limité à du png8)

[Shadow]

Cool

[Ar-S]

J'ai pas encore re-testé mais vue tes captures c'est du propre bravo.

[Micoute]

Bonjour Spock, je réitère mes remerciements pour ce magnifique travail.