fSoundBASS.pas 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148
  1. unit fSoundBASS;
  2. interface
  3. uses
  4. System.Classes,
  5. System.SysUtils,
  6. System.Math,
  7. Vcl.Forms,
  8. Vcl.ExtCtrls,
  9. Vcl.ComCtrls,
  10. Vcl.Controls,
  11. Vcl.StdCtrls,
  12. GLS.Scene,
  13. Stage.VectorTypes,
  14. Stage.VectorGeometry,
  15. GLS.Cadencer,
  16. GLS.Objects,
  17. GLS.SoundManager,
  18. GLS.Sounds.BASS,
  19. GLS.SceneViewer,
  20. GLS.GeomObjects,
  21. GLS.Coordinates,
  22. GLS.BaseClasses,
  23. GLS.FileWAV,
  24. GLS.FileMP3,
  25. Stage.Utils
  26. ;
  27. type
  28. TFormSoundBASS = class(TForm)
  29. GLScene: TGLScene;
  30. GLSceneViewer: TGLSceneViewer;
  31. GLCamera1: TGLCamera;
  32. DummyCube: TGLDummyCube;
  33. SphereSound: TGLSphere;
  34. GLLightSource: TGLLightSource;
  35. GLSoundLibrary: TGLSoundLibrary;
  36. GLSMBASS: TGLSMBASS;
  37. GLCadencer1: TGLCadencer;
  38. Timer: TTimer;
  39. Mickey: TGLSphere;
  40. Sphere2: TGLSphere;
  41. Sphere3: TGLSphere;
  42. Cone1: TGLCone;
  43. TrackBar: TTrackBar;
  44. Plane1: TGLPlane;
  45. Disk1: TGLDisk;
  46. Torus1: TGLTorus;
  47. TrackBar1: TTrackBar;
  48. Panel1: TPanel;
  49. btnChimes: TButton;
  50. btnHowl: TButton;
  51. LabelFPS: TLabel;
  52. procedure SphereSoundProgress(Sender: TObject; const deltaTime, newTime: Double);
  53. procedure TimerTimer(Sender: TObject);
  54. procedure TrackBarChange(Sender: TObject);
  55. procedure TrackBar1Change(Sender: TObject);
  56. procedure FormCreate(Sender: TObject);
  57. procedure btnChimesClick(Sender: TObject);
  58. procedure btnHowlClick(Sender: TObject);
  59. private
  60. Path: TFileName;
  61. public
  62. end;
  63. var
  64. FormSoundBASS: TFormSoundBASS;
  65. implementation
  66. {$R *.DFM}
  67. procedure TFormSoundBASS.FormCreate(Sender: TObject);
  68. begin
  69. Path := GetCurrentAssetPath() + '\audio';
  70. SetCurrentDir(Path);
  71. // Load our sound samples
  72. GLSoundLibrary.Samples.AddFile('drumloop.wav', 'drumloop.wav');
  73. GLSoundLibrary.Samples.AddFile('chimes.wav', 'chimes.wav');
  74. GLSoundLibrary.Samples.AddFile('howl.mp3', 'howl.mp3');
  75. end;
  76. procedure TFormSoundBASS.SphereSoundProgress(Sender: TObject;
  77. const deltaTime, newTime: Double);
  78. var
  79. alpha: Single;
  80. begin
  81. // Move the red sphere (sound source) along an elliptic path
  82. alpha := 60 * DegToRad(newTime);
  83. TGLSphere(Sender).Position.SetPoint(sin(alpha) * 1, 0.5, cos(alpha) * 5);
  84. end;
  85. procedure TFormSoundBASS.TrackBarChange(Sender: TObject);
  86. begin
  87. // Rotate the listener around the vertical axis
  88. DummyCube.TurnAngle := TrackBar.Position;
  89. Application.ProcessMessages;
  90. end;
  91. procedure TFormSoundBASS.TrackBar1Change(Sender: TObject);
  92. begin
  93. // Move the listener forward/back
  94. Mickey.Position.Z := TrackBar1.Position / 10;
  95. Application.ProcessMessages;
  96. end;
  97. procedure TFormSoundBASS.TimerTimer(Sender: TObject);
  98. var
  99. mngName: String;
  100. begin
  101. // some stats
  102. if ActiveSoundManager is TGLSMBASS then
  103. mngName := 'BASS'
  104. else
  105. mngName := '';
  106. if ActiveSoundManager <> nil then
  107. LabelFPS.Caption := Format('%.2f FPS, %s CPU use : %.2f%%',
  108. [GLSceneViewer.FramesPerSecond, mngName, ActiveSoundManager.CPUUsagePercent])
  109. else
  110. LabelFPS.Caption := 'No active sound manager.';
  111. GLSceneViewer.ResetPerformanceMonitor;
  112. end;
  113. procedure TFormSoundBASS.btnChimesClick(Sender: TObject);
  114. begin
  115. with TGLBSoundEmitter.Create(SphereSound.Behaviours) do
  116. begin
  117. Source.SoundLibrary := GLSoundLibrary;
  118. Source.SoundName := 'chimes.wav';
  119. Playing := True;
  120. end;
  121. end;
  122. procedure TFormSoundBASS.btnHowlClick(Sender: TObject);
  123. begin
  124. with TGLBSoundEmitter.Create(SphereSound.Behaviours) do
  125. begin
  126. Source.SoundLibrary := GLSoundLibrary;
  127. Source.SoundName := 'howl.mp3';
  128. Playing := True;
  129. end;
  130. end;
  131. end.