MISE EN NOIR ET BLANC D'UNE TIMAGE

Commentaire de balgrim le 26/10/2002 21:23:11

var
x,y:integer;
pix:dword;
r,g,b:byte;
moyenne:byte;

begin
for x:=1 to image1.picture.width do                 //on prend une ligne
begin
for y:=1 to image1.picture.height do                 //les colonnes de cette ligne
        begin
        pix:=image1.canvas.Pixels[x,y];                         //on prend les couleurs RVB
        asm
        push eax
        mov eax,pix
        mov r,al
        mov g,ah
        shr eax,16
        mov b,al
        pop eax
        end;
        moyenne:=Byte((r+g+b)/3)
        image2.Canvas.pixels[x,y]:=rgb(moyenne,moyenne,moyenne);           //ecriture du pixel en N&B a la même place sur l'autre Timage
        end;
end;

Commentaire de ender27 le 11/03/2008 11:32:08

J'ai un problème avec le code de morpheus, car lorsque l'image apparaît dans le TImage numéro2, elle se trouve agrandie par rapport à l'image de départ. Savez-vous d'où vient ce problème?

Commentaire de arckhenstone le 30/03/2009 10:38:28

quelqu'un aurait un site ou un lien web a me conseiller pour un programme qui permet de mettre une image en NOIR et BLANC et pas en niveau de gris ?
Merci d'avance.
Sinon comme pour ender27, mon image est grossie après la mise en niveau de gris?

Commentaire de arckhenstone le 31/03/2009 09:02:44

Donc ca me donnerai en gros ça comme code ?
je dois avoir des erreur ... ca ne marche pas :(



procedure TForm1.BiChromieClick(Sender: TObject);
const
seuil=128;
var
x,y:word;
begin

  for x:=0 to image1.picture.width do // pour les x
  begin

      for y:=0 to image1.picture.height  do // pour les y
      begin
          if image1.Picture.Bitmap.Canvas.Pixels [x,y]>seuil then
          image1.Picture.Bitmap.Canvas.Pixels [x,y] =255 else image1.Picture.Bitmap.Canvas.Pixels [x,y]=0;
      end;

  end;

end;

Commentaire de arckhenstone le 31/03/2009 10:21:56

Yes !!! maintenant mon image est bien tramer en noir et blanc MAIS lol :(
il y a de multiples pixels blanc comme si mon image n'était pas propre
par exemple j'ai une image toute noire avec un cercle blanc dessus et en fait autour du cercle blanc
j'ai une panoplie de petit point blanc :s



voici le nouveau code :


procedure TForm1.BiChromieClick(Sender: TObject);
Const
seuil=128;
Var
x,y:word;
begin

  for x:=0 to image1.picture.width do
  begin

      for y:=0 to image1.picture.Height do
      begin
          if image1.Picture.Bitmap.Canvas.Pixels [x,y]>seuil then
          image1.Picture.Bitmap.Canvas.Pixels [x,y]:=rgb(255,255,255) else image1.Picture.Bitmap.Canvas.Pixels [x,y]:=0;
      end;

  end;

end;



encore merci pour ton aide Renfield :D c'est super sympa !

Commentaire de arckhenstone le 31/03/2009 11:19:32

j'y ai déjà été, mais malheureusement, avec l'ordi qu'il m'ont filé sur mon lieu de stage je ne peux rien dlw... donc je ne peux pas accéder au ligne du code...
Merci quand même Cirec.

Commentaire de arckhenstone le 31/03/2009 14:07:41

Voila j'ai réussi à mettre mon image en noir et blanc sans aucun soucil.
Meric pour votre aide.

procedure TForm1.BiChromieClick(Sender: TObject);
Const
seuil=128;
filtrage=$ffffff; //blanc
Var
x,y,A,B:word;
begin
x:=A+1;
x:=B-1;
  for x:=0 to image1.picture.width-1 do
  begin

      for y:=0 to image1.picture.Height-1 do
      begin
          if image1.Picture.Bitmap.Canvas.Pixels [x,y]and $ff>seuil then
          image1.Picture.Bitmap.Canvas.Pixels [x,y]:=$ffffff else image1.Picture.Bitmap.Canvas.Pixels [x,y]:=$000000;

      end;
  end;

end;


Lol maintenant il faudrait que grâce à mon image noir et blanc je trouve le centre de gravité de l'image en utilisant le calcul des moments géométriques. Et aussi, complétement à part, que je mette dans un afficheur la luminosité moyenne de l'image
Lol dure la première semaine à faire du DELPHI :s

Une idée ? lol