Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Графика и игры
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 25.06.2010, 00:23
gendalf71 gendalf71 вне форума
Прохожий
 
Регистрация: 25.06.2010
Сообщения: 5
Репутация: 10
Вопрос Ухудшить качество изображения.

Вопрос прост: в TImage есть изображение. При сохранении оно весит ~3mb. Как уменьшить до нормального веса?) 200-500кб =)
Ответить с цитированием
  #2  
Старый 25.06.2010, 02:51
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,096
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Отмасштабировать.
Тебе нужна будет функция StretchDraw.
Теперь как рассчитать нужный размер.
При уменьшении картинки в 2 раза ее вес уменьшается примерно в 4 раза (квадрат) (для битмапа, для форматов со сжатием все подругому). Соответсвенно, чтобы из 3 Мб сделать 500 кб (т.е. уменьшение в 6 раз) тебе нвдо обе стороны уменьнить в корень из 6 раз (2,5 примерно).

Код:
procedure ResizeImage(ASrc, ADst : TBitmap; K : Double);
begin
  If (ASrc = Nil) Or (ADst = Nil) Then
    Raise Exception.Create('Source or destination is Nil');

  ADst.Width := Round(ASrc.Width / Sqrt(K));
  ADst.Height := Round(ASrc.Height / Sqrt(K));
  ADst.Canvas.StretchDraw(Rect(0,0,ADst.Width,ADst.Height),ASrc);
end;

Кажется так, писал по памяти, мог чего и напутать.
Ответить с цитированием
  #3  
Старый 25.06.2010, 03:12
gendalf71 gendalf71 вне форума
Прохожий
 
Регистрация: 25.06.2010
Сообщения: 5
Репутация: 10
По умолчанию

Эмм,а без уменьшения размера? Т.е. ухудшить качество =) или я чего-то непонимаю?
Ответить с цитированием
  #4  
Старый 25.06.2010, 03:16
gendalf71 gendalf71 вне форума
Прохожий
 
Регистрация: 25.06.2010
Сообщения: 5
Репутация: 10
По умолчанию

Код:
var
  Form1: TForm1;
  ASrc, ADst :Tbitmap;
  K : Double;

procedure TForm1.btn1Click(Sender: TObject);
begin
  ADst := TBitmap.Create;
    ADst.Width := Screen.Width;
    ADst.Height := Screen.Height;
    BitBlt(ADst.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
           GetDC(0), 0,0,SRCCOPY);
     If (ASrc = Nil) Or (ADst = Nil) Then
    Raise Exception.Create('Source or destination is Nil');
    ADst.Width := Round(ASrc.Width / Sqrt(K));
  ADst.Height := Round(ASrc.Height / Sqrt(K));
  ADst.Canvas.StretchDraw(Rect(0,0,ADst.Width,ADst.Height),ASrc);
    //ADst.Picture.Assign(ADst);
    ADst.SavetoFile('D:\123.jpg');
    ADst.Free;
end;
Выдает Source or destination is Nil. Извините, туплю =)
Ответить с цитированием
  #5  
Старый 25.06.2010, 03:18
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,096
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Да, ты чего-то не понимаешь.
Если мы говорим о несжатых форматах - то только уменьшением фихического размера. Если готорить о сжатии с потерями - то тут другой разговор. Можно просто "пережать" картинку в JPEG'е с более высоким коэф. сжатия, что ухудшит ее качество, но уменьшит размер файла (при отображении она все-равно съест столько же места в памяти). Есть еще вариант перевода в другую глубину цвета. Если у нас есть битмап с 1М цветов, то переведя его в 256 цветов ты получишь уменьшение размера файла в 3 раза.
Ответить с цитированием
  #6  
Старый 25.06.2010, 03:20
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,096
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Цитата:
Сообщение от gendalf71
Выдает Source or destination is Nil. Извините, туплю =)

ну ADst ты созадл, а кто будет ASrc создавать?
Ответить с цитированием
  #7  
Старый 25.06.2010, 03:56
gendalf71 gendalf71 вне форума
Прохожий
 
Регистрация: 25.06.2010
Сообщения: 5
Репутация: 10
По умолчанию

Цитата:
Сообщение от lmikle
Да, ты чего-то не понимаешь.
Если мы говорим о несжатых форматах - то только уменьшением фихического размера. Если готорить о сжатии с потерями - то тут другой разговор. Можно просто "пережать" картинку в JPEG'е с более высоким коэф. сжатия, что ухудшит ее качество, но уменьшит размер файла (при отображении она все-равно съест столько же места в памяти). Есть еще вариант перевода в другую глубину цвета. Если у нас есть битмап с 1М цветов, то переведя его в 256 цветов ты получишь уменьшение размера файла в 3 раза.
Пережать в jpeg надо.

Код:
ASrc := TBitmap.Create;
Invalid floating point operation
Ответить с цитированием
  #8  
Старый 25.06.2010, 08:32
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

PHP код:
unit Unit1;

interface

uses
  jpeg
,
  
WindowsMessagesSysUtilsVariantsClassesGraphicsControlsForms,
  
DialogsExtCtrls;

type
  TForm1 
= class(TForm)
    
Image1TImage;
    
procedure FormCreate(SenderTObject);
  private
    { Private 
declarations }
  public
    { Public 
declarations }
  
end;

var
  
Form1TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(SenderTObject);
var
  
jpgTJPEGImage;
begin
  Image1
.Picture.LoadFromFile('c:\Downloads\img.bmp'); // загрузим исходный bmp
  
jpg:=TJPEGImage.Create;
  try
    
jpg.Assign(Image1.Picture.Bitmap);
    
jpg.CompressionQuality:=50// на сколько плохое? 100 - отличное, 0 - никакое
    
jpg.SaveToFile('c:\Downloads\img.jpg'); // где сохранить jpg?
  
finally
    jpg
.Free;
  
end;
end;

end
Ответить с цитированием
  #9  
Старый 25.06.2010, 14:23
gendalf71 gendalf71 вне форума
Прохожий
 
Регистрация: 25.06.2010
Сообщения: 5
Репутация: 10
По умолчанию

Спасибо огромное! =)
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 03:15.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025