- 0
Торможение при длитоельном использовании
-
Похожий контент
-
- 4 ответа
- 2 495 просмотров
-
- 1 ответ
- 6 747 просмотров
-
- 1 ответ
- 4 116 просмотров
-
TScrollBox [Android] Как включить функцию оттягивания скроллинга за границу контента и его возврат на место?
От brunnengi,
- AniCalculations
- Animation
- (и ещё 2 )
- 2 ответа
- 2 588 просмотров
-
TScrollBox [TScrollBox] Как предотвратить автоскрытие скроллбара при использовании AniCalculations
От NesDmitrijj,
- AniCalculations
- Animation
- (и ещё 1 )
- 1 ответ
- 2 069 просмотров
-
- 1 ответ
- 3 594 просмотра
-
- 1 ответ
- 4 092 просмотра
-
-
Последние посетители 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
Ссылка на комментарий
25 ответов на этот вопрос
Рекомендуемые сообщения
Присоединяйтесь к обсуждению
Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.