Comprimir Imagenes en JPG
 

Aunque ya se ha tratado el tema, tengo un problema al querer comprimir todo un directorio de imagenes.
El código es:

Código Delphi [-]
procedure TForm1.btComprimirImagenesClick(Sender: TObject);
var
  i : Integer;
  jpg:TJpegImage;
begin

  for i:= 0 to ListBox1.Count -1 do
  begin
      vFichero := ListBox1.Items[i];
      Image1.Picture.LoadFromFile(edDirectorioOrigen.Text + '\' + vFichero);
      Application.ProcessMessages;
      Refresh;
      jpg := TJpegImage.Create;
      jpg.Assign(Image1.Picture);                  
      jpg.CompressionQuality := jpg.CompressionQuality DIV 2;
      jpg.Compress;
      jpg.SaveToFile(edDirectorioDestino.Text + '\' + vFichero);
      jpg.Free;
  end;

end;

Necesito 2 cosas.
1.- Como puedo mantener los attributos de las fotos originales, es decir fecha de creacion o Imagen tomada del dia...etc
2.- He tenido que poner
Application.ProcessMessages;
sino me ponia el tamaño a 0 en el fichero resultante, aun así si hago otros procesos mientras comprimo me pone el tamaño a 0, es porque ejecuta el jpg.assign(image1.picture) antes que se cargue la imagen.
He probado con retrasos y tampoco funciona.

¿Alguna sugerencia?
Gracias.

Para este punto, creo que esto te va a servir:

Código Delphi [-]
function GetFileTimeByName(lpFileName: PAnsiChar; lpCreationTime, lpLastAccessTime, lpLastWriteTime: PFileTime): boolean;
var
  hFile: THandle;
begin
  hFile := CreateFile(lpFileName, GENERIC_READ, FILE_SHARE_READ, Nil, OPEN_EXISTING, 0, 0);
  if hFile <> 0 Then
    try
      Result := GetFileTime(hFile, lpCreationTime, lpLastAccessTime, lpLastWriteTime);
    finally
      CloseHandle(hFile);
    end
  else
    Result := False;
end;

function SetFileTimeByName(lpFileName: PAnsiChar; lpCreationTime, lpLastAccessTime, lpLastWriteTime: PFileTime): boolean;
var
  hFile: THandle;
begin
  hFile := CreateFile(lpFileName, GENERIC_WRITE, FILE_SHARE_READ, Nil, OPEN_EXISTING, 0, 0);
  if hFile <> 0 Then
    try
      Result := SetFileTime(hFile, lpCreationTime, lpLastAccessTime, lpLastWriteTime);
    finally
      CloseHandle(hFile);
    end
  else
    Result := False;
end;

function CopyFileTimes(lpSource, lpDest: PAnsiChar): boolean;
var
  ftCreationTime,
  ftLastAccessTime,
  ftLastWriteTime: TFileTime;
begin
  if GetFileTimeByName(lpSource, @ftCreationTime, @ftLastAccessTime, @ftLastWriteTime) then
    Result := SetFileTimeByName(lpDest, @ftCreationTime, @ftLastAccessTime, @ftLastWriteTime)
  else
    Result := False;
end;

Simplemente deberías utilizar la función CopyFileTimes pasando el archivo origen y destino.

Para el resto... ¿Es necesario que lo cargues en un TImage?

Saludos!