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

Delphi Sources



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

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 03.03.2015, 18:20
kyran29 kyran29 вне форума
Прохожий
 
Регистрация: 03.03.2010
Сообщения: 13
Репутация: 10
Вопрос Уменьшить масштаб изображения

Необходимо уменьшить масштаб полученного снимка с минимальными потерями качества.

Результат: масштаб был уменьшен с помощью функции ResizeBitmap - качество изображения изменилось с худшим результатом:


Качество изображения без функции нормальное, но масштаб 1366х768:


Прошу помочь разобраться с уменьшением масштаба изображения с минимальными потерями в качества.
Код:
uses Jpeg;
 
function ResizeBitmap(BmpIn : TBitmap; NewWidth, NewHeight : Integer) : TBitmap;
begin
  Result := TBitmap.Create;
 try
   Result.Width := NewWidth;
   Result.Height := NewHeight;
   Result.PixelFormat := BmpIn.PixelFormat;
   Result.Canvas.StretchDraw(Rect(0, 0, Result.Width, Result.Height), BmpIn);
 except
   Result.Free;
 end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
 var
   JpegIm: TJpegImage;
   bm: TBitMap;
   ScrJpg : String;
 begin
   ScrJpg := 'screenshot.jpg';
   DeleteFile(ScrJpg);
   bm := TBitMap.Create;
   bm.Width := Screen.Width;
   bm.Height := Screen.Height;
   BitBlt(bm.Canvas.Handle, 0, 0, bm.Width, bm.Height, GetDC(0), 0, 0, SRCCOPY);
   bm := ResizeBitmap(bm, 1280, 720);
   JpegIm := TJpegImage.Create;
   JpegIm.Assign(bm);
   JpegIm.CompressionQuality := 90;
   JpegIm.Compress;
   JpegIm.SaveToFile(ScrJpg);
   bm.Destroy;
   JpegIm.Destroy;
   Form1.Close;
end;
Ответить с цитированием
  #2  
Старый 03.03.2015, 21:48
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Пример использования:
Код:
ResampleBitmap(BmpSrc, BmpDest, ResampleFilters[5].Filter, ResampleFilters[5].Width);
Вложения
Тип файла: rar rsmpl.rar (2.7 Кбайт, 16 просмотров)
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #3  
Старый 04.03.2015, 01:28
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Вот тут еще можно посмотреть:
https://msdn.microsoft.com/en-us/lib...v=vs.110).aspx
Заголовки для GDI+ ищи в интернете, они есть.

PS. angvelem, а ты нигде бикубическую фильтрацию не встречал?
Ответить с цитированием
  #4  
Старый 04.03.2015, 01:42
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

offtop: Я особо не заморачивался поиском различных фильтров. Этот исходник я нарыл около 10 лет назад, когда писал программу для различных эффектов над изображениями. Больше подобным не занимался.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #5  
Старый 04.03.2015, 08:57
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

Код:
type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
...
procedure TForm1.FormCreate(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  Width:=Screen.Width;
  Height:=Screen.Height;
  Left:=0;
  Top:=0;
  Image1.Width:=ClientWidth-Image1.Left shl 1;
  Image1.Height:=ClientHeight-Image1.Top shl 1;
  Bitmap:=TBitmap.Create;
  try
    Bitmap.LoadFromFile('Безымянный.bmp');
    SetStretchBltMode(Image1.Canvas.Handle, HALFTONE);
    StretchBlt(Image1.Canvas.Handle, 0, 0, Image1.Width, Image1.Height, Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, SRCCOPY);
  finally
    Bitmap.Free;
  end;
end;

основной момент в коде:
Код:
SetStretchBltMode(Image1.Canvas.Handle, HALFTONE);
StretchBlt(Image1.Canvas.Handle, 0, 0, Image1.Width, Image1.Height, Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, SRCCOPY);
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #6  
Старый 04.03.2015, 12:59
kyran29 kyran29 вне форума
Прохожий
 
Регистрация: 03.03.2010
Сообщения: 13
Репутация: 10
По умолчанию

Цитата:
Сообщение от angvelem
Пример использования:
Код:
ResampleBitmap(BmpSrc, BmpDest, ResampleFilters[5].Filter, ResampleFilters[5].Width);

Все перепробовал, в итоге получается изображение с весом в 0 кб, Подскажи angvelem, может, что-то я не так делаю?
Ответить с цитированием
  #7  
Старый 04.03.2015, 13:02
kyran29 kyran29 вне форума
Прохожий
 
Регистрация: 03.03.2010
Сообщения: 13
Репутация: 10
По умолчанию

Цитата:
Сообщение от NumLock
основной момент в коде:
Код:
SetStretchBltMode(Image1.Canvas.Handle, HALFTONE);
StretchBlt(Image1.Canvas.Handle, 0, 0, Image1.Width, Image1.Height, Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, SRCCOPY);

результат тот же, качество изображения плохое.
Ответить с цитированием
  #8  
Старый 04.03.2015, 14:08
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

а хорошим оно никогда не будет. это же растровая картинка.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #9  
Старый 04.03.2015, 18:13
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию согласись есть разница в пользу HALFTONE

по умолчанию:



с HALFTONE:

__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #10  
Старый 27.05.2015, 16:17
Аватар для Каролина
Каролина Каролина вне форума
Прохожий
 
Регистрация: 27.05.2015
Сообщения: 2
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

разница с HALFTONE ощутимая)
Ответить с цитированием
Ответ


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter