[iOSSimulator] TBitmap.Resize - иногда белый прямоугольник

[kami]

Доброго времени суток, уважаемые!

Есть код:

procedure TmyThread.RescalePhoto(const FileName: string);
const
  DefaultHeight = 300;
var
  Bitmap: TBitmap;
  xScale: Double;
  newWidth, newHeight: integer;
begin
  Bitmap := TBitmap.Create;
  try
    try
      Bitmap.LoadFromFile(FileName);
      // установим высоту в 300 пикселей.
      if Bitmap.Height <> DefaultHeight then
        begin
          xScale := Bitmap.Height / DefaultHeight;
          newHeight := DefaultHeight;
          newWidth := Round(Bitmap.Width / xScale);
          Bitmap.Resize(newWidth, newHeight);
          Bitmap.SaveToFile(FileName);
        end;
    except
      DeleteFile(FileName);
      raise;
    end;
  finally
    Bitmap.Free;
  end;
end;

В Windows все отлично, а вот на симуляторе есть проблемы.

Проблема №1: вместо некоторых отмасштабированных jpg-файлов - белый прямоугольник корректного размера.

Проблема №2: размер итогового файла (если не наблюдается проблемы №1) значительно больше, чем при запуске в Windows, хотя размеры правильные. (к примеру 96кб vs 19кб)

 

Где моя ошибка? Пример файла, масштабируемого в белый прямоугольник прилагаю.

 

P.S. iOS 7.1 (iPad), Win8, Delphi XE7Upd1.

PHOTO_original.zip

[Alex7wrt]

Не знаю как в IOS, но в Android TBitmap.Resize тоже иногда некорректно работает. Могу посоветовать в таких случаях использовать функцию типа

function ResizeBitmap(Source: TBitmap; Width, Height: Integer):TBitmap;
begin
    Result:=TBitmap.Create(Width,Height); 
    Result.Clear(0);
    if Result.Canvas.BeginScene then
    try
        Result.Canvas.DrawBitmap(Source,RectF(0,0,Source.Width,Source.Height),RectF(0,0,Width,Height),1);
    finally
        Result.Canvas.EndScene;
    end;
end;

.......
Bitmap:=ResizeBitmap(Bitmap,newWidth,newHeight);

[zairkz]

Проблема 1: Есть встроенная функция CreateThumbnail в Delphi

Проблема 2: Нужно пересохранить в другой формат (по умолчанию не сжатый bmp вроде как)

 

Попробуйте сделать так

uses FMX.Surfaces;

 

procedure TmyThread.RescalePhoto(const FileName: string);
const
  DefaultHeight = 300;
var
  Bitmap: TBitmap;
  BitmSur:  TBitmapSurface;
  TBSS:   TBitmapCodecSaveParams;
  xScale: Double;
  newWidth, newHeight: integer;
begin
  Bitmap := TBitmap.Create;
  try
    try
      Bitmap.LoadFromFile(FileName);
      // установим высоту в 300 пикселей.
      if Bitmap.Height <> DefaultHeight then
        begin
          xScale := Bitmap.Height / DefaultHeight;
          newHeight := DefaultHeight;
          newWidth := Round(Bitmap.Width / xScale);

          Bitmap.CreateThumbnail(newWidth, newHeight);
          TBSS.Quality := 90; //Укажите качество
          BitmSur:= TBitmapSurface.Create;
          BitmSur.Assign(Bitmap);
          TBitmapCodecManager.SaveToFile(FileName, BitmSur, @TBSS); //Сохраняем в файл
        end;
    except
      DeleteFile(FileName);
      raise;
    end;
  finally
    Bitmap.Free;
    BitmSur.Free;
  end;
end;

Изменено 7 июля, 2015 пользователем zairkz

[kami]

Господа, спасибо за участие!

zairkz, упростил и немного подправил ваш код, вот что получилось:

procedure TSiteExchangerThread.RescalePhoto(const FileName: string);
const
  DefaultHeight = 300;
var
  Bitmap: TBitmap;
  Thumb: TBitmap;
  BSS: TBitmapCodecSaveParams;
  xScale: Double;
  newWidth, newHeight: integer;
begin
  Bitmap := TBitmap.Create;
  try
    try
      Bitmap.LoadFromFile(FileName);
      if Bitmap.Height <> DefaultHeight then
        begin
          xScale := Bitmap.Height / DefaultHeight;
          newHeight := DefaultHeight;
          newWidth := Round(Bitmap.Width / xScale);

          Thumb := Bitmap.CreateThumbnail(newWidth, newHeight); // далее работаем с Thumb, а не с Bitmap
          try
            BSS.Quality := 90;
            Thumb.SaveToFile(FileName, @BSS); // все менеджеры и surface не нужны, они есть внутри Save-метода
          finally
            Thumb.Free;
          end;
        end;
    except
      DeleteFile(FileName);
      raise;
    end;
  finally
    Bitmap.Free;
  end;
end;

Кстати, весьма удивился, что результат получился нужный: TBitmap.Resize использует тот же самый CreateThumbnail. Единственное отличие - в Resize-методе используется Assign получившегося thumb-а в себя же. А вот в самом assign какие-то непонятные манипуляции со счетчиками ссылок FImage. Имхо, именно здесь и возникает проблема с белым прямоугольником, ибо все остальное - 1:1 уже используемое в методах TBitmap