fSoundWaveout.pas 3.5 KB

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