Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Trucos (https://www.clubdelphi.com/foros/forumdisplay.php?f=52)
-   -   Optimizar un archivo Jpeg (https://www.clubdelphi.com/foros/showthread.php?t=80439)

seoane 08-06-2006 13:51:36

Optimizar un archivo Jpeg
 
Los archivos Jpeg ademas de la propia imagen contienen informacion extra añadida por algunos programas (comentarios, tipo de camara, thumbnails, etc) que engordan el archivo pero que no son necesarios para ver la imagen.

En este truco vamos a eliminar todas esa informacion extra y dejar el archivo lo mas pequeño posible si modificar en nada la calidad de la imagen.

Código Delphi [-]
procedure Limpiar(Origen, Destino: TStream);
var
  Buffer: array[0..$FFFF] of Char;
  Header: array[1..4] of byte;
  Size: Integer;
begin
  Origen.Seek(0,soFromBeginning);
  Origen.ReadBuffer(Header,2);
  if (Header[1] <> $FF) or (Header[2] <> $D8) then
    raise Exception.Create('Identificador incorrecto');
  Destino.WriteBuffer(Header,2);
  repeat
    Origen.ReadBuffer(Header,4);
    Size:= ((Header[3] shl 8) + Header[4]) - 2;
    case Header[2] of
      // $FE: Origen.Seek(Size,soFromCurrent);
      $FE, $E0..$EF: Origen.Seek(Size,soFromCurrent);
      $01,$D0..$D9: begin
                      Destino.WriteBuffer(Header,2);
                      Origen.Seek(-2,soFromCurrent)
                    end
      else
      begin
        Origen.ReadBuffer(Buffer,Size);
        Destino.WriteBuffer(Header,4);
        Destino.WriteBuffer(Buffer,Size);
      end;
    end;
  until Header[2] = $DA;
  Destino.CopyFrom(Origen,Origen.Size - Origen.Position);
end;

Ejemplo de uso (Se utiiza un TOpenDialog):

Código Delphi [-]
var
  Origen, Destino: TFileStream;
begin
  if OpenDialog1.Execute then
  begin
    Origen:= TFileStream.Create(OpenDialog1.FileName, fmOpenRead);
    try
      Destino:= TFileStream.Create(ChangeFileExt(OpenDialog1.FileName,'_b.jpg'),fmCreate);
      try
        Limpiar(Origen,Destino);
      finally
        Destino.Free;
      end;
    finally
      Origen.Free;
    end;
  end;
end;


La franja horaria es GMT +2. Ahora son las 15:11:47.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi