请教VCL高手，PlaySound如何延时，防止假死

Question

我在delphi中调用MMSystem Unit 下的 playSound函数来播放声音文件
通过循环来读出数字，例如12.5，连续播放内容为“壹”、“拾”、“贰”、“点”，“伍"，五个声音文件，
但需要在播放每个声音文件后延时，否则就只能听到最后一个声音文件的内容，
我使用的是sleep()函数来延时
但问题是，使用sleep后，程序在播放声音文件时，会出现假死现象，即软件暂时对用户的操作没有反应，即使调用TTread对象使用了多线程也是不行。
请教大家该如何处理这个问题。
谢谢！

Answer 1

异步改成同步
另外，sleep最好不要用，会阻塞线程。

Answer 2

playSound应该有参数吧，也就是阻塞模式，让声音播放完了再返回的那种

Answer 3

是啊，如楼上所说，用阻塞模式，将播放代码放到一线程中，再制造一个播放队列，很是好用给你一段粗陋的代码使用方法：Create 一个 TSoundQueue 对像，指定CurrentPath: 位置调用 TSoundQueue.PlaySound 就行了如 S123;  则发声 一 二 三
   T123;  则发声 一百二十三小数点没做，有兴趣自已加上去
unit SoundU;interface
uses
  Classes,SysUtils,Windows,Mmsystem,Forms;
type
 TLanguage = (lgChinese,lgGuangDong,lgDouble);
 TSoundQueue = class(TThread)
  private
    FLanguage: TLanguage;  //发声类型： 普通话、广州话、普通话+广州话
    FQueue: TStringList;
    FEnable: Boolean;  //是否允许发声
    FSoundDir: String;
    FCurrentPath: String;
  protected
    procedure Execute; override;
    procedure Play(sCMD: String);
  public
    constructor Create;
    destructor Destroy;override;
    procedure Append(SoundStr:String);  //在发声队列中增加一发命令串
    procedure Clear;                    //清除发声队列
    function Count: Integer;            //发声队列中未处理记录
    property Enable: Boolean read FEnable write FEnable;      //是否需要发音
    property CurrentPath: String read FCurrentPath write FCurrentPath;  //默认路径
    property Language: TLanguage read FLanguage write FLanguage;       //发音方式
  end;implementation
{ TSoundQueue }procedure TSoundQueue.Append(SoundStr: String);
begin
  if (Trim(SoundStr) <> '') AND FEnable then
  FQueue.Append(SoundStr);
  Resume;
end;procedure TSoundQueue.Clear;
begin
  FQueue.Clear;
end;function TSoundQueue.Count: Integer;
begin
  Result := FQueue.Count;
end;constructor TSoundQueue.Create;
begin
  FQueue := TStringList.Create;
  FEnable := True;
  FCurrentPath := ExtractFilePath(Application.ExeName);
  inherited Create(True);
end;destructor TSoundQueue.Destroy;
begin
  FQueue.Free;
  inherited;
end;procedure TSoundQueue.Execute;
var
  sSoundCMD: String;
begin
  while Not Terminated do
  begin
     if  FQueue.Count > 0 then         //如果有发声队列
     begin
       try
         sSoundCMD := FQueue.Strings[0];   //从队首部取发声指令字串
         FQueue.Delete(0);
       finally
       end;
     end
     else
     sSoundCMD := '';
     try
      case FLanguage of
        lgChinese:                 //普通话发音
            begin
              FSoundDir := 'Sound1';
              if FEnable then
              Play(sSoundCMD);
            end;
        lgGuangDong:              //广州话发音
            begin
              FSoundDir := 'Sound2';
              if FEnable then
              Play(sSoundCMD);
            end;
        lgDouble:                //普通话 + 广州话 发音
           begin
              FSoundDir := 'Sound1';
              if FEnable then
              Play(sSoundCMD);
              FSoundDir := 'Sound2';
              if FEnable then
              Play(sSoundCMD);
            end;
      end;
  except
   // WriteErrorLog('发声过程错');
  end;{End try}
    if FQueue.Count <= 0 then
    Suspend;                      //无发声队列挂起
  end;{End while}
end;
procedure TSoundQueue.Play(sCMD: String);
var
  sSoundPath: String;
  ii: integer;
  s1,s2: string;  procedure ExecCMD(OneAction: String);  //解析发声批令字串
  const
    sSound = '  十百千万十百千亿十百千万亿';
  var
    s3,s4: String;
    lp1,lp2: integer;
  begin
    if OneAction = '' then  Exit;
    try
    case OneAction[1] of
    'L','l':    //指定以应用程序主目录为起始 的wav文件相对路径 该路径在本指令串内生效 :Loaction
      begin
        FSoundDir := Trim(Copy(OneAction,2,MAXWORD));
        sSoundPath := FCurrentPath + FSoundDir;
      end;
    'V','v':   //播放sSoundPath目录指定wav文件  :Voice
      begin
        if Length(Trim(OneAction)) = 1 then Exit;
        s3 := sSoundPath + '\' + Trim(Copy(OneAction,2,MAXWORD)) + '.wav';
        PlaySound(Pchar(s3),0,SND_FILENAME + SND_SYNC);
      end;
    'S','s':  //播放指定数字串单字发音不带单位  :String
      begin
        s4 := '';
        s3 := Trim(Copy(OneAction,2,MAXWORD));
        for lp1 := 1 to Length(s3) do
        s4 := s4 + 'V' + s3[lp1] + ';' ;
        Play(s4);
      end;
    'M','m':
       case OneAction[2] of
         '1':  ;
         '2':  ;
         '3':  ;
       end;
    'T','t':  //播放指定整数 带单位 -- 部分效果有待完善  :Talk
      begin
        s3 := Trim(Copy(OneAction,2,MAXWORD));
        if s3 = '' then Exit;
        if StrToInt(s3) <> 0 then
        if (StrToInt(s3) >= 10) And (StrToInt(s3) < 20) then //解决发十号音问题
        begin
          s4 := s4 + 'V十;V';
          if s3[2] <> '0' then s4 := s4 + s3[2] + ';';
        end
        else
        begin
          lp2 := Length(s3);
          for lp1 := Length(s3) downto 1 do
          if s3[lp1] = '0' then
            s3[lp1] := #$20
          else
            Break;
          for lp1 := 1  to Length(s3) do
          begin
          if (s3[lp1] = '0') or (s3[lp1] = #$20) then
            s4 := s4 + 'V' + s3[lp1] + ';'
          else
            s4 := s4 + 'V' + s3[lp1] + ';V' + sSound[lp2*2 - 1] + sSound[lp2*2] + ';';
          lp2 := lp2 - 1;
          end;{End for}
       end{End if then}
       else s4 := 'V0';
        Play(s4);
      end;
    end;{End Case}
    except
    //  Raise;
    end;{End try}
  end;
begin
  sSoundPath := FCurrentPath + FSoundDir;
  s1 := Trim(sCMD);
  ii := Pos(';',s1);
  while ii <> 0 do
  begin
    s2 := Trim(Copy(s1,1,ii-1));
    ExecCMD(s2);
    s1 := Trim(Copy(s1,ii+1,MAXWORD-1));
    ii := Pos(';',s1);
  end;
  if s1 <> '' then ExecCMD(s1);
end;
end.

Answer 4

MCI资源好像是独占的，用多线程也不行

Answer 5

使用如下调用方法后，可以等待前面的文件播放完毕后再开始播放后面的文件，达到连续播放的效果
playSound(pchar(strFileName),0,SND_FILENAME + SND_SYNC);
但，在播放时，资源被独占了，鼠标点击其它菜单是没有反应

Answer 6

塞到线程里面呢？
如这样：
function ThreadProc(Param: Pointer): Integer;
begin
  PlaySound(PChar(strFileName), 0, SND_FILENAME + SND_SYNC);
end;procedure TForm1.FormCreate(Sender: TObject);
var
  ThreadId: Cardinal;
begin
  BeginThread(nil, 0, ThreadProc, 0, 0, ThreadId);
end;