Евгений (KeeperWorld)

Евгений Корепов · 8 марта, 2019

3 часа назад, #WAMACO сказал:

Приложите, пожалуйста весь код целиком, я думаю многим пригодится.

Да там всё Евгений Корепов сделал уже. Я только три копейки своих добавил...

Вот конечный код:

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.Net.HttpClient, System.Generics.Collections,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.ListView;

const
  ListViewItemImageEmpty = -1;
  ListViewItemImageLoading = 0;
  ListViewItemImageLoaded = 1;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Layout1: TLayout;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FListViewUpdating : Boolean;
    FHTTPClient : THTTPClient;
    FAsyncResultList : TList<IAsyncResult>;
    procedure LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage);
    procedure ClearListViewAndCancelAsynchronousRequests();
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
  listview1.ItemIndex := 0;
  listview1.ItemAppearance.ItemAppearance := 'Custom';
  listview1.ItemAppearanceObjects.ItemObjects.Accessory.Visible := False;

  FHTTPClient := THTTPClient.Create;
  FAsyncResultList := TList<IAsyncResult>.Create;
  FListViewUpdating := False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ClearListViewAndCancelAsynchronousRequests();
  FListViewUpdating := True;
  FreeAndNil(FAsyncResultList);
  if Assigned(FHTTPClient) then
    FHTTPClient.Free;
end;

procedure TForm1.ClearListViewAndCancelAsynchronousRequests();
var
  I: Integer;
begin
  FListViewUpdating := True; // Запрещаем продолжать загружать фотки (если ещё не успели загрузиться все)
  while FAsyncResultList.Count > 0 do  // Дожидаемся окончания выполнения всех IAsyncResult.Cancel, несмотря на асинхронность
  begin
    for I := FAsyncResultList.Count - 1 downto 0 do
      if Assigned(FAsyncResultList.Items) and (not FAsyncResultList.Items.IsCompleted) then
        FAsyncResultList.Items.Cancel
      else
        FAsyncResultList.Delete(I); // Заодно удаляем отработанные элементы
  end;
  ListView1.Items.Clear;
  FListViewUpdating := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
var 
  I: Integer;
  Item: TListViewItem;
  ARandom: Integer;
begin
  ClearListViewAndCancelAsynchronousRequests();
  //Формирование нового списка
  for I := 1 to 10000 do
  begin
    FAsyncResultList.Add(nil);
    FListViewUpdating := True;
    Item := listview1.Items.Add;
    Item.Height := 45;
    Randomize;
    ARandom := Random(6);
    case ARandom of
      0 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2017_06/me.thumb.jpg.966ddc17d5602ee14feb43479c1f6963.jpg';
      1 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2018_05/B-IpGQmVgTM.thumb.jpg.2ebeb0bd766ab7cf19f10195d6ea2be9.jpg';
      2 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2016_04/10.png.b9ab371e8fd38172fee96bcf75fb6699.thumb.png.b0685259b03bfff540903913845532a5.png';
      3 : Item.data['ImageURL'] := 'https://secure.gravatar.com/avatar/9942c50b1641a921c52d4b389bd718d6?d=http://fire-monkey.ru/uploads/monthly_2017_12/K_member_87.png';
      4 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/monthly_2016_11/photo-1529.png.7267be10b59f950b7c5bb3f34a60901e.thumb.png.22027ae85266216220310ed694d57628.png';
      5 : Item.data['ImageURL'] := 'http://fire-monkey.ru/uploads/profile/photo-thumb-115.jpg';
    end;
    Item.Data['ImageState'] := ListViewItemImageEmpty;
    FListViewUpdating := False;
    Item.Adapter.ResetView(Item);
  end;
end;

procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage);
var
  K: Integer; // Анонимная процедура захватывает локальную переменную, а не обращается к AItem, которой уже может не быть в момент _окончания_ скачивания фотки
  AAsyncResult: IAsyncResult;
begin
  if Not Assigned(AItem) or Not Assigned(AListItemImage) then
    Exit;
  if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpty then
    Exit;
  if AItem.Data['ImageURL'].AsString.IsEmpty then
    Exit;
  AItem.Data['ImageState'] := ListViewItemImageLoading;
  K := AItem.Index; // Запоминаем индекс в локальную K, которая уйдёт в анонимку (время жизни K > времени жизни анонимки)
  FAsyncResultList.Items[K] := FHTTPClient.BeginGet(
    procedure (const ASyncResult: IAsyncResult)
    var
      AHTTPResponse: IHTTPResponse;
    begin
      if ASyncResult.IsCancelled then
        Exit;
      try
        AHTTPResponse := THTTPClient.EndAsyncHTTP(ASyncResult);
        if Not Assigned(AHTTPResponse) then
          Exit;
        if AHTTPResponse.StatusCode <> 200 then
          Exit;
      except
        Exit;
      end;

      TThread.Synchronize(Nil,
        procedure
        begin
          if FListViewUpdating or ASyncResult.IsCancelled then // Выходим, так как внутри анонимной процедуры AItem или AListItemImage - не сброшены в nil, хотя их уже может и не быть
            Exit;
          if Not Assigned(AItem) or Not Assigned(AListItemImage) then
            Exit;
          AListItemImage.BeginUpdate;
          AListItemImage.Bitmap := TBitmap.Create;
          AListItemImage.Bitmap.LoadFromStream(AHTTPResponse.ContentStream);
          AListItemImage.EndUpdate;
          AItem.Data['ImageState'] := ListViewItemImageLoaded;
          FAsyncResultList.Items[K] := nil; 
        end
      );
    end,
    AItem.Data['ImageURL'].AsString
  );
end;

procedure TForm1.ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean);

  function SetupImageObject(const AName: String; AWidth, AHeight, X , Y: Single; AAlign, AVertAlign: TListItemAlign): TListItemImage;
  var
    LIT: TListItemText;
  begin
    Result := TListItemImage(AItem.View.FindDrawable(AName));
    if Result = Nil then
    begin
      // Создаём картинку
      Result := TListItemImage.Create(AItem);
      Result.Name := AName;
      Result.Bitmap := nil;
      Result.OwnsBitmap := True;
      // Создаём надпись
      LIT := TListItemText.Create(AItem);
      LIT.Name := 'LIT-' + AItem.Index.ToString;
      LIT.Width := 100;
      LIT.Height := 22;
      LIT.PlaceOffset.X := X + AWidth + 10;
      LIT.PlaceOffset.Y := Y;
      LIT.Text := LIT.Name;
      LIT.Visible := True;
    end;
    Result.Width := AWidth;
    Result.Height := AHeight;
    Result.PlaceOffset.X := X;
    Result.PlaceOffset.Y := Y;
    Result.Align := AAlign;
    Result.VertAlign := AVertAlign;
    Result.ScalingMode := TImageScalingMode.StretchWithAspect;
    Result.Visible := True;
  end;

Var 
  AListItemImage: TListItemImage;
begin
  if FListViewUpdating then
    Exit;
  AListItemImage := SetupImageObject('s_image', 35, 35, 0 , 0, TListitemalign.Leading, TListItemAlign.Center);
  LoadImage(AItem, AListItemImage);
  AHandled := True;
end;

end.

#WAMACO · 8 марта, 2019

В 06.02.2019 в 14:48, Евгений Корепов сказал:

procedure TForm1.ClearListViewAndCancelAsynchronousRequests();

Var I : Integer;

begin

for I := 0 to FAsyncResultList.Count - 1 do

if FAsyncResultList.Items <> Nil then

if Not FAsyncResultList.Items.IsCompleted then

FAsyncResultList.Items.Cancel;

FListViewUpdating:=True;

for I := ListView1.Items.Count - 1 downto 0 do

ListView1.Items.Delete(I);

FListViewUpdating:=False;

end;

Евгений, спасибо громадное за код!!! Красиво и лаконично!

Но под Rio всё равно крэшится с ошибкой, если приложение закрывать раньше, чем успевают загрузиться фотки:
Project Test21.exe raised exception class ENetHTTPClientException with message 'Error receiving data: (12017) Операция отменена'.

Поправил вот так:

procedure TForm1.ClearListViewAndCancelAsynchronousRequests();
var
I: Integer;
begin
FListViewUpdating := True; // Запрещаем продолжать загружать фотки (если ещё не успели загрузиться все)
while FAsyncResultList.Count > 0 do // Дожидаемся окончания выполнения всех IAsyncResult.Cancel, несмотря на асинхронность
begin
for I := FAsyncResultList.Count - 1 downto 0 do
if Assigned(FAsyncResultList.Items) and (not FAsyncResultList.Items.IsCompleted) then
FAsyncResultList.Items.Cancel
else
FAsyncResultList.Delete(I); // Заодно удаляем элементы (раннее не удалялись - утечка памяти)
end;
ListView1.Items.Clear;
FListViewUpdating := False;
end;

=====

Тоже, кстати, пару раз поймал ошибку в TMonitor и в TDictionary.

Выяснил, что возникает из-за обращения к элементам списка в LoadImage, когда их уже нет. Пофиксил так (отмечено синим):

procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage);

var
K: Integer; // Анонимная процедура захватывает локальную переменную, а не обращается к AItem, которой уже может не быть в момент _окончания_ скачивания фотки
AAsyncResult: IAsyncResult;
begin
if Not Assigned(AItem) or Not Assigned(AListItemImage) then
Exit;
if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpty then
Exit;
if AItem.Data['ImageURL'].AsString.IsEmpty then
Exit;
AItem.Data['ImageState'] := ListViewItemImageLoading;
K := AItem.Index; // Запоминаем индекс в локальную K, которая уйдёт в анонимку (время жизни K > времени жизни анонимки)
FAsyncResultList.Items[K] := FHTTPClient.BeginGet(
procedure (const ASyncResult: IAsyncResult)
var
AHTTPResponse: IHTTPResponse;
begin
if ASyncResult.IsCancelled then
Exit;
try
AHTTPResponse := THTTPClient.EndAsyncHTTP(ASyncResult);
if Not Assigned(AHTTPResponse) then
Exit;
if AHTTPResponse.StatusCode <> 200 then
Exit;
except
Exit;
end;

TThread.Synchronize(Nil,
procedure
begin
if FListViewUpdating then // Выходим, так как внутри анонимной процедуры AItem или AListItemImage - не сброшены в nil, хотя их уже может и не быть
Exit; // Кстати, наверное, правильнее было бы вместо проверки FListViewUpdating использовать и/или условие: if ASyncResult.IsCancelled then Exit; ?
if Not Assigned(AItem) or Not Assigned(AListItemImage) then
Exit;
AListItemImage.BeginUpdate;
AListItemImage.Bitmap := TBitmap.Create;
AListItemImage.Bitmap.LoadFromStream(AHTTPResponse.ContentStream);
AListItemImage.EndUpdate;
AItem.Data['ImageState'] := ListViewItemImageLoaded;
FAsyncResultList.Items[K] := nil; // Наверное, это присвоение лучше вытащить наверх, перед проверкой всех условий? Ведь фотка скачалась успешно... Или не надо?
end
);
end,
AItem.Data['ImageURL'].AsString
);
end;

====

Прогонял много раз, клацал по кнопке один и много раз и закрывал сразу приложение, ошибки пока больше не появлялись... Тьфу-тьфу-тьфу....

Войти

Евгений (KeeperWorld)

Постов

Зарегистрирован

Посещение

Победитель дней

Тип контента

Профили

Форумы

Сообщения, опубликованные Евгений (KeeperWorld)

Отображение картинок в ListView

Отображение картинок в ListView

Сайт

FGX

Активность