1 | unit Sound;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, MMSystem;
|
---|
7 |
|
---|
8 | function PrepareSound(FileName: string): integer;
|
---|
9 | procedure PlaySound(FileName: string);
|
---|
10 |
|
---|
11 | type
|
---|
12 | TSoundPlayer = class(TForm)
|
---|
13 | private
|
---|
14 | procedure OnMCI(var m: TMessage); message MM_MCINOTIFY;
|
---|
15 | end;
|
---|
16 |
|
---|
17 | implementation
|
---|
18 |
|
---|
19 | {$R *.DFM}
|
---|
20 |
|
---|
21 | type
|
---|
22 | TSound = class
|
---|
23 | public
|
---|
24 | FDeviceID: word;
|
---|
25 | FFileName: string;
|
---|
26 | constructor Create(const FileName: string);
|
---|
27 | destructor Destroy; override;
|
---|
28 | procedure Play(HWND: DWORD);
|
---|
29 | procedure Stop;
|
---|
30 | procedure Reset;
|
---|
31 | end;
|
---|
32 |
|
---|
33 | constructor TSound.Create(const FileName: string);
|
---|
34 | var
|
---|
35 | OpenParm: TMCI_Open_Parms;
|
---|
36 | begin
|
---|
37 | FDeviceID := 0;
|
---|
38 | FFileName := FileName;
|
---|
39 | if FileExists(FFileName) then
|
---|
40 | begin
|
---|
41 | OpenParm.dwCallback := 0;
|
---|
42 | OpenParm.lpstrDeviceType := 'WaveAudio';
|
---|
43 | OpenParm.lpstrElementName := PChar(FFileName);
|
---|
44 | mciSendCommand(0, MCI_Open, MCI_WAIT or MCI_OPEN_ELEMENT or
|
---|
45 | MCI_OPEN_SHAREABLE, integer(@OpenParm));
|
---|
46 | FDeviceID := OpenParm.wDeviceID;
|
---|
47 | end
|
---|
48 | end;
|
---|
49 |
|
---|
50 | destructor TSound.Destroy;
|
---|
51 | begin
|
---|
52 | if FDeviceID <> 0 then
|
---|
53 | mciSendCommand(FDeviceID, MCI_CLOSE, MCI_WAIT, 0);
|
---|
54 | inherited Destroy;
|
---|
55 | end;
|
---|
56 |
|
---|
57 | procedure TSound.Play(HWND: DWORD);
|
---|
58 | var
|
---|
59 | PlayParm: TMCI_Play_Parms;
|
---|
60 | begin
|
---|
61 | if FDeviceID <> 0 then
|
---|
62 | begin
|
---|
63 | PlayParm.dwCallback := HWND;
|
---|
64 | mciSendCommand(FDeviceID, MCI_PLAY, MCI_NOTIFY, integer(@PlayParm));
|
---|
65 | end
|
---|
66 | end;
|
---|
67 |
|
---|
68 | procedure TSound.Stop;
|
---|
69 | begin
|
---|
70 | mciSendCommand(FDeviceID, MCI_STOP, 0, 0);
|
---|
71 | end;
|
---|
72 |
|
---|
73 | procedure TSound.Reset;
|
---|
74 | begin
|
---|
75 | mciSendCommand(FDeviceID, MCI_SEEK, MCI_SEEK_TO_START, 0);
|
---|
76 | end;
|
---|
77 |
|
---|
78 | type
|
---|
79 | TSoundList = array [0 .. 99999] of TSound;
|
---|
80 |
|
---|
81 | var
|
---|
82 | nSoundList: integer;
|
---|
83 | SoundPlayer: TSoundPlayer;
|
---|
84 | SoundList: ^TSoundList;
|
---|
85 | PlayingSound: TSound;
|
---|
86 |
|
---|
87 | procedure TSoundPlayer.OnMCI(var m: TMessage);
|
---|
88 | begin
|
---|
89 | if (m.wParam = MCI_Notify_Successful) and (PlayingSound <> nil) then
|
---|
90 | begin
|
---|
91 | PlayingSound.Reset;
|
---|
92 | PlayingSound := nil;
|
---|
93 | end;
|
---|
94 | end;
|
---|
95 |
|
---|
96 | function PrepareSound(FileName: string): integer;
|
---|
97 | begin
|
---|
98 | for result := 1 to Length(FileName) do
|
---|
99 | FileName[result] := upcase(FileName[result]);
|
---|
100 | result := 0;
|
---|
101 | while (result < nSoundList) and (SoundList[result].FFileName <> FileName) do
|
---|
102 | inc(result);
|
---|
103 | if result = nSoundList then
|
---|
104 | begin // first time this sound is played
|
---|
105 | if nSoundList = 0 then
|
---|
106 | ReallocMem(SoundList, 16 * 4)
|
---|
107 | else if (nSoundList >= 16) and (nSoundList and (nSoundList - 1) = 0) then
|
---|
108 | ReallocMem(SoundList, nSoundList * (2 * 4));
|
---|
109 | inc(nSoundList);
|
---|
110 | SoundList[result] := TSound.Create(FileName);
|
---|
111 | end;
|
---|
112 | end;
|
---|
113 |
|
---|
114 | procedure PlaySound(FileName: string);
|
---|
115 | begin
|
---|
116 | if PlayingSound <> nil then
|
---|
117 | exit;
|
---|
118 | if SoundPlayer = nil then
|
---|
119 | Application.CreateForm(TSoundPlayer, SoundPlayer);
|
---|
120 | PlayingSound := SoundList[PrepareSound(FileName)];
|
---|
121 | if PlayingSound.FDeviceID = 0 then
|
---|
122 | PlayingSound := nil
|
---|
123 | else
|
---|
124 | PlayingSound.Play(SoundPlayer.Handle);
|
---|
125 | end;
|
---|
126 |
|
---|
127 | var
|
---|
128 | i: integer;
|
---|
129 |
|
---|
130 | initialization
|
---|
131 |
|
---|
132 | nSoundList := 0;
|
---|
133 | SoundList := nil;
|
---|
134 | PlayingSound := nil;
|
---|
135 | SoundPlayer := nil;
|
---|
136 |
|
---|
137 | finalization
|
---|
138 |
|
---|
139 | if PlayingSound <> nil then
|
---|
140 | begin
|
---|
141 | PlayingSound.Stop;
|
---|
142 | Sleep(222);
|
---|
143 | end;
|
---|
144 | for i := 0 to nSoundList - 1 do
|
---|
145 | SoundList[i].Free;
|
---|
146 | ReallocMem(SoundList, 0);
|
---|
147 |
|
---|
148 | end.
|
---|