home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d123456 / SIMONS.ZIP / Units / SRWave.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-10-11  |  3.6 KB  |  156 lines
  1. unit SRWave;
  2.  
  3. { TSRWavePlayer - Komponente (C)opyright 2000   Version 1.02
  4.   Autor : Simon Reinhardt
  5.   eMail : reinhardt@picsoft.de
  6.   Internet : http://www.picsoft.de
  7.  
  8.   Die Komponente TSRWavePlayer kapselt die Methoden PlaySound (32Bit)
  9.   bzw. sndPlaySound (16Bit) der Windows-API zur Wiedergabe von Wave-Sounds.
  10.  
  11.   Diese Komponente ist Public Domain, das Urheberrecht liegt aber beim Autor.
  12.   Fragen und VerbesserungsvorschlĪ£ge sind immer willkommen. }
  13.  
  14. interface
  15.  
  16. {$I SRDefine.inc}
  17.  
  18. uses
  19.   {$IFDEF SR_Win32} Windows, {$ELSE} WinTypes, WinProcs, SysUtils, {$ENDIF}
  20.   Classes, Graphics, Controls, Forms, MMSystem;
  21.  
  22. type
  23.   TWaveLocation = (wlFile, wlResource, wlRAM);
  24.  
  25.   TSRWavePlayer = class(TComponent)
  26.   private
  27.     FAsync,
  28.     FLoop         : boolean;
  29.     FWaveName     : string;
  30.     FWavePointer  : pointer;
  31.     FWaveLocation : TWaveLocation;
  32.  
  33.     FBeforePlay,
  34.     FAfterPlay    : TNotifyEvent;
  35.  
  36.     procedure SetAfterPlay(Value: TNotifyEvent);
  37.     procedure SetAsync(Value: boolean);
  38.     procedure SetBeforePlay(Value: TNotifyEvent);
  39.     procedure SetLoop(Value: boolean);
  40.  
  41.   public
  42.     property WavePointer: pointer read fWavePointer write fWavePointer;
  43.     function Play: boolean;
  44.     procedure Stop;
  45.  
  46.   published
  47.     property Async: boolean read FAsync write SetAsync;
  48.     property Loop: boolean read FLoop write SetLoop;
  49.     {$IFDEF SR_Delphi2_Up}
  50.     property WaveLocation: TWaveLocation read FWaveLocation write fWaveLocation default wlFile;
  51.     {$ENDIF}
  52.     property WaveName: string read FWaveName write FWaveName;
  53.     property BeforePlay: TNotifyEvent read FBeforePlay write SetBeforePlay;
  54.     property AfterPlay: TNotifyEvent read FAfterPlay write SetAfterPlay;
  55.  
  56.   end;
  57.  
  58. procedure Register;
  59.  
  60. implementation
  61.  
  62. {$IFDEF SR_Delphi2_Up}
  63. {$R *.D32}
  64. {$ELSE}
  65. {$R *.D16}
  66. {$ENDIF}
  67.  
  68. procedure TSRWavePlayer.SetAfterPlay(Value: TNotifyEvent);
  69. begin
  70.   FAfterPlay:=Value;
  71. end;
  72.  
  73. procedure TSRWavePlayer.SetAsync(Value: boolean);
  74. begin
  75.   FAsync:=Value;
  76.   if not FAsync then
  77.     FLoop:=false;
  78. end;
  79.  
  80. procedure TSRWavePlayer.SetBeforePlay(Value: TNotifyEvent);
  81. begin
  82.   FBeforePlay:=Value;
  83. end;
  84.  
  85. procedure TSRWavePlayer.SetLoop(Value: boolean);
  86. begin
  87.   if (FLoop<>Value) and FAsync then
  88.     FLoop:=Value;
  89. end;
  90.  
  91. function TSRWavePlayer.Play;
  92. {$IFDEF SR_Delphi2_Up}
  93. var Flags     : DWORD;
  94. {$ELSE}
  95. var Flags     : WORD;
  96.     PWaveName : PChar;
  97. {$ENDIF}
  98. begin
  99.   if Assigned(FBeforePlay) then
  100.     FBeforePlay(Self);
  101.   {$IFDEF SR_Delphi2_Up}
  102.     case FWaveLocation of
  103.       wlFile     : Flags:=SND_FILENAME;
  104.       wlResource : Flags:=SND_RESOURCE;
  105.       else         Flags:=SND_MEMORY;
  106.     end;
  107.   {$ELSE}
  108.   Flags := 0;
  109.   {$ENDIF}
  110.   if FLoop then
  111.     Flags:=Flags or SND_LOOP;
  112.   if FAsync then
  113.     Flags:=Flags or SND_ASYNC
  114.   else
  115.     Flags:=Flags or SND_SYNC;
  116.   {$IFDEF SR_Delphi2_Up}
  117.   if FWaveLocation = wlRAM then
  118.     Result:=PlaySound(FWavePointer, 0, Flags)
  119.   else
  120.     Result:=PlaySound(PChar(FWaveName), HInstance, Flags);
  121.   {$ELSE}
  122.   PWaveName:=StrAlloc(255);
  123.   StrPCopy(PWaveName, FWaveName);
  124.   Result:=sndPlaySound(PWaveName, Flags);
  125.   StrDispose(PWaveName);
  126.   {$ENDIF}
  127.   if Assigned(FAfterPlay) then
  128.     FAfterPlay(Self);
  129. end;
  130.  
  131. procedure TSRWavePlayer.Stop;
  132. {$IFDEF SR_Delphi2_Up}
  133. var Flags : DWORD;
  134. {$ELSE}
  135. var Flags : WORD;
  136. {$ENDIF}
  137. begin
  138.   {$IFDEF SR_Delphi2_Up}
  139.   case FWaveLocation of
  140.     wlFile     : Flags:=SND_FILENAME;
  141.     wlResource : Flags:=SND_RESOURCE;
  142.     else         Flags:=SND_MEMORY;
  143.   end;
  144.   PlaySound(nil, 0, Flags);
  145.   {$ELSE}
  146.   sndPlaySound(nil, 0);
  147.   {$ENDIF}
  148. end;
  149.  
  150. procedure Register;
  151. begin
  152.   RegisterComponents('Simon', [TSRWavePlayer]);
  153. end;
  154.  
  155. end.
  156.