在 delphi10 中使用 SAPI TTS 时语音播放冻结

Question

我正在尝试创建一个简单的应用程序来使用 Delphi10 处理接收到的 BLE 数据： -Win10 -德尔福11 -从“onecore”目录导入SAPI（我只在这个目录下找到中文引擎）

代码很简单：

unit unitTTS;

interface
uses
  SpeechLib_TLB,
  globalDefinitions,
  System.Generics.Collections, System.Generics.Defaults,
  FMX.Dialogs,
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants;


type
  SPEAKFLAGS = (
    //--- SpVoice flags
    SPF_DEFAULT,
    SPF_ASYNC,
    SPF_PURGEBEFORESPEAK,
    SPF_IS_FILENAME,
    SPF_IS_XML,
    SPF_IS_NOT_XML,
    SPF_PERSIST_XML,

    //--- Normalizer flags
    SPF_NLP_SPEAK_PUNC,

    //--- TTS Format
    SPF_PARSE_SAPI,
    SPF_PARSE_SSML,
    SPF_PARSE_AUTODETECT,

    //--- Masks
    SPF_NLP_MASK,
    SPF_PARSE_MASK,
    SPF_VOICE_MASK,
    SPF_UNUSED_FLAGS
  );

  TextFlags=(
    TXTF_SCORE,
    TXTF_TIMEOUT,
    TXTF_OTHER
  );

  TmyTTS = class
    private
      FSpVoice:TSpVoice;

      function initCNSpeech(AOwner: TComponent):Boolean;
    public
      constructor Create(AOwner: TComponent);
      destructor Destroy;override;

      procedure speak(s:string;txtf:TextFlags);
      procedure SetRate(v:integer);
      procedure SetVolume(v:integer);
  end;

var
  tts : TmyTTS;

implementation


procedure TmyTTS.speak(s:string;txtf:TextFlags);
var
  flags:LongWord;
  cb:LongWord;
  pStatus: SPVOICESTATUS;
  ppszLastBookmark: PWideChar;
begin
  //exit;

  if FSpVoice = NIL then exit;
  if length(trim(s))=0 then exit;

  FSpVoice.GetStatus(pStatus,ppszLastBookmark);
  if pStatus.dwRunningState = 2 then
    case txtf of
      TXTF_SCORE:   FSpVoice.Speak('',2,cb);
      TXTF_TIMEOUT: exit;
      TXTF_OTHER:   exit;
    end;

  flags := LongWord(SPF_ASYNC);
  cb := 0;
  //不能使用@s，因为下标从1开始，0位置存储字符串长度，必须明确标出开始位置
  FSpVoice.Speak(@s[1],flags,cb);
end;


constructor TmyTTS.Create(AOwner: TComponent);
begin
  Inherited Create;
  initCNSpeech(AOwner);
end;

destructor TmyTTS.Destroy;
begin
  FreeAndNIL(FSpVoice);
  Inherited;
end;

procedure TmyTTS.SetRate(v:integer);
begin
  if FSpVoice = NIL then exit;
  FSpVoice.SetRate(v);
end;

procedure TmyTTS.SetVolume(v:integer);
begin
  if FSpVoice = NIL then exit;
  FSpVoice.SetVolume(v);
end;

function TmyTTS.initCNSpeech(AOwner: TComponent):Boolean;
var
  cnt:longword ;
  tok : ISpObjectToken;
  toks:IEnumSpObjectTokens;
  ppTokenCategory: ISpObjectTokenCategory;
begin
  Result := false;
  FSpVoice := TSpVoice.Create(AOwner);

  FSpVoice.GetVoice(&tok);
  tok.GetCategory(&ppTokenCategory);
  ppTokenCategory.EnumTokens('language=804',nil,&toks);
  toks.GetCount(cnt);
  if cnt=0 then
  begin
    showmessage('没有中文语音生成引擎.');
    FSpVoice.Free;
    exit;
  end;
  toks.Item(0,tok);
  FSpVoice.SetVoice(tok);

  result := true;
end;

end.

调用起来也很简单：

tts.speak(s,TXTF_SCORE);

我遇到的问题是：

1. 语音播放卡顿，尤其是操作系统负载较高时； 我认为根本原因是应用程序进程的优先级，它有时会被其他工作负载中断。但我们知道其他应用程序可以保持语音播放流畅，例如音乐播放器。正确的做法是什么？
2. 无法改变语速； 它不起作用：

   tts.SetRate(trunc(TTrackBar(Sender).Value));

   但我可以用 OS GUI 更改它，它会反映在播放中。
   我不知道这是否是因为“onecore”版本的原因。 感谢您的建议。

我尝试在线程中启动speack()，但没有帮助。

Answer 1

原因应该是异步模式设置的优先级太低。 我创建了一个最高优先级的不间断线程，它也可以顺利完成播放（不如同步模式）。 这是代码：

  TSpeechThread = class(TThread)
  private
    procedure delFirstString;
  protected
    procedure Execute; override;
  public
    constructor Create;
  end;
    
constructor TSpeechThread.Create;
begin
  Inherited Create(True);
  Priority:=tpTimeCritical;
  FreeOnTerminate:=false;
end;

procedure TSpeechThread.delFirstString;
begin
  if tts.FStrings.Count>0 then
    tts.FStrings.Delete(0);
end;

procedure TSpeechThread.Execute;
begin
  while(true) do
  if not Terminated  then
    begin
      if tts.FStrings<>NIL then
      begin
        if tts.FStrings.Count>0 then
          begin
            tts.speak(tts.FStrings[0],TXTF_SCORE);
            synchronize(delFirstString);
          end
        else
          suspend;
      end;
    end
  else
    break;
end;

合作代码：

procedure TmyTTS.addSentence(s:string);
begin
  FStrings.Add(s);
  if (speechThread<>NIL) then
    if speechThread.Suspended then
      speechThread.Resume;
end;

但是，我仍然无法改变语速。 欢迎任何建议。