Dernière connexion : 18/06/2025 à 22:44 Fin de session : 18/06/2025 à 22:54 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 » Compression d'images sans perte de qualité

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

« Sujet précédent | Sujet suivant »  Auteur: Sujet: Compression d'images sans perte de qualité   ( Réponses: 12 | Vues: 1596 ) ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 30/04/2004 à 00:16 Compression d'images sans perte de qualité Voilà... On efface tout et on recommence... Première étape : faire un RLE. J'ai fait la procédure de compression, il me reste à faire la décompression... Je pense poster tout ca demain http://ftprods.free.fr #33 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 30/04/2004 à 16:51 RE : Compression d'images sans perte de qualité J'ai bien avancé dans les procédures de compression et décompression. Je sais, c'est pas compliqué, mais c'est encore buggé... Je les posterai plutot ce week-end, si je m'en sors... #38 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 30/04/2004 à 17:31 RE : Compression d'images sans perte de qualité Bah en fait, comme ça, ça a l'air de marcher. code: with text_io; use text_io; with ada.integer_Text_Io; use ada.integer_Text_Io; with sequential_io; procedure ProjetCompression is --////////////////////////////////////////////////////////////////////////-- --                                    Paquetages                          -- --////////////////////////////////////////////////////////////////////////-- package fichier_car is new sequential_IO(character); use fichier_car; --////////////////////////////////////////////////////////////////////////-- --                                    Procedures                          -- --////////////////////////////////////////////////////////////////////////-- procedure CompresserFichier(fichierInitial : in fichier_car.file_type; FichierResultat : in out fichier_car.file_type) is nbPixels : integer; CarLu, CarRef : Character; begin  -- Lecture et ecriture de l'entête  for i in 1..256 loop    read(fichierInitial, CarLu);    write(FichierResultat, CarLu);  end loop;  -- Compression du contenu de l'image  read(FichierInitial, carRef);  nbPixels := 1;  write(FichierResultat, carRef);  -- On lit le fichier jusqu'à la fin  while not end_of_file(fichierInitial) loop    read(fichierInitial, CarLu);    nbPixels := nbPixels + 1;    if (carLu /= CarRef) then      write(FichierResultat, character'val(nbPixels - 1));      nbPixels := 1;      carRef := carLu;      write(FichierResultat, carRef);    else      if nbPixels = 255 then        write(FichierResultat, character'val(nbPixels));        nbPixels := 1;        read(fichierInitial, carRef);        write(fichierResultat, carRef);      end if;    end if;  end loop;  write(FichierResultat, character'val(NbPixels)); end CompresserFichier; procedure decompresserFichier(fichierInitial : in fichier_car.file_type; FichierResultat : in out fichier_car.file_type) is   ValPixel, nbPixels : Character; begin  -- Lecture et ecriture de l'entête  for i in 1..256 loop    read(fichierInitial, valPixel);    write(FichierResultat, ValPixel);  end loop;  while not end_of_file(fichierInitial) loop    read(FichierInitial, ValPixel);    read(FichierInitial, NbPixels);    for i in 1..character'pos(nbPixels) loop      write(FichierResultat, ValPixel);    end loop;  end loop; end DecompresserFichier; --////////////////////////////////////////////////////////////////////////-- --                                Programme principal                     -- --////////////////////////////////////////////////////////////////////////-- Choix : Character; NomFichierInitial, NomFichierResultat : string(1..30); comptChaine : integer; fichierInitial, FichierResultat: fichier_car.file_type; begin  -- On demande à l'utilisateur ce qu'il souhaite faire  put("Souhaitez-vous compresser (c), ou decompresser un fichier (d) ? ");  get(choix);  skip_line;  -- Suivant ce choix, on effectue le traitement correspondant  case choix is    when 'c' =>      put("Donnez le nom du fichier source : ");       get_line(item => nomFichierInitial, last => comptChaine);       open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));      put("Entrez le nom du fichier de destination : ");      get_line(item => NomfichierResultat, last => comptChaine);       create(FichierResultat, name => NomFichierResultat(1..comptChaine));      CompresserFichier(FichierInitial, FichierResultat);      close(FichierInitial);      Close(FichierResultat);    when 'd' =>      put("Donnez le nom du fichier source : ");       get_line(item => nomFichierInitial, last => comptChaine);       open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));      put("Entrez le nom du fichier de destination : ");      get_line(item => NomfichierResultat, last => comptChaine);       create(FichierResultat, name => NomFichierResultat(1..comptChaine));      decompresserFichier(FichierInitial, FichierResultat);      close(FichierInitial);      Close(FichierResultat);    when others =>      put("Aucun traitement effectue. ");  end case; end ProjetCompression; Si quelqu'un trouve des bugs, c'est cool de me le signaler :) Y'a moyen de faire mieux. Je tâcherai de poster les améliorations (comme de l'adapter aux .png,...) http://ftprods.free.fr #40 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 26/05/2004 à 23:32 RE : Compression d'images sans perte de qualité Demain, je poste une update Comme il faut le rendre cette semaine... Pour la douleur, une photo de mon pied : Aucun maquillage... #48 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 27/05/2004 à 00:16 RE : Compression d'images sans perte de qualité Alors voilà, en fait le premier RLE correspond un parcours du type :   Image de 8 x 8 Ici, les pixels sont lus les uns à la suite des autres, comme on lirait un texte. Or, dans une images, les pixels qui ont a priori le plus de chance d'être de la même couleur que le pixel de référence, sont ceux situés dans son voisinage proche. Ainsi, la deuxième étape a consisté en un RLE plus complexe, se basant sur un parcours du type :   Image de 8 x 8 ...la suite demain... http://ftprods.free.fr #49 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 27/05/2004 à 17:14 RE : Compression d'images sans perte de qualité Avec un parcours complexe, j'arrive au code suivant : code: --////////////////////////////////////////////////////////////////////////-- --                       Code ecrit par Julien COIGNET              -- --                  Pour le CNAM de Cergy                  -- --          Sujet : Compression d'images sans perte de qualité        -- --            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)            -- --////////////////////////////////////////////////////////////////////////-- -- A FAIRE : --        - Effacer les fichiers temporaires with text_io; use text_io; with ada.integer_Text_Io; use ada.integer_Text_Io; with sequential_io; procedure ProjetCompression is --////////////////////////////////////////////////////////////////////////-- --                                    Paquetages                          -- --////////////////////////////////////////////////////////////////////////-- package fichier_car is new sequential_IO(character); use fichier_car; --////////////////////////////////////////////////////////////////////////-- --                                    Types                              -- --////////////////////////////////////////////////////////////////////////-- -- Type Bit: Binaire; peut prendre les valeurs 0 ou 1 type TypeBit is new integer range 0..1; -- Type Octet: Ensemble de 8 bits type TypeOctet is array (1..8) of TypeBit; -- 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; --////////////////////////////////////////////////////////////////////////-- --                                    Fonctions                           -- --////////////////////////////////////////////////////////////////////////-- function puissance(i, j : integer) return integer is resultat : integer := 1; begin   if j = 0 then    return 1;   else    if i = 0 then      return 0;    end if;   end if;   for nbBoucles in 1..j loop    resultat := resultat * i;   end loop;   return resultat; end puissance; function EntierVersBinaire(nbEntier : integer) return TypeOctet is ValDec : integer := NbEntier; -- Valeur décimale à convertir NbBit : integer := 0;         -- Nombre de bits sur lequel se code l'entier Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0); begin   -- Si le décimal vaut 0, le binaire est 00000000   if NbEntier = 0 then return Resultat;   end if;   -- On détermine le nombre de bits qu'il faut pour coder le décimal   while NbEntier >= puissance(2, NbBit) loop      NbBit := NbBit + 1;   end loop;   for PoidBit in reverse 1..NbBit loop      if ValDec >= puissance(2, (PoidBit - 1)) then         ValDec := ValDec - puissance(2, (PoidBit - 1));         Resultat(PoidBit) := 1;      end if;   end loop;   return Resultat; end entierVersBinaire; function BinaireVersEntier(Octet : TypeOctet) return integer is Resultat : integer := 0; begin   for i in 1..8 loop      if Octet(i) = 1 then         Resultat := Resultat + puissance(2, (i - 1));      end if;   end loop;   return Resultat; end BinaireVersEntier; function EtLogique(Bit1, Bit2 : TypeBit) return TypeBit is Resultat : TypeBit; begin   if (Bit1 = 1) and (Bit2 = 1) then      Resultat := 1;   else      Resultat := 0;   end if;   return Resultat; end EtLogique; -- Applique un masque à l'octet envoyé en paramètre function TraiterOctet(Octet : TypeOctet; Niveau : integer := 3) return TypeOctet is Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0); Masque : TypeOctet := (1, 1, 1, 1, 1, 1, 1, 1); begin   for i in 1..Niveau loop      Masque(i) := 0;   end loop;   for i in 1..8 loop      Resultat(i) := EtLogique(Octet(i), Masque(i));   end loop;   return Resultat; end TraiterOctet; -- Transforme un binaire naturel en binaire réfléchi function binaireNVersBinaireR(octet : typeOctet) return typeOctet is   OctetDecalGauche : typeOctet := (0, 0, 0, 0, 0, 0, 0, 0); Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0); begin  for i in 1..7 loop    OctetDecalGauche(i + 1) := Octet(i);  end loop;  for i in 2..8 loop    if octet(i) = 1 xor octetDecalGauche(i) = 1 then      resultat(i - 1) := 1;    end if;  end loop;  return Resultat; end binaireNVersBinaireR; -- Transforme un binaire réfléchi en un binaire naturel function binaireRVersBinaireN(Octet : typeOctet) return typeOctet is Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0);   begin  for i in reverse 1..8 loop    if i = 8 then      resultat(i) := Octet(i);    else      if octet(i) = 1 then        if resultat(i + 1) = 1 then          resultat(I) := 0;        else          resultat(i) := 1;        end if;      else        if resultat(i + 1) = 1 then          resultat(I) := 1;        else          resultat(i) := 0;        end if;      end if;    end if;  end loop;  return resultat; end binaireRVersBinaireN; -- Détermine la colonne de la matrice à remplir à partir des coordonnées initiales function GetColonneComp(OctetLigne, OctetColonne : in TypeOctet) return typeOctet is Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0); begin  for i in 1..4 loop    Resultat(2 * i) := OctetLigne(i);    resultat((2 * i) - 1) := OctetColonne(i);  end loop;  return Resultat; end GetColonneComp; -- Détermine la ligne de la matrice à remplir à partir des coordonnées initiales function GetLigneComp(OctetLigne, OctetColonne : in TypeOctet) return typeOctet is Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0); begin  for i in 1..4 loop    Resultat(2 * i) := OctetLigne(i + 4);    resultat((2 * i) - 1) := OctetColonne(i + 4);  end loop;  return Resultat; end GetLigneComp; -- Retourne la colonne initiale du pixel  à partir de ses coordonnées après parcours complexe function GetColonneDecomp(OctetLigne, OctetColonne : in TypeOctet) return typeOctet is Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0); begin  for i in 1..4 loop    Resultat(i) := OctetColonne((2 * i) - 1);    resultat(i + 4) := OctetLigne((2 * i) - 1);  end loop;  return Resultat; end GetColonneDecomp; -- Retourne la ligne initiale du pixel  à partir de ses coordonnées après parcours complexe function GetLigneDecomp(OctetLigne, OctetColonne : in TypeOctet) return typeOctet is Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0); begin  for i in 1..4 loop    Resultat(i) := OctetColonne(2 * i);    resultat(i + 4) := OctetLigne(2 * i);  end loop;  return Resultat; end GetLigneDecomp; -- 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 0..255 loop    for j in 0..255 loop      read(Fichier, carLu);      resultat(i, j) := carLu;    end loop;  end loop;  return resultat; end FichierDansMatrice; -- fonction qui crée une matrice modifiée selon parcours complexe function ModifierMatrice(MatriceOriginale : in typeMatrice) return typeMatrice is Resultat : TypeMatrice; k, l : integer; begin  for i in 0..255 loop    for j in 0..255 loop      k := BinaireVersEntier(getLigneComp(entierVersBinaire(i), entierVersBinaire(j)));      l := BinaireVersEntier(getColonneComp(entierVersBinaire(i), entierVersBinaire(j)));      resultat(k, l) := MatriceOriginale(i, j);    end loop;  end loop;  return resultat; end ModifierMatrice; -- 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; --////////////////////////////////////////////////////////////////////////-- --                                    Procedures                          -- --////////////////////////////////////////////////////////////////////////-- procedure CompresserFichier(fichierInitial : in fichier_car.file_type; FichierResultat : in out fichier_car.file_type) is nbPixels : integer; CarLu, CarRef, choix : Character; begin    -- Lecture et ecriture de l'entête  for i in TypeEntete'Range loop    read(fichierInitial, CarLu);    write(FichierResultat, CarLu);  end loop;  -- On demande à l'utilisateur s'il veut conserver toutes les nuances de gris  put("Souhaitez-vous conserver toutes les nuances de gris ? (o/n) : ");  get(choix);  skip_line;  -- Selon ce choix, on fait le traitement adéquat  case choix is    when 'n' =>      -- Compression du contenu de l'image      read(FichierInitial, carRef);      carRef := character'val(binaireVersEntier(traiterOctet(entierVersBinaire(character'pos(carRef)))));      nbPixels := 1;      write(FichierResultat, carRef);      -- On lit le fichier jusqu'à la fin      while not end_of_file(fichierInitial) loop        read(fichierInitial, CarLu);        carlu := character'val(binaireVersEntier(traiterOctet(entierVersBinaire(character'pos(carLu)))));        nbPixels := nbPixels + 1;        if (carLu /= CarRef) then          write(FichierResultat, character'val(nbPixels - 1));          nbPixels := 1;          carRef := carLu;          write(FichierResultat, carRef);        else          if nbPixels = 255 then            write(FichierResultat, character'val(nbPixels));            nbPixels := 1;            read(fichierInitial, carRef);            write(fichierResultat, carRef);          end if;        end if;      end loop;      write(FichierResultat, character'val(NbPixels));    when others =>      if choix /= 'o' then        put("Aucun traitement ne correspond. Toutes les nuances seront conservees.");        new_line;      end if;      -- Compression du contenu de l'image      read(FichierInitial, carRef);      nbPixels := 1;      write(FichierResultat, carRef);      -- On lit le fichier jusqu'à la fin      while not end_of_file(fichierInitial) loop        read(fichierInitial, CarLu);        nbPixels := nbPixels + 1;        if (carLu /= CarRef) then          write(FichierResultat, character'val(nbPixels - 1));          nbPixels := 1;          carRef := carLu;          write(FichierResultat, carRef);        else          if nbPixels = 255 then            write(FichierResultat, character'val(nbPixels));            nbPixels := 1;            read(fichierInitial, carRef);            write(fichierResultat, carRef);          end if;        end if;      end loop;      write(FichierResultat, character'val(NbPixels));  end case; end CompresserFichier; procedure decompresserFichier(fichierInitial : in fichier_car.file_type; FichierResultat : in out fichier_car.file_type) is   ValPixel, nbPixels : Character; begin  -- Lecture et ecriture de l'entête  for i in TypeEntete'Range loop    read(fichierInitial, valPixel);    write(FichierResultat, ValPixel);  end loop;  while not end_of_file(fichierInitial) loop    read(FichierInitial, ValPixel);    read(FichierInitial, NbPixels);    for i in 1..character'pos(nbPixels) loop      write(FichierResultat, ValPixel);    end loop;  end loop; end DecompresserFichier; -- 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 0..255 loop    for j in 0..255 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 0..255 loop    for j in 0..255 loop      write(Fichier, matrice(i, j));    end loop;  end loop; end ecrireMatriceDansFichier; -- Procedure qui ecrit la matrice modifiee dans un fichier temporaire -- puis compresse ce fichier dans un autre (et y inclut aussi l'entete) procedure CompresserMatriceModifiee(entete : in typeEntete; matrice : in typeMatrice; fichierResultat : in out fichier_car.file_type) is  fichierTemp : fichier_car.file_type;  CarRef, CarLu, choix : character;  NbPixels : integer; begin  -- On deùande à l'utilisateur s'il souhaite conserver toutes les nuances de gris  put("Voulez-vous conserver toutes les nuances de gris ? (o/n) : ");  get(choix);  skip_line;  -- On cree le fichier de tavail  create(FichierTemp, name => "DataComp.trv");  -- On le remplit à l'aide d'une matrice suivant je choix de l'utilisateur  case choix is    when 'o' =>      for i in 0..255 loop        for j in 0..255 loop          -- Sans perte de nuances          write(FichierTemp, Matrice(i, j));        end loop;      end loop;    when 'n' =>      for i in 0..255 loop        for j in 0..255 loop          -- Avec 32 nuances de gris max (on fait "sauter" les trois de poids          -- faible de l'octet codant le caractère          write(FichierTemp, character'val(binaireVersEntier(traiterOctet(entierVersBinaire(character'pos(Matrice(i, j)))))));        end loop;      end loop;    when others =>      put("Aucun traitement ne correspond a ce choix.");      new_line;      put("Toutes les nuances de gris seront conservees.");      for i in 0..255 loop        for j in 0..255 loop          -- Sans perte de nuances          write(FichierTemp, Matrice(i, j));        end loop;      end loop;  end case;  -- On reinitialise le fichier de travail en lecture seule  reset(fichierTemp, in_File);    --Ecriture de l'entete dans le fichier résultat  for i in TypeEntete'Range loop    write(fichierResultat, entete(i));    carLu := entete(i);  end loop;  -- Compression du fichier de travail  read(FichierTemp, carRef);  nbPixels := 1;  write(FichierResultat, carRef);  -- On lit le fichier jusqu'à la fin  while not end_of_file(fichierTemp) loop    read(fichierTemp, CarLu);    nbPixels := nbPixels + 1;    if (carLu /= CarRef) then      write(FichierResultat, character'val(nbPixels - 1));      nbPixels := 1;      carRef := carLu;      write(FichierResultat, carRef);    else      if nbPixels = 255 then        write(FichierResultat, character'val(nbPixels));        nbPixels := 1;        read(fichierTemp, carRef);        write(fichierResultat, carRef);      end if;    end if;  end loop;  write(FichierResultat, character'val(NbPixels));  -- On ferme le fichier de travaille...  close(fichierTemp);  -- ... puis on l'efface  --delete(FichierTemp); end CompresserMatriceModifiee; Ca tient pas sur un seul post, je poste la suite sur le suivant. http://ftprods.free.fr #51 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 27/05/2004 à 17:17 RE : Compression d'images sans perte de qualité code à coller juste à la suite du code précédent : code: -- Procedure qui va decompresser le fichier dans un fichier temporaire... -- ... puis remplir la matrice procedure DecompresserFichierModifie(fichierInitial : in fichier_car.file_type; entete : in out typeEntete; matrice : in out typeMatrice) is  fichierTemp : fichier_car.file_type;  valPixel, NbPixels : character;  k, l : integer; begin  -- On cree le fichier de travail  create(FichierTemp, name => "DataDecomp.trv");    -- On récupère l'entete du fichier compressé  for i in TypeEntete'Range loop    read(fichierInitial, entete(i));  end loop;  -- On le remplit ce fichier à l'aide des données compressées  while not end_of_file(fichierInitial) loop    read(FichierInitial, ValPixel);    read(FichierInitial, NbPixels);    for i in 1..character'pos(nbPixels) loop      write(FichierTemp, ValPixel);    end loop;  end loop;  -- On réinitialise le fichier temporaire en lecture seule  reset(fichierTemp, in_file);  for i in 0..255 loop    for j in 0..255 loop      read(fichierTemp, ValPixel);      k := BinaireVersEntier(getLigneDecomp(entierVersBinaire(i), entierVersBinaire(j)));      l := BinaireVersEntier(getColonneDecomp(entierVersBinaire(i), entierVersBinaire(j)));      Matrice(k, l) := ValPixel;    end loop;  end loop;  -- On ferme le fichier temporaire  close(fichierTemp);  -- et on l'efface  --delete(fichierTemp); end decompresserFichierModifie; --////////////////////////////////////////////////////////////////////////-- --                                Programme principal                     -- --////////////////////////////////////////////////////////////////////////-- Choix1, choix2 : Character; NomFichierInitial, NomFichierResultat : string(1..30); comptChaine : integer; fichierInitial, FichierResultat : fichier_car.file_type; Entete : TypeEntete; Octet : typeOctet := (0, 0, 1, 1, 0, 0, 0, 0); matriceI, MatriceR : typeMatrice; begin    -- On demande à l'utilisateur le mode de parcours avec lequel il veut travailler  put("Parcours simple (s), ou parcours complexe (c) ? ");  get(choix1);  skip_line;  case choix1 is    --////////////////////////////////////////////////////////////////--  --                parcours simple                --  --////////////////////////////////////////////////////////////////--    when 's' =>      -- On demande à l'utilisateur ce qu'il souhaite faire      put("Souhaitez-vous compresser (c), ou decompresser un fichier (d) ? ");      get(choix2);      skip_line;      -- Suivant ce choix, on effectue le traitement correspondant      case choix2 is        when 'c' =>          put("Donnez le nom du fichier a compresser : ");           get_line(item => nomFichierInitial, last => comptChaine);           open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));          put("Entrez le nom du fichier de destination : ");          get_line(item => NomfichierResultat, last => comptChaine);           create(FichierResultat, name => NomFichierResultat(1..comptChaine));          CompresserFichier(FichierInitial, FichierResultat);          close(FichierInitial);          Close(FichierResultat);          put("Traitement effectue.");        when 'd' =>          put("Donnez le nom du fichier a decompresser : ");           get_line(item => nomFichierInitial, last => comptChaine);           open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));          put("Entrez le nom du fichier de destination : ");          get_line(item => NomfichierResultat, last => comptChaine);           create(FichierResultat, name => NomFichierResultat(1..comptChaine));          decompresserFichier(FichierInitial, FichierResultat);          close(FichierInitial);          Close(FichierResultat);          put("Traitement effectue.");        when others =>          put("Aucun traitement effectue. ");      end case;  --////////////////////////////////////////////////////////////////--  --                parcours complexe                --  --////////////////////////////////////////////////////////////////--    when 'c' =>        -- On demande à l'utilisateur ce qu'il souhaite faire      put("Souhaitez-vous compresser (c), ou decompresser un fichier (d) ? ");      get(choix2);      skip_line;          -- Suivant ce choix, on effectue le traitement correspondant      case choix2 is                -- Compression du fichier        when 'c' =>          -- On récupère le nom du fichier initial          put("Donnez le nom du fichier a compresser : ");          get_line(item => nomFichierInitial, last => comptChaine);           -- On l'ouvre en lecture seule          open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));          -- On récupere l'entete de ce fichier          entete := getEntete(fichierInitial);          -- On remet le pointeur au début du fichier          reset(fichierInitial);          -- On demande à l'utilisateur le nom du fichier de destination          put("Entrez le nom du fichier de destination : ");          get_line(item => NomfichierResultat, last => comptChaine);          -- On crée le fichier de destination          create(FichierResultat, name => NomFichierResultat(1..comptChaine));          -- On insère l'image telle quelle dans MatriceI (sans l'entete)          matriceI := FichierDansMatrice(FichierInitial);          -- MatriceR récupère le contenu de MatriceI, mais suivant le parcours complexe          matriceR := ModifierMatrice(matriceI);          -- On insère ensuite l'entete du fichier source, puis le RLE de la matrice          -- modifiée dans le fichier de destination          CompresserMatriceModifiee(entete, MatriceR, FichierResultat);          -- On ferme les fichiers          close(FichierInitial);          Close(FichierResultat);          -- On indique que le traitement est terminé          put("Traitement effectue.");            -- Décompression du fichier        when 'd' =>          -- On récupère le nom du fichier à décompresser          put("Donnez le nom du fichier a decompresser : ");          get_line(item => nomFichierInitial, last => comptChaine);          -- On ouvre ce fichier          open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));          -- On place l'entete de ce fichier dans dans Entete          -- on décompresse l'image dans MatriceI en remettant dans les pixels dans l'ordre          decompresserFichierModifie(fichierInitial, entete, matriceI);          -- On réinitialise FichierInitial en lecture seule          reset(fichierInitial, in_file);          -- On récupère le nom du fichier de destination          put("Entrez le nom du fichier de destination : ");          get_line(item => NomfichierResultat, last => comptChaine);           -- on crée ce fichier          create(FichierResultat, name => NomFichierResultat(1..comptChaine));          -- On écrit l'entete et le contenu de l'image dans FichierResultat          ecrireMatriceDansFichier(entete, MatriceI, FichierResultat);          -- On ferme les fichiers          close(fichierInitial);          close(fichierResultat);          -- On indique à l'utilisateur que le programme est terminé          put("Traitement effectue.");        when others =>          put("Aucun traitement effectue. ");      end case;      when others =>        put("Aucun traitement effectue.");        new_line;        put("Programme termine.");  end case  ; end ProjetCompression; J'ai ajouté le choix de garder 255 niveaux de gris, ou de n'en conserver que 32 (a priori meilleure compression, et non perceptible par l'oeuil humain). C'est à n'en pas douter perfectible... Je suis pas non plus tout à fait sûr que ça fasse exactement le parcours décrit plus haut... Faut que je teste plus en profondeur... Mais je perds pas de pixel pendant la compression / décompression, et ils se remettent a priori bien à leur place. Ouvert à toutes question, discussion, ou suggestion. :) http://ftprods.free.fr #52 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 28/05/2004 à 01:05 RE : Compression d'images sans perte de qualité J'ai modifié le prog pour qu'il prenne en compte les .pgm Les résultats ne sont pas satisfaisants car la méthode de parcours simple donne un meilleur résultat sur une image complexe que le parcours complexe justement... :( Pourtant je parcours l'image comme expliqué plus haut (en Z), et d'aprés le prof, les résultats devraient être meilleurs (ça me semble aussi logique...). J'ai fait un logiciel pour créer une image (un .pgm) particulier pour vérifier que je ne m'étais pas planté dans le parcours complexe, et visiblement, je parcours le fichier comme il faut. Voilà le code de ce programme : code: --//////////////////////////////////////////////////////////-- --          Code écrit par Julien COIGNET            -- --      afin de vérifier le programme de compression      -- --//////////////////////////////////////////////////////////-- with text_io; use text_io; with ada.integer_Text_Io; use ada.integer_Text_Io; with sequential_io; procedure creationImage 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 (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; --////////////////////////////////////////////////////////////////////////-- --                  Programme principal                  -- --////////////////////////////////////////////////////////////////////////-- Fichier : fichier_car.file_type; Matrice : typeMatrice; entete : typeEntete; compteur : integer := 0; begin    create(Fichier, name => "img.pgm");  entete(0..1) := "P5";  entete(2) := character'val(10);  entete(3..29) := "# Created by Julien COIGNET";  entete(30) := character'val(10);  entete(31..37) := "256 256";  entete(38) := character'val(10);  entete(39..41) := "255";  entete(42) := character'val(10);  for i in 0..42 loop    write(fichier, entete(i));  end loop;  for i in 0..255 loop    for j in 0..255 loop      compteur := compteur + 1;      if compteur <= 2 then        write(fichier, character'val(0));      else        write(fichier, character'val(255));      end if;      if compteur = 4 then        compteur := 0;      end if;    end loop;  end loop;  close(fichier);    put("Image creee avec succes."); end creationImage; On crée ici une image avec des rayures verticales de 2 pixels de large. D'après les descriptions des 2 types de RLE étudiés, il semble évident que la compression avec le parcours complexe doit prendre 2 fois moins de place que la compression avec le parcours simple. Et c'est ce qu'il se passe en effet... Donc je ne comprends pas pourquoi les résultats sur une image complexe sont décevants... #54 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 28/05/2004 à 19:06 RE : Compression d'images sans perte de qualité voilà 3 images de test : premiere (image réalisée avec le programme ci-dessus. deuxieme troisieme, ou les limites de ma méthode RLE Attention, elles apparaissent en jpg, il faut cliquer sur lien pour télécharger la version .pgm. voilà http://ftprods.free.fr #57 arnaud Member     Messages: 5 Inscrit(e) le: 25/08/2004 Lieu de résidence : montataire Déconnecté(e) Publié le 25/08/2004 à 14:17 RE : Compression d'images sans perte de qualité eh ! mais qu'est-ce que t'as fais a ta guibole ! le plus débutant des débutants en ADA95 j'habite dans le sud du 60 #77 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 25/08/2004 à 20:41 RE : Compression d'images sans perte de qualité Une entorse grave. 10 semaines d'arrêt de travail http://ftprods.free.fr #79 arnaud Member     Messages: 5 Inscrit(e) le: 25/08/2004 Lieu de résidence : montataire Déconnecté(e) Publié le 26/08/2004 à 13:01 RE : Compression d'images sans perte de qualité ca t'es arrive comment ? le plus débutant des débutants en ADA95 j'habite dans le sud du 60 #83 ftbass Administrator     Messages: 72 Inscrit(e) le: 27/02/2004 Déconnecté(e) Publié le 27/08/2004 à 12:18 RE : Compression d'images sans perte de qualité En jouant au basket... C'est dangeureux pour la santé le sport... http://ftprods.free.fr #84    « Sujet précédent | Sujet suivant »

Forum ada95000 » Ada 95 » Projets » Compression d'images sans perte de qualité

10.3.122.74

22:44 - 18 Juin 2025

10.3.122.74

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