Graphics32: изменить размер многих изображений

Question

24.03.2016 Мне 76, и когда я писал, я думал, что это имеет смысл, но, как и все остальные, я не уверен, о чем я спрашивал. Вот то, что я собрал вместе (это не красиво) от чистки интернета. Это почти работает, единственное, чего не хватает, это сохранить соотношение сторон. Это заставляет высокие фотографии выглядеть толстыми. За 40 лет программирования у меня, вероятно, было всего два часа работы над графикой.:)

procedure TfrmTools.Shrink(aFn : String; Wid,Ht : Integer);
var
  Bmp : TBitmap;    // These three are created
  Jpg : TJpegImage; //  and Freed globally
  Dst : TBitmap32;  //  to save some bit-thrashing
begin
  try
    Src.Bitmap.LoadFromFile(aFn);  // Src = TImage32
    Dst:=TBitmap32.Create;
    Dst.SetSize(Wid,Ht);
    Src.Bitmap.DrawTo(Dst,Dst.BoundsRect);
    bmp:=TBitmap.Create;
    jpg:=TJPEGImage.Create;
    bmp.Assign(Dst);
    jpg.Assign(bmp);
    jpg.SaveToFile('D:\Test1280x720.jpg');  // Just testing
  finally
    Bmp.Free;  // As above
    Jpg.Free;  // As above
    Dst.Free;  // As above
  end;
end;

23.03.2016 Я взял совет от доброй души здесь и укусил пулю с Graphis32 и рад, что я сделал, но ударил стену. У меня есть Пути к приблизительно 1200 изображениям в базе данных, и все идет хорошо для отображения, сохранения и т. Д.

Некоторые изображения имеют размер от 6 до 9 МБ, и их не нужно хранить настолько большими, поскольку их можно будет просматривать только на экране ПК. Я хочу уменьшить их до желаемого размера, скажем, 1920 x 1080 и сохранить соотношение H x W. Я не хочу уменьшать изображения, если они уже меньше, чем 1920 x 1080.

Я сделал много поисков и проб и ошибок и пока только ошибки. У меня есть Saving-часть после масштабирования и / или поворота, когда пользователь работает, работая вручную. Но я хочу иметь возможность сканировать всю базу данных и изменять размеры на лету.

Фрагмент кода был бы великолепен.

Answer 1

Этот ответ основан на вашем редактировании с пометкой 3/24/2016 где вы говорите, что остающаяся проблема заключается в отсутствующем соотношении сторон при изменении размера больших изображений. Предполагая два аргумента Wid, Ht: integer максимальная ширина и высота, которую нужно применить, я предлагаю следующие изменения, отмеченные комментариями:

procedure TfrmTools.Shrink(aFn : String; Wid,Ht : Integer);
var
  Bmp : TBitmap;    // These three are created
  Jpg : TJpegImage; //  and Freed globally
  Dst : TBitmap32;  //  to save some bit-thrashing
  DstWidth, DstHeight: integer; // Add
  AspRatio: single;             // Add
begin
  Bmp := nil;  // not related to your question, see comment in text
  Jpg := nil;  // -"-
  Dst := nil;  // -"-
  try
    Src.Bitmap.LoadFromFile(aFn);  // Src = TImage32

  // Add following lines
  DstWidth := Src.Width;
  DstHeight := Src.Height;
  AspRatio := Src.Width/Src.Height;

  if (DstWidth > Wid) then
  begin
    DstWidth := Wid;
    DstHeight := round(DstWidth / AspRatio);
  end;

  if (DstHeight > Ht) then
  begin
    DstHeight := Ht;
    DstWidth := round(DstHeight * AspRatio);
  end;
  // end of added lines

    Dst:=TBitmap32.Create;
//    Dst.SetSize(Wid,Ht); // Replace parameters
    Dst.SetSize(DstWidth,DstHeight);
    Src.Bitmap.DrawTo(Dst,Dst.BoundsRect);
    bmp:=TBitmap.Create;
    jpg:=TJPEGImage.Create;
    bmp.Assign(Dst);
    jpg.Assign(bmp);
    jpg.SaveToFile('D:\Test1280x720.jpg');  // Just testing
  finally
    Bmp.Free;  // As above
    Jpg.Free;  // As above
    Dst.Free;  // As above
  end;
end;

Bmp, Jpg а также Dst переменные должны быть обнулены перед try чтобы предотвратить возможные звонки Free с неинициализированными ссылками на память. Это может произойти, если какой-либо код перед созданием всех трех объектов вызывает исключение.

Answer 2

Вам просто нужно перебрать список имен файлов и выполнить код изменения размера для каждого из них. Как простое начало...

function TForm1.ResizeImage(const Filename: String): String;
begin
  Result:= '';
  try

    //Your resizing code here

  except
    on e: Exception do begin
      Result:= e.Message;
    end;
  end;
end;

procedure TForm1.ResizeAllImages(const List: TStringList);
var
  X: Integer;
  R: String;
begin
  for X := 0 to List.Count - 1 do begin
    R:= ResizeImage(List[X]);
    if R <> '' then begin
      //Report error in a memo control
      Memo1.Lines.Add(List[X]);
      Memo1.Lines.Add(R);
      Memo1.Lines.Add('');
    end;
  end;
end;

Загрузить список имен файлов в TStringList а затем позвоните ResizeAllImages проходя в этом списке строк. Рекомендуется также сообщать об исключениях, поэтому я также включил очень простое сообщение об ошибках. Вы определенно захотите расширить это, например, добавив индикатор выполнения.

Если это для производственной среды, например, что-то, что вы собираетесь распространять или даже продавать, вы можете рассмотреть возможность использования отдельного потока для таких задач.

Я также настоятельно рекомендую не перезаписывать существующие изображения, на всякий случай. Реализуйте какой-нибудь каталог вывода и сохраните вновь измененные изображения там.