fSoundWaveout.pas 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147
  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. GLS.VectorTypes,
  16. GLS.VectorGeometry,
  17. GLS.Sound,
  18. Sounds.WaveOut,
  19. GLS.SceneViewer,
  20. GLS.GeomObjects,
  21. GLS.Coordinates,
  22. GLS.BaseClasses,
  23. GLS.FileWAV,
  24. GLS.FileMP3,
  25. GLS.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. Button1: 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 Button1Click(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. SetGLSceneMediaDir();
  68. // Load our sound sample
  69. GLSoundLibrary.Samples.AddFile('drumloop.wav', 'drumloop.wav');
  70. GLSoundLibrary.Samples.AddFile('chimes.wav', 'chimes.wav');
  71. GLSoundLibrary.Samples.AddFile('howl.mp3', 'howl.mp3');
  72. end;
  73. procedure TFormSoundWaveout.SphereProgress(Sender: TObject;
  74. const deltaTime, newTime: Double);
  75. var
  76. alpha: Single;
  77. begin
  78. // Move the red sphere (sound source) along an elliptic path
  79. alpha := 60 * DegToRad(newTime);
  80. TGLSphere(Sender).Position.SetPoint(sin(alpha) * 2, 0.5, cos(alpha) * 5);
  81. end;
  82. procedure TFormSoundWaveout.TrackBarChange(Sender: TObject);
  83. begin
  84. // Rotate the listener around the vertical axis
  85. DummyCube.TurnAngle := TrackBar.Position;
  86. Application.ProcessMessages;
  87. end;
  88. procedure TFormSoundWaveout.TrackBar1Change(Sender: TObject);
  89. begin
  90. // Move the listener forward/back
  91. Mickey.Position.Z := TrackBar1.Position / 10;
  92. Application.ProcessMessages;
  93. end;
  94. procedure TFormSoundWaveout.TimerTimer(Sender: TObject);
  95. var
  96. mngName: String;
  97. begin
  98. // some stats
  99. if ActiveSoundManager is TGLSMWaveOut then
  100. mngName := 'WaveOut'
  101. else
  102. mngName := '';
  103. if ActiveSoundManager <> nil then
  104. LabelFPS.Caption := Format('%.2f FPS, %s CPU use : %.2f%%',
  105. [GLSceneViewer.FramesPerSecond, mngName,
  106. ActiveSoundManager.CPUUsagePercent])
  107. else
  108. LabelFPS.Caption := 'No active sound manager.';
  109. GLSceneViewer.ResetPerformanceMonitor;
  110. end;
  111. procedure TFormSoundWaveout.Button1Click(Sender: TObject);
  112. begin
  113. with TGLBSoundEmitter.Create(Sphere.Behaviours) do
  114. begin
  115. Source.SoundLibrary := GLSoundLibrary;
  116. Source.SoundName := 'chimes.wav';
  117. Playing := True;
  118. end;
  119. end;
  120. procedure TFormSoundWaveout.btnHowlClick(Sender: TObject);
  121. begin
  122. with TGLBSoundEmitter.Create(Sphere.Behaviours) do
  123. begin
  124. Source.SoundLibrary := GLSoundLibrary;
  125. Source.SoundName := 'howl.mp3';
  126. Playing := True;
  127. end;
  128. end;
  129. end.