Перейти к содержанию

ddr 2

Пользователи
  • Активность

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

  • Посещение

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

    1

ddr 2 стал победителем дня 11 марта

ddr 2 имел наиболее популярный контент!

Информация о ddr 2

  • Звание
    Пользователь
  1. Спасибо. Ясности действительно прибавило. Ещё мне вот эти исходники помогли разбираться http://fire-monkey.ru/topic/1902-семисегментный-индикатор/ ,как создавать визуальные компоненты на примитивах. По моим базовым непониманиям, по которыхзадавал вопросы: - очищать канву в Paint не нужно, она и так очищена; - при рисовании примитовов на канве нужно следить, что бы ничего не "нарисовать" вне размеров элемента, иначе будет, как я писал выше. переопределите функцию GetDefaultSize: TSizeF Что-то такое "размеры по умолчанию", я так и не понял. Я своём вопросе я имел в виду значения Width и Heigth которые отображаются в Object Inspector при добавлении компонента в Design. Получается не корректно задал вопрос. Прошу прощения. А решение, которое я нашел, что инициализация указанных свойств в конструкторе.
  2. Здравствуйте. Разработал свой первый визуальный компонент – Индикатор из 4-х состояний. Разобраться слету во всех иерархиях имеющихся классов тяжко. Что «наинтернетил», так и сделал. Есть вопросы. И в целом любая критика приветствуется. 1. Разумно ли выбран TImage в качестве предка? 2. Основной вопрос. В TLEDIndicator.Paint, с помощью Canvas.DrawEllipse(TRectF.Create(1, 1,width-2,width-2), 1); отприсовывается внешний контур Индикатора. Применен отступ от краёв в 1 пиксель. И это вынужденная мера. Если сделать без отступа TRectF.Create(0, 0,Width-1,Width-1), то при изменении статуса индикатора подразумевающие изменения цвета внешнего контура, остаются частично «следы» старого цвета контура. Если окно свернуть/развернуть, то «следы» пропадают. Делаю вывод, что все корректно, и это скорее всего результат используемого в DrawEllipse «сглаживания». Логично попробовать решить это через очистку канвы. В качестве эксперимента в Paint добавляю Canvas.Clear(TAlphaColorRec.Green); В результате зеленеет(очищается) вся форма!?!?!? Смотрю размер канвы. 640x480. Тоже вопросы.. откуда??? Пытаюсь изменить размер канвы Canvas.SetSize(trunc(Width),trunc(Height)); Результат- ошибки, зависание, аварийное завершение. Меня вполне устраивает решение с отступом в 1 пиксель, но хочу разобраться с полученным, я явно делаю, что-то не правильно. 3. Как задать размеры элемента по умолчанию? unit ULEDIndicator; interface uses System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Objects,FMX.Graphics,System.Types,System.UITypes; type TLEDStatus=(Red,Green,Null); TLEDIndicator = class(TImage) {вопрос 1} private FStatus: TLEDStatus; procedure SetLEDStatus(Value:TLEDStatus); Function GetInColor:TColor; inline; Function GetOutColor:TColor; inline; protected procedure Paint; override; public constructor Create(AOwner: TComponent); override; published property Status:TLEDStatus read Fstatus write SetLEDStatus stored true default TLEDStatus.Green; end; procedure Register; implementation procedure Register; begin RegisterComponents('Samples', [TLEDIndicator]); end; constructor TLEDIndicator.Create(AOwner: TComponent); Begin inherited; FStatus:=TLEDStatus.Green; End; procedure TLEDIndicator.Paint; var IWidth:integer; begin inherited; {вопрос 2} IWidth:=Canvas.Width; // Canvas.Clear(TAlphaColorRec.Green); Canvas.Stroke.Color:=GetIncolor; Canvas.Fill.Color:=GetOutColor; Canvas.Stroke.Thickness:=1; Canvas.Stroke.Dash:= TStrokeDash.Solid; Canvas.Stroke.Kind:= TBrushKind.Solid; Canvas.DrawEllipse(TRectF.Create(1, 1,width-2,width-2), 1);{вопрос 2} Canvas.FillEllipse(TRectF.Create(3, 3,width-4,width-4), 1); end; procedure TLEDIndicator.SetLEDStatus(Value:TLEDStatus); Begin Fstatus:=Value; Repaint; End; Function TLEDIndicator.GetInColor:TColor; Begin if Enabled then Result:= TAlphaColorF.Create(42 / 255, 42 / 255, 42 / 255, 1).ToAlphaColor else Result:=TAlphaColorF.Create($E5/ 255, $E5 / 255, $E5/ 255, 1).ToAlphaColor; End; Function TLEDIndicator.GetOutColor:TColor; Begin if Enabled then case FStatus of Red:Result:= TAlphaColorRec.Red; Green:Result:= TAlphaColorRec.Green; Null:Result:=TAlphaColorF.Create($E5/ 255, $E5 / 255, $E5/ 255, 1).ToAlphaColor; end else Result:=TAlphaColorF.Create($E5/ 255, $E5 / 255, $E5/ 255, 1).ToAlphaColor End; end.
  3. Форум жив! Это радует. Ответ, через 4 месяца, лучше, чем без ответа вообще (без сарказма). Благодарю за внимание! Я долго разбирался с ранее описанными проблемами. И в некотором роде разобрался. Пусть останется для истории. Ранее я несколько сумбурно описал проблемы при использовании TThreadedQueue, отчасти это связано, что на тот момент я не понимал природу этих проблем. Итак имеем: -Проблема 1: «замусоривание» данных при использовании TThreadedQueue<T> , где <T>=Tbytes; (и как выяснилось любой динамический массив). Ранее я это называл {жучок 2} -Проблема 2: TThreadedQueue.PopItem при определенных обстоятельствах перестаёт «ожидать» данные заданное кол-во времени соответственно не «усыпляет» поток в котором он был вызван. Ранее я это называл {жучок 1} Начну с 2-ой проблемы. Пытаясь разобраться, я пошел по пути написать своей TThreadedQueue. Что и было сделано. Итак, оригинальный TThreadedQueue реализован через TMonitor, который в WIN32\64 реализуется через критическую секцию. Т.к. меня в первую очередь интересует windows платформа, то свой TThreadedQueue я реализовал сразу на критической секции. Далее изучая исходники TThreadedQueue, я выяснил, что PopItem реализован через WINAPIшные WaitForSingleObject(WaitForMultipleObjects) у которых один из параметров dwMilliseconds(время ожидания в мсек, которое передаётся из конструктора TThreadedQueue). И как выяснилось именно эти функции реализуют описанную проблему. В разных версиях Windows и при разном кол-ве ядер CPU функции ведут себя по-разному в плане «ожидания». Далее не буду углубляться… я пришел к выводу, что такой подход имеет смысл. Правильный подход это всегда использовать dwMilliseconds= INFINITE. И за слишком частые вызовы WaitForMultipleObjects с параметром ожидания 1мсек, или 100мсек, Microsoft попросту «наказывает» программиста за неэффективное проектирование кода. Пробовал экспериментировать с задержками, в поиске найти «безопасную» задержку, так вот безопасная это только INFINITE. На 500мсек., при 50 потоках ждать проблему приходиться до 8 минут. При 1 секунде- не дождался, но… скорее всего если оставить программу работать на несколько суток, то эффект был бы получен. Возвращаясь к бесконечной задержке ожидания, в числе прочего меня к ней подтолкнул исходники TThreadedQueue. Если без подробностей, то в нем есть публичный метод DoShutDown, он позволяет «выйти» из бесконечного ожидания PopItem, при этом вызывать его естественно нужно не из потока «читателя». DoShutDown – необходимо использовать ВСЕГДА, при использовании TThreadedQueue. А использование бесконечной задержки – гарантия, что проблема не возникнет. Да проблемы проявляется скорее в «экстремальной» нагрузке, при 1-2 «читателей-писателей» или при низкой активности «писателей» проблема может и не проявиться, но лучше не рисковать. Фактически данная особенность не имеет отношение ни к Delphi ни к реализации TThreadedQueue, это WINAPI и возможно, что на других платформах этого не будет. Что касается 1-ой проблемы с «замусориванием» данных, то решение есть – никогда не использовать динамические массивы в TThreadedQueue<T>, а значит и в любом многопоточном приложении, а т.е. в любом… Поясню. Ранее написанный пример демонстрирует «замусоривание» данных. Если в примере заменить TBytes на статический массив array[0..2048]of byte – проблема исчезает. Так же, если «обернуть» TBytes в class, то проблемы так же исчезает. Фактически динамические массивы нужно использовать очень осторожно, они не потокобезопасны даже при использовании критических секций. Это очень печальная «особенность» в Delphi. Опять же проявляется только под «экстремальной» нагрузкой.
  4. Попробовал TBitmapSurface. Работает стабильно. Спасибо! Ниже аналогичная реализация с TBitmapSurface. Но, увы, эта реализация работает медленнее. Изучив исходники TBitmapSurface, стало понятно почему: а) в TBitmapSurface.SetSize происходит прописывание нулями всего массива данных(спорное решение) б) в TBitmap.Assign(TPersistent), если параметр TBitmap, то происходит лишь копирование ссылки, а если TBitmapSurface, то копирование всего битмапа. В своей реализации пошел другим путем, но изучение исходников TBitmapSurface в этом сильно помогло. Ещё раз спасибо. По поводу «потокобезопастности» TBitmap в RIO, однозначно нет в Win32-64, и мой пример тому доказательство, но судя по коду, есть ощущение, что с ARC в Android и прочих, все будет работать «безопасно», но это только догадка, без фактической проверки. function GetFMXBitmapSurface: TBitmapSurface ; var Count_X,Count_Y:NativeInt; CurrentColor:TAlphaColor; begin Result := TBitmapSurface.Create; Result.SetSize(640,512); for Count_X := 0 to Result.width-1 do for Count_Y := 0 to Result.height-1 do begin TAlphaColorRec(CurrentColor).R:=Random(255); TAlphaColorRec(CurrentColor).G:=Random(255); TAlphaColorRec(CurrentColor).B:=Random(255); TAlphaColorRec(CurrentColor).A:=$FF; Result.Pixels[Count_X,Count_Y]:=CurrentColor; end; end;
  5. ddr 2

    TBitmapData

    Требуется на форме отображать картинку TImage(кадр) обновляя её с высокой частотой. Обновляемая картинка динамически формируется попиксельно. Попиксельный доступ реализован через TBitmapData. Формирование кадра достаточно ресурсоёмко. Есть желание вынести формирование кадра в отдельный поток. Но опытным путем я выяснил, что TBitmapData нельзя использовать вне основного потока. Ниже тестовая демонстрационная реализация. Формирование кадра вынесено в функцию GetFMXBitmap. Если bmp := GetFMXBitmap; вызывается через Synchronize, то код на 100% потокобезопасен, если же вызов идет без Synchronize, то приложение валиться, достаточно лишь мышкой энергично изменять размеры окна(формы). Вопрос: TBitmapData полученный через TBitMap.Map действительно можно использовать только из основного потока, или я допустил какую-то ошибку? Если только основной поток, то как бы поизящней обойти это ограничение? 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.Objects; type TTestThread=class(TThread) Private Protected Procedure execute;override; Public constructor create(); end; TForm1 = class(TForm) Image1: TImage; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } TestTthread: TTestThread; end; var Form1: TForm1; implementation {$R *.fmx} function GetFMXBitmap: FMX.Graphics.TBitmap; var bitdata: TBitmapData; Count:Cardinal; begin Result := FMX.Graphics.TBitmap.Create; Result.SetSize(640,512); if (Result.Map(TMapAccess.ReadWrite{Write}, bitdata)) then try // здесь "рисуем" через bitdata for count := 0 to Result.width*Result.height-1 do begin pbyte(bitdata.Data)[4*count]:=Random(255); pbyte(bitdata.Data)[4*count+1]:=Random(255); pbyte(bitdata.Data)[4*count+2]:=Random(255); pbyte(bitdata.Data)[4*count+3]:=$FF; end; finally Result.Unmap(bitdata); end; end; constructor TTestThread.create(); begin FreeOnTerminate := true; inherited Create(false); end; Procedure TTestThread.execute; var bmp: FMX.Graphics.TBitmap; begin while not Terminated do begin {Вариант 1- следующая строчка закоментарена, Вариант 2- следующая строчка НЕ закоментарена } //bmp := GetFMXBitmap; TThread.Synchronize(nil, procedure begin {Вариант 1- следующая строчка НЕ закоментарена, Вариант 2- следующая строчка закоментарена } bmp := GetFMXBitmap; Form1.Image1.Bitmap.Assign(bmp); bmp.Free; end); end; end; procedure TForm1.FormCreate(Sender: TObject); begin Image1.Width:=640; Image1.Height:=512; TestTthread:=TTestThread.create; end; procedure TForm1.FormDestroy(Sender: TObject); begin TestTthread.Terminate; end; end.
  6. Добрый день! Заметил неприятный эффект(баг, особенность либо моё недопонимание чего либо). Через некоторое непродолжительно время работы PopItem( в версии возвращающей TWaitResult) перестаёт ожидать данные из очереди, и перестаёт "усыплять" на(до) TThreadedQueue.FPopTimeout мсек, поток из которого была вызвана, а возвращает wrTimeout без ожидания(менее 100 тактов). Ниже тестовый код, который демонстрирует этот эффект. Описание теста: основной поток, создаёт поток с условным названием FirstDepthThread, который: -запускает MaxThread(константа)+1 потоков( по умолчанию их 10) с условными названиями SecondDepthThread_X ; - c интервалом в 2-5 секунды в каждую из очередей записывается константный идентификатор. Кол-во очередей =MaxThread+1(в каждом из потоков SecondDepthThread_X есть поле с очередью) . Функционал потоков SecondDepthThread_X - ждать данных извлекать их из очереди. В Procedure TSecondDepthThread.Execute есть 2-а условия( помечены в тексте, как {жучок 1} и {жучок 2}), которые в моём понимании никогда не должны выполняться, но...выполняются. Понимание, как обойти этот эффект есть, но очень хочется разобраться, что не так с указанной реализацией? Буду рад мнениям. Условия тестирования: Delphi 10.3.1., W10.1903. Так же рекомендуется попробовать разные значения MaxThread( при MaxThread=2, эффект может и не наступить,при MaxThread= 9, на 3-х разные cpu Intel эффект наступает через ,5-5 секунд, на стареньком AMD FX-8300 лишь через 2-10 минут. при MaxThread=14, AMDешный cpu так же "сдаётся" за несколько секунд). В отладчике смотрим окно Events. Если без отладчика, то в виндовом диспетчере задач, как только загрузка процессора у данного процесс подскочила от 0 к 100%, значит эффект достигнут. unit UThreadedQueue; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,System.Generics.Collections; Const MaxThread=9; type TSecondDepthThread=class(TThread) Protected FThreadNomber:integer; FError:boolean; Procedure Execute;override; Public TickSending:Cardinal; TickInterval:Cardinal; SendingDataQuery:TThreadedQueue<TBytes>; constructor Create(AThreadCount:integer); Destructor Destroy;override; Property ThreadNomber:integer read FThreadNomber; end; TFirstDepthThread=class(TThread) Protected FSecondDepthThreads:array[0..MaxThread] of TSecondDepthThread; Procedure Execute;override; Public SendingDataQuery:TThreadedQueue<TBytes>; constructor Create; Destructor Destroy;override; end; TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private FFirstDepthThread:TFirstDepthThread; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses SyncObjs,TypInfo; {$R *.dfm} Constructor TSecondDepthThread.Create(AThreadCount: Integer); begin FError:=false; TickInterval:=2000+random(3000); FThreadNomber:=AThreadCount; SendingDataQuery:=TThreadedQueue<TBytes>.Create(100, 1, 1); //инициализация очереди FreeOnTerminate := false; Inherited Create(false); end; Destructor TSecondDepthThread.Destroy; begin FreeAndNil(SendingDataQuery); inherited; end; Procedure TSecondDepthThread.Execute; var iCounterPerSec,TimeStart, TimeFinish: TLargeInteger; QSize:integer; WaitResult:TWaitResult; ReceivedData:TBytes; ElapsedTime:double; begin NameThreadForDebugging('SecondDepthThread_'+inttostr(FThreadNomber)); while (not Terminated)do begin QueryPerformanceFrequency(iCounterPerSec); QueryPerformanceCounter(TimeStart); WaitResult:=SendingDataQuery.PopItem(QSize,ReceivedData); QueryPerformanceCounter(TimeFinish); ElapsedTime:= (TimeFinish - TimeStart)/iCounterPerSec; if (ElapsedTime<0.000082)and(WaitResult=TWaitResult.wrTimeout)and(not FError) then begin {жучок 1} OutputDebugString(pchar('Поток№ '+inttostr(FThreadNomber)+ ' Всё.., началось! Ответ(состояние) очереди='+ GetEnumName(TypeInfo(TWaitResult), Ord(WaitResult))+' выполнение за '+ FormatFloat('0.000000', ElapsedTime) + ' сек., а должно быть более 0.001 сек')); FError:=true; // дальше сообщения с wrTimeout не выводим, т.к. их слишком много end; if (WaitResult=TWaitResult.wrSignaled)and(length(ReceivedData)>0) then begin if ReceivedData[0]=100+FThreadNomber then {OutputDebugString(pchar('Поток№ '+inttostr(FThreadNomber)+ ' ,есть корректные данные'))}; if ReceivedData[0]<>100+FThreadNomber then {жучок 2} OutputDebugString(pchar('Поток№ '+inttostr(FThreadNomber)+ 'некорректные данные, должно прийти'+ inttostr(100+FThreadNomber)+' ,а пришло '+inttostr(ReceivedData[0]))); if ReceivedData[0]=0 then {подвид 2-го жука} OutputDebugString(pchar('Поток№ '+inttostr(FThreadNomber)+ ' Такого быть не должно! Ответ(состояние) очереди='+ GetEnumName(TypeInfo(TWaitResult), Ord(WaitResult))+ ' сигнал о наличии данных есть, а данных нет,'+ ' выполнение за '+FormatFloat('0.000000', ElapsedTime) )); ReceivedData[0]:=0; // для контроля извлекаемых из очереди данных. end end; end; Constructor TFirstDepthThread.Create; Var Count:integer; begin for count := 0 to MaxThread do FSecondDepthThreads[Count]:=TSecondDepthThread.Create(Count); FreeOnTerminate := false; Inherited Create(false); end; Destructor TFirstDepthThread.Destroy; Var Count:integer; begin for Count := 0 to MaxThread do begin FSecondDepthThreads[Count].Terminate; FSecondDepthThreads[Count].WaitFor; FSecondDepthThreads[Count].Free; end; inherited; end; Procedure TFirstDepthThread.Execute; var Count:integer; SendingData:Tbytes; begin NameThreadForDebugging('FirstDepthThread'); Setlength(SendingData,1); while not terminated do begin for Count := 0 to MaxThread do with FSecondDepthThreads[Count] do if GetTickCount-TickSending>TickInterval then begin SendingData[0]:=100+ThreadNomber; SendingDataQuery.PushItem(SendingData); TickSending:=GetTickCount; end; sleep(1); //yield; end; end; procedure TForm1.FormCreate(Sender: TObject); begin FFirstDepthThread:=TFirstDepthThread.Create; end; procedure TForm1.FormDestroy(Sender: TObject); begin FFirstDepthThread.Terminate; FFirstDepthThread.WaitFor; FFirstDepthThread.Free; end; end.
  7. Таймер был моей самой первой реализацией, но он негативно сказывается на отзывчивости интерфейса. В качестве стресс-теста на отзывчивость - в Windows перемещение окна мышкой. Таймер вызывает лаг(и) при перемещении окна. OnIdle, я раньше не пробовал. Попробовал- работает "мягче"- лаг не замечен. Кстати этот стресс-тест создаёт "пропуск" пакетов на экране, но это не критично и решается созданием более длинной очереди(1). Это зависит от того, какого эффекта надо добиться. Извините, я не правильно сформулировал вопрос. Меня заботило, то, что при закрытии формы, в момент, когда мы в FormDestroy завершаем поток TMyThread, у нас в очереди могут быть(остаться) сообщения/пакеты, которые никогда не будут обработаны, т.е. фактически это потерянные данные. Если в TMyThread.Execute, убрать sleep(random(800)), то данный эффект наблюдается, как в моём предыдущем варианте с подпиской на сообщения, так и в варианте Евгения. И на решении этой локальной задачи, я признал, вариант Евгения лучшим из имеющихся, потому, что в его варианте эта задача решается достаточно просто(ниже), а в варианте с подпиской, возможно решение и существует, но я пас. Вариант решения задачи "потерянных данных"(2), заменяем procedure TForm1.FormDestroy(Sender: TObject); begin FMyThread.Terminate; FMyThread.WaitFor; FMyThread.Free; FMyQueueIn.Free; FMyQueueOut.Free end; на procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); var TempBoolean:Boolean; begin FMyThread.Terminate; FMyThread.WaitFor; onIdle(Sender,TempBoolean); end; procedure TForm1.FormDestroy(Sender: TObject); begin FMyThread.Free; FMyQueueIn.Free; FMyQueueOut.Free end; Так же для оптимизации, в TForm1.OnIdle заменил условие выполнения цикла(3). procedure TForm1.OnIdle(Sender: TObject; var Done: Boolean); Var AMyMessage : TMyMessage; S : String; begin while FMyQueueIn.QueueSize>0 do begin AMyMessage:=FMyQueueIn.PopItem; 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; В новом варианте при каждом вызове OnIdle, если в очереди(TThreadedQueue) нет "сообщений"/элементов, то происходит лишь обращение к полю и сравнение, а ранее был вызов метода TThreadedQueue.PopItem в котором выполняется много всего и большая часть в критической секции. Вместо резюме: Всем спасибо за ответы! Для себя в решении задачи двустороннего обмена сообщениями между формой и потоком, остановился на варианте Евгения с правками (1)(2)(3) Углубившись в проблематику, пришёл к выводу, что в кроссплатформенном FMX лучше избегать архитектуры двусторонней связи формы с потоком, а пользоваться передачей данный из формы в запускаемый поток, через конструктор потока, а обратно, через обработчик onTerminate.
  8. Поставил бряк, посмотрел стек, да Вы правы, вызов идет из потока mythread. Я хотел реализовать "PostMessage" из потока в главный поток, которого FMX нет. Нашёл подсказку Переделал.Все работает и вызов ReciveMessage происходит из главного потока(MainThread). Правильно ли я понимаю, что в подобной реализации "PostMessage"(речь не про данный код, а про сам подход) нужно учитывать и контролировать, что бы поток не завершился раньше, чем все "сообщения" будут обработаны основным потоком? Буду рад услышать, о других возможных реализация "PostMessage" unit Unit2; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,System.Messaging, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.StdCtrls,System.Generics.Collections; type tmythread=class(TThread) public constructor Create; protected PackedNumber:integer; procedure PostMessage; procedure Execute; override; end; TForm2 = class(TForm) Memo1: TMemo; Label1: TLabel; Label2: TLabel; procedure FormCreate(Sender: TObject); private mythread:tmythread; { Private declarations } public procedure ReciveMessage; { Public declarations } end; var Form2: TForm2; qqueue: TThreadedQueue<string>; implementation constructor tmythread.Create; begin PackedNumber:=0; FreeOnTerminate := true; inherited create(false); end; procedure tmythread.Execute; var strmessage:string; begin while (not Terminated) do begin inc(PackedNumber); strmessage:='Пакет№ '+inttostr(PackedNumber)+' значение X='+inttostr(random(1000))+ ' значение Y='+inttostr(random(1000))+' значение Z='+inttostr(random(1000)); qqueue.PushItem(strmessage); Tthread.Queue(nil,PostMessage); sleep(random(800)); end; end; {$R *.fmx} procedure TForm2.ReciveMessage; var stringrecive:string; begin stringrecive:=qqueue.PopItem; label1.Text:=stringrecive; label2.Text:=stringrecive; memo1.Lines.Add(stringrecive);memo1.GoToTextEnd; end; procedure tmythread.PostMessage; begin Form2.ReciveMessage; end; procedure TForm2.FormCreate(Sender: TObject); begin qqueue := TThreadedQueue<string>.Create(5, 1000); memo1.StyledSettings:=[] ; memo1.TextSettings.Font.Size:=8; label1.StyledSettings:=[]; label1.TextSettings.Font.Size:=8; label2.StyledSettings:=[]; label2.TextSettings.Font.Size:=8; mythread:=tmythread.Create; end; end.
  9. Не знал про TThreadedQueue. Полезный функционал, спасибо! Полагаю, что отсылку сообщения из потока в форму можно/нужно делать через TMessageManager. Написал небольшой тест(ниже по тексту- поток посылает сообщения, а форма принимает их и отображает ). Увы, но тест работает не корректно. При запуске под Windows, в процедуре обработке принятого сообщения выскакивает исключение, где-то в районе label1.Text:=stringrecive; . Если в процедуре TForm2._ReciveMessage закоментировать строчки label1.Text:=stringrecive; и label2.Text:=stringrecive ,то оставшиеся добавление строки в memo работает, но явно "не здорово" подмаргивает. При запуске под Android, изменение текста в метках работает, но memo так же дергается и моргает. Применение TThreadedQueue никак не влияет на результат и в тексте закоментировано. Прошу помощи, в чем ошибка? unit Unit2; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,System.Messaging, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.StdCtrls,System.Generics.Collections; type tmythread=class(TThread) public constructor Create; protected packetnomber:integer; procedure Execute; override; end; TForm2 = class(TForm) Memo1: TMemo; Label1: TLabel; Label2: TLabel; procedure FormCreate(Sender: TObject); private mythread:tmythread; procedure _ReciveMessage(const Sender: TObject; const M: TMessage); { Private declarations } public { Public declarations } end; var Form2: TForm2; // qqueue: TThreadedQueue<string>; implementation constructor tmythread.Create; begin packetnomber:=0; FreeOnTerminate := true; inherited create(false); end; procedure tmythread.Execute; var strmessage:string; MessageManager: TMessageManager;_Message: TMessage; begin while (not Terminated) do begin inc(packetnomber); strmessage:='Пакет№ '+inttostr(packetnomber)+' значение X='+inttostr(random(1000))+ ' значение Y='+inttostr(random(1000))+' значение Z='+inttostr(random(1000)); //qqueue.PushItem(strmessage); _Message:=TMessage<String>.Create(strmessage); MessageManager := TMessageManager.DefaultManager; MessageManager.SendMessage(self, _Message, true); sleep(random(800)); end; end; {$R *.fmx} procedure TForm2._ReciveMessage(const Sender: TObject; const M: TMessage); var stringrecive:string; begin stringrecive:=(M as TMessage<String>).Value; //stringrecive:=qqueue.PopItem; label1.Text:=stringrecive; label2.Text:=stringrecive; memo1.Lines.Add(stringrecive);memo1.GoToTextEnd; end; procedure TForm2.FormCreate(Sender: TObject); var SubscriptionId: Integer; MessageManager: TMessageManager; begin // qqueue := TThreadedQueue<string>.Create(5, 1000); memo1.StyledSettings:=[] ; memo1.TextSettings.Font.Size:=8; label1.StyledSettings:=[]; label1.TextSettings.Font.Size:=8; label2.StyledSettings:=[]; label2.TextSettings.Font.Size:=8; mythread:=tmythread.Create; MessageManager := TMessageManager.DefaultManager; SubscriptionId := MessageManager.SubscribeToMessage(TMessage<String>,self._ReciveMessage); end; end.
  10. Привет Под WIN32/64: - сообщение из формы в поток отправлял PostThreadMessage(myThread.ThreadID, WM_user+1, nativeuint(@data1),nativeuint(@data2)); - сообщение из потока в форму SendMessage(FormHandle,WM_user+2,nativeuint(@data1),nativeuint(@data2)); В Android такого нет. Подскажите, как организовать обмен сообщениями между формой и потоками в Android?
×
×
  • Создать...