Dernière connexion : 24/08/2025 à 18:04 Fin de session : 24/08/2025 à 18:14 Choisissez un forum: Forum ada95000 Ada 95--> Cours--> Structure de données--> ProjetsGénéral--> Des idées pour améliorer ce site ?--> Discussion générale Vous n'êtes pas connecté [Connexion - Inscription] Liste des membres   Rechercher   FAQ   Stats   Last Posts   Chatterbox Retour vers ada95000

Forum ada95000 » Ada 95 » Projets » Détection des contours dans une image

Version imprimable | Envoyer à un ami | S'abonner | Ajouter aux Favoris

« Sujet précédent | Sujet suivant »  Auteur: Sujet: Détection des contours dans une image   ( Réponses: 4 | Vues: 1977 ) ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 03/07/2004 à 19:29 Détection des contours dans une image Ce projet vise à détecter des contours dans une image. Je travaille pour l'instant sur des .pgm (images à niveaux de gris) de 256x256 pixels. La première méthode consiste à parcourir tous les pixels de l'image. La valeur du pixel est notée P. Pour chacun de ces pixels, on récupère la valeur maximale des 8 pixels de son entourage (notée Max). On marque le pixel dans l'image résultant du traitement si le coefficient  (P/Max) est inférieur à une valeur donnée, sinon, on le laisse blanc. Donc plus la tolérance est élevée, plus on a de détails. code: --////////////////////////////////////////////////////////////////////////-- --                       Code ecrit par Julien COIGNET              -- --                  Pour le CNAM de Cergy                  -- --                Sujet : Détection de contours                -- --            Traite exclusivement les images au format .pgm        -- --                d'une taille de 256 x 256 pixels              -- --            (intervalle du type TypeEntete à adapter            -- --              selon le logiciel qui a créé le .pgm)            -- --////////////////////////////////////////////////////////////////////////-- --with Paquetage_Image; use Paquetage_Image; with text_io; use text_io; with ada.integer_Text_Io; use ada.integer_Text_Io; with ada.Float_Text_Io; use ada.Float_Text_Io; with sequential_io; procedure Contours is --////////////////////////////////////////////////////////////////////////-- --                                    Paquetages                          -- --////////////////////////////////////////////////////////////////////////-- package fichier_car is new sequential_IO(character); use fichier_car; --////////////////////////////////////////////////////////////////////////-- --                                    Types                              -- --////////////////////////////////////////////////////////////////////////-- -- Type Entete: Vecteur qui contient l'entete du fichier image      -- Intervalles de TypeEntete suivant le logiciel :    --      --        irfanview : 0..37                  --      --        Paint Shop Pro : 0..42              --      --        CréationImage (logiciel maison) : 0..42  -- type TypeEntete is array (0..42) of character; -- Type Matrice: Matrice qui reçoit le contenu d'une image de 256 par 256 pixels type TypeMatrice is array (0..255, 0..255) of character; -- Type MatriceTrv : Matrice de plongement Type TypeMatriceTrv is array (0..257, 0..257) of character; --////////////////////////////////////////////////////////////////////////-- --                                    Fonctions                            -- --////////////////////////////////////////////////////////////////////////-- -- Fonction qui récupère l'entête du fichier image function getEntete(fichier : in fichier_car.file_type) return typeEntete is Car : character; Resultat : typeEntete; begin  for i in TypeEntete'Range loop    read(Fichier, car);    resultat(I) := Car;  end loop;  return resultat; end GetEntete; -- Lit le fichier et le met dans une matrice function FichierDansMatrice(fichier : in fichier_car.file_type) return typeMatrice is CarLu : character; Resultat : TypeMatrice; begin  -- On zappe l'entete  for i in TypeEntete'Range loop    read(Fichier, carLu);  end loop;  -- On remplit la matrice avec le contenu de l'image  for i in typeMatrice'range(1) loop    for j in typeMatrice'range(2) loop      read(Fichier, carLu);      resultat(i, j) := carLu;    end loop;  end loop;  return resultat; end FichierDansMatrice; -- Fonction qui retourne la matrice donnée en argument en matrice plongée function PlongerMatrice(MatriceIni : in TypeMatrice) return TypeMatriceTrv is   Resultat : TypeMatriceTrv; begin  -- On initialise les bords à 0  for i in Resultat'range(1) loop    Resultat(0, i) := character'val(0);    Resultat(257, i) := character'val(0);    Resultat(I, 0) := character'val(0);    Resultat(i, 257) := character'val(0);  end loop;  -- On remplit le reste  for i in MatriceIni'range(1) loop    for j in MatriceIni'range(2) loop      Resultat(I+1, J+1) := MatriceIni(I, J);    end loop;  end loop;  return resultat; end; -- Fonction qui détermine les contours selon la première méthode function ContoursImage1(MatriceI : in typeMatriceTrv; seuil : float := 0.5) return TypeMatrice is Resultat : TypeMatrice; Valeur, Max : integer; Coeff : float; begin  -- Pour chaque pixel de l'image...  for i in (MatriceI'First(1) + 1)..(MatriceI'last(1) - 1) loop    for j in (MatriceI'First(2) + 1)..(MatriceI'last(2) - 1) loop      Valeur := character'pos(MatriceI(i, j));      Max := Valeur;      -- ...on cherche la valeur la plus élevée des 9 pixels      for k in (i-1)..(i+1) loop        for l in (j-1)..(j+1) loop          if Max < character'pos(MatriceI(K, L)) then            Max := character'pos(matriceI(K, L));          end if;        end loop;      end loop;      --put(max);      if Max > 0 then        if ((float(Valeur) / float(Max)) <= Seuil) then          Resultat(i-1, j-1) := character'val(0);        else          Resultat(i-1, j-1) := character'val(255);        end if;      else        Resultat(i-1, j-1) := character'val(255);      end if;    end loop;  end loop;  return Resultat; end; --////////////////////////////////////////////////////////////////////////-- --                               Procédures                              -- --////////////////////////////////////////////////////////////////////////-- -- Procedure qui lit une matrice (TypeMatrice) et l'ecrit dans un fichier procedure EcrireMatriceDansFichier(Matrice : in typeMatrice; Fichier : in out fichier_car.file_type) is begin    for i in typeMatrice'range(1) loop    for j in typeMatrice'range(2) loop      write(Fichier, matrice(i, j));    end loop;  end loop; end ecrireMatriceDansFichier; procedure EcrireMatriceDansFichier(entete : in typeEntete; Matrice : in typeMatrice; Fichier : in out fichier_car.file_type) is begin  for i in TypeEntete'Range loop    write(fichier, entete(i));  end loop;  for i in typeMatrice'range(1) loop    for j in typeMatrice'range(2) loop      write(Fichier, matrice(i, j));    end loop;  end loop; end ecrireMatriceDansFichier; --////////////////////////////////////////////////////////////////////////-- --                               Prog principal                            -- --////////////////////////////////////////////////////////////////////////-- MatriceI, MatriceR : TypeMatrice; MatriceTemp : TypeMatriceTrv; NomFichierInitial, NomFichierResultat : string(1..30); comptChaine : integer; fichierInitial, FichierResultat : fichier_car.file_type; Entete : TypeEntete; Tolerance : float; begin  put("Donnez le nom du fichier a traiter : ");  get_line(item => nomFichierInitial, last => comptChaine);  open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));  Entete := GetEntete(FichierInitial);  reset(FichierInitial);  MatriceI := FichierDansMatrice(FichierInitial);  MatriceTemp := PlongerMatrice(MatriceI);  put("Entrez la tolerance (comprise entre 0 et 1) : ");  get(Tolerance);  skip_line;  MatriceR := ContoursImage1(MatriceTemp, Tolerance);  put("Entrez le nom du fichier de destination : ");  get_line(item => NomfichierResultat, last => comptChaine);  create(FichierResultat, name => NomFichierResultat(1..comptChaine));  EcrireMatriceDansFichier(Entete, MatriceR, FichierResultat);  close(FichierInitial);  Close(FichierResultat);  put("Traitement effectue."); end Contours; Comme d'hab', si il y a des commentaires, des améliorations, je suis preneur... http://ftprods.free.fr #64 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 03/07/2004 à 19:50 RE : Détection des contours d'une image Pour voir un peu ce que ça donne avec différentes valeurs : http://ftprods.free.fr #65 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 05/07/2004 à 22:45 RE : Détection des contours dans une image La meme avec IrfanView : Conclusion : y'a du taff... http://ftprods.free.fr #68 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 09/07/2004 à 14:03 RE : Détection des contours dans une image En attendant de déchiffrer les formules que m'a donné mon prof pour améliorer la détection des contours, j'ai fait en sorte de pouvoir traiter toute image .pgm (quels que soient la taille et le logiciel qui l'a fait). code: --////////////////////////////////////////////////////////////////////////-- -- Code ecrit par Julien COIGNET -- -- Pour le CNAM de Cergy -- -- Sujet : Détection de contours -- -- Traite exclusivement les images au format .pgm -- --////////////////////////////////////////////////////////////////////////-- --with Paquetage_Image; use Paquetage_Image; with text_io; use text_io; with ada.integer_Text_Io; use ada.integer_Text_Io; with ada.Float_Text_Io; use ada.Float_Text_Io; with sequential_io; procedure Contours is --////////////////////////////////////////////////////////////////////////-- -- Paquetages -- --////////////////////////////////////////////////////////////////////////-- package fichier_car is new sequential_IO(character); use fichier_car; --////////////////////////////////////////////////////////////////////////-- -- Types -- --////////////////////////////////////////////////////////////////////////-- -- Type Entete: Vecteur qui contient l'entete du fichier image type TypeEntete is array (integer range <>) of character; -- Type Matrice: Matrice qui reçoit le contenu d'une image de 256 par 256 pixels type TypeMatrice is array (integer range <>, integer range <>) of character; -- Type MatriceTrv : Matrice de plongement Type TypeMatriceTrv is array (integer range <>, integer range <>) of character; -- Type qui contient la chaine décrivant les dimensions de l'image type TabDim is array(1..10) of character; --////////////////////////////////////////////////////////////////////////-- -- Fonctions -- --////////////////////////////////////////////////////////////////////////-- -- Fonction qui récupère l'entête du fichier image function getEntete(fichier : in fichier_car.file_type; Entete : in TypeEntete) return typeEntete is Car : character; Resultat : typeEntete(Entete'range); begin   for i in Resultat'Range loop      read(Fichier, car);      resultat(I) := Car;   end loop;   return resultat; end GetEntete; -- Lit le fichier et le met dans une matrice function FichierDansMatrice(fichier : in fichier_car.file_type; Entete : in TypeEntete; Matrice : in TypeMatrice) return typeMatrice is CarLu : character; Resultat : TypeMatrice(Matrice'range(1), Matrice'range(2)); begin   -- On zappe l'entete   for i in Entete'Range loop      read(Fichier, carLu);   end loop;   -- On remplit la matrice avec le contenu de l'image   for i in Matrice'range(1) loop      for j in Matrice'range(2) loop         read(Fichier, carLu);         resultat(i, j) := carLu;      end loop;   end loop;   return resultat; end FichierDansMatrice; -- Fonction qui retourne la matrice donnée en argument en matrice plongée function PlongerMatrice(MatriceIni : in TypeMatrice) return TypeMatriceTrv is Resultat : TypeMatriceTrv(0..MatriceIni'last(1)+2, 0..MatriceIni'last(2)+2); begin   -- On initialise les bords à 0   for i in Resultat'range(1) loop        Resultat(I, 0) := character'val(0);      Resultat(i, Resultat'last(2)) := character'val(0);   end loop;   for i in Resultat'range(2) loop      Resultat(0, i) := character'val(0);      Resultat(Resultat'last(1), i) := character'val(0);   end loop;   -- On remplit le reste   for i in MatriceIni'range(1) loop      for j in MatriceIni'range(2) loop         Resultat(I+1, J+1) := MatriceIni(I, J);      end loop;   end loop;   return resultat; end; -- Fonction qui détermine les contours selon la première méthode function ContoursImage1(MatriceI : in typeMatriceTrv; seuil : float := 0.5; Matrice : in TypeMatrice) return TypeMatrice is Resultat : TypeMatrice(Matrice'range(1), Matrice'range(2)); Valeur, Max : integer; Coeff : float; begin   -- Pour chaque pixel de l'image...   for i in (MatriceI'First(1) + 1)..(MatriceI'last(1) - 1) loop      for j in (MatriceI'First(2) + 1)..(MatriceI'last(2) - 1) loop         Valeur := character'pos(MatriceI(i, j));         Max := Valeur;         -- ...on cherche la valeur la plus élevée des 9 pixels         for k in (i-1)..(i+1) loop            for l in (j-1)..(j+1) loop               if Max < character'pos(MatriceI(K, L)) then                  Max := character'pos(matriceI(K, L));               end if;            end loop;         end loop;         --put(max);         if Max > 0 then            if ((float(Valeur) / float(Max)) <= Seuil) then               Resultat(i-1, j-1) := character'val(0);            else               Resultat(i-1, j-1) := character'val(255);            end if;         else            Resultat(i-1, j-1) := character'val(255);         end if;      end loop;   end loop; return Resultat; end; function CarVersNombre(Car : in character; Rang : integer) return integer is Resultat : integer; Coeff : integer:= 1; begin   case Car is      when '0' =>         Resultat := 0;      when '1' =>         Resultat := 1;      when '2' =>         Resultat := 2;      when '3' =>         Resultat := 3;      when '4' =>         Resultat := 4;      when '5' =>         Resultat := 5;      when '6' =>         Resultat := 6;      when '7' =>         Resultat := 7;      when '8' =>         Resultat := 8;      when '9' =>         Resultat := 9;      when others =>         Resultat := 0;   end case;   if Rang = 0 then      Coeff := 1;   else      for i in 0..(Rang - 1) loop         Coeff := (Coeff * 10);      end loop;   end if;   Resultat := Resultat * Coeff;   return Resultat;   end CarVersNombre; -- Fonction qui retourne le nombre de caractères présents dans une entete function NbCarEntete(Fichier : in fichier_car.file_type) return integer is Resultat : integer := 0; CarLu : Character; ComptChar10 : integer := 0; begin   while ComptChar10 < 4 loop      read(Fichier, Carlu);      Resultat := Resultat + 1;      if CarLu = character'val(10) then         ComptChar10 := ComptChar10 + 1;      end if;   end loop;   return Resultat; end NbCarEntete; --////////////////////////////////////////////////////////////////////////-- -- Procédures -- --////////////////////////////////////////////////////////////////////////-- -- Procedure qui lit une matrice (TypeMatrice) et l'ecrit dans un fichier procedure EcrireMatriceDansFichier(Matrice : in typeMatrice; Fichier : in out fichier_car.file_type) is begin   for i in Matrice'range(1) loop      for j in Matrice'range(2) loop         write(Fichier, matrice(i, j));      end loop;   end loop; end ecrireMatriceDansFichier; procedure EcrireMatriceDansFichier(entete : in typeEntete; Matrice : in typeMatrice; Fichier : in out fichier_car.file_type) is begin   for i in Entete'Range loop      write(fichier, entete(i));   end loop;   for i in Matrice'range(1) loop      for j in Matrice'range(2) loop         write(Fichier, matrice(i, j));      end loop;   end loop; end ecrireMatriceDansFichier; -- Procédure qui va lire les dimensions d'une imageet les mettre dans DimL, et DimH procedure LireDimImage(Fichier : in fichier_car.file_type; DimL, DimH : in out integer) is ComptChar10 : integer := 0; CarLu : character; i : integer := 1; Tab : TabDim := ('a', 'a', 'a', 'a', 'a', 'a', 'a', 'a', 'a', 'a'); rang : integer := 0; EspaceTrouve : boolean := false; begin   DimL := 0;   DimH := 0;   --reset(Fichier);   while ComptChar10 < 3 loop      read(Fichier, Carlu);      if ComptChar10 = 2 then         Tab(i) := CarLu;         i := i + 1;      end if;      if Carlu = character'val(10) then         ComptChar10 := ComptChar10 + 1;        end if;   end loop;   for i in reverse 1..10 loop      if Tab(i) /= 'a' then         if Tab(i) = ' ' then            EspaceTrouve := true;            Rang := 0;         end if;         if Tab(i) /= 'a' then            Rang := Rang + 1;            if EspaceTrouve = true then               DimH := DimH + CarVersNombre(Tab(i), rang - 2);            else               DimL := DimL + CarVersNombre(Tab(i), rang - 2);            end if;         end if;      end if;   end loop;   end LireDimImage; --////////////////////////////////////////////////////////////////////////-- -- Prog principal -- --////////////////////////////////////////////////////////////////////////-- NomFichierInitial, NomFichierResultat : string(1..30); comptChaine : integer; fichierInitial, FichierResultat : fichier_car.file_type; Tolerance : float; DimL, DimH : integer; begin   put("Donnez le nom du fichier a traiter : ");   get_line(item => nomFichierInitial, last => comptChaine);   open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));   declare Entete : TypeEntete(0..(NbCarEntete(FichierInitial) - 1));   begin      reset(FichierInitial);      LireDimImage(FichierInitial, DimL, DimH);            declare MatriceI: TypeMatrice(0..DimL-1, 0..DimH-1);      begin               declare MatriceR: TypeMatrice(0..DimL-1, 0..DimH-1);         begin                 reset(FichierInitial);         Entete := GetEntete(FichierInitial, Entete);         reset(FichierInitial);         MatriceI := FichierDansMatrice(FichierInitial, Entete, MatriceI);         declare MatriceTemp : TypeMatriceTrv (0..MatriceI'last(1)+2, 0..MatriceI'last(2)+2);         begin                    MatriceTemp := PlongerMatrice(MatriceI);            put("Entrez la tolerance (comprise entre 0 et 1) : ");            get(Tolerance);            skip_line;            MatriceR := ContoursImage1(MatriceTemp, Tolerance, MatriceR);            put("Entrez le nom du fichier de destination : ");            get_line(item => NomfichierResultat, last => comptChaine);            create(FichierResultat, name => NomFichierResultat(1..comptChaine));            EcrireMatriceDansFichier(Entete, MatriceR, FichierResultat);            close(FichierInitial);            Close(FichierResultat);            put("Traitement effectue.");         end;        end;      end;   end; end Contours; Je vais mettre le code qui permet de déterminer les dimensions d'une image .pgm dans la partie cours du forum. ps: Je recherche de l'aide pour déchiffrer les fameuses formules... #70 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 08/09/2004 à 11:36 RE : Détection des contours dans une image J'ai ajouté une deuxieme methode : code: -- Fonction qui détermine les contours selon la -- DEUXIEME -- méthode function ContoursImage2(MatriceI : in typeMatriceTrv; seuil : float := 0.5; Matrice : in TypeMatrice) return TypeMatrice is Resultat : TypeMatrice(Matrice'range(1), Matrice'range(2)); ValeurPixel, Max : integer; Coeff : float; v : integer; h : integer; TabConvolution1 : array(-1..1, -1..1) of integer := ((-1, -1, -1), (0, 0, 0), (1, 1, 1)); TabConvolution2 : array(-1..1, -1..1) of integer := ((1, 0, -1), (1, 0, -1), (1, 0, -1)); begin  -- Pour chaque pixel de l'image...  for i in (MatriceI'First(1) + 1)..(MatriceI'last(1) - 1) loop     for j in (MatriceI'First(2) + 1)..(MatriceI'last(2) - 1) loop        ValeurPixel := character'pos(MatriceI(i, j));                -- ...on cherche la valeur la plus élevée des 9 pixels        v := 0;        h := 0;        for k in -1..1 loop           for l in -1..1 loop              v := v + (TabConvolution1(k, l) * character'pos(MatriceI(i + k, j + l)));              h := h + (TabConvolution2(k, l) * character'pos(MatriceI(i + k, j + l)));                            if (k = 1 and l = 1) then                if (v * v + h * h) > 8000 then                  Resultat(i-1, j-1) := character'val(0);              else                  Resultat(i-1, j-1) := character'val(255);                end if;            end if;           end loop;        end loop;     end loop;  end loop; return Resultat; end; (la valeur 8000 est fixée arbitrairement suite à des tests. Ce que j'obtiens : - image originale : - Méthode 1 : - Méthode 2 : http://ftprods.free.fr #85    « Sujet précédent | Sujet suivant »

Forum ada95000 » Ada 95 » Projets » Détection des contours dans une image

10.8.113.169

18:04 - 24 Août 2025

10.8.113.169

[ 0.1944258 secondes | Effacer le cookie | 19 requêtes ]
Oxygen v1.0.11 © 2002	|	Oxygen WebSite © 2002