Перейти к содержанию
  • Регистрация
  • 0
Евгений Корепов

Helper для TBitmap - асинхронная загрузка картинки из URL

Вопрос

Для одного своего проекта сделал, поделюсь, вдруг кому пригодится. Тестировал под Windows и Android.

Для использования просто добавьте BitmapAsyncLoader в uses, а дальше все просто:

ImageControl.Bitmap.LoadFromURLAsync('https://bipbap.ru/wp-content/uploads/2017/10/0_8eb56_842bba74_XL-640x400.jpg');

Код юнита хелпера:

unit BitmapAsyncLoader;

interface

uses
  FMX.Graphics,
  System.Net.HttpClient,
  System.Types,
  System.Classes;

type
  TBitmapAsyncLoader = class helper for TBitmap
    procedure LoadFromUrlAsync(const AUrl : String);
  end;

implementation

var
  AHTTPClient : THTTPClient;

procedure TBitmapAsyncLoader.LoadFromURLAsync(const AURL : String);
begin
  try
    AHTTPClient.BeginGet(
      procedure (const ASyncResult: IAsyncResult)
      var
        AHTTPResponse : IHTTPResponse;
      begin
        if Not ASyncResult.IsCompleted then
          exit;
        try
          AHTTPResponse:=THTTPClient.EndAsyncHTTP(ASyncResult);
        except
        end;
        if Assigned(AHTTPResponse) and (AHTTPResponse.StatusCode = 200) then
          TThread.Synchronize(Nil,
            procedure
            begin
              try
                Self.LoadFromStream(AHTTPResponse.ContentStream);
              except
              end;
            end
          );
      end,
      AURL
    );
  except
  end;
end;

initialization

AHTTPClient:=THTTPClient.Create;

finalization

if Assigned(AHTTPClient) then
begin
  AHTTPClient.DisposeOf;
end;

end.

Архив с тестовым проектом прилагаю.

BitmapAsyncLoader.7z

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

Рекомендуемые сообщения

  • 1

Пока тестировал хелпер в боевом проекте он потихоньку оброс исрпавлениями/улучшениями:

  1. Загрузка из потока сделана через TBitmapSurface - это позволяет избежать множества глюков.
  2. LoadFromStream вынесен из Synchronize (основного потока) в поток HTTPClient - по результатам бенчмарка операция оказалась самая жручая. После исправления интерфейс перестал залипать совсем.
  3. Добавлен overload вариант с передачей в процедуру TListItemImage - для использования в TListView и корректной перерисовки подгруженных картинок через AListItemImage.Invalidate.
unit BitmapAsyncLoader;

interface

uses
  FMX.Graphics,
  FMX.Surfaces,
  System.Net.HttpClient,
  System.Types,
  System.Classes,
  FMX.ListView.Types,
  FMX.ListView.Appearances;

type
  TBitmapAsyncLoader = class helper for TBitmap
    procedure LoadFromURLAsync(const AUrl : String); overload;
    procedure LoadFromURLAsync(const AUrl : String; const AListItemImage : TListItemImage); overload;
  end;

implementation

var
  AHTTPClient : THTTPClient;

procedure TBitmapAsyncLoader.LoadFromURLAsync(const AURL : String);
begin
  try
    AHTTPClient.BeginGet(
      procedure (const ASyncResult: IAsyncResult)
      var
        AHTTPResponse : IHTTPResponse;
        ABitmapSurface : TBitmapSurface;
      begin
        if Not ASyncResult.IsCompleted then
          exit;
        try
          AHTTPResponse:=THTTPClient.EndAsyncHTTP(ASyncResult);
        except
        end;
        if Assigned(AHTTPResponse) and (AHTTPResponse.StatusCode = 200) then
        begin
          ABitmapSurface:=TBitmapSurface.Create;
          if TBitmapCodecManager.LoadFromStream(AHTTPResponse.ContentStream, ABitmapSurface, CanvasClass.GetAttribute(TCanvasAttribute.MaxBitmapSize)) then
            TThread.Synchronize(Nil,
              procedure
              begin
                if Assigned(Self)then
                  Assign(ABitmapSurface);
                ABitmapSurface.Free;
              end
            )
          else
            ABitmapSurface.Free;
        end;
      end,
      AURL
    );
  except
  end;
end;

procedure TBitmapAsyncLoader.LoadFromURLAsync(const AURL : String; const AListItemImage : TListItemImage);
begin
  try
    AHTTPClient.BeginGet(
      procedure (const ASyncResult: IAsyncResult)
      var
        AHTTPResponse : IHTTPResponse;
        ABitmapSurface : TBitmapSurface;
      begin
        if Not ASyncResult.IsCompleted then
          exit;
        try
          AHTTPResponse:=THTTPClient.EndAsyncHTTP(ASyncResult);
        except
        end;
        if Assigned(AHTTPResponse) and (AHTTPResponse.StatusCode = 200) then
        begin
          ABitmapSurface:=TBitmapSurface.Create;
          if TBitmapCodecManager.LoadFromStream(AHTTPResponse.ContentStream, ABitmapSurface, CanvasClass.GetAttribute(TCanvasAttribute.MaxBitmapSize)) then
            TThread.Synchronize(Nil,
              procedure
              begin
                if Assigned(Self) and Assigned(AListItemImage) then
                begin
                  AListItemImage.BeginUpdate;
                  Assign(ABitmapSurface);
                  AListItemImage.Invalidate;
                  AListItemImage.EndUpdate;
                end;
                ABitmapSurface.Free;
              end
            )
          else
            ABitmapSurface.Free;
        end;
      end,
      AURL
    );
  except
  end;
end;

initialization

AHTTPClient:=THTTPClient.Create;

finalization

if Assigned(AHTTPClient) then
  AHTTPClient.DisposeOf;

end.

Тестовый проект, на этот раз с ListView (по кнопке добавляется 100 итемов) прилагаю.

BitmapAsyncLoaderListView.7z

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

Присоединяйтесь к обсуждению

Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.

Гость
Ответить на вопрос...

×   Вставлено с форматированием.   Вставить как обычный текст

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.


  • Похожий контент

    • От PavelS
      Здравствуйте! Начал изучать FireMonkey  и столкнулся с тем, что TBitmap не поддерживает размер изображения больше 8132, кажется. Т.е. большие размеры рисунка он грузит, но за счёт потери качества, размер пиксела растёт, а размер рисунка по оси всё равно не превышает 8132. В то же время в простом дельфи можно грузить и работать с гораздо большими размерами, например, один из файлов имеет размер 61216 х 1486 точек. Подскажите пожалуйста, есть ли возможность работать с большими файлами в FireMоnkey и как это можно организовать? Программа создаётся для работы только в Windows.
    • От Tot999
      Добрый день! 
      Решил покопаться в своей старой спрайтовой игрушке, чтобы освежить в памяти знания и состряпать что-нибудь новое. Возникли сомнения, нормально ли сделано графическое отображение, можно ли доработать.
      Все спрайты в дизайнтайме распиханы по Timagelist-ам.  На старте приложения я загружаю битмапы из имэджлистов в свои обджектлисты, подгоняя под нужный размер. 
      MeduzasBitmpAr : array [1..numofMeduzas] of TObjectList<Tbitmap>;  
      Дальше рисую по таймеру в основном окне игры Tpaintbox.OnPaint:
               
      В принципе, даже на слабеньких телефончиках, всё вроде бодро. Но может, опытные товарищи чего подскажут, а то я 3ий день в собственном соку варюсь, ничего толкового.
    • От fredhack
      Доброго времени суток подскажите пожалуйста как мне получить ссылку из браузера запущенного через intent в общем суть такова:
      1 запускаю браузер через интент с сылкой http://fire-monkey.ru
      2 на ссылке происходит редирект
      3 я попадаю на http://fire-monkey.ru/forum/
      Как получить последнюю ссылку после редиректа? в данном случае она равна http://fire-monkey.ru/forum/
      var Intent: JIntent; begin Intent := TJIntent.Create; Intent.setAction(TJIntent.JavaClass.ACTION_VIEW); Intent.setData(StrToJURI('http://fire-monkey.ru')); SharedActivity.startActivity(Intent); end;  
    • От x11
      Можно ли получить TBitmap из TBitmapImage? Конвертировать.
    • От x11
      Нет ли у FMX готовой функции для открытия веб-ссылок из приложения?
      А то приходится городить огород с лисапетами и кучей IFDEF.
      В итоге что у меня получилось.
      Для удобства разнес все по разным модулям.
      Модуль для Windiws
      unit uUtilsWindows; interface {$IFDEF MSWINDOWS} uses ShellApi, Variants, Windows, FMX.Types, FMX.Platform.Win; procedure WindowsOpenUrl(const sUrl: string; WindowHandle: TWindowHandle); {$ENDIF} implementation {$IFDEF MSWINDOWS} procedure WindowsOpenUrl(const sUrl: string; WindowHandle: TWindowHandle); begin ShellExecute(FmxHandleToHWND(WindowHandle), 'open', PChar(VarToStr(sURL)), nil, nil, SW_NORMAL); end; {$ENDIF} end.  
      Модуль для Android
      unit uUtilsAndroid; interface {$IFDEF ANDROID} uses FMX.Helpers.Android, Androidapi.JNI.Net, Androidapi.JNI.GraphicsContentViewText, AndroidApi.Helpers; procedure AndroidOpenUrl(const sUrl: string); {$ENDIF} implementation {$IFDEF ANDROID} procedure AndroidOpenUrl(const sUrl: string); Var Uri: Jnet_Uri; OpenLinkIntent: JIntent; begin Uri := StrToJURI(sUrl); OpenLinkIntent := TJIntent.JavaClass.init(TJIntent.JavaClass.ACTION_VIEW, Uri);// будем что-то смотреть OpenLinkIntent.addCategory(TJIntent.JavaClass.CATEGORY_BROWSABLE);// смотреть в браузере OpenLinkIntent.setData(Uri);// смотреть эту ссылку SharedActivity.startActivity(OpenLinkIntent);// открываем end; {$ENDIF} end.  
      теперь в основной форме:
      uses ..., ...{$IFDEF ANDROID}, vkbdhelper, uUtilsAndroid{$ENDIF} {$IFDEF MSWINDOWS}, uUtilsWindows {$ENDIF}; ... ... ... procedure TfmEditObject.actOpenUrlExecute(Sender: TObject); begin {$IFDEF ANDROID}AndroidOpenUrl(edMapsCoordUrl.Text);{$ENDIF} {$IFDEF MSWINDOWS}WindowsOpenUrl(edMapsCoordUrl.Text, Self.Handle);{$ENDIF} end;  
      А если добавлять ещё одну платформу, то ещё один модуль понадобится.
      Может есть более правильный вариант, так сказать, дизайна исходного кода?
       
    • От Freezer_86
      Пишу кроссплатформенное приложение. Результат поиска отображается в TGrid. Стал вопрос отображения картинки в одной из колонок.
      На Windows все ок, но на планшете происходят просто чудеса: при первом отображение все корректно, но если простоколить вверх-вниз как картинки одни перетираются другими, часть вообще отображается вверх ногами.
      Код для сохранение картинки(jpg) в базу:
      if Assigned(sm) then begin sm.Position := 0; //TBlobField(dmData.cdsPlayerData.FieldByName('Photo')).LoadFromStream(sm); vImage := TImage.Create(nil); try sm.Position := 0; vImage.Bitmap.LoadFromStream(sm); vKoef := vImage.Bitmap.Height / 64; vImage.Bitmap.Resize(Trunc(vImage.Bitmap.Width / vKoef), Trunc(vImage.Bitmap.Height / vKoef)); sm.Free; sm := TMemoryStream.Create(); try vImage.Bitmap.SaveToStream(sm); TBlobField(dmData.cdsPlayerData.FieldByName('SmallPhoto')).LoadFromStream(sm); finally sm.Free; end; finally vImage.Free; end; end{if}; До скрола:

      После скрола:

      Пробовал и LiveBinding, и ручную прорисовку - результат один и тот же. Есть идеи что не так?
      P.S. Знаю что нужно делать через TListView, но заказчик хочет «сеточку как в старой программе», так как на android будет работать только на планшетах – я согласился.
       
    • От Barbanel
      Здравствуйте!
      Стоит задача загружать фотографии и отображать их в списке. Казалось бы, как два пальца, но...
      Код работал долгое время, все грузилось и отображалось. Спустя какое-то время, фото грузиться перестали. Дебаггинг выявил, замкнутый бесконечный цикл в этой процедуре:
      procedure TBitmap.AssignFromSurface(const Source: TBitmapSurface); var BitmapData: TBitmapData; MaxSize: Integer; ResampledSurface: TBitmapSurface; I: Integer; SourceRect: TRectF; begin MaxSize := CanvasClass.GetAttribute(TCanvasAttribute.MaxBitmapSize); <-- MaxSize = 0 if (Source.Width > MaxSize) or (Source.Height > MaxSize) then begin SourceRect := TRectF.Create(0, 0, Source.Width, Source.Height); SourceRect.Fit(TRectF.Create(0, 0, MaxSize, MaxSize)); ResampledSurface := TBitmapSurface.Create; try ResampledSurface.StretchFrom(Source, Trunc(SourceRect.Width), Trunc(SourceRect.Height), PixelFormat); AssignFromSurface(ResampledSurface); <-- infinity loop here finally ResampledSurface.Free; end; end else begin SetSize(Source.Width, Source.Height); if Map(TMapAccess.Write, BitmapData) then try for I := 0 to TBitmapSurface(Source).Height - 1 do Move(TBitmapSurface(Source).Scanline[I]^, BitmapData.GetScanline(I)^, BitmapData.BytesPerLine); finally Unmap(BitmapData); end; end; end; В самом начале процедуры MaxSize получает значение 0 (ноль!), размеры картинки больше нуля и процедура влетает в бесконечный цикл на строке
            AssignFromSurface(ResampledSurface);
       
      Кто-то сталкивался? Есть мысли как лечить?
      Всем спасибо!
    • От hryasch
      Добрый день. Существует одна проблема, с которой уже несколько недель не могу справиться. Есть старый код под WinAPI, его нужно переделать под Android через firemonkey. И главная проблема - есть код, который из собственного формата делает HBITMAP из WinAPI. Фактически это структура, где последнее поле - указатели на биты. Это переделать легко, создав собственную копию такой структуры. Но теперь мне нужно перевести ее в TBitmap, и я не очень понимаю как это сделать.
       
    • От Rustam Bikeev
      Доброго времени суток уважаемые форумчане, назрел вопрос по компоненту ThttpClient. Я сам слеп в области Http что такое Post, Get  и прочие аббревиатуры для меня страшные и дикие звери которых никогда не видел. Потому и приходится спрашивать у вас. Как отправить на веб сервер запрос для получения текстового файла или картинки. Куда и как принять этот файл. Я нечерта не пойму если вы напишите сделай это сделай то, прошу вас опишите как пользоваться этими 3 функциями 
      THTTPClient.GetRequest
      THTTPClient.Post
      THTTPClient.Get
       
    • От Alex7wrt
      Часто при отрисовке битмапа на холсте используется метод DrawBitmap, где, в частности, в качестве аргумента необходимо указать прямоугольные области источника (SrcRect) и приемника (DestRect). Эти прямоугольники имеют формат записи (Left, Top, Right, Bottom).
      При указании в качестве SrcRect всего битмапа целиком как здесь на формуме так и в книге Осипова я встречал такую запись:
      RectF(0,0,ABitmap.Width,ABitmap.Height) Но моя логика подсказывает, что такой битмап должен иметь размеры на 1 пиксель по горизонтали и вертикали больше, чем на самом деле, ведь первый пиксель имеет координаты (0;0), а последний (ABitmap.Width,ABitmap.Height). Что, наверное, приводит к искажениям при отображении битмапа на холсте.
      Мне думается, что при рисовании целого битмапа следует писать так:
      RectF(0,0,ABitmap.Width-1,ABitmap.Height-1) Прав ли я или не прав? Если нет, то почему?
  • Последние посетители   0 пользователей онлайн

    Ни одного зарегистрированного пользователя не просматривает данную страницу

×
×
  • Создать...