Alterando uma imagem colorida para preto e branco (tons de cinza):
Exemplo:
dCopieImage(IMG_FAX1, IMG_FAX1, copiePasSrcCopie)
IMG_FAX1=dSauveImageJPEG(IMG_ORIGINE,enMémoire,100,imgNiveauDeGris)
Floyd_Steinberg(IMG_FAX1,POT_SEUIL)
Procedure Floyd_Steinberg(ChampImage,rSeuil=50)
nLargeur,nHauteur sont des entiers
nLargeur =ChampImage..Largeur
nHauteur =ChampImage..Hauteur
dDébutDessin(ChampImage)
nCouleurPoint est un entier
nNouvelleCouleurPoint est un entier
nQteErreur est un entier
POUR x=1 _A_ nLargeur
POUR y=1 _A_ nHauteur
nCouleurPoint=dPixelCouleur( x,y)
nNouvelleCouleurPoint=NouvelleCouleur(nCouleurPoint,rSeuil)
dPoint(x,y,nNouvelleCouleurPoint)
SI nNouvelleCouleurPoint<>iNoir ALORS
nQteErreur=255
SINON
nQteErreur=0
FIN
SI x<nLargeur ALORS dPoint(x+1,y,dPixelCouleur(x+1,y)+(nQteErreur*(7/16)))
SI y<nHauteur ALORS dPoint(x-1,y+1,dPixelCouleur(x-1,y+1)+(nQteErreur*(3/16)))
SI y<nHauteur ALORS dPoint(x,y+1,dPixelCouleur(x,y+1)+(nQteErreur*(5/16)))
SI y<nHauteur ALORS dPoint(x+1,y+1,dPixelCouleur(x+1,y+1)+(nQteErreur*(1/16)))
FIN
FIN
POUR x=1 _A_ nLargeur
POUR y=1 _A_ nHauteur
nCouleurPoint=dPixelCouleur( x,y)
SI nCouleurPoint<>iNoir ALORS
dPoint(x,y,iBlanc)
FIN
FIN
FIN
Procedure Monochrome(ChampImage,rSeuil=50)
nLargeur est un entier=ChampImage..Largeur
nHauteur est un entier=ChampImage..Hauteur
dDébutDessin(ChampImage)
POUR x=0 _A_ nLargeur
POUR y=0 _A_ nHauteur
dPoint(x,y,NouvelleCouleur(dPixelCouleur( x,y),rSeuil))
FIN
FIN
Procedure NouvelleCouleur(nCouleurPoint,rSeuil)
SI CouleurLuminosité(nCouleurPoint)>=rSeuil ALORS
RENVOYER iNoir
SINON
RENVOYER iBlanc
FIN
--
Adriano José Boller
______________________________________________
Consultor e Representante Oficial da
PcSoft no Brasil
+55 (41) 9949 1800
adrianoboller@gmail.com
skype: adrianoboller
http://wxinformatica.com.br/