Delphi XE5 FireMonkey移动开发示例：粒子系统

全栈程序员站长

发布于 2022-09-09 10:26:03

6140

发布于 2022-09-09 10:26:03

文章被收录于专栏：全栈程序员必看

大家好，又见面了，我是你们的朋友全栈君。

这个例子是参照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.

效果图：