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.