COMPRESSEUR JPEG

Commentaire de f0xi le 16/04/2006 17:29:47 administrateur CS

procedure TForm1.OuvrirFichier(Name: String);
var
  F : File of byte;
begin
  Image1.Picture.LoadFromFile(Name);
  AssignFile(F, Name);
  Reset(F);
  SizeDebut := FileSize(F);
  CloseFile(F);

  Longueur := Image1.Picture.Width;
  Largeur  := Image1.Picture.Height;

  Lbl_Taille_Initiale.Caption := format('Taille initiale : %.2f Ko',[SizeDebut/1024]);
  Lbl_Taille_Finale.Caption := 'Taille finale : ';
  Lbl_Gain.Caption := 'Gain : ';
  Lbl_TauxCompression.Caption := 'Taux de compression : ';
  Lbl_TempsCompression.Caption := 'Temps de compression : ';
  Lbl_TempsDecompression.Caption := 'Temps de dcompression : ';

  Image2.Canvas.Pen.Color := clBtnFace;
  Image2.Canvas.Brush.Color := clBtnFace;
  Image2.Canvas.Rectangle(0, 0, Image2.Width, Image2.Height);
end;

___________________________________________


procedure TForm1.Button2Click(Sender: TObject);
begin
  if Image1.Picture.Width = 0 then Exit;
  Time := GetTickCount;
  StatusBar1.Panels[0].Text := 'Compression...';
  Application.ProcessMessages;

  SaveTableauPixels; //Enregistre l'image initiale dans un tableau
  ConvertRGBToYCrCb; //Convertit les couleurs de RGB vers YCrCb
  DownSample; //Sous-chantillonne la chrominance
  LevelShift; //Dcale toutes les valeurs de -128
  ApplyDCT; //Applique la DCT
  ApplyCoeffs; //Quantifie la matrice (seule tape de perte de l'algorithme)
  CodageRLE; //Codage avec le systme RLE
  CodageHuffman; //Codage avec le systme Huffman
  SafeToFile; //Enregistre le fichier final

  StatusBar1.Panels[0].Text := '';
  Lbl_TempsCompression.Caption := format('Temps de compression : %.1f s', [(GetTickCount-Time)/1000]);
end;

____________________________________________


procedure TForm1.SaveTableauPixels;
var
  I, J  : Integer;
  Ligne : ^TRGBArray;
begin
  SetLength(TableauPixels, Longueur, Largeur, 3);
  Image1.Picture.Bitmap.PixelFormat := pf32bit;
  for J := 0 to Largeur - 1 do begin
      Ligne := Image1.Picture.Bitmap.ScanLine[J];
      for I := 0 to Longueur - 1 do begin
          with Ligne[I] do begin  
               TableauPixels[I, J, 0] := rgbRed;
               TableauPixels[I, J, 1] := rgbGreen;
               TableauPixels[I, J, 2] := rgbBlue;
          end;
      end;
   end;
end;

____________________________________________


if R < 0 then R := 0 else if R > 255 then R := 255;
if G < 0 then G := 0 else if G > 255 then G := 255;
if B < 0 then B := 0 else if B > 255 then B := 255;

>> uses Math;

R := Max( Min(R, 255), 0);
G := Max( Min(G, 255), 0);
B := Max( Min(B, 255), 0);