Пока тестировал хелпер в боевом проекте он потихоньку оброс исрпавлениями/улучшениями:
Загрузка из потока сделана через TBitmapSurface - это позволяет избежать множества глюков.
LoadFromStream вынесен из Synchronize (основного потока) в поток HTTPClient - по результатам бенчмарка операция оказалась самая жручая. После исправления интерфейс перестал залипать совсем.
Добавлен 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