Réduction de couleur: Floyd–Steinberg dithering

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Réduction de couleur: Floyd–Steinberg dithering

Message par Fig »

Une simple réduction du nombre de couleur dans une image crée des aplats disgracieux. (image 2 du chat)
Avec l'algorithme de Floyd–Steinberg, l'erreur est répartie sur les pixels en créant un effet pointillé qui peut bluffer l’œil humain créant artificiellement plus de nuances. (image 3 du chat)

lire: https://fr.wikipedia.org/wiki/Algorithm ... -Steinberg

Le programme vous demandera de choisir une image (bmp ou jpg) et sauvegardera une version allégée en couleurs. On peut régler la réduction du nombre de couleur avec la constante #factor.
Ce n'est pas une application, juste une astuce, à intégrer à un logiciel plus complet, éventuellement.

Image

Nb: NewR/G/B peut être remplacé par n'importe quelle réduction de couleur.

Code : Tout sélectionner

;Floyd–Steinberg dithering
#factor=8 ;modify this value to change the number of color in final picture.
File$ = OpenFileRequester("Select a picture to convert","","",0)
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or OpenWindow(0, 0, 0, 720,854, "Dithering", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)=0 Or OpenWindowedScreen(WindowID(0),0,0,720,854,0,0,0,#PB_Screen_NoSynchronization)=0
   MessageRequester("Error", "Can't open the sprite system", 0)
   End
EndIf
Structure pxl
   R.w
   G.w
   B.w
   x.i
   y.i
   errordif.f
EndStructure
UseJPEGImageDecoder()
LoadSprite(0,File$)
Dim pxl.pxl(3)
pxl(0)\x=1:pxl(0)\y=0:pxl(0)\errordif=7/16
pxl(1)\x=-1:pxl(1)\y=1:pxl(1)\errordif=3/16
pxl(2)\x=0:pxl(2)\y=1:pxl(2)\errordif=5/16
pxl(3)\x=1:pxl(3)\y=1:pxl(3)\errordif=1/16
StartDrawing(SpriteOutput(0))
For y=0 To SpriteHeight(0)-2
   For x=1 To SpriteWidth(0)-2
      pixel.i=Point(x,y)
      oldR.a=Red(pixel)
      oldG.a=Green(pixel)
      oldB.a=Blue(pixel)
      newR.f=Round(oldr*#factor/255,#PB_Round_Nearest)*255/#factor
      newG.f=Round(oldg*#factor/255,#PB_Round_Nearest)*255/#factor
      newB.f=Round(oldb*#factor/255,#PB_Round_Nearest)*255/#factor
      errR.f=oldR-newR
      errG.f=oldG-newG
      errB.f=oldB-newB
      For i=0 To 3
         color.i=Point(x+pxl(i)\x,y+pxl(i)\y)
         pxl(i)\R=Red(color)+errR*pxl(i)\errordif
         pxl(i)\G=Green(color)+errG*pxl(i)\errordif
         pxl(i)\B=Blue(color)+errB*pxl(i)\errordif
         If pxl(i)\R<0:pxl(i)\R=0:EndIf
         If pxl(i)\R>255:pxl(i)\R=255:EndIf
         If pxl(i)\G<0:pxl(i)\G=0:EndIf
         If pxl(i)\G>255:pxl(i)\G=255:EndIf
         If pxl(i)\B<0:pxl(i)\B=0:EndIf
         If pxl(i)\B>255:pxl(i)\B=255:EndIf
         Plot(x+pxl(i)\x,y+pxl(i)\y,RGB(pxl(i)\R,pxl(i)\G,pxl(i)\B))
      Next i
   Next x
Next y
StopDrawing()
SaveSprite(0,"test.bmp")
Edit: Je viens de voir que Dobro en a déjà implanté un dans son programme.
http://www.purebasic.fr/french/viewtopi ... =3&t=16784
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Réduction de couleur: Floyd–Steinberg dithering

Message par Ar-S »

Et tu as vu que la fonction encodeimage à l'option #PB_Image_FloydSteinberg ?
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Réduction de couleur: Floyd–Steinberg dithering

Message par Zorro »

@Fig
C'est quand meme bien cool de voir un code spécialisé
Pour le floyd :)

Merci :)
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Répondre