|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Сжатие изображение Jpg (вес)
Всем привет нужно помощь. Имеется фотографии более размерным весом более 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; Последний раз редактировалось lmikle, 23.03.2022 в 22:19. |
#2
|
|||
|
|||
Ну что сложного. Единственный параметр, который ты можешь менять - 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; |
Этот пользователь сказал Спасибо lmikle за это полезное сообщение: | ||
alexdudchenko2022 (24.03.2022)
|
#3
|
|||
|
|||
Чудеса случаются! Спасибо человеческое. Единственная ошибка в функции поторопился видимо:
begin Bmp : TBitmap.Creare; А так всё классно! |
#4
|
|||
|
|||
Это не ошибка, это опечатка. Писал тут, не проверял, вот и пропустил. Но по контексту понятно, что там именно Create.
Пожалуйста. Хотя такой простой код мог бы и сам догадаться. Если оставляем размер картинки тот же, то можно играться только со степенью сжатия... |
#5
|
|||
|
|||
Я люблю программирование просто не каждому дано всё знать, я умею всё правильно расставлять делать я сделаю но мне очень тяжело дается логика хоть и стараюсь в этом разбираться. Особенно с циклами всегда проблемы! Греёбанная логика!!!
|