Delphi播放声音文件类（包括调整其中任意一个声音的大小）

自行封装的播放声音类文件 TSoundPlayer , 用MCI播放的。

但是TSoundPlayer类无法提供针对每个声音的大小调节，比如一个背景音乐，一个前景音乐。

为此，我安装了MMTools2.0，在窗体上放上MidiPlayBg:TMMDSMidiChannel控件和TMMDSWaveMixer控件，

并且进行关联，就可以调用TMMDSMidiChannel.Volume来设置音量了MidiPlayBg.Volume := -1500; 在这里，

我的背景音乐是Midi文件。

MMTools官方网站为：http://www.swiftsoft.de/

类文件：

{ 播放声音; 有相对目录; 可以播放列表; 可以循环播放 }
unit SoundPlayer;

interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Controls,Graphics, MPlayer;

type
// 播放方式( sptPlayAll - 全部播放一遍; sptLoopAll - 全部循环播放)
TSoundPlayType = (sptPlayAll, sptLoopAll);

TSoundPlayer = class(TMediaPlayer)
private
FBaseDir: string; // 基本路径一定以 /结束
FPlayFileList: TStringList; // 相对 FBaseDir的路径
FPlayType: TSoundPlayType; // 播放方式
FCurPlayIndex: integer; // 当前播放的文件 -1表示没有

procedure SetBaseDir(const Value: string);
procedure SetFileList(const Value: TStringList);
procedure SetPlayType(const Value: TSoundPlayType);
procedure MPOnNotify(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

// AddFile - 添加一个文件
// SetFile - 修改指定位置文件
// ClearFile - 清空文件列表
procedure AddFile(const vFileName: string);
procedure SetFile(const vIndex: integer; const vFileName: string);
procedure ClearFile;

// 播放单个文件
procedure AddSingleFile(const AFileName: string);

// 开始和结束播放
procedure StartPlay;
procedure StopPlay;

property BaseDir: string read FBaseDir write SetBaseDir;
property PlayFileList: TStringList read FPlayFileList write SetFileList;
property PlayType: TSoundPlayType read FPlayType write SetPlayType;
end;

implementation

{ TSoundPlayer }

procedure TSoundPlayer.AddFile(const vFileName: string);
var
vFile: string;
begin
//如果不用System, 会冲突
if System.Length(vFileName) = 0 then
exit;
vFile := FBaseDir + vFileName;
if not FileExists(vFile) then
exit;
FPlayFileList.Add(vFileName);
end;

procedure TSoundPlayer.ClearFile;
begin
StopPlay;
FPlayFileList.Clear;
end;

constructor TSoundPlayer.Create(AOwner: TComponent);
begin
inherited;
AutoOpen := false;
DeviceType := dtAutoSelect;
Notify := False; //如果 Notify=true, Open也通知成功
OnNotify := MPOnNotify;
Visible := false;
Height := 0;
Width := 0;

FBaseDir := '';
FPlayFileList := TStringList.Create;
FPlayFileList.Clear;
FPlayType := sptPlayAll;
FCurPlayIndex := -1;
end;

destructor TSoundPlayer.Destroy;
begin
StopPlay;
if Assigned(FPlayFileList) then
FreeAndNil(FPlayFileList);
inherited;
end;

procedure TSoundPlayer.MPOnNotify(Sender: TObject);
begin
//播放完毕
if NotifyValue = nvSuccessful then
begin

//没有开始则退出
if FCurPlayIndex < 0 then
Exit;

case FPlayType of
sptPlayAll:
begin
Inc(FCurPlayIndex);

//如果播放完毕
if FCurPlayIndex >= FPlayFileList.Count then begin
StopPlay;
Exit;
end;
end;
sptLoopAll:
begin
Inc(FCurPlayIndex);

if FCurPlayIndex >= FPlayFileList.Count then
begin
FCurPlayIndex := 0;
//如果列表已经清空
if FPlayFileList.Count = 0 then
begin
StopPlay;
Exit;
end;
end;
end;
end;

//开始下一个
FileName := FBaseDir + FPlayFileList.Strings[FCurPlayIndex];
try Open; except StopPlay; end;
Play;
end;
end;

procedure TSoundPlayer.SetBaseDir(const Value: string);
var
Len: integer;
begin
if FBaseDir = Value then
exit;
if not DirectoryExists(Value) then
exit;
StopPlay;
FBaseDir := Value;
Len := System.Length(FBaseDir);
if FBaseDir[Len] <> '/' then
FBaseDir := FBaseDir + '/';
end;

procedure TSoundPlayer.SetFile(const vIndex: integer;
const vFileName: string);
begin
if vIndex < 0 then
exit;
if vIndex >= FPlayFileList.Count then
exit;
if not FileExists(FBaseDir + vFileName) then
exit;
if FPlayFileList.Strings[vIndex] = vFileName then
exit;
StopPlay;
FPlayFileList.Strings[vIndex] := vFileName;
end;

procedure TSoundPlayer.SetFileList(const Value: TStringList);
begin
if not Assigned(Value) then
exit;
StopPlay;
FPlayFileList.Clear;
FPlayFileList.Assign(Value);
end;

procedure TSoundPlayer.SetPlayType(const Value: TSoundPlayType);
begin
if FPlayType = Value then
exit;
StopPlay;
FPlayType := Value;
end;

procedure TSoundPlayer.AddSingleFile(const AFileName: string);
begin
if System.Length(AFileName) = 0 then
Exit;

ClearFile;
AddFile(AFileName);
end;

procedure TSoundPlayer.StartPlay;
begin
if not DirectoryExists(FBaseDir) then
Exit;

if FPlayFileList.Count < 1 then
Exit;

StopPlay;

FCurPlayIndex := 0;
FileName := FBaseDir + FPlayFileList.Strings[FCurPlayIndex];
try
Open;
except
StopPlay;
end;

Play;
end;

procedure TSoundPlayer.StopPlay;
begin
case Self.Mode of
mpPlaying: begin
Stop;
Close;
end;
mpRecording: begin
Stop;
Close;
end;
mpSeeking: begin
Stop;
Close;
end;
mpOpen: begin
Close;
end;
end;
FCurPlayIndex := -1;
end;

end.