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

Delphi Sources



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

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 07.06.2018, 00:40
Аватар для Guaho
Guaho Guaho вне форума
Начинающий
 
Регистрация: 27.08.2017
Сообщения: 179
Версия Delphi: Delphi7
Репутация: 10
По умолчанию Компонент для сжатия изображения

Приветствую вас, форумчане!
Работаю сейчас над базой данных, содержащей графические поля. Большие изображения, это приблизительно 200 - 300 кб, и более 800 х 600 пикселей, записывать в БД нежелательно, ибо чем больше изображение, тем ощутимее сказывается подтормаживание при навигации (это не говоря даже об общем объёме модуля данных). Возникает необходимость предварительного (до записи в БД) сжатия изображения, находящееся в фале или буфере обмена (формат bmp или jpg), а именно нужно уменьшить как его геометрические размеры, так и объём (для jpg регулировать степень сжатия картинки). Существуют ли в природе компоненты, которые могли бы выполнять такие функции?

Последний раз редактировалось Guaho, 07.06.2018 в 00:42.
Ответить с цитированием
  #2  
Старый 07.06.2018, 04:10
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,057
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Ну, для jpeg есть соотв. модуль. так и называется. достаточно подключить в проект.
Код для изменения размеров картинки тоже достаточно простой, хотя иногда дает не самый лучший результат. Как и сильное сжатие jpeg'а.

Но есть другой вариант.
Вариант 1. Если есть файл-сервер или доступ к облачному хранилищу, то можно просто файлы картинок писать туда, а в БД сохранять только путь к картинке.
Вариант 2. Тут еще зависит от БД. В некоторых базах можно выделить таблицу в отдельное пространство. В этом случае картинки не замедляют операции с осноной таблицей.

А вообще, картинки надо грузить по мере необходимости, а не при выборке основного списка.
Ответить с цитированием
  #3  
Старый 07.06.2018, 20:21
Аватар для Guaho
Guaho Guaho вне форума
Начинающий
 
Регистрация: 27.08.2017
Сообщения: 179
Версия Delphi: Delphi7
Репутация: 10
По умолчанию

БД работает на "движке" AbsoluteDataBase, все данные находятся в одном файле. Примерное ожидаемое число записей - несколько тысяч. Если изображения не сжимать, размер базы будет порядка нескольких Гиг, а это многовато, да и не нужно. Сверх-высокое качество и разрешение не требуется (база технической направленности). Грузить картинки по мере необходимости - не пойдёт, т.к. нужно сразу видеть изображение, связанное с выбранной записью, это обязательно. Вариант 1 не подойдёт, т.к. это фактически почти то же, что и БД, только вид сбоку (суммарный размер файлов всё равно окажется огромным); а "облако" категорически отпадает. Вариант 2 для моего "движка" не подходит. Остаётся или код, или компонент. Искал среди доступных граф. компонентов сторонних разработчиков - не нашёл ничего путного.
Ответить с цитированием
  #4  
Старый 07.06.2018, 20:51
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,057
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Ну, сжать можно так:
Код:
uses jpeg, math;

function CompressBitmapToJpeg(ASource : TBitmap; AWidth, AHeight : Integer) : TJpegImage;
var
  TargetBmp : TBitmap;
  K : Double;
  NewWidth, NewHeihg : Integer;
begin
  Result := Nil;
  TargetBmp := TBitmap.Create;
  TargetBmp.PixelsPerInch := pf24bit;
  Try
    If (ASource.Width <= AWidth) And (ASource.Height <= Height)
	  Then K := 1
	  Else K := Min(AWidth/ASource.Width, AHeight/ASource.Height);
	  NewWidth := Round(SourceBmp.Width*K);
	  NewHeight := Round(SourceBmp.Height*K);
	  TargetBmp.Width := NewWidth;
	  TargetBmp.Height := NewHeight;
	  TargetBmp.Canvas.StretchDraw(Rect(0,0,NewWidth,NewHeight),ASource);
	  Result := TJpegImage.Create;
	  Result.Assign(TargetBmp);    	
  Finally
	TargetBmp.Free;
  End;
end;

function CompressJpeg(ASource : TJpegImage; AWidth, AHeight : Integer) : TJpegImage;
var
  SourceBmp : TBitmap;
begin
  Result := Nil;
  If (ASource.Width <= AWidth) And (ASource.Height <= AHeight) 
    Then
      Begin
        // Do not need to copress jpeg, just copy source to target
	    Result := TJpegImage.Create;
		Result.Assign(ASource);
      End
    Else
      Begin
	    // Need to compress
	    SourceBmp := TBitmap.Create;
        Try
		  SourceBmp.Assign(ASource);
		  Result := CompressBitmapToJpeg(SourceBmp,AWidth,AHeigh);
        Finally
          SourceBmp.Free;
        End;
end;
На выходе функции получишь TJpegImage.
Перед сохранением установи его свойство CompressionQuality в желаемое значение (чем выше - тем выше качество, но и больше размер). Если правильно помню, то там от 1 до 100. Я бы рекомендовал где-то 60-70.

ЗЫ. Код не проверял, так что могут быть очепятки.
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
Guaho (07.06.2018)
  #5  
Старый 26.06.2018, 18:42
Аватар для Guaho
Guaho Guaho вне форума
Начинающий
 
Регистрация: 27.08.2017
Сообщения: 179
Версия Delphi: Delphi7
Репутация: 10
По умолчанию

Благодарю за приведённый код, он указал мне направление. Я решил не играться с качеством jpg, а просто ужимать размеры независимо от типа изображения. Проведённые эксперименты показали, что такой подход вполне приемлем: урезание размеров уже даёт нужный результат по весу файла даже для bmp, и следовательно, для jpg, и не нужно играться со степенью его компрессии.
В качестве промежуточного хранилища "входящего" изображения я использовал компонент TDBImageEh из библиотеки EhLib (имя im0). Вот что получилось, может пригодится кому-нибудь:
Код:
{ Функция загрузки изображения из буфера обмена и при необходимости уменьшения его размеров.}
function Tdm.PictureLoadFromClipboard():TBitmap;
begin
  try
    im0.Picture.Assign(Clipboard);
  except
    Application.MessageBox('Данные в буфере обмена не являются изображением! ' + #13 +
                           'В это поле БД можно вставить только изображение.', '  Предупреждение', MB_ICONWARNING + MB_OK);
    Result := nil;
    exit;
  end;
  PictureResize;
  Result := im0.Picture.Bitmap;
end;

{ Функция загрузки изображения из файла и при необходимости уменьшения его размеров.}
function Tdm.PictureLoadFromFile():TBitmap;
begin
  if opPd1.Execute then
    begin
      try
        im0.Picture.LoadFromFile(opPd1.FileName);
        im0.CopyToClipboard;
        im0.Picture.Assign(Clipboard);
      except
        Application.MessageBox('Не удалось загрузить изображение в БД. ' +  #13 +
                               'Возможно, оно имеет неверный или неподходящий формат.', '  Предупреждение', MB_ICONWARNING + MB_OK);
        Result := nil;
        exit;
      end;
    end;  
  PictureResize;
  Result := im0.Picture.Bitmap;
end;


{ Процедура уменьшения размеров изображения, уже находящегося в компоненте im0.
  Результат сжатия помещается туда же, в im0.
}
procedure Tdm.PictureResize;
  var sW, sH, tW, tH, max: Integer;
      TBM: TBitmap;
begin
  max := fm_param._eMaxPictureSize.Value;
  sW := im0.Picture.Bitmap.Width;
  sH := im0.Picture.Bitmap.Height;
  if ((sW > max) or (sH > max)) then
    begin
      if sW > sH then
        begin
          tW := max;
          tH := Trunc(sH * max / sW);
        end
          else
            begin
              if sW < sH then
                begin
                  tH := max;
                  tW := Trunc(sW * max / sH);
                end
                  else//sW = sH
                    begin
                      tH := max;
                      tW := max;
                    end;
            end;
    end
      else
        begin
          tH := sH;
          tW := sW;
        end;
  TBM := TBitmap.Create;
  TBM.Width:= tW;
  TBM.Height:= tH;
  TBM.Canvas.StretchDraw(rect(0, 0, TBM.Width, TBM.Height), im0.Picture.Bitmap);
  im0.Picture.Bitmap.Assign(TBM);
  TBM.Free;
end;

Последний раз редактировалось Guaho, 26.06.2018 в 19:22.
Ответить с цитированием
Ответ


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter