Перейти к содержанию
Fire Monkey от А до Я

ddr 2

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

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

  • Посещение

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

    2

Активность репутации

  1. Like
    ddr 2 получил реакцию от Ingalime в Векторный стилевой класс   
    Задумался о применении векторных изображений в стилях контролов. На примере TButton, т.е. создать векторный "стилевой" класс по аналогичный с растровым TButtonStyleObject, 
    где для 4-х визуальных представлений будет использовать не TBitmapLinks, а TPath. 
    Минусы:
    Не будет 9parts, а значит только фиксированное соотношение сторон;  Не родное решение (ниже Сомнение№2);  Плюсы:
    Самый очевидный - один стиль с 4-мя картинками, вместо в много раз(10+) больше картинок под разные scale/разрешений экрана/размеров....(в зависимости от выбронного способа избавления от "мыла" для работы приложения на любых экранах и мониторах с любым разрешением и scale);  Меньшая ресурсоёмкость. Будет шустрее работать (как минимум НЕ медленне), что не критично для Windows, но актуально для  большей части комьюнити данного форума, разработчиков под мобильные платформы. Только за счет отказа от 9parts, быстродействие отрисовки вырастет. См. реализацию TCustomStyleObject.DoDrawToCanvas -9 частей отрисовываются всегда(9 вызовов Canvas.DrawBitmap(...)), даже если они фактически не используются. Я, к примеру, 9parts использую только у стиля листбокса, который "внутри" комбобокса. В остальных случаях, дефакто - 1 область + 8 областей нулевой площади. При желении, даже у листбокса можно отказаться от 9parts. Время загрузки Стиля- (+/-)10% по сравнению к растровому решению. Сомнения:
    Поизучав FMX.Styles.Objects.pas "легкой" реализации, что бы, что-нибудь наследовать и пару строк дописать, я не нашёл. Для меня понятное решение, это полностью скопировать(взять за основу "векторных" стиливых классов) TCustomStyleObject и TButtonStyleObject и править... Это 1500+ строк кода. Зная свой темп работы, я для себя переписывание и отладку оцениваю в 2-е недели работы. А потом выйдет 10.4.3 или если сильно повезет, то переставать работать "векторный" класс будет лишь на каждом втором релизе и... goto п.1 ПРЕДЛАГАЮ ОБСУДИТЬ + И - ТАКОГО РЕШЕНИЯ, РЕАЛИЗАЦИЮ,  ЦЕЛЕСООБРАЗНОСТЬ, АЛЬТЕРНАТИВЫ.
  2. Like
    ddr 2 получил реакцию от Евгений Корепов в TThreadedQueue некорректное "ожидание" данных очереди   
    Добрый день!
    Заметил неприятный эффект(баг, особенность либо моё недопонимание чего либо). Через некоторое непродолжительно время работы 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.  
×
×
  • Создать...