PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

image .. reduction des couleurs

http://forums.purebasic.com/french/viewtopic.php?t=15882

Page 1 sur 1

Re: image .. reduction des couleurs

Publié : dim. 13/mars/2016 14:14
par 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

Re: image .. reduction des couleurs

Publié : dim. 13/mars/2016 23:23
par 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.

Image

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

Re: image .. reduction des couleurs

Publié : lun. 14/mars/2016 7:11
par Micoute
Merci Spock pour ce très travail partagé, ça le fait mieux comme ça.

Re: image .. reduction des couleurs

Publié : lun. 14/mars/2016 11:55
par 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.

Re: image .. reduction des couleurs

Publié : lun. 14/mars/2016 13:14
par Ar-S
Bien j'arrête là mes recherches...
Vu que PB sait tout faire ^^

Image
Le modele

2bits Image - 4bits (16c)Image

8bits (256c) Image - 24bits Image

Et il utilise bien Floyd..
Voilà voilà :mrgreen:

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

Re: image .. reduction des couleurs

Publié : lun. 14/mars/2016 17:53
par 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 :


Image
Le modele

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

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 :wink:

Re: image .. reduction des couleurs

Publié : lun. 14/mars/2016 18:43
par 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

Re: image .. reduction des couleurs

Publié : lun. 14/mars/2016 20:41
par 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)

Re: image .. reduction des couleurs

Publié : mer. 16/mars/2016 14:50
par Shadow
Cool :)

Re: image .. reduction des couleurs

Publié : jeu. 17/mars/2016 23:10
par Ar-S
J'ai pas encore re-testé mais vue tes captures c'est du propre bravo.

Re: image .. reduction des couleurs

Publié : ven. 18/mars/2016 9:36
par Micoute
Bonjour Spock, je réitère mes remerciements pour ce magnifique travail.
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru