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

Delphi XE5 FireMonkey移动开发示例:粒子系统这个例子是参照Processing中的例子写的。  测试结果:在Windows7上,脱离开发环境的性能与Processing相当,在Android上表现良好。 源码如下:  unitExample.Particles;interfaceusesSystem.SysUtils,System.Types,System.UITypes,System.Classes,

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

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

  效果图:

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

版权声明:本文内容由互联网用户自发贡献,该文观点仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 举报,一经查实,本站将立刻删除。

发布者:全栈程序员-用户IM,转载请注明出处:https://javaforall.cn/161307.html原文链接:https://javaforall.cn

【正版授权,激活自己账号】: Jetbrains全家桶Ide使用,1年售后保障,每天仅需1毛

【官方授权 正版激活】: 官方授权 正版激活 支持Jetbrains家族下所有IDE 使用个人JB账号...

(0)
blank

相关推荐

  • ip2long之后有什么好处?

    ip2long之后有什么好处?

    2021年10月18日
  • c语言入门教程–-2基本语法

    c语言入门教程–-2基本语法

  • 关于tcp连接中timewait的作用

    关于tcp连接中timewait的作用今天简单的谈一下tcp连接中timewait的作用,如果没有timewait会发生什么呢?我们知道首先请求关闭连接的一方会存在timewait状态。首先我们来看一下tcp四次挥手的过程示意图:客户端首先发起FIN请求,所以客户端会进入time_wait状态。如果没有time_wait或者用户自己通过调整tcp_tw_recycle缩短了time_wait的时间会出现生什问题呢?

  • mybatis 拦截器 添加参数_mybatis传递多个参数

    mybatis 拦截器 添加参数_mybatis传递多个参数上一篇中讲了mybatis拦截器的实现这一篇扩展mybatis在拦截器中添加额外参数在mybatis的mapper.xml文件中,我们可以使用#{}或${}的方式获取到参数,这些参数都需要提前我们在mapper.java接口文件中通过参数的方式传入参数才能取到为了扩展参数,我们需要了解mybatis是怎么帮我们保管mapper.java中传入的参数的进入Executor.java接口查看query方法,可以看到第一个参数MappedStatement对象中有一个parameterMap字段,该字段是

  • 哪些线程是安全的_redis是线程安全的吗

    哪些线程是安全的_redis是线程安全的吗Java中平时用的最多的map就是hashmap但是它却是线程不安全的。那除了hashmap还有哪些常见的线程安全的map?1.hashtableMap<String,Object>hashtable=newHashtable<String,Object>();这是所有人最先想到的,那为什么她是线程安全的?那就看看她的源码,我们可以看出我们常用的put,get,…

  • Truncate用法详解[通俗易懂]

    Truncate用法详解[通俗易懂]前言:当我们想要清空某张表时,往往会使用truncate语句。大多时候我们只关心能否满足需求,而不去想这类语句的使用场景及注意事项。本篇文章主要介绍truncate语句的使用方法及注意事项。1.truncate使用语法truncate的作用是清空表或者说是截断表,只能作用于表。truncate的语法很简单,后面直接跟表名即可,例如:truncatetabletbl_name …

    2022年10月22日

发表回复

您的电子邮箱地址不会被公开。

关注全栈程序员社区公众号