[alexdudchenko2022]

Всем привет нужно помощь. Имеется фотографии более размерным весом более 1мб. Мне нужно ее подгрузить в Image1 и пере сохранить уже в сжатом по весу, разрешение и холст не трогаем, только исключительно вес, по условию состояние точнее не более 200 кб.

Вообщем нашел то что хотел это самое идеальное что мог найти.

Код:

procedure TForm1.Button1Click(Sender: TObject);

const FileName = 'e:\Безымянный.jpg';
      FileNameOut = 'e:\БезымянныйOut.jpg';

var JpegIn: TJpegImage;
    Bitmap: TBitmap;
    MS: TMemoryStream;

function GetFileSize(PFileName: String): Int64;
var FS: TFileStream;
begin
  FS:=TFileStream.Create(PFileName,fmOpenRead);
  Result:=FS.Size;
  FS.Free;
end;

begin
  {загрузили jpg из файла}
  Label1.Caption:=Format('Размер исходного файла - %d',[GetFileSize(FileName)]);
  JpegIn:=TJpegImage.Create;
  JpegIn.LoadFromFile(FileName);

  {сконвертировали в bmp}
  Bitmap:=TBitmap.Create;
  Bitmap.Assign(JpegIn);

  {компрессия}
  JpegIn.Assign(Bitmap);
  Bitmap.Free;
  JpegIn.CompressionQuality:=50;
  JpegIn.Compress;

  {посмотрели размер в стреам}
  MS:=TMemoryStream.Create;
  JpegIn.SaveToStream(MS);
  Label3.Caption:=Format('Размер в стреам - %d',[MS.Size]);
  MS.Free;

  {записали в файл}
  JpegIn.SaveToFile(FileNameOut);
  Label2.Caption:=Format('Размер выходного файла - %d',[GetFileSize(FileNameOut)]);
  JpegIn.Free;

Но мне теперь надо как то через цикл сделать что бы проверяла размер то что напишу в Edit. Здесь все считай готово на 95% остается еще маленький шаг сделать и на этом всё.

[lmikle]

Ну что сложного. Единственный параметр, который ты можешь менять - CompressionQuality. Тогда как-то так:

Код:

const
  szBytes = 1;
  szKbytes = 1024;
  szMbytes = 1024 * szKbytes;

function CompressToJpeg(jpgIn : TJPEGImage; szLimit : Integer) : TJPEGImage;
var
  I : Integer;
  Bmp : TBitmap;
  memStream : TMemoryStream;
  sz : Integer;
begin
  Bmp : TBitmap.Creare;
  Bmp.Assign(jpgIn);
  
  Result := TJPEGImage.Create;
  
  I := 100;
  While I >=10 Do
    Begin
	  Result.Assign(Bmp);
	  Result.CompressionQuality := I;
	  Result.Compress;
	  
	  memStream := TMemoryStream.Create;
	  Result.SaveToStream(memStream);
	  sz := memStream.Size;
	  memStream.Free;
	  
	  If sz <= szLimit Then Break;

          I := I - 10;
	End;
	
  Bmp.Free;
end;

Использование:

Код:

var
  jpg, out : TJPEGImage;
begin
   jpg := TJPEGImage.Create;
   jpg.LoadFromFile('filename.jpg');
   
   out := CompressToJpeg(jpg,200*szKbytes);

   out.SaveToFile('newfilename.jpg');
   out.Free;
   jpg.Free;
end;

Т.е. код попытается сжать файл что бы уложиться в предел 200к, если не получится, то вернет максимально сжатый вариант (10%).

[alexdudchenko2022]

Чудеса случаются! Спасибо человеческое. Единственная ошибка в функции поторопился видимо:
begin
Bmp : TBitmap.Creare;
А так всё классно!

[lmikle]

Это не ошибка, это опечатка. Писал тут, не проверял, вот и пропустил. Но по контексту понятно, что там именно Create.

Пожалуйста. Хотя такой простой код мог бы и сам догадаться. Если оставляем размер картинки тот же, то можно играться только со степенью сжатия...

[alexdudchenko2022]

Я люблю программирование просто не каждому дано всё знать, я умею всё правильно расставлять делать я сделаю но мне очень тяжело дается логика хоть и стараюсь в этом разбираться. Особенно с циклами всегда проблемы! Греёбанная логика!!!