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.
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")
http://www.purebasic.fr/french/viewtopi ... =3&t=16784