Евгений Корепов

А опишите вашу концепцию движения данных. Что вообще за комплекс приложений, какие команды, какие ответы? Мы, посредством мозгового штурма, дадим вам варианты решений.

Вот тут лучше перестраховаться и взять за правило принцип "Любое обращение к адресному пространству другого потока выполнять потокобезопасными способами". Потому как даже чтение может привести к непредсказуемым результатам - читаете вы данные, строку к примеру из другого потока, прочитали половину, а тот поток в это время перезаписал содержимое ячеек памяти, и вы после этого читаете оставшуюся половину. Вместо ожидаемых данных получаете черте что. Это грубый пример конечно.

Не понял, что значит выводит "одной строкой"? Причем тут Memo? И где танец с бубном? ))) Если вы хотите загружать файл напрямую с помощью Navigate, то делайте это: Делаем ресурс В деплоймент вы сразу увидите этот файл (он никуда не встраивается, а кладется как есть) И вам остается только лишь сделать WebBrowser1.Navigate('file://путь_до_вашего_файла'); Вы это хотели получить?

Очистка проекта? Если не поможет, то видимо переустановка среды. У меня вот с 10.3 была беда - https://quality.embarcadero.com/browse/RSP-22965 Application not started on Android 4.4, Android 5, Android 6. Помогло только полное удаление всех версий дельфи с компа, удаление из реестра всех упоминаний о дельфи, и удаление всего мусора дельфи из всех папок (AppData и прочих).

Хотя попробовал ваш исходник без изменений запустить - полосы у меня все равно нет.

Распаковал ваш исходник, вот так у вас выглядят библиотеки изначально:

Проверьте библиотеки, в вашем проекте они были какие то левые и не полностью. Кликните на Librares правой кнопкой и далее Rever system files to Default

LineRight.7z

Проверил на 10.3.1 - нет полосы. Вы уверены что это эффект приложения?

Для Андроид и Ios вам лучше использовать push. Сервер отправляет пуши (индивидуально, группе, или всем), а приложения их получают, парсят полученный JSON и раскидывают по контролам.

Вы можете на этапе создания формы загрузить из ресурсов нужный вам HTML: procedure TFormMain.InitResource(); var ResStream: TResourceStream; SL : TStringList; begin ResStream := TResourceStream.Create(hInstance, 'HTMLSpinner', RT_RCDATA); SL:=TStringList.Create; SL.LoadFromStream(ResStream, TEncoding.UTF8); FHTMLSpinner:=SL.Text; ResStream.Free; SL.Free; end; Где FHTMLSpinner, типа String, и из этой строки уже грузить в браузер по мере надобности: FWB.LoadFromStrings(FHTMLSpinner, 'localhost');

Очень сильно жрет CPU при изменении размеров формы - 100% CPU

Вроде все работает. Разрешений не нужно никаких вообще. До этого ошибочно требовало доступ к учетной записи - пофиксили. Код вроде остался прежним, вот кусок из живого проекта: procedure TFormMain.InitPushService; begin TTask.Run( procedure Var ADeviceID, ADeviceToken : String; begin FPushService := TPushServiceManager.Instance.GetServiceByName(TPushService.TServiceNames.GCM); FPushService.AppProps[TPushService.TAppPropNames.GCMAppID] := ConstGCMAppID; if Assigned(FPushService) then begin FPushServiceConnection := TPushServiceConnection.Create(FPushService); FPushServiceConnection.OnChange := OnPushServiceConnectionChange; FPushServiceConnection.OnReceiveNotification := OnReceivePushNotificationEvent; FPushServiceConnection.Active := True; ADeviceID := FPushService.DeviceIDValue[TPushService.TDeviceIDNames.DeviceID]; ADeviceToken := FPushService.DeviceTokenValue[TPushService.TDeviceTokenNames.DeviceToken]; FSettings.Flags.PushServiceInited:=True; TThread.Synchronize(TThread.CurrentThread, procedure () begin FNetwork.DeviceID:=ADeviceID; FNetwork.DeviceToken:=ADeviceToken; FNetwork.SendFCMRegistration(); // ?????????????????????????????? Log('DeviceID: ' + FNetwork.DeviceID); Log('DeviceToken: ' + FNetwork.DeviceToken); end); end; end ); end; procedure TFormMain.OnPushServiceConnectionChange(Sender: TObject; AChange: TPushService.TChanges); begin TThread.Synchronize(TThread.CurrentThread, procedure () begin if TPushService.TChange.DeviceToken in AChange then begin if Assigned(FNetwork) then begin FNetwork.DeviceID := FPushService.DeviceIDValue[TPushService.TDeviceIDNames.DeviceID]; FNetwork.DeviceToken := FPushService.DeviceTokenValue[TPushService.TDeviceTokenNames.DeviceToken]; Log('DeviceID: ' + FNetwork.DeviceID); Log('DeviceToken: ' + FNetwork.DeviceToken); FNetwork.SendFCMRegistration(); end; end; end ); end; procedure TFormMain.OnReceivePushNotificationEvent(Sender: TObject; const ANotification: TPushServiceNotification); var AMessageSection : String; begin if Assigned(ANotification.Json) then begin Log('Push Message Json'); Log(ANotification.Json.ToString); if ANotification.Json.TryGetValue('message_section', AMessageSection) then begin if AMessageSection.Equals('support') then SetActiveTab(ConstSectionSupport); if AMessageSection.Equals('news') then SetActiveTab(ConstSectionNews); if AMessageSection.Equals('info') then SetActiveTab(ConstSectionInfo); if AMessageSection.Equals('services') then SetActiveTab(ConstSectionServices); end else if FSettings.CurrentSection <> ConstSectionSupport then SetActiveTab(ConstSectionSupport) else WebBrowserCallJS(TCallJS.SupportLoadContent); PlaySoundEffects(1); end; end; procedure TFormMain.CheckStartupNotifications(); var CurNotification : TPushServiceNotification; begin if Length(FPushService.StartupNotifications) > 0 then for CurNotification in FPushService.StartupNotifications do if Assigned(CurNotification) then OnReceivePushNotificationEvent(Self, CurNotification); NotificationCenter.CancelAll; end; Метод FNetwork.SendFCMRegistration() отсылает регистрацию на мой сервер. В методе проверяется получение регистрации и факт отсылки (он может вызываться несколько раз у меня)

Потому что перед этой строкой вы делаете Item := ListView3.Items.Add; Item.Text := i.ToString; Item.Detail := 'Detail: '+i.ToString; Вы добавили Item, но не дали возможность его отрисовать. Т.е. ListView3 добавил себе итем, но еще ничего о нем не знает. Параметры Item вам нужно выставлять в событии ListView3UpdatedObjects - тут уже будет известна высота.

Для полноценной работы вам нужно добавить параметры в вызов (иначе вы не узнаете дал ли пользователь разрешение или нет) PermissionsService.RequestPermissions([FPermissionWrite, FPermissionRead], nil); Вот так: PermissionsService.RequestPermissions([FPermissionWrite, FPermissionRead], PermissionRequestResult, ExplainReason); PermissionRequestResult - это обработка ответа пользователя procedure TForm.PermissionRequestResult(Sender: TObject; const APermissions: TArray<string>; const AGrantResults: TArray<TPermissionStatus>); begin if (Length(AGrantResults) = 2) and (AGrantResults[0] = TPermissionStatus.Granted) and (AGrantResults[1] = TPermissionStatus.Granted) then begin // Ура! Пользователь дал разрешение на оба наших запроса. Выставялем глобальные флаги (к примеру) которые сигнализируют что можно читать/писать карту памти end else TDialogService.ShowMessage('Не возможно продолжить работу, требуемые разрешения не получены') end; И ExplainReason - если пользователь сдуру не дал разрешение, то вам нужно объяснить ему что без этого приложение работать не будет. procedure TForm.ExplainReason(Sender: TObject; const APermissions: TArray<string>; const APostRationaleProc: TProc); begin TDialogService.ShowMessage('Приложению нужен доступ к карте памяти для таких то целей, иначе приложение не сможет работать. Зайдите в настроки Андроид и дайте разрешение на доступ', procedure(const AResult: TModalResult) begin APostRationaleProc; end) end;

Столкнулся вот тоже с этой фигней. Как правильно выставить флаг? По идее я должен выяснить версию IE в системе и подогнать значение под нее? Пока врубил 11001 - работает норм, по крайней мере у клиентов у которых стоит IE11

Вот вам еще пища для размышления и экспериментов. По моему мнению самый простой способ передачи из потока в главную форму: unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, Generics.Collections, System.Generics.Collections, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.StdCtrls, System.Rtti, FMX.Grid.Style, FMX.Media, FMX.Grid; type TMyMessage = record StringMessage : String; //Я вынужден был добавить еще строку, иначе в Rio косяк https://quality.embarcadero.com/browse/RSP-21806 PackedNumber : Integer; X : Integer; Y : Integer; Z : Integer; end; TOnReceiveDataEvent = procedure(const AMyMessage : TMyMessage) of object; TMyQueue = TThreadedQueue<TMyMessage>; TMyThread = class(TThread) protected FMyQueueIn : TMyQueue; FOnReceiveData : TOnReceiveDataEvent; FPackedNumber : Integer; procedure Execute; override; public constructor Create(AMyQueueIn : TMyQueue); property OnReceiveData: TOnReceiveDataEvent read FOnReceiveData write FOnReceiveData; end; TForm1 = class(TForm) Memo: TMemo; ToolBar1: TToolBar; Button1: TButton; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } FMyQueueOut: TMyQueue; FMyThread : TMyThread; procedure OnReceiveData(const AMyMessage : TMyMessage); public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} constructor TMyThread.Create(AMyQueueIn : TMyQueue); begin FMyQueueIn:=AMyQueueIn; FPackedNumber:=0; inherited Create(True); end; procedure TMyThread.Execute; var AMyMessage : TMyMessage; S : String; begin while (not Terminated) do begin S:=''; if FMyQueueIn.PopItem(AMyMessage) = TWaitResult.wrSignaled then S:='Из главного потока получено: ' + AMyMessage.StringMessage; Inc(FPackedNumber); with AMyMessage do begin StringMessage:=S; PackedNumber:=FPackedNumber; X:=Random(1000); Y:=Random(1000); Z:=Random(1000); end; // Отправляем Record в главную форму (главный поток) if Assigned(FOnReceiveData) then // Тут на выбор три метода доставки :-) // TThread.Synchronize(Self, // TThread.ForceQueue(Self, TThread.Queue(Self, procedure begin FOnReceiveData(AMyMessage); end ); sleep(random(800)); end; end; procedure TForm1.FormCreate(Sender: TObject); begin FMyQueueOut:=TMyQueue.Create(30, 1000, 10); FMyThread:=TMyThread.Create(FMyQueueOut); FMyThread.OnReceiveData:=OnReceiveData; FMyThread.Start; end; procedure TForm1.FormDestroy(Sender: TObject); begin FMyThread.Terminate; FMyThread.WaitFor; FMyThread.Free; FMyQueueOut.Free; end; procedure TForm1.OnReceiveData(const AMyMessage : TMyMessage); Var S : String; begin S:='Пакет№ ' + AMyMessage.PackedNumber.ToString + ' X=' + AMyMessage.X.ToString + ' Y=' + AMyMessage.Y.ToString + ' Z=' + AMyMessage.Z.ToString + ' ' + AMyMessage.StringMessage; Memo.BeginUpdate; Memo.Lines.Add(S); Memo.GoToTextEnd; Memo.EndUpdate; end; procedure TForm1.Button1Click(Sender: TObject); Var AMyMessage : TMyMessage; begin AMyMessage.StringMessage:='Сообщение для потока № ' + Random(100).ToString; FMyQueueOut.PushItem(AMyMessage); end; end.

Этот замкнутый круг разорвали в Rio, переходите на последнюю версию среды и пуши будут работать.

А в каком компоненте вы выделяете текст? Если в стандартных компонентах редактирования текста, то может вот так проще? Edit1.SelStart:=5; Edit1.SelLength:=10; Memo1.SelStart:=5; Memo1.SelLength:=5;

У меня на Rio работает как то не стабильно. Изредка вылазят исключения при закрытии приложения. То в TMonitor, то даже в TDictionary ((( Сделал стабильную версию - работает быстро и без глюков, но с использованием внешнего списка с IAsyncResult. Добавил процедуру ClearListViewAndCancelAsynchronousRequests() где выполняется Cancel и очищается ListView. Теперь можно клацать по кнопке сколько угодно. 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.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, System.Net.HttpClient, System.Generics.Collections, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.ListView; const ListViewItemImageEmpy = -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 { Private declarations } FListViewUpdating : Boolean; FHTTPClient : THTTPClient; FAsyncResultList : TList<IAsyncResult>; procedure LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); procedure ClearListViewAndCancelAsynchronousRequests(); public { Public declarations } 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; if Assigned(FHTTPClient) then FHTTPClient.Free; end; procedure TForm1.ClearListViewAndCancelAsynchronousRequests(); Var I : Integer; begin for I := 0 to FAsyncResultList.Count - 1 do if FAsyncResultList.Items[I] <> Nil then if Not FAsyncResultList.Items[I].IsCompleted then FAsyncResultList.Items[I].Cancel; FListViewUpdating:=True; for I := ListView1.Items.Count - 1 downto 0 do ListView1.Items.Delete(I); 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']:=ListViewItemImageEmpy; FListViewUpdating:=False; item.Adapter.ResetView(item); end; end; procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); Var AAsyncResult : IAsyncResult; begin if Not Assigned(AItem) or Not Assigned(AListItemImage) then exit; if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpy then exit; if AItem.Data['ImageURL'].AsString.IsEmpty then exit; AItem.Data['ImageState']:=ListViewItemImageLoading; FAsyncResultList.Items[AItem.Index]:=FHTTPClient.BeginGet( // AItem.TagObject:=TBaseAsyncResult(FHTTPClient.BeginGet( // FHTTPClient.BeginGet( procedure (const ASyncResult: IAsyncResult) Var AHTTPResponse : IHTTPResponse; begin if ASyncResult.IsCancelled then begin exit; end; 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 Not Assigned(AItem) then exit; if Not Assigned(AListItemImage) then exit; AListItemImage.BeginUpdate; AListItemImage.Bitmap:=TBitmap.Create; AListItemImage.Bitmap.LoadFromStream(AHTTPResponse.ContentStream); AListItemImage.EndUpdate; AItem.Data['ImageState']:=ListViewItemImageLoaded; FAsyncResultList.Items[AItem.Index]:=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; 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; 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.

С помощью стандартного (тот что в палитре компонентов Delphi) это сделать затруднительно. Вам нужно написать свои реализации классов TMedia и TCustomMediaCodec. Это долгий и муторный путь. Но можно забыть про куцую оболочку Эмбаркадеро под названием TMediaPlayer, и все становиться гораздо проще: unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, Androidapi.JNI.Media, Androidapi.Helpers, Androidapi.JNI.GraphicsContentViewText, FMX.Controls.Presentation, FMX.StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } FPlayer : JMediaPlayer; public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} procedure TForm1.Button1Click(Sender: TObject); begin FPlayer:=TJMediaPlayer.Create; FPlayer.setDataSource(StringToJString('http://cdndl.zaycev.net/228184/8640962/lana_del_rey_-_hope_is_a_dangerous_thing_for_a_woman_like_me_to_have_but_i_have_it_%28zaycev.net%29.mp3')); FPlayer.prepare; FPlayer.Start(); end; end.

Добавлю - вместо OnIdle, очередь можно проверять по таймеру. В TMyMessage = record не планировал вначале добавлять StringMessage, но без него в Rio косяк - компилятор выдает ошибку https://quality.embarcadero.com/browse/RSP-21806

На основе вашего кода накидал свой вариант. Главная форма создает 2 очереди: FMyQueueIn - очередь из потока в форму, и FMyQueueOut - очередь из формы в поток. Тип очередей сделал вот такой: TMyMessage = record StringMessage : String; PackedNumber : Integer; X : Integer; Y : Integer; Z : Integer; end; Вдруг вам понадобятся данные в виде цифр, а не в виде строки. Конструктор потока получает в качестве параметров эти два потока (но поменянные местами - чтоб в контексте потока они соотвествовали своим названиям). Так же добавил по нажатию кнопки отправку текстового сообщения из формы в поток. Поток получает его, добавляет в начало фразу 'Из главного потока получено: ' и возвращает в форму с очередными данными. Код и архив проекта прилагаю: unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, Generics.Collections, System.Generics.Collections, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.StdCtrls; type TMyMessage = record StringMessage : String; //Я вынужден был добавить еще строку, иначе в Rio косяк https://quality.embarcadero.com/browse/RSP-21806 PackedNumber : Integer; X : Integer; Y : Integer; Z : Integer; end; TMyQueue = TThreadedQueue<TMyMessage>; TMyThread = class(TThread) protected FMyQueueIn : TMyQueue; FMyQueueOut : TMyQueue; FPackedNumber : Integer; procedure Execute; override; public constructor Create(AMyQueueIn, AMyQueueOut : TThreadedQueue<TMyMessage>); end; TForm1 = class(TForm) Memo: TMemo; ToolBar1: TToolBar; Button1: TButton; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } FMyQueueIn: TMyQueue; FMyQueueOut: TMyQueue; FMyThread : TMyThread; procedure OnIdle(Sender: TObject; var Done: Boolean); public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} constructor TMyThread.Create(AMyQueueIn, AMyQueueOut : TMyQueue); begin FMyQueueIn:=AMyQueueIn; FMyQueueOut:=AMyQueueOut; FPackedNumber:=0; inherited Create(False); end; procedure TMyThread.Execute; var AMyMessage : TMyMessage; S : String; begin while (not Terminated) do begin S:=''; if FMyQueueIn.PopItem(AMyMessage) = TWaitResult.wrSignaled then S:='Из главного потока получено: ' + AMyMessage.StringMessage; Inc(FPackedNumber); with AMyMessage do begin StringMessage:=S; PackedNumber:=FPackedNumber; X:=Random(1000); Y:=Random(1000); Z:=Random(1000); end; // Отправляем Record в главную форму (главный поток) FMyQueueOut.PushItem(AMyMessage); sleep(random(800)); end; end; procedure TForm1.FormCreate(Sender: TObject); begin FMyQueueIn:=TMyQueue.Create(30, 1000, 10); FMyQueueOut:=TMyQueue.Create(30, 1000, 10);; Application.OnIdle:=OnIdle; // При передаче в поток меняем местами In и Out - чтоб к контексте потока Out формы был In потока и наоборот. FMyThread:=TMyThread.Create(FMyQueueOut, FMyQueueIn); end; procedure TForm1.FormDestroy(Sender: TObject); begin FMyThread.Terminate; FMyThread.WaitFor; FMyThread.Free; FMyQueueIn.Free; FMyQueueOut.Free end; procedure TForm1.OnIdle(Sender: TObject; var Done: Boolean); Var AMyMessage : TMyMessage; S : String; begin while FMyQueueIn.PopItem(AMyMessage) = TWaitResult.wrSignaled do begin S:='Пакет№ ' + AMyMessage.PackedNumber.ToString + ' X=' + AMyMessage.X.ToString + ' Y=' + AMyMessage.Y.ToString + ' Z=' + AMyMessage.Z.ToString + ' ' + AMyMessage.StringMessage; Memo.BeginUpdate; Memo.Lines.Add(S); Memo.GoToTextEnd; Memo.EndUpdate; end; end; procedure TForm1.Button1Click(Sender: TObject); Var AMyMessage : TMyMessage; begin AMyMessage.StringMessage:='Сообщение для потока № ' + Random(100).ToString; FMyQueueOut.PushItem(AMyMessage); end; end. test161.zip

Надо собраться с силами и сделать тест производительности на разных платформах. А то вот я руководствуюсь субъективными ощущениями в этом вопросе ?

Точно! Век живи - век учись! Что то я сильно тупанул в свое время, проверяя возможности асинхронности. Проверил - работает отменно. Сделал вариант с глобальным HTTPClient, отдельной процедурой загрузки (в ней также можно воткнуть проверку на видимость/невидимость итема, если требуется такая логика) Единственная проблема - остановка всей ассинхронной загрузки. При выходе из приложения, при нажатии старт до полной загрузки картинок - выбрасывает исключение, что логично (специально для этого увеличил количество итемов до 10 тысяч). Пробовал создавать лист с IAsyncResult и ими манипулировать, но надоело разбираться, закомментировал. Просто болеем всей семьей, сейчас у меня температура 39.8 - голова работает отчасти только ))))))))))) Код и архив с проектом: 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.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, System.Net.HttpClient, System.Generics.Collections, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.ListView; const ListViewItemImageEmpy = -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 { Private declarations } FListViewUpdating : Boolean; FHTTPClient : THTTPClient; // FAsyncResultList : TList<IAsyncResult>; procedure LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} procedure TForm1.FormCreate(Sender: TObject); begin FHTTPClient:=THTTPClient.Create; // FAsyncResultList:=TList<IAsyncResult>.Create; FListViewUpdating:=False; end; procedure TForm1.FormDestroy(Sender: TObject); Var I : Integer; begin FListViewUpdating:=True; ListView1.Items.Clear; // for I := 0 to FAsyncResultList.Count - 1 do // if Assigned(FAsyncResultList.Items[I]) then // if Not FAsyncResultList.Items[I].IsCompleted then // FAsyncResultList.Items[I].Cancel; // FHTTPClient.EndAsyncHTTP(FAsyncResultList.Items[I]); if Assigned(FHTTPClient) then FHTTPClient.Free; end; procedure TForm1.Button1Click(Sender: TObject); var i:integer; item:TListViewItem; ARandom : Integer; begin listview1.ItemIndex:=0; listview1.ItemAppearance.ItemAppearance:='Custom'; listview1.ItemAppearanceObjects.ItemObjects.Accessory.Visible:=false; //Очистка ListView // for i := Listview1.ItemCount-1 downto 0 do // ListView1.Items.Delete(i); FListViewUpdating:=True; ListView1.Items.Clear; FListViewUpdating:=False; //Формирование нового списка 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']:=ListViewItemImageEmpy; FListViewUpdating:=False; item.Adapter.ResetView(item); end; end; procedure TForm1.LoadImage(const AItem: TListViewItem; const AListItemImage : TListItemImage); Var AAsyncResult : IAsyncResult; begin if Not Assigned(AItem) or Not Assigned(AListItemImage) then exit; if AItem.Data['ImageState'].AsInteger <> ListViewItemImageEmpy then exit; if AItem.Data['ImageURL'].AsString.IsEmpty then exit; AItem.Data['ImageState']:=ListViewItemImageLoading; // FAsyncResultList.Items[AItem.Index]:=FHTTPClient.BeginGet( FHTTPClient.BeginGet( procedure (const ASyncResult: IAsyncResult) Var AHTTPResponse : IHTTPResponse; begin AHTTPResponse:=THTTPClient.EndAsyncHTTP(ASyncResult); if AHTTPResponse.StatusCode <> 200 then exit; TThread.Synchronize(Nil, procedure begin 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; 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; 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; 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. LoadBitmaps.zip