fParticles.pas 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119
  1. unit fParticles;
  2. interface
  3. uses
  4. Winapi.OpenGL,
  5. System.SysUtils,
  6. System.Classes,
  7. Vcl.Forms,
  8. Vcl.StdCtrls,
  9. Vcl.ExtCtrls,
  10. Vcl.Controls,
  11. GLS.Scene,
  12. GLS.Objects,
  13. GLS.Particles,
  14. GLS.Behaviours,
  15. GLS.VectorGeometry,
  16. GLS.PersistentClasses,
  17. GLS.Cadencer,
  18. GLS.VectorTypes,
  19. GLS.SceneViewer,
  20. GLS.Coordinates,
  21. GLS.BaseClasses,
  22. GLS.Utils;
  23. type
  24. TFormParticles = class(TForm)
  25. GLSceneViewer1: TGLSceneViewer;
  26. GLScene1: TGLScene;
  27. GLCamera1: TGLCamera;
  28. GLParticles1: TGLParticles;
  29. Sprite1: TGLSprite;
  30. GLCadencer1: TGLCadencer;
  31. Timer1: TTimer;
  32. procedure GLParticles1ActivateParticle(Sender: TObject;
  33. particle: TGLBaseSceneObject);
  34. procedure Sprite1Progress(Sender: TObject;
  35. const deltaTime, newTime: Double);
  36. procedure Timer1Timer(Sender: TObject);
  37. procedure FormCreate(Sender: TObject);
  38. procedure FormResize(Sender: TObject);
  39. public
  40. end;
  41. var
  42. FormParticles: TFormParticles;
  43. implementation
  44. {$R *.DFM}
  45. procedure TFormParticles.FormCreate(Sender: TObject);
  46. var
  47. MediaPath: String;
  48. begin
  49. SetGLSceneMediaDir;
  50. MediaPath := GetCurrentDir + '\';
  51. Sprite1.Material.Texture.Image.LoadFromFile(MediaPath + 'Flare1.bmp');
  52. // if we don't do this, our random won't look like random
  53. Randomize;
  54. end;
  55. procedure TFormParticles.GLParticles1ActivateParticle(Sender: TObject;
  56. particle: TGLBaseSceneObject);
  57. begin
  58. // this event is called when a particle is activated,
  59. // ie. just before it will be rendered we pick a random color
  60. TGLSprite(Particle).Material.FrontProperties.Emission.Color := PointMake(Random, Random, Random);
  61. // our halo starts transparent
  62. TGLSprite(Particle).Material.FrontProperties.Diffuse.Alpha := 0;
  63. // this is our "birth time"
  64. TGLSprite(Particle).TagFloat := GLCadencer1.CurrentTime;
  65. end;
  66. procedure TFormParticles.Sprite1Progress(Sender: TObject;
  67. const deltaTime, newTime: Double);
  68. var
  69. life: Double;
  70. begin
  71. with TGLSprite(Sender) do
  72. begin
  73. // calculate for how long we've been living
  74. life := (newTime - TagFloat);
  75. if life > 10 then
  76. // old particle to kill
  77. GLParticles1.KillParticle(TGLSprite(Sender))
  78. else if life < 1 then
  79. // baby particles become brighter in their 1st second of life...
  80. Material.FrontProperties.Diffuse.Alpha := life
  81. else // ...and slowly disappear in the darkness
  82. Material.FrontProperties.Diffuse.Alpha := (9 - life) / 9;
  83. end;
  84. end;
  85. procedure TFormParticles.Timer1Timer(Sender: TObject);
  86. begin
  87. // every timer, we create a particle at a random position
  88. with TGLSprite(GLParticles1.CreateParticle).Position do
  89. begin
  90. X := 3 * (Random - 0.5);
  91. Y := 3 * (Random - 0.5);
  92. Z := 3 * (Random - 0.5);
  93. end;
  94. // infos for the user
  95. Caption := 'Particles - ' + Format('%d particles, %.1f FPS',
  96. [GLParticles1.Count - 1, GLSceneViewer1.FramesPerSecond]);
  97. GLSceneViewer1.ResetPerformanceMonitor;
  98. end;
  99. procedure TFormParticles.FormResize(Sender: TObject);
  100. begin
  101. // change focal so the view will shrink and not just get clipped
  102. GLCamera1.FocalLength := 50 * Width / 280;
  103. end;
  104. end.