fWhirl.pas 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119
  1. unit fWhirl;
  2. interface
  3. uses
  4. Winapi.Windows,
  5. Winapi.Messages,
  6. Winapi.OpenGL,
  7. System.SysUtils,
  8. System.Math,
  9. System.Variants,
  10. System.Classes,
  11. Vcl.Graphics,
  12. Vcl.Controls,
  13. Vcl.Forms,
  14. Vcl.Dialogs,
  15. Vcl.ExtCtrls,
  16. GLS.BaseClasses,
  17. GLS.Scene,
  18. GLS.PersistentClasses,
  19. GLS.VectorGeometry,
  20. GLS.SceneViewer,
  21. GLS.Particles,
  22. GLS.Cadencer,
  23. GLS.Objects,
  24. GLS.Coordinates,
  25. GLS.Behaviours;
  26. type
  27. TFormWhirlD = class(TForm)
  28. GLSceneViewer1: TGLSceneViewer;
  29. Panel1: TPanel;
  30. Timer1: TTimer;
  31. GLCadencer1: TGLCadencer;
  32. GLScene1: TGLScene;
  33. GLParticles1: TGLParticles;
  34. DummyCube1: TGLDummyCube;
  35. Sprite1: TGLSprite;
  36. GLCamera1: TGLCamera;
  37. procedure Timer1Timer(Sender: TObject);
  38. procedure GLDummyCube1Progress(Sender: TObject;
  39. const deltaTime, newTime: Double);
  40. procedure GLParticles1ActivateParticle(Sender: TObject;
  41. Particle: TGLBaseSceneObject);
  42. procedure GLCadencer1Progress(Sender: TObject;
  43. const deltaTime, newTime: Double);
  44. procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  45. X, Y: Integer);
  46. procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  47. Shift: TShiftState; X, Y: Integer);
  48. private
  49. mx, my: Integer;
  50. public
  51. end;
  52. var
  53. FormWhirlD: TFormWhirlD;
  54. implementation
  55. {$R *.dfm}
  56. procedure TFormWhirlD.GLParticles1ActivateParticle(Sender: TObject;
  57. Particle: TGLBaseSceneObject);
  58. var
  59. r, alpha, cr, sr: Single;
  60. begin
  61. alpha := Random * 2 * PI;
  62. r := 2 * Random;
  63. SinCosine(alpha, r * r, sr, cr);
  64. Particle.Children[0].Position.SetPoint(sr, 3 * r - 3, cr);
  65. GetOrCreateInertia(Particle).TurnSpeed := Random(30);
  66. TGLCustomSceneObject(Particle).TagFloat := GLCadencer1.CurrentTime;
  67. end;
  68. procedure TFormWhirlD.GLSceneViewer1MouseDown(Sender: TObject;
  69. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  70. begin
  71. mx := X;
  72. my := Y;
  73. end;
  74. procedure TFormWhirlD.GLSceneViewer1MouseMove(Sender: TObject;
  75. Shift: TShiftState; X, Y: Integer);
  76. begin
  77. if Shift <> [] then
  78. begin
  79. GLCamera1.MoveAroundTarget(my - Y, mx - X);
  80. mx := X;
  81. my := Y;
  82. end;
  83. end;
  84. procedure TFormWhirlD.GLDummyCube1Progress(Sender: TObject;
  85. const deltaTime, newTime: Double);
  86. begin
  87. with TGLCustomSceneObject(Sender) do
  88. begin
  89. if newTime - TagFloat > 3 then
  90. GLParticles1.KillParticle(TGLCustomSceneObject(Sender));
  91. end;
  92. end;
  93. procedure TFormWhirlD.Timer1Timer(Sender: TObject);
  94. begin
  95. Panel1.Caption := Format('%d particles, %.1f FPS',
  96. [GLParticles1.Count, GLSceneViewer1.FramesPerSecond]);
  97. GLSceneViewer1.ResetPerformanceMonitor;
  98. end;
  99. procedure TFormWhirlD.GLCadencer1Progress(Sender: TObject;
  100. const deltaTime, newTime: Double);
  101. begin
  102. GLParticles1.CreateParticle;
  103. end;
  104. end.