大家好,又见面了,我是你们的朋友全栈君。
这个例子是参照Processing中的例子写的。
测试结果:在Windows7上,脱离开发环境的性能与Processing相当,在Android上表现良好。
源码如下:
unit Example.Particles;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
System.Generics.Collections, System.UIConsts,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.PixelFormats;
type
TParticle = class
private
FGravity: TPointF;
FVelocity: TPointF;
FLifeSpan: Integer;
FPart: TBitmap;
FPartSize: Integer;
FPosition: TPointF;
public
constructor Create(ASprite: TBitmap; X, Y: Single);
destructor Destroy(); override;
procedure Rebirth(X, Y: Single);
function IsDead(): Boolean;
procedure Update(Canvas: TCanvas);
end;
TParticleSystem = class
private
FParticles: TObjectList<TParticle>;
public
constructor Create(Count: Integer; ASprite: TBitmap; X, Y: Single);
procedure Update(Canvas: TCanvas);
procedure SetEmmitter(X, Y: Single);
end;
implementation
{ TParticle }
constructor TParticle.Create(ASprite: TBitmap; X, Y: Single);
begin
FGravity := TPointF.Create(0, 0.1);
FPartSize := Random(50) + 10;
FPart := ASprite;
Rebirth(X, Y);
FLifeSpan := Random(255);
end;
destructor TParticle.Destroy;
begin
//FPart.Free;
inherited;
end;
function TParticle.IsDead: Boolean;
begin
Result := (FLifeSpan <= 0);
end;
procedure TParticle.Rebirth(X, Y: Single);
var
Alpha: Single;
Speed: Single;
begin
Alpha := Random() * 2 * PI;
Speed := Random() * 4 + 0.5;
FVelocity := TPointf.Create(Cos(Alpha), Sin(Alpha));
FVelocity := FVelocity * Speed;
FLifeSpan := Random(100) + 155;
FPosition := TPointF.Create(X, Y);
end;
procedure TParticle.Update(Canvas: TCanvas);
begin
FLifeSpan := FLifeSpan - 1;
FVelocity.Offset(FGravity);
FPosition := FPosition + FVelocity;
Canvas.DrawBitmap(FPart,
RectF(0, 0, FPart.Width, FPart.Height),
RectF(FPosition.X, FPosition.Y,
FPosition.X + FPartSize, FPosition.Y + FPartSize),
FLifeSpan, True);
end;
{ TParticleSystem }
constructor TParticleSystem.Create(Count: Integer; ASprite: TBitmap; X, Y: Single);
var
I: Integer;
begin
FParticles := TObjectList<TParticle>.Create(True);
for I := 0 to Count - 1 do
FParticles.Add(TParticle.Create(ASprite, X, Y));
end;
procedure TParticleSystem.SetEmmitter(X, Y: Single);
var
Part: TParticle;
begin
for Part in FParticles do
if Part.IsDead then
Part.Rebirth(X, Y);
end;
procedure TParticleSystem.Update(Canvas: TCanvas);
var
Part: TParticle;
begin
for Part in FParticles do
Part.Update(Canvas);
end;
end.
unit Example.ParticleMain;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
FMX.Edit, Example.Particles, FMX.MaterialSources;
type
TParticleForm = class(TForm)
Timer1: TTimer;
TextureMaterial: TTextureMaterialSource;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
FParticleSystem: TParticleSystem;
FPS: Integer;
procedure DoIdle(Sender: TObject; var Done: Boolean);
public
procedure Setup();
procedure Loop();
end;
var
ParticleForm: TParticleForm;
implementation
{$R *.fmx}
procedure TParticleForm.DoIdle(Sender: TObject; var Done: Boolean);
begin
Invalidate();
end;
procedure TParticleForm.FormCreate(Sender: TObject);
begin
Setup();
end;
procedure TParticleForm.FormDestroy(Sender: TObject);
begin
FParticleSystem.Free;
end;
procedure TParticleForm.FormPaint(Sender: TObject; Canvas: TCanvas;
const ARect: TRectF);
begin
Loop();
end;
procedure TParticleForm.Loop();
var
P: TPointF;
begin
Inc(FPS);
P := ScreenToClient(Screen.MousePos);
Canvas.BeginScene();
Canvas.Clear($FF000000);
Canvas.Fill.Color := $FFFFFFFF;
Canvas.FillText(Rectf(0, 0, Width, Height), Caption, False,
255, [], TTextAlign.taLeading, TTextAlign.taLeading);
FParticleSystem.Update(Canvas);
Canvas.Fill.Color := $FF000000;
Canvas.FillText(RectF(0, 0, ClientWidth, ClientHeight), '2013 曹伟民 ', False,
255, [], TTextAlign.taCenter, TTextAlign.taTrailing);
Canvas.EndScene;
FParticleSystem.SetEmmitter(P.X, P.Y);
end;
procedure TParticleForm.Setup;
begin
Randomize;
Application.OnIdle := DoIdle;
FParticleSystem := TParticleSystem.Create(10000, TextureMaterial.Texture,
Width / 2, Height / 2);
end;
procedure TParticleForm.Timer1Timer(Sender: TObject);
begin
Caption := Format('Frames Per Second: %d', [FPS]);
FPS := 0;
end;
end.
效果图:
发布者:全栈程序员-用户IM,转载请注明出处:https://javaforall.cn/161307.html原文链接:https://javaforall.cn
【正版授权,激活自己账号】: Jetbrains全家桶Ide使用,1年售后保障,每天仅需1毛
【官方授权 正版激活】: 官方授权 正版激活 支持Jetbrains家族下所有IDE 使用个人JB账号...