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

Торможение при длитоельном использовании


Akromd

Вопрос

Захотелось сделать красивую отрисовку TPath, т.к. отрисовку необходимо будет сделать одновременно в разных местах одного и того же объекта, то решено было использовать потоки. Собственно все реализовал, но чем больше отрисовываешь тем сильнее тормоза. Помогите разобраться. Тема для меня новая, поэтому не пойму где происходят потери. Сам проект прилагается.

Спойлер

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, FMX.Objects, FMX.Edit;

type
  TForm1 = class(TForm)
    Path1: TPath;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Edit4: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TAnimationPath = class(TThread)
  public
    NowP,EndP: TPoint;
    Sender: TObject;
    SizePoint: Integer;
    tag:byte;
  private
    countflash: byte;
    sizeX,sizeY:single;
    exitbol:boolean;
    { Private declarations }
  protected
    procedure Execute; override;
    procedure update;
    procedure flashanim;
    procedure flashcreate;
    procedure delassept;
  end;

var
  Form1: TForm1;
  Assept: array of Integer;

implementation

{$R *.fmx}

procedure TAnimationPath.delassept;
  var I: integer;
      J: integer;
begin
  for I := Low(Assept) to High(Assept) do
    if Assept[i] = tag then
      begin
        if i < high(Assept) then
          for J := i+1 to High(Assept) do
            Assept[j-1] := Assept[j];
        SetLength(Assept,Length(Assept)-1);
      end;
end;

procedure TAnimationPath.Execute;
begin
  inherited;
  countflash := 5;
  sizeX := TPath(Sender).Width / SizePoint;
  sizeY := TPath(Sender).Height / SizePoint;
  try
  while (NowP.X <> EndP.X)or(NowP.Y <> EndP.Y) do
    begin
      Synchronize(Update);
      Synchronize(Flashcreate);
      Synchronize(flashanim);
      Sleep(50);
    end;

  exitbol := true;

  while (TPath(Sender).ChildrenCount > 0)and(exitbol) do
    begin
      Exitbol := false;
      Synchronize(flashanim);
      Sleep(50);
    end;
  except
  end;
  Synchronize(delassept);
end;

procedure TAnimationPath.flashanim;
  var C: TCircle;
      I: integer;
begin
  for I := TPath(Sender).ChildrenCount-1 Downto 0
    do if TPath(Sender).Children[I] is TCircle
      then if TPath(Sender).Children[I].Tag = tag then
        begin
          exitbol := true;
          C := TCircle(TPath(Sender).Children[I]);
          C.Position.Point := C.Position.Point + C.Position.DefaultValue;
          if C.TagFloat / 10 < 1 then C.Opacity := C.TagFloat / 10;
          C.TagFloat := C.TagFloat - 1;
          if C.TagFloat < 0
            then
              begin
                Tpath(Sender).RemoveObject(C);
                C.Free;
              end;
        end;
end;

procedure TAnimationPath.flashcreate;
  var I: Integer;
      C: TCircle;
begin
  for I := 0 to countflash do
    begin
      C := TCircle.Create(nil);
      C.Parent := TPath(Sender);
      C.Width := 2 + Random * 4;
      C.Height := C.Width;
      C.fill.Color := TAlphaColors.Yellow;
      C.Stroke.Kind := TBrushKind.None;
      C.Position.Point := PointF(NowP.X*SizeX,NowP.Y*SizeY);
      C.Position.DefaultValue := PointF(0.5 - Random,0.5 - Random).Normalize * (1 + random * 2);
      C.TagFloat := 10 + Random(15);
      C.Opacity := 1 - Random;
      C.Tag := tag;
    end;
end;

procedure TAnimationPath.update;
begin
  TPath(Sender).Data.Data := TPath(Sender).Data.Data + ' M' + IntToStr(Trunc(NowP.X)) +',' + IntToStr(Trunc(NowP.Y));
  if (NowP.X < EndP.X) then NowP.X := NowP.X + 1;
  if (NowP.Y < EndP.Y) then NowP.Y := NowP.Y + 1;
  if (NowP.X > EndP.X) then NowP.X := NowP.X - 1;
  if (NowP.Y > EndP.Y) then NowP.Y := NowP.Y - 1;
  TPath(Sender).Data.Data := TPath(Sender).Data.Data + ' L' + IntToStr(Trunc(NowP.X)) +',' + IntToStr(Trunc(NowP.Y));
end;

procedure TForm1.Button1Click(Sender: TObject);

  Function CheckId(Id:integer):boolean;
  var i:integer;
  begin
    Result := True;
    if Length(Assept) = 0 then Exit;

    for I := Low(Assept) to High(Assept) do
      begin
        if Assept[i] = id then
          begin
            Result := false;
            Exit;
          end;
      end;
  end;

  var TmpAnim: TAnimationPath;
      Id:integer;
      X,Y: Integer;
begin
  TmpAnim := TAnimationPath.Create(True);
  TmpAnim.FreeOnTerminate := True;
  X := Random(25);
  Y := Random(25);
  TmpAnim.NowP := Point(X,Y);
  TmpAnim.EndP := Point(X + Random(25+(X-25)),Y + Random(25+(Y-25)));
  TmpAnim.Sender := Path1;
  TmpAnim.SizePoint := 50;
  Id := 39;
    repeat
     Id := Id + 1;
     TmpAnim.tag := id;
    until CheckId(TmpAnim.tag);
  SetLength(Assept,length(Assept) + 1);
  Assept[High(Assept)] := TmpAnim.tag;
  TmpAnim.Start;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Path1.Data.Clear;
  Path1.Data.MoveTo(PointF(0,0));
  Path1.Data.LineTo(PointF(50,0));
  Path1.Data.LineTo(PointF(50,50));
  Path1.Data.LineTo(PointF(0,50));
  Path1.Data.LineTo(PointF(0,0));
end;

end.

 

P.s. в проекте начало и конец координаты уже не вводится через эдиты.

Постоепенная отрисовкаTPath.rar

Ссылка на комментарий

Рекомендуемые сообщения

  • 0
Только что, GASCHE сказал:

А зачем поток, если в нем только четыре Synchronize не считая Sleep

Имеешь ввиду почему не использовал Ttread.create(nil, procedure.... в основном потоке? или что?

Ссылка на комментарий
  • 0

Нет, Synchronize очень затратная операция, Sleep это даже понять не могу зачем, какой тут выигрыш в скорости?

Изменено пользователем GASCHE
Ссылка на комментарий
  • 0

нет

имеется в виду что Synchronize - это выполнение в главном потоке

если весь код вашего потока выполняется в главном потоке, то зачем заводить поток???

у меня аналогичная анимация Path происходит путем расчетов ключевых точек в дополнительном потоке, и только заполнение готового Path.Path происходит в главном

т.к. это всяко компонент и тут без ГП никак

Ссылка на комментарий
  • 0
3 минуты назад, GASCHE сказал:

Нет, Synchronize очень затратная операция, Sleep это даже понять не могу зачем, какой тут выигрыш в скорости?

Честно не понимаю о чем речь. Я пытаюсь создать анимацию, отсюда и sleep, чтобы его выполнение было не мгновенным. Если бы я использовал его в главном потоке это привело бы к стопоры всей программы.

Нужно понимать, что я тестирую анимацию для большого проекта, в котором во время этой анимации будут происходить другие действия, в том числе от пользователя и поэтому я не понимаю как я смогу использовать synchronize без sleep в главном потоке.

Ссылка на комментарий
  • 0
4 минуты назад, krapotkin сказал:

нет

имеется в виду что Synchronize - это выполнение в главном потоке

если весь код вашего потока выполняется в главном потоке, то зачем заводить поток???

у меня аналогичная анимация Path происходит путем расчетов ключевых точек в дополнительном потоке, и только заполнение готового Path.Path происходит в главном

т.к. это всяко компонент и тут без ГП никак

Мне кажется я ответил выше, но все же поясню. Тут принцип тот же: задается ключевая точка и рисуется, проблема в том, что отдновременно их может рисоваться огромное количество на разных объектах и в то же время пользователь можето что то делать и поэтому я не понимаю как можно из главного потока это все сделать.

Ссылка на комментарий
  • 0

1. все, что происходит с КОМПОНЕНТОМ, придется делать в ГП. Это заполнение св-ва Path

2. НО! все, что нужно предварительно рассчитать, не должно быть в ГП

Как вариант 

procedure TMyThread.Execute;
begin
  while not Terminated do
  begin
    ProcessCurrentState();
    Synchronize(UpdateUserInterface);
    sleep(UpdateInterval);
  end;
end;

при этом ПО-ЛЮБОМУ будет уходить время на UpdateUserInterface/ Линейно увеличиваясь с кол-вом компонентов

Ссылка на комментарий
  • 0
4 минуты назад, krapotkin сказал:

1. все, что происходит с КОМПОНЕНТОМ, придется делать в ГП. Это заполнение св-ва Path

2. НО! все, что нужно предварительно рассчитать, не должно быть в ГП

Как вариант 


procedure TMyThread.Execute;
begin
  while not Terminated do
  begin
    ProcessCurrentState();
    Synchronize(UpdateUserInterface);
    sleep(UpdateInterval);
  end;
end;

при этом ПО-ЛЮБОМУ будет уходить время на UpdateUserInterface/ Линейно увеличиваясь с кол-вом компонентов

То есть использование synchromize не рентабельно, и лучше использовать заполнение в ГП? Тогда вопрос зачем он нам в потоке для UpdateUserInterface? Или этот метод в ГП?

Не совсем понимаю конструкцию while not Teminated. Получается мы бесконечно выполняем цикл?

Ссылка на комментарий
  • 0
  • Администраторы

Не делайте велосипед. Посмотрите в исходниках, как реализована анимация любого свойства. Можете взять из моих компонентов аниматоров FGX. 

Ссылка на комментарий
  • 0
8 минут назад, Brovin Yaroslav сказал:

Не делайте велосипед. Посмотрите в исходниках, как реализована анимация любого свойства. Можете взять из моих компонентов аниматоров FGX. 

А где связь с анимацией любого свойства? ведь мы пытаемся анимировать не просто свойство opacity или width, а именно отрисовку TPath. И где можно найти аниматоры FGX?

Ссылка на комментарий
  • 0
  • Администраторы

Скачайте пакет и посмотрите на TfgBitmapLinkAnimationTfgPositionAnimationTfgPosition3DAnimation (Модуль FGX.Animations). И обратите внимание, что все это не простые типы. 

Можете даже просто взять за основу TfgCustomPropertyAnimation и вам будет достаточно переопределить только один метод: DefineCurrentValue.

 

Ссылка на комментарий
  • 0
3 минуты назад, Brovin Yaroslav сказал:

Скачайте пакет и посмотрите на TfgBitmapLinkAnimationTfgPositionAnimationTfgPosition3DAnimation (Модуль FGX.Animations). И обратите внимание, что все это не простые типы. 

Спасибо, сейчас ознакомлюсь

Ссылка на комментарий
  • 0
  • Администраторы

Аниматор работает с обычным параметром. Параметр ANormalizedTime меняется от 0 до 1. Соответственно, вам просто нужно присвоить новые значения для анимируемого свойства в  DefineCurrentValue в зависимости от этого параметра. Если у вас свойство сложное (многосоставное, состоит их нескольких свойств или TPath), то вам соответственно, нужно выполнить вычисление нового значения для каждого подсвойств по отдельности. 

Например для TPosition:

procedure TfgCustomPositionAnimation.DefineCurrentValue(const ANormalizedTime: Single);
begin
  FCurrentValue.X := InterpolateSingle(StartValue.X, StopValue.X, ANormalizedTime);
  FCurrentValue.Y := InterpolateSingle(StartValue.Y, StopValue.Y, ANormalizedTime);
end;

 

Ссылка на комментарий
  • 0

Немного пояснения: требовалось анимировать объект Tpath (не путать с TpathAnimation!) - то есть анимировать отрисовку "сложных" объектов через SVG.

За отрисовку объектов отвечает свойство data.data, которое в виде строки хранит SVG код.

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

Немного подумав, оказалось, что из постоянного дополнения этого свойства (data.data), оно очень быстро "переполнялось" и отрисовка занимала очень длительное время. Поэтому было решено использовать другой метод: вместо того чтобы постепенно изменять это свойство, мы создаем новый объект типа Tline и изменяя его размер как будто рисуем постепенно новую линию, а в конце уничтожаем ее, заменяя начало и конец добавлением в то самое свойство data.data тем самым экономя и память, и размер свойства.

Опять же, почему не использовать более простые методы? Во-первых требуется чтобы эта анимация могла происходит параллельно действиям всей программы. Во-вторых, таких анимаций одновременно может происходит довольно много.

Если кому интересно, выложу исходники

Ссылка на комментарий
  • 0

Проект прикреплен к посту.

Код:

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, FMX.Objects, FMX.Edit;

type
  TForm1 = class(TForm)
    Path1: TPath;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Edit4: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TAnimationPath = class(TThread)
  public
  private
    countflash: byte;
    tmpline: TLine;
    NowP,EndP: TPoint;
    Sender: TObject;
    duration: single;
    Step: TPoint;
    updateinterval: integer;
    { Private declarations }
  protected
    procedure Execute; override;
    constructor Create(StartPos,EndPos:TPoint;induration:single;inSender:TObject);
    procedure update;
    procedure flashanim;
    procedure flashcreate;
    procedure delassept;
  end;

var
  Form1: TForm1;
  Assept: array of Integer;

implementation

{$R *.fmx}

constructor TAnimationPath.Create(StartPos, EndPos: TPoint; induration: single; inSender: TObject);
begin
   inherited Create(false);
   NowP := StartPos;
   EndP := EndPos;
   Sender := inSender;
   countflash := 5;
   duration := induration*1000;
   updateinterval := 50;
   Step := (EndP - NowP);
   Step.X := abs(Step.X * updateinterval);
   Step.Y := abs(Step.Y * updateinterval);
   Step.X := Trunc(Step.X / duration);
   Step.Y := Trunc(Step.Y / duration);
   tmpline := Tline.Create(nil);
   tmpline.Parent := TPath(sender);
   tmpline.Position.X := NowP.X;
   tmpline.Position.Y := NowP.Y;
   tmpline.Width := 1;
   tmpline.Height := 1;
   tmpline.Stroke := TPath(Sender).Stroke;
end;

procedure TAnimationPath.delassept;
  var I: integer;
      J: integer;
      L: TLine;
begin
  I := Trunc(tmpline.Width)-1;
  J := Trunc(tmpline.Height)-1;

  Tpath(Sender).Data.Data := Tpath(Sender).Data.Data + ' M' + IntToStr(Trunc(tmpline.Position.X)) + ',' + IntToStr(Trunc(tmpline.Position.Y)) + ' L' + IntToStr(Trunc(tmpline.Position.X + I)) + ',' + IntToStr(Trunc(tmpline.Position.Y + J));

  for I := TPath(Sender).ChildrenCount-1 downto 0
    do if TPath(Sender).Children[I] is TLine then
      if (TLine(TPath(Sender).Children[I]) = tmpline) then
      begin
        L := TLine(TPath(Sender).Children[I]);
        TPath(Sender).RemoveObject(L);
        L.Free;
        Exit;
      end;
end;

procedure TAnimationPath.Execute;
begin
  if (NowP.X <> EndP.X) and (NowP.Y <> EndP.Y) then tmpline.LineType := TLineType.Diagonal
  else
    begin
      if (NowP.X <> EndP.X) then tmpline.LineType := TLineType.Top;
      if (NowP.Y <> EndP.Y) then tmpline.LineType := TLineType.Left;
    end;
  try
  while (NowP.X <> EndP.X)or(NowP.Y <> EndP.Y) do
    begin
      Synchronize(Update);
      Synchronize(Flashcreate);
      Synchronize(flashanim);
      Sleep(updateinterval);
    end;
  while (tmpline.ChildrenCount > 0) do
    begin
      Synchronize(flashanim);
      Sleep(updateinterval);
    end;
  except
  end;
  Synchronize(delassept);
end;

procedure TAnimationPath.flashanim;
  var C: TCircle;
      I: integer;
begin
  for I := Tmpline.ChildrenCount-1 Downto 0
    do if tmpline.Children[I] is TCircle
      then
        begin
          C := TCircle(tmpline.Children[I]);
          C.Position.Point := C.Position.Point + C.Position.DefaultValue;
          if C.TagFloat / 10 < 1 then C.Opacity := C.TagFloat / 10;
          C.TagFloat := C.TagFloat - 1;
          if C.TagFloat < 0
            then
              begin
                Tpath(Sender).RemoveObject(C);
                C.Free;
              end;
        end;
end;

procedure TAnimationPath.flashcreate;
  var I: Integer;
      C: TCircle;
      P: TPointF;
begin
  for I := 0 to countflash do
    begin
      C := TCircle.Create(nil);
      C.Parent := tmpline;
      C.Width := 2 + Random * 4;
      C.Height := C.Width;
      C.fill.Color := TAlphaColors.Yellow;
      C.Stroke.Kind := TBrushKind.None;
      if NowP.X < EndP.X then P.X := tmpline.Width
      else P.X := 0;
      if NowP.Y < EndP.Y then P.Y := tmpline.Height
      else P.Y := 0;
      C.Position.Point := P;
      C.Position.DefaultValue := PointF(0.5 - Random,0.5 - Random).Normalize * (1 + random * 2);
      C.TagFloat := 10 + Random(15);
      C.Opacity := 1 - Random;
    end;
end;

procedure TAnimationPath.update;
begin
  if (NowP.X < EndP.X) then
    begin
      if (NowP.X + Step.X > EndP.X) then
        begin
          tmpline.Width := tmpline.Width + EndP.X - NowP.X;
          NowP.X := EndP.X;
        end
      else
        begin
          NowP.X := NowP.X + Step.X;
          tmpline.Width := tmpline.Width + Step.X;
        end;
    end;
  if (NowP.Y < EndP.Y) then
    begin
      if (NowP.Y + Step.Y > EndP.Y) then
        begin
          NowP.Y := EndP.Y;
          tmpline.Height := tmpline.Height + EndP.Y - NowP.X;
        end
      else
        begin
          NowP.Y := NowP.Y + Step.Y;
          tmpline.Height := tmpline.Height + Step.Y;
        end;
    end;
  if (NowP.X > EndP.X) then
    begin
      if (NowP.X - Step.X < EndP.X) then
        begin
          NowP.X := EndP.X;
          tmpline.Position.X := tmpline.Position.X - (NowP.X - EndP.X);
          tmpline.Width := tmpline.Width + (NowP.X - EndP.X);
        end
      else
        begin
          NowP.X := NowP.X - Step.X;
          tmpline.Position.X := tmpline.Position.X - Step.X;
          tmpline.Width := tmpline.Width + Step.X;
        end;
    end;
  if (NowP.Y > EndP.Y) then
    begin
      if (NowP.Y - Step.Y < EndP.Y) then
        begin
          NowP.Y := EndP.Y;
          tmpline.Position.Y := tmpline.Position.Y - (NowP.Y - EndP.Y);
          tmpline.Height := tmpline.Height + (NowP.Y - EndP.Y);
        end
      else
        begin
          NowP.Y := NowP.Y - Step.Y;
          tmpline.Position.Y := tmpline.Position.Y - Step.Y;
          tmpline.Height := tmpline.Height + Step.Y;
        end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var TmpAnim: TAnimationPath;
      X,Y: Integer;
begin
  TmpAnim := TAnimationPath.create(Point(0,0),Point(0,200),1,Path1);

  TmpAnim := TAnimationPath.create(Point(0,200),Point(400,200),2,Path1);

  TmpAnim := TAnimationPath.create(Point(400,200),Point(400,0),3,Path1);

  TmpAnim := TAnimationPath.create(Point(400,0),Point(0,0),4,Path1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Path1.Data.Clear;
end;

end.

 

Постоепенная отрисовкаTPath.zip

Ссылка на комментарий
  • 0
20 минут назад, Rusland сказал:

Криво как-то рисует

Еще пока дорабатывается, проблема в скорости отрисовки, поэтому может не совсем точно быть в той точке которую мы хотим получить

Ссылка на комментарий
  • 0
20 часов назад, GASCHE сказал:

Да столько объясняли и напрасно, видно плохие из нас советчики.

К сожалению я не увидел вашего объяснения, так что не пойму о чем речь.

Ссылка на комментарий

Присоединяйтесь к обсуждению

Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.

Гость
Ответить на вопрос...

×   Вставлено с форматированием.   Вставить как обычный текст

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

×
×
  • Создать...