Показать сообщение отдельно
  #5  
Старый 26.06.2018, 18:42
Аватар для Guaho
Guaho Guaho вне форума
Начинающий
 
Регистрация: 27.08.2017
Сообщения: 173
Версия 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;
Ответить с цитированием