Лидеры

Евгений, спасибо громадное за код!!! Красиво и лаконично! Но под 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; ==== Прогонял много раз, клацал по кнопке один и много раз и закрывал сразу приложение, ошибки пока больше не появлялись... Тьфу-тьфу-тьфу....

Да там всё Евгений Корепов сделал уже. Я только три копейки своих добавил... Вот конечный код: 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.

Подготовил за пол часа реализацию с цветом и стилем строки. Правда поменял форматирование кода под то которое мне удобней и понятней. FastMemo.zip

Первым делом FMX пытается использовать аппаратное ускорение (DirectX на Windows), при невозможности - GDI+. Посмотрите исходники и увидите на каком канвасе все рисуется.

https://github.com/rzaripov1990/ModernListView

Спасибо @slav_z за идею, чуть допилил выделение и контекстное меню, еще бы прикрутить CTRL-C грамотно:) Впрочем уже и так отлично FastMemo.zip

выделение только построчное (одна строка или несколько). Выделение по символам - это сложнее. тоже можно, но в 100$ не влезет. посмотрите во вложении EXE. если устроит, то выложу исходники (лично или прям сюда) и только потом 100$ если все устроит. если не устроит - тогда все отдам бесплатно (сюда). Использование: unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, Frame.Log; type TForm5 = class(TForm) LogFrame1: TLogFrame; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form5: TForm5; implementation {$R *.fmx} procedure TForm5.FormCreate(Sender: TObject); begin LogFrame1.ReleasedItems:=False; // не удалять "старые" строки end; procedure TForm5.Button2Click(Sender: TObject); begin LogFrame1.Add('One item'); LogFrame1.ScrollTo(MaxInt); end; procedure TForm5.Button3Click(Sender: TObject); begin LogFrame1.Clear; end; procedure TForm5.Button4Click(Sender: TObject); begin LogFrame1.CopyToClipboard; end; procedure TForm5.Button1Click(Sender: TObject); var I: Integer; begin LogFrame1.BeginUpdate; try for I:=0 to 100000 do LogFrame1.Add('Item '+I.ToString); finally LogFrame1.EndUpdate; end; LogFrame1.ScrollTo(MaxInt); end; end. LogViewExe.zip