Задать вопрос
@tabbols95
Недопрограммист
изображения

Как сжать размер сохраняемого файла в Delphi?

Есть изображение, вес которого равняется 558 Кб (скриншот)
С помощью кода на изображение накладывается текст и сохраняет изображение с текстом уже с размером 6,5 Мб, как можно сжать вес изображения при сохранении?
procedure TForm1.Button1Click(Sender: TObject);
var r : integer;
    numberStr : string;
    SR : tSearchRec;
    jpg:TJpegimage;
begin
Memo1.Clear;
numberStr:=Memo2.Lines[0];
r := FindFirst(Edit1.Text+numberStr+'.jpg', faAnyFile, SR);
  if r = 0 then begin
    Memo1.Lines.Add('Screen : '+FormatDateTime('mm/dd/yyyy hh:nn:ss',
      FileAccessDateToDateTime(SR.FindData.ftCreationTime)));
  end;
jpg:=TJpegImage.Create;
jpg.LoadFromFile(Edit1.Text+numberStr+'.jpg');
with Image1 do
 begin
   canvas.font.Size:=26;
   canvas.Font.Color:=clRed;
   picture.Bitmap.Assign(jpg);
   canvas.Brush.Style:=bsClear;
   canvas.TextOut(10,20,Memo1.Lines[0]);
   picture.SaveToFile(Edit1.Text+numberStr+'(number).png');
 end;
 Memo2.Lines.Delete(0);
end;
  • Вопрос задан
  • 414 просмотров
Комментировать
Подписаться 1 Простой Комментировать
Решения вопроса 1
@tabbols95 Автор вопроса
Недопрограммист
В итоге подредактировал по примерам kalapanga и добился результата
jpg.Assign(Image1.Picture.Graphic);
     jpg.CompressionQuality := 100;
     jpg.Compress;
     jpg.SaveToFile(Edit1.Text+'\SnapShots(new)\'+numberStr+'(new).bmp');
     jpg.Free;
Ответ написан
Комментировать
Комментировать
Пригласить эксперта
Ответы на вопрос 1
@kalapanga
TPicture про png ничего не знает. Посмотрите файл, он у Вас только с расширением png, а внутри обычный битмап. Нужно обратно к соответствующему классу перейти (TJPEGImage, TPNGImage):
jpgout := TJPEGImage.Create;
  try
    with jpgout do
    begin
      Assign(Image1.Picture.Bitmap);
      SaveToFile('myfile.jpg');
    end;
  finally
    jpgout.Free;
  end;
Ответ написан
5 комментариев
5 комментариев
Ваш ответ на вопрос

Войдите, чтобы написать ответ

Войти через центр авторизации
Похожие вопросы
Вакансии с Хабр Карьеры
Java Developer (стажер)
Aston
от 70 000 до 80 000 ₽
Инженер тех поддержки / внедрения
Axess • Санкт-Петербург
от 10 000 до 30 000 ₽
Консультант-аналитик 1С
ITOB • Москва
от 60 000 до 100 000 ₽
Ещё вакансии
Заказы с Хабр Фриланса
Нарисовать рекламный креатив для ios приложения
25 апр. 2024, в 12:26
10000 руб./за проект
Верстка
25 апр. 2024, в 12:23
2500 руб./за проект
ASO дизайн для ios приложения (Иконка+Скриншоты)
25 апр. 2024, в 12:21
10000 руб./за проект
Ещё заказы