Обработка уведомлений и синтез речи в аудиофайл

Для более полной информации и глубокого понимания данного вопроса советую преобрести мою книгу «MS Agent и Speech API в Delphi», которая вышла в 2005 году в издательстве БХВ-Петербург. Теме Speech API посвещена отдельная ее глава (более 120 стр).
Если этой книги нет в магазинах вашего города, то ее можно заказать на сайте http://books.ru для получения по почте наложенным платежом.

Краткие основы:

Speech API имеет несколько уровней интерфейсов.

1. Voice Commnad API, Voice Dictation API, Voice Text API

2. Shared Object

3. DirectSpeechRecognition API, DirectTextToSpeech API

4. Audio Object

Интерфейсы самого верхнего уровня (наиболее простые) — 1. Данные интерфейсы предоставляют несколько ограниченный уровень доступа к речевым модулям. Зато интерфейсы управления у них намного проще, чем у интерфейсов низкого уровня(3).

Несмотря на то, что DirectTextToSpeech является более низким интерфейсом прикладного программирования, прямой синтез речи (Text-To-Speech) ничуть не сложнее, чем VoiceText API. Даже наоборот, именно API обладает большей гибкостью, скоростью и, следовательно, мощными возможностями.

DirectTextToSpeech иначе называется интерфейсом прямого синтеза речи, так как при его использовании приходится все делать руками, в том числе устанавливать соединение с аудиоустройством, производить поиск и выбор необходимого речевого модуля в системе и т. д. Например, в случае с VoiceText нам не нужно специально инициализировать звуковое устройство, в которое должны записываться волновые данные. В Direct TextToSpeech все не так. Здесь потребуется познакомиться с рядом объектов из Audio Objects и объектами для работы с движками.

DirectTextToSpeech иначе называется интерфейсом прямого синтеза речи, так как при его использовании приходится все делать руками, в том числе устанавливать соединение с аудиоустройством, производить поиск и выбор необходимого речевого модуля в системе и т. д. Например, в случае с VoiceText нам не нужно специально инициализировать звуковое устройство, в которое должны записываться волновые данные. В Direct TextToSpeech все не так. Здесь потребуется познакомиться с рядом объектов из Audio Objects и объектами для работы с движками.

В SAPI имеется ряд базовых аудио объектов для обращения и отправления звуковых данных на аудиоустройство. Причем под аудиоустройством здесь понимается не только физическое устройство в виде звуковой карты, а еще и волновой файл.

  • DirectSound Audio Destination
  • Multimedia Audio Destination
  • File Audio Destination

Объект DirectSound Audio Destination самый быстрый, так как посылает всё аудио на растерзание DirectSound API из DirectX. Как следствие этот объект можно(и нужно, если понадобится синтез речи) использовать только в играх, включающих голосовые технологии. Для обычных приложений по удобству и привычности лучше всего подойдет объект Multimedia Audio Destination. Если синтез речи должен осуществляться в звуковой файл, то следует использовать File Audio Destination.

Из имеющихся сведений вполне может обозначиться алгоритм работы. Схема достижения синтеза речи через Direct TextToSpeech API такова:
1. Осуществить подключение с аудиоустройству через один из возможных интерфейсов. При необходимости выбрать нужное устройство. Если требуется, то получить указатели на дополнительные интерфейсы;
2. Произвести выбор речевого модуля. Обычно по причине нашего Windows-интерфейса на этом этапе происходит поиск всех установленных модулей(синтезаторов), но выбор остается за пользователем, ему все-таки виднее;
3. После того, как пользователь выбрал модуль или вы программно определились какой из TTS-генераторов будет использоваться для синтеза речи, то данный режим нужно применить, при этом возвращается указатель на центральный интерфейс Engine Object;
4. Затем по усмотрению регистрируется объект, реализующий ITTSNotifySink, который будет получать уведомления о ходе синтеза речи;
5. Наконец, в нужный момент передается буфер текста в очередь на синтез и указатель на объект, получающий уведомления ITTSBufNotifySink;

Обработка уведомлений(Notification Sink)

Синтез речи на звуковую карту описан в предыдущей статье «Speech API в Delphi». Во многих случаях, если не во всех, желательно указывать какое место текста читает программа. Для этого и некоторых других функциий необходимо использовать интерфейсы обработки уведомлений Notification Sink.
Engine Object поддерживает два интерфейса уведомлений —ITTSNotifySink и ITTSBufNotifySink, первый посылает уведомления о состоянии чтения, второй — о состоянии буфера чтения. Для получения уведомлений DirectTextToSpeech нужно создать объект, реализующий данный интерфейс. Объект, реализующий интерфейс ITTSBufNotifySink, не нужно регистрировать через специальный метод, интерфейс этих уведомлений не меняется при смене устройства назначения аудио данных. Поэтому-то все извещения разнесены по нескольким интерфейсам.
Для обработки уведомлений необходимо создать специальный класс, реализующий интерфейс ITTSBufNotifySink, в классе реализовать необходимые методы. Ссылку на экземпляр класса передать в интерфейс TTSCentral.

type
TTSBufNotifySink = class(TInterfacedObject, ITTSBufNotifySink)
end;
var
fTTSBufNotifySink: ITTSBufNotifySink;
fITTSCentral: ITTSCentral;
begin
try
fTTSBufNotifySink := TTSBufNotifySink.Create(Self);
fITTSCentral.TextData(CHARSET_TEXT, 1, SData, pointer(fTTSBufNotifySink), IID_ITTSBufNotifySink);
except
end;
end;


Для определения позиции читаемых слов необходимо реализовать метод WordPosition. Например так:

function TTSBufNotifySink.WordPosition(qTimeStamp: QWORD; dwByteOffset: DWORD): HResult;
begin
result := 0;
fForm.RichEdit1.SelStart:=0;
fForm.RichEdit1.SelLength:=dwByteOffset;
end;


Чтобы определить начало и конец чтения вообще, необходимо обработать события AudioStart и AudioStop интрфейса ITTSNotifySink.
Вот список поддерживаемых методов интерфейсом ITTSNotifySink:

function AttribChanged(dwAttribute: DWORD): HResult; stdcall;
function AudioStart(qTimeStamp: QWORD): HResult; stdcall;
function AudioStop(qTimeStamp: QWORD): HResult; stdcall;
function Visual(qTimeStamp: QWORD; cIPAPhoneme: AnsiChar; cEnginePhoneme: AnsiChar; dwHints: DWORD; pTTSMouth: PTTSMOUTH): HResult; stdcall;


Методы интерфейса ITTSBufNotifySink:

function TextDataStarted(qTimeStamp: QWORD): HResult; stdcall;
function TextDataDone(qTimeStamp: QWORD; dwFlags: DWORD): HResult; stdcall;
function BookMark(qTimeStamp: QWORD; dwMarkNum: DWORD): HResult; stdcall;

function WordPosition(qTimeStamp: QWORD; dwByteOffset: DWORD): HResult; stdcall;


Простейшее приложение, выделяющее читаемый текст, может выглядеть так:

DTTSNotifySink

unit Unit1;

interface

uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      Buttons, ToolWin, ComCtrls, ExtCtrls, StdCtrls, Speech, ActiveX, ComObj;

type
      TTSBufNotifySink = class;
      TTSNotifySink = class;

  TForm1 = class(TForm)
        RichEdit1: TRichEdit;
        ControlBar1: TControlBar;
        ToolBar1: TToolBar;
        Speak: TSpeedButton;
        PauseSpeak: TSpeedButton;
        Stop: TSpeedButton;
        ComboBox1: TComboBox;
        Splitter1: TSplitter;
        StatusBar1: TStatusBar;
        ListBox1: TListBox;
        procedure FormCreate(Sender: TObject);
        procedure ComboBox1Change(Sender: TObject);
        procedure SpeakClick(Sender: TObject);
        procedure PauseSpeakClick(Sender: TObject);
        procedure StopClick(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
      private
        { Private declarations }
        fITTSCentral: ITTSCentral; {Центральный интерфейс,
          через который производятся все действия с речью}
        fIAMM: IAudioMultimediaDevice;
          {Интерфейс для связи с аудио устройством}
        aTTSEnum: ITTSEnum;
          {Интерфейс для перебора движков}
        fpModeInfo: PTTSModeInfo;
          {Указатель на параметры движка}
        Pause: Boolean;

    fTTSNotifySink : ITTSNotifySink;
        fTTSBufNotifySink : ITTSBufNotifySink;
        fdwKey: DWord;
        procedure AddLog(const s: string);
      public
        { Public declarations }
      end;

      TTSBufNotifySink = class(TInterfacedObject, ITTSBufNotifySink)
      private
        fForm : TForm1;
      protected
       function TextDataDone(qTimeStamp: QWORD; dwFlags: DWORD): HResult; stdcall;
       function TextDataStarted(qTimeStamp: QWORD) : HResult; stdcall;
       function BookMark(qTimeStamp: QWORD; dwMarkNum: DWORD) : HResult; stdcall;
       function WordPosition(qTimeStamp: QWORD; dwByteOffset: DWORD) : HResult; stdcall;
      public
       constructor create(aForm : TForm1);
      end; //ITTSBufNotifySink

  TTSNotifySink = class(TInterfacedObject, ITTSNotifySink)
      private
        fForm : TForm1;
      protected
       function AttribChanged(dwAttribute: DWORD) : HResult; stdcall;
       function AudioStart(qTimeStamp: QWORD) : HResult; stdcall;
       function AudioStop(qTimeStamp: QWORD) : HResult; stdcall;
       function Visual(qTimeStamp: QWORD;
                       cIPAPhoneme: Char;
                       cEnginePhoneme: Char;
                       dwHints: DWORD;
                       apTTSMouth: PTTSMouth) : HResult; stdcall;
      public
          constructor create(aForm : TForm1);
      end; //TTSNotifySink

    var
      Form1: TForm1;

implementation

{$R *.DFM}

{--------------------TTSBufNotifySink ----------------------}
    constructor TTSBufNotifySink.create(aForm : TForm1);
    begin
      fForm := aForm;
    end;

function TTSBufNotifySink.TextDataDone(qTimeStamp: QWORD; dwFlags: DWORD) : HResult;
    begin
      result := 0;
      fForm.AddLog('Событие TextDataDone. TimeStamp :' +
         IntToStr(qTimeStamp) + ' Flags :' + IntToStr(dwFlags));

  fForm.StatusBar1.Panels.Items[1].Text:='TextDataDone...';
      fForm.Update;

  if Assigned(fForm.fTTSBufNotifySink) then
       begin
         fForm.Speak.Down:=False;
         fForm.Stop.Down:=False;
       end;
    end;

function TTSBufNotifySink.TextDataStarted(qTimeStamp: QWORD): HResult;
    begin
      result := 0;
      fForm.AddLog('Событие TextDataStarted. TimeStamp: ' +
         IntToStr(qTimeStamp));
    end;

function TTSBufNotifySink.BookMark(qTimeStamp: QWORD; dwMarkNum: DWORD): HResult;
    begin
      result := 0;
      fForm.AddLog('Событие BookMark. TimeStamp :' +
         IntToStr(qTimeStamp) + ' MarkNum :' + IntToStr(dwMarkNum));
    end;

function TTSBufNotifySink.WordPosition(qTimeStamp: QWORD; dwByteOffset: DWORD): HResult;
    begin
      result := 0;
      fForm.AddLog('Событие WordPosition. TimeStamp :' +
         IntToStr(qTimeStamp) + ' Offset: ' + IntToStr(dwByteOffset));
      fForm.RichEdit1.SelStart:=0;
      fForm.RichEdit1.SelLength:=dwByteOffset;
    end;

{--------------------------TTSNotifySink-------------------------}
    constructor TTSNotifySink.create(aForm : TForm1);
    begin
      fForm := aForm;
    end;

function TTSNotifySink.AttribChanged(dwAttribute: DWORD) : HResult;
    var
     S:String;
    begin
      result := 0;
      case dwAttribute of
       TTSNSAC_LANGUAGE : S := 'Язык';
       TTSNSAC_REALTIME : S := 'Приоритет процессорного времени';
       TTSNSAC_PITCH    : S := 'Тон';
       TTSNSAC_SPEED    : S := 'Скорость';
       TTSNSAC_VOLUME   : S := 'Громкость';
      else
       S := 'Attr='+IntToStr(dwAttribute);
      end;
      fForm.AddLog('Событие AttribChanged. Attribute :' + S);
    end;

function TTSNotifySink.AudioStart(qTimeStamp: QWORD) : HResult;
    begin
      result := 0;
      fForm.AddLog('Событие AudioStart, TimeStamp :' + IntToStr(qTimeStamp));
      fForm.StatusBar1.Panels.Items[0].Text:='Читаю';
    end;

function TTSNotifySink.AudioStop(qTimeStamp: QWORD) : HResult;
    begin
      result := 0;
      fForm.AddLog('Событие AudioStop. TimeStamp :' + IntToStr(qTimeStamp));
      fForm.StatusBar1.Panels.Items[0].Text:='Стоп';
      fForm.Speak.Down:=false;
    end;

function TTSNotifySink.Visual(qTimeStamp: QWORD;
                    cIPAPhoneme: Char;
                    cEnginePhoneme: Char;
                    dwHints: DWORD;
                    apTTSMouth: PTTSMouth) : HResult;
    var
      tmp: String;
    begin
      result := 0;
      if cEnginePhoneme = '@' then
        exit;
      tmp := '';
      if dwHints <> 0 then
       begin
        If (TTSNSHINT_QUESTION and dwHints) <> 0 then
          tmp := tmp + 'Question ';
        If (TTSNSHINT_STATEMENT and dwHints) <> 0 then
          tmp := tmp + 'Statement ';
        If (TTSNSHINT_COMMAND and dwHints) <> 0 then
          tmp := tmp + 'Command ';
        If (TTSNSHINT_EXCLAMATION and dwHints) <> 0 then
          tmp := tmp + 'Exclamation ';
        If (TTSNSHINT_EMPHASIS and dwHints) <> 0 then
          tmp := tmp + 'Emphasis ';
       end
      else
        tmp := 'None';

  fForm.AddLog('Событие Visual. TStamp :'+FloatToStr(qTimeStamp));
      fForm.AddLog('    IPAPhoneme :' + IntToStr(ord(cIPAPhoneme)));
      fForm.AddLog('    Phoneme :' + cEnginePhoneme);
      fForm.AddLog('    Hints :' + tmp);
      fForm.AddLog('    Data :'+IntToStr(apTTSMouth^.bMouthHeight)+','+
            IntToStr(apTTSMouth^.bMouthWidth));
    end;
    {---------------------------------------------------------------------------}

procedure TForm1.AddLog(const s: string);
    begin
     Form1.ListBox1.Items.Add(s);
     Form1.ListBox1.ItemIndex:=Form1.ListBox1.Items.Count-1;
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    var
      NumFound : DWord;
      ModeInfo : TTSModeInfo;
    begin
      try
        {Инициализация аудио устройства}
        CoCreateInstance(CLSID_MMAudioDest, Nil, CLSCTX_ALL,
               IID_IAudioMultiMediaDevice, fIAMM);
      except
      end;
      {Создание перечисляемого объекта для перебора всех движков в системе
       с помощью интерфейса ITTSEnum}
      CoCreateInstance(CLSID_TTSEnumerator, Nil, CLSCTX_ALL, IID_ITTSEnum, aTTSEnum);
      aTTSEnum.Reset;//Сбрасываем на первый
      aTTSEnum.Next(1, ModeInfo, @NumFound); {Получаем первый движок}
      While NumFound > 0 do
       begin
         ComboBox1.Items.Add(String(ModeInfo.szModeName));
         aTTSEnum.Next(1, ModeInfo, @NumFound); {Получаем остальные}
       end;
    end;

procedure TForm1.ComboBox1Change(Sender: TObject);
    var
     NumFound: DWord;
     ModeInfo : TTSModeInfo;{Для хранения информации о текущем движке}
    begin
       try
         CoCreateInstance(CLSID_MMAudioDest, Nil, CLSCTX_ALL,
              IID_IAudioMultiMediaDevice, fIAMM);
         CoCreateInstance(CLSID_TTSEnumerator, Nil, CLSCTX_ALL, IID_ITTSEnum, aTTSEnum);
         aTTSEnum.Reset;
         {Перескакиваем на нужный движок}
         Form1.aTTSEnum.skip(ComboBox1.ItemIndex);
         aTTSEnum.Next(1, ModeInfo, @NumFound);
         if assigned(fpModeInfo) then
         {если fpModeInfo не равен nil}
          dispose(fpModeInfo);
         new(fpModeInfo);
         fpModeInfo^:=ModeInfo;
         {загружаем движок}
         aTTSEnum.Select(fpModeInfo^.gModeID, fITTSCentral, IUnknown(fIAMM));
         try
           fTTSBufNotifySink := TTSBufNotifySink.Create(Self);
           AddLog('Создание BufNotifySink прошло успешно');
         except
           AddLog('Создание BufNotifySink неудачно');
         end;

     try
          fTTSNotifySink := TTSNotifySink.Create(Self);
          AddLog('Создание Engine NotifySink успешно');
          try
            OleCheck(fITTSCentral.Register(pointer(fTTSNotifySink), 
IID_ITTSNotifySink, fdwKey));
            AddLog('Регистрация Engine NotifySink завершилась успешно');
          except
            fTTSNotifySink := nil;
            AddLog('Регистрация Engine NotifySink прошла неудачно');
          end;
         except
          AddLog('Создание Engine NotifySink неудачно');
         end;
       except
       end;
    end;

procedure TForm1.SpeakClick(Sender: TObject);
    var
      fSData: TSData;
      BufRich: string;
    begin
      if not assigned(fITTSCentral) then
       begin
        ShowMessage('Не выбран движок!');
        exit;
       end;
      if pause then
       begin
        try
          fITTSCentral.AudioResume;
          Pause:=False;
        except
          exit;
        end;
       end
      else
       begin
        RichEdit1.SetFocus;
        BufRich:=copy(RichEdit1.Text, RichEdit1.SelStart,
                            length(RichEdit1.Text)-RichEdit1.SelStart);
        fSData.dwSize := length(BufRich) + 1;
        fSData.pData := pChar(BufRich);
        try
          fITTSCentral.TextData(CHARSET_TEXT, 1, fSData, pointer(fTTSBufNotifySink),
                                                IID_ITTSBufNotifySink);
        except
        end;
       end;
      Speak.Down:=true;
    end;

procedure TForm1.PauseSpeakClick(Sender: TObject);
    begin
      Speak.Down:=false;
      PauseSpeak.Down:=true;
      if not assigned(fITTSCentral) then
       begin
        ShowMessage('Не выбран движок!');
        exit;
       end;
      if Pause then
        exit;
      try
        fITTSCentral.AudioPause;
        pause:=True;
      except
      end;
    end;

procedure TForm1.StopClick(Sender: TObject);
    begin
      Speak.Down:=false;
      if not assigned(fITTSCentral) then
       begin
        showmessage('Не выбран движок!');
        exit;
       end;
      try
        fITTSCentral.AudioReset;
        Pause:=False;
      except
      end;
    end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
     if Assigned(fITTSCentral) then
      fITTSCentral.AudioReset;
     if fdwKey<>0 then
      try
       fITTSCentral.UnRegister(fdwKey);
       fTTSNotifySink:= Nil;
      except
      end;

 try
       fTTSBufNotifySink:=nil;
 except
 end;
end;

end.

Синтез речи в волновой файл


В ходе работы со звуковой картой инциализация устройства выглядела следующим образом:
CoCreateInstance(CLSID_MMAudioDest, Nil, CLSCTX_ALL,
IID_IAudioMultiMediaDevice, fIAMM)


Теперь она немного изменится, необходимо подлючаться к File Audio Destination. Основной интерфейс управления объекта File Audio Destination — IAudioFile, через него осуществляются все основные манипуляции с файлом.

var
fIAF: IAudioFile;

При инициализации приложения нужно получать интерфейс на IAudioFile.

CoCreateInstance(CLSID_AudioDestFile, Nil, CLSCTX_ALL,
IID_IAudioFile, fIAF);

Далее схема не нарушается. Также осуществляется поиск движка и его выбор, однако, при выборе синтезатора методом Select мы передаем указатель на интерфейс аудио файла: aTTSEnum.Select(fpModeInfo^.gModeID, fITTSCentral, IUnknown(fIAF));

Определение имени конкретного файла, в который будут записываться аудио данные, лучше сделать перед чтением. Указание имени файла реализуется через интерфейс IAudioFile методом DoSet. Данный метод сбрасывает с очереди все аудио файлы и ставит в нее текущий. В параметрах нужно указывать имя файла в Unicode и идентификатор файла, который будет посылаться при старте и завершении записи файла в соответствующих уведомлениях. Допустим, в поле редактирование Edit1 введено имя файла, тогда код, запускающий синтез речи в файл, примет вид:

var fSData: TSData; FlName: PWideChar; fID: Cardinal; fIAF: IAudioFile;

begin
FlName:=StringToOleStr(Edit1.Text);
fIAF.DoSet(FlName, hKey);
fITTSCentral.TextData(CHARSET_TEXT, 0, fSData, pointer(fTTSBufNotifySink), IID_ITTSBufNotifySink);
end;
После того, как будет запущен метод DoSet в файловой системе создастся пустой файл.
Когда чтение завершится, то вам может показаться странным, что размер файла остался нулевым, однако, при закрытии программы он все-таки приобретет свой законный размер. Происходит это, потому что после завершения чтения нужно сбрасывать файл из очереди, как при работе с обычными файлами, которые нужно закрывать, чтобы они не испортились, здесь же файл нужно просто освобождать, чтобы можно было к нему обратиться. Делается это методом Flush, его следует разместить в обработке уведомления, например, в AudioStop интерфейса ITTSNotifySink или ITTSBufNotifySink.TextDataDone. function TTSNotifySink.AudioStop(qTimeStamp: QWORD) : HResult; begin result := S_OK; fForm.fIAF.Flush; end; Для того, чтобы увеличить скорость записи в файл и тем самым уменьшить время ожидания, нужно применить метод RealTimeSet интерфейса IAudioFile. В виде параметра здесь передается значение, символизирующее скорость. Так, реальная скорость(однократная) имеет значение 256 или в шестнадцатиричной форме $100, двухкратная — $200, четырех — $400, и т. д. Странно, что в Speech API SDK не указан верхний предел скорости, но сразу можно сказать о физическом пределе — это размер типа WORD — 65535. Проверка этого параметра закончилась положительно, но скорость была такой же, как шестнадцатикратная.Простейшая программа синтезирующая речь в файл:

SpeechToWav

unit Unit1;

interface

uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      Buttons, ToolWin, ComCtrls, ExtCtrls, StdCtrls, Speech, ActiveX, ComObj;

type
      TTSBufNotifySink = class;
      TAudioFileNotifySink = class;

  TForm1 = class(TForm)
        RichEdit1: TRichEdit;
        ControlBar1: TControlBar;
        ToolBar1: TToolBar;
        Speak: TSpeedButton;
        PauseSpeak: TSpeedButton;
        Stop: TSpeedButton;
        ComboBox1: TComboBox;
        Splitter1: TSplitter;
        StatusBar1: TStatusBar;
        ToolBar2: TToolBar;
        Edit1: TEdit;
        SpeedButton1: TSpeedButton;
        SaveDialog1: TSaveDialog;
        ListBox1: TListBox;
        Panel4: TPanel;
        cbSpeed: TComboBox;
        procedure FormCreate(Sender: TObject);
        procedure ComboBox1Change(Sender: TObject);
        procedure SpeakClick(Sender: TObject);
        procedure PauseSpeakClick(Sender: TObject);
        procedure StopClick(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure SpeedButton1Click(Sender: TObject);
        procedure cbSpeedChange(Sender: TObject);
      private
        { Private declarations }
        fITTSCentral: ITTSCentral; {Центральный интерфейс,
          через который производятся все действия с речью}
        fIAF: IAudioFile;
          {Интерфейс для связи с аудиофайлом}

    aTTSEnum: ITTSEnum;
          {Интерфейс для перебора движков}
        fpModeInfo: PTTSModeInfo;
          {Указатель на параметры движка}

    fAudioFileNotifySink : IAudioFileNotifySink;
        fTTSNotifySink : ITTSNotifySink;
        fTTSBufNotifySink : ITTSBufNotifySink;

    Pause: Boolean;

    fID: Cardinal;
        fdwKey: DWord;

    FlName:  PWideChar;
        procedure AddLog(s: string);
      public
        { Public declarations }
      end;

      TTSBufNotifySink = class(TInterfacedObject, ITTSBufNotifySink)
      private
        fForm : TForm1;
      protected
       function TextDataDone(qTimeStamp: QWORD; dwFlags: DWORD): HResult; stdcall;
       function TextDataStarted(qTimeStamp: QWORD) : HResult; stdcall;
       function BookMark(qTimeStamp: QWORD; dwMarkNum: DWORD) : HResult; stdcall;
       function WordPosition(qTimeStamp: QWORD; dwByteOffset: DWORD) : HResult; stdcall;
      public
       constructor create(aForm : TForm1);
      end; //ITTSBufNotifySink

  TTSNotifySink = class(TInterfacedObject, ITTSNotifySink)
      private
        fForm : TForm1;
      protected
       function AttribChanged(dwAttribute: DWORD) : HResult; stdcall;
       function AudioStart(qTimeStamp: QWORD) : HResult; stdcall;
       function AudioStop(qTimeStamp: QWORD) : HResult; stdcall;
       function Visual(qTimeStamp: QWORD;
                       cIPAPhoneme: Char;
                       cEnginePhoneme: Char;
                       dwHints: DWORD;
                       apTTSMouth: PTTSMouth) : HResult; stdcall;
      public
          constructor create(aForm : TForm1);
      end; //TTSNotifySink

      TAudioFileNotifySink = class(TInterfacedObject, IAudioFileNotifySink)
      private
        fForm : TForm1;
      protected
        function FileBegin(dwID: DWORD): HResult; stdcall;
        function FileEnd(dwID: DWORD): HResult; stdcall;
        function QueueEmpty: HResult; stdcall;
        function Posn(qwProcessed: QWORD; qwLeft: QWORD): HResult; stdcall;
      public
        constructor Create(aForm : TForm1);
      end; //TTSNotifySink

    var
      Form1: TForm1;

implementation

{$R *.DFM}

{-------------------------TTSBufNotifySink ---------------------------------------}
    constructor TTSBufNotifySink.Create(aForm : TForm1);
    begin
      fForm := aForm;
    end;

function TTSBufNotifySink.TextDataDone(qTimeStamp: QWORD; dwFlags: DWORD) : HResult;
    begin
      result := S_OK;
      fForm.AddLog('Событие TextDataDone. TimeStamp :' +
         FloatToStr(qTimeStamp) + ' Flags :' + IntToStr(dwFlags));

  fForm.StatusBar1.Panels.Items[1].Text:='TextDataDone...';
      fForm.RichEdit1.SelectAll;
      fForm.Update;

  fForm.Speak.Down:=false;

  if Assigned(fForm.fTTSBufNotifySink) then
       begin
         fForm.Speak.Down:=False;
         fForm.Stop.Down:=False;
       end;
    end;

function TTSBufNotifySink.TextDataStarted(qTimeStamp: QWORD): HResult;
    begin
      result := S_OK;
      fForm.AddLog('Событие TextDataStarted. TimeStamp: ' +
         FloatToStr(qTimeStamp));
    end;

function TTSBufNotifySink.BookMark(qTimeStamp: QWORD; dwMarkNum: DWORD): HResult;
    begin
      result := S_OK;
      fForm.AddLog('Событие BookMark. TimeStamp :' +
         FloatToStr(qTimeStamp) + ' MarkNum :' + IntToStr(dwMarkNum));
    end;

function TTSBufNotifySink.WordPosition(qTimeStamp: QWORD; dwByteOffset: DWORD): HResult;
    begin
      result := S_OK;
      fForm.AddLog('Событие WordPosition. TimeStamp :' +
         FloatToStr(qTimeStamp) + ' Offset: ' + IntToStr(dwByteOffset));
      fForm.RichEdit1.SelStart:=0;
      fForm.RichEdit1.SelLength:=dwByteOffset;
    end;
    {--------------------------TTSNotifySink-------------------------}
    constructor TTSNotifySink.create(aForm : TForm1);
    begin
      fForm := aForm;
    end;

function TTSNotifySink.AttribChanged(dwAttribute: DWORD) : HResult;
    var
     S:String;
    begin
      result := S_OK;
      case dwAttribute of
       TTSNSAC_LANGUAGE : S := 'Язык';
       TTSNSAC_REALTIME : S := 'Приоритет процессорного времени';
       TTSNSAC_PITCH    : S := 'Тон';
       TTSNSAC_SPEED    : S := 'Скорость';
       TTSNSAC_VOLUME   : S := 'Громкость';
      else
       S := 'Attr='+IntToStr(dwAttribute);
      end;
      fForm.AddLog('Событие AttribChanged. Attribute :' + S);
    end;

function TTSNotifySink.AudioStart(qTimeStamp: QWORD) : HResult;
    begin
      result := S_OK;
      fForm.AddLog('Событие AudioStart, TimeStamp :' + IntToStr(qTimeStamp));
      fForm.StatusBar1.Panels.Items[0].Text:='Читаю';
    end;

function TTSNotifySink.AudioStop(qTimeStamp: QWORD) : HResult;
    begin
      result := S_OK;
      fForm.fIAF.Flush;
      fForm.AddLog('Событие AudioStop. TimeStamp :' + IntToStr(qTimeStamp));
      fForm.StatusBar1.Panels.Items[0].Text:='Стоп';
      fForm.Speak.Down:=false;
    end;

function TTSNotifySink.Visual(qTimeStamp: QWORD;
                    cIPAPhoneme: Char;
                    cEnginePhoneme: Char;
                    dwHints: DWORD;
                    apTTSMouth: PTTSMouth) : HResult;
    var
      tmp: String;
    begin
      result := 0;
      if cEnginePhoneme = '@' then
        exit;
      tmp := '';
      if dwHints <> 0 then
       begin
        If (TTSNSHINT_QUESTION and dwHints) <> 0 then
          tmp := tmp + 'Question ';
        If (TTSNSHINT_STATEMENT and dwHints) <> 0 then
          tmp := tmp + 'Statement ';
        If (TTSNSHINT_COMMAND and dwHints) <> 0 then
          tmp := tmp + 'Command ';
        If (TTSNSHINT_EXCLAMATION and dwHints) <> 0 then
          tmp := tmp + 'Exclamation ';
        If (TTSNSHINT_EMPHASIS and dwHints) <> 0 then
          tmp := tmp + 'Emphasis ';
       end
      else
        tmp := 'None';

  fForm.AddLog('Событие Visual. TStamp :'+FloatToStr(qTimeStamp));
      fForm.AddLog('    IPAPhoneme :' + IntToStr(ord(cIPAPhoneme)));
      fForm.AddLog('    Phoneme :' + cEnginePhoneme);
      fForm.AddLog('    Hints :' + tmp);
      fForm.AddLog('    Data :'+IntToStr(apTTSMouth^.bMouthHeight)+','+
            IntToStr(apTTSMouth^.bMouthWidth));
    end;

{----------------------- IAudioFileNotifySink ------------------------}
    constructor TAudioFileNotifySink.create(aForm : TForm1);
    begin
      fForm := aForm;
    end;

function TAudioFileNotifySink.FileBegin(dwID: DWORD): HResult; stdcall;
    begin
     fForm.StatusBar1.Panels.Items[0].Text:='Пишу в файл('+IntToStr(dwID)+')';
     Result:=0;
    end;

function TAudioFileNotifySink.FileEnd(dwID: DWORD): HResult; stdcall;
    begin
     fForm.StatusBar1.Panels.Items[0].Text:='Готово('+IntToStr(dwID)+')';
     Result:=0;
    end;

function TAudioFileNotifySink.QueueEmpty: HResult; stdcall;
    begin
     //fForm.StatusBar1.Panels.Items[0].Text:='Пусто';
     Result:=0;
    end;

function TAudioFileNotifySink.Posn(qwProcessed: QWORD; qwLeft: QWORD): HResult; stdcall;
    begin
     fForm.AddLog('Событие Posn. qwProcessed: '+IntToStr(qwProcessed)+
', qwLeft: '+IntToStr(qwLeft));
     Result:=0;
    end;
    {---------------------------------------------------------------------------}

procedure TForm1.AddLog(s: string);
    begin
     Form1.ListBox1.Items.Add(s);
     Form1.ListBox1.ItemIndex:=Form1.ListBox1.Items.Count-1;
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    var
      NumFound : DWord;
      ModeInfo : TTSModeInfo;
    begin
      try
        {Инициализация аудио файла}
        CoCreateInstance(CLSID_AudioDestFile, Nil, CLSCTX_ALL, IID_IAudioFile, fIAF);
      except
      end;
      {Создание перечисляемого объекта для перебора всех движков в системе
       с помощью интерфейса ITTSEnum}
      CoCreateInstance(CLSID_TTSEnumerator, Nil, CLSCTX_ALL, IID_ITTSEnum, aTTSEnum);
      aTTSEnum.Reset;//Сбрасываем на первый
      aTTSEnum.Next(1, ModeInfo, @NumFound); {Получаем первый движок}
      while NumFound > 0 do
       begin
         ComboBox1.Items.Add(String(ModeInfo.szModeName));
         aTTSEnum.Next(1, ModeInfo, @NumFound); {Перескакиваем на следующий}
       end;
    end;

procedure TForm1.ComboBox1Change(Sender: TObject);
    var
     NumFound: DWord;
     ModeInfo: TTSModeInfo;{Для хранения информации о текущем движке}
    begin
       try
         aTTSEnum.Reset;
         {Перескакиваем на нужный движок}
         aTTSEnum.skip(ComboBox1.ItemIndex);
         aTTSEnum.Next(1, ModeInfo, @NumFound);
         if assigned(fpModeInfo) then
         {если fpModeInfo не равен nil}
          dispose(fpModeInfo);
         new(fpModeInfo);
         fpModeInfo^:=ModeInfo;
         {загружаем движок}
         aTTSEnum.Select(fpModeInfo^.gModeID, fITTSCentral, IUnknown(fIAF));

     try
           fTTSBufNotifySink := TTSBufNotifySink.Create(Self);
           AddLog('Создание BufNotifySink прошло успешно');
         except
           AddLog('Создание BufNotifySink неудачно');
         end;

     try
          fTTSNotifySink := TTSNotifySink.Create(Self);
          AddLog('Создание Engine NotifySink успешно');
          try
            OleCheck(fITTSCentral.Register(pointer(fTTSNotifySink), 
IID_ITTSNotifySink, fdwKey));
            AddLog('Регистрация Engine NotifySink завершилась успешно');
          except
            fTTSNotifySink := nil;
            AddLog('Регистрация Engine NotifySink прошла неудачно');
          end;
         except
          AddLog('Создание Engine NotifySink неудачно');
         end;

     try
          fAudioFileNotifySink := TAudioFileNotifySink.Create(Self);
          AddLog('Создание AudioFileNotifySink прошло успешно');
          try
            OleCheck(fIAF.Register(fAudioFileNotifySink));
            AddLog('Регистрация AudioFileNotifySink прошло успешно');
          except
            fAudioFileNotifySink := nil;
            AddLog('Регистрация AudioFileNotifySink неудачно');
          end;
         except
          AddLog('Создание AudioFileNotifySink неудачно');
         end;
       except
       end;
    end;

procedure TForm1.SpeakClick(Sender: TObject);
    var
      fSData: TSData;
      BufRich: string;
    begin
      if not assigned(fITTSCentral) then
       begin
        ShowMessage('Не выбран движок!');
    exit;
       end;
      if Edit1.Text='' then
       begin
         ShowMessage('Не указан файл');
         exit;
       end;

  if pause then
       begin
        try
          fITTSCentral.AudioResume;
          Pause:=False;
        except
          exit;
        end;
       end
      else
       begin
        RichEdit1.SetFocus;
        FlName:=StringToOleStr(Edit1.Text);
        fID:=1;
        fIAF.DoSet(FlName, fID);
        BufRich:=copy(RichEdit1.Text, RichEdit1.SelStart,
                            length(RichEdit1.Text)-RichEdit1.SelStart);
        fSData.dwSize:= length(BufRich) + 1;
        fSData.pData:= pChar(BufRich);
        try
          fITTSCentral.TextData(CHARSET_TEXT, 0, fSData, pointer(fTTSBufNotifySink),
                                                IID_ITTSBufNotifySink);
        except
        end;
       end;
      Speak.Down:=true;
    end;

procedure TForm1.PauseSpeakClick(Sender: TObject);
    begin
      Speak.Down:=false;
      PauseSpeak.Down:=true;
      if not assigned(fITTSCentral) then
       begin
        ShowMessage('Не выбран движок!');
        exit;
       end;
      if Pause then
        exit;
      try
        fITTSCentral.AudioPause;
        pause:=True;
      except
      end;
    end;

procedure TForm1.StopClick(Sender: TObject);
    begin
      Speak.Down:=false;
      if not assigned(fITTSCentral) then
       begin
        showmessage('Не выбран движок!');
        exit;
       end;
      try
        fITTSCentral.AudioReset;
        Pause:=False;
      except
      end;
    end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
    begin
      if SaveDialog1.Execute then
       Edit1.Text:=SaveDialog1.FileName;
    end;

procedure TForm1.cbSpeedChange(Sender: TObject);
    var
     RTime: Word;
     spd: integer;
    begin
      spd:=cbSpeed.ItemIndex;
      if spd=cbSpeed.Items.Count-1 then
       RTime:=MAXWORD
      else
       RTime:=256 shl spd;
      fIAF.RealTimeSet(RTime);
    end;

procedure TForm1.FormDestroy(Sender: TObject);
    begin
     if Assigned(fITTSCentral) then
       fITTSCentral.AudioReset;

 try
       fAudioFileNotifySink:=nil;
     except
     end;

 try
       fTTSBufNotifySink:=nil;
     except
     end;
    end;

    end.


Для более полного и глубокого понимания советую преобрести мою книгу «MSAgent и SpeechAPI в Delphi», которая вышла в 2005 году в издательстве БХВ-Петербург.

Заказ книги для получения ее по наиболее удобному для вас способу, в том числе и по почте, наложенным платежом осуществляется на сайте http://books.ru, по адресу: http://www.books.ru/shop/books/239205

 

Speak up! Let us know what you think.