SpeechModule.pas

unit SpeechModule;

interface

uses
  Windows, Classes, ExtCtrls, Speech, ActiveX, ComObj, SysUtils;

type
  TSpeechUnit = class(TObject)
  private
    MessageQueue: TStringList;
    SpeechTimer: TTimer;
    // Öåíòðàëüíûé èíòåðôåéñ, ÷åðåç êîòîðûé ïðîèçâîäÿòñÿ âñå äåéñòâèÿ ñ ðå÷üþ}
    fITTSCentral: ITTSCentral;
    // Èíòåðôåéñ äëÿ ñâÿçè ñ àóäèîóñòðîéñòâîì
    fIAMM: IAudioMultimediaDevice;
    // Èíòåðôåéñ äëÿ ïåðåáîðà äâèæêîâ
    aTTSEnum: ITTSEnum;
    // Óêàçàòåëü íà ïàðàìåòðû äâèæêà
    fpModeInfo: PTTSModeInfo;
    // Ñïèñîê äâèæêîâ
    VoicesList: TStringList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure SelectVoiceEngine(EngineIndex: Integer);
    function GetVoicesList: TStringList;
    procedure SpeechText(const AText: string);
    procedure AddSpeechText(const AText: string);
  published
    procedure SpeechTextFromQueue(Sender: TObject);
  end;

{ Âîçâðàùàåò òåêñòîâîå ïðåäñòàâëåíèå âðåìåíè, íàïðèìåð: "ïÿòü ÷àñîâ ñåìü ìèíóò" }
function GetTimeString(ATime: TDateTime): string;

implementation

function GetTimeString(ATime: TDateTime): string;
var
  Hour, Min, Sec, MSec: Word;
begin
  DecodeTime(ATime, Hour, Min, Sec, MSec);
  case Hour of
    0: Result := 'íîëü ÷àñîâ ';
    1: Result := 'îäèí ÷àñ ';
    2: Result := 'äâà ÷àñà ';
    3: Result := 'òðè ÷àñà ';
    4: Result := '÷åòûðå ÷àñà ';
    5: Result := 'ïÿòü ÷àñîâ ';
    6: Result := 'øåñòü ÷àñîâ ';
    7: Result := 'ñåìü ÷àñîâ ';
    8: Result := 'âîñåìü ÷àñîâ ';
    9: Result := 'äåâÿòü ÷àñîâ ';
    10: Result := 'äåñÿòü ÷àñîâ ';
    11: Result := 'îäèííàäöàòü ÷àñîâ ';
    12: Result := 'äâåíàäöàòü ÷àñîâ ';
    13: Result := 'òðèíàäöàòü ÷àñîâ ';
    14: Result := '÷åòûðíàäöàòü ÷àñîâ ';
    15: Result := 'ïÿòíàäöàòü ÷àñîâ ';
    16: Result := 'øåñòíàäöàòü ÷àñîâ ';
    17: Result := 'ñåìíàäöàòü ÷àñîâ ';
    18: Result := 'âîñåìíàäöàòü ÷àñîâ ';
    19: Result := 'äåâÿòíàäöàòü ÷àñîâ ';
    20: Result := 'äâàäöàòü ÷àñîâ ';
    21: Result := 'äâàäöàòü îäèí ÷àñ ';
    22: Result := 'äâàäöàòü äâà ÷àñà ';
    23: Result := 'äâàäöàòü òðè ÷àñà ';
  end;

  case Min of
    0: Result := Result + 'íîëü ìèíóò';
    1: Result := Result + 'îäíà ìèíóòà';
    2: Result := Result + 'äâå ìèíóòû';
    3: Result := Result + 'òðè ìèíóòû';
    4: Result := Result + '÷åòûðå ìèíóòû';
    5: Result := Result + 'ïÿòü ìèíóò';
    6: Result := Result + 'øåñòü ìèíóò';
    7: Result := Result + 'ñåìü ìèíóò';
    8: Result := Result + 'âîñåìü ìèíóò';
    9: Result := Result + 'äåâÿòü ìèíóò';
    10: Result := Result + 'äåñÿòü ìèíóò';
    11: Result := Result + 'îäèííàäöàòü ìèíóò';
    12: Result := Result + 'äâåíàäöàòü ìèíóò';
    13: Result := Result + 'òðèíàäöàòü ìèíóò';
    14: Result := Result + '÷åòûðíàäöàòü ìèíóò';
    15: Result := Result + 'ïÿòíàäöàòü ìèíóò';
    16: Result := Result + 'øåñòíàäöàòü ìèíóò';
    17: Result := Result + 'ñåìíàäöàòü ìèíóò';
    18: Result := Result + 'âîñåìíàäöàòü ìèíóò';
    19: Result := Result + 'äåâÿòíàäöàòü ìèíóò';
    20: Result := Result + 'äâàäöàòü ìèíóò';
    21: Result := Result + 'äâàäöàòü îäíà ìèíóòà';
    22: Result := Result + 'äâàäöàòü äâå ìèíóòû';
    23: Result := Result + 'äâàäöàòü òðè ìèíóòû';
    24: Result := Result + 'äâàäöàòü ÷åòûðå ìèíóòû';
    25: Result := Result + 'äâàäöàòü ïÿòü ìèíóò';
    26: Result := Result + 'äâàäöàòü øåñòü ìèíóò';
    27: Result := Result + 'äâàäöàòü ñåìü ìèíóò';
    28: Result := Result + 'äâàäöàòü âîñåìü ìèíóò';
    29: Result := Result + 'äâàäöàòü äåâÿòü ìèíóò';
    30: Result := Result + 'òðèäöàòü ìèíóò';
    31: Result := Result + 'òðèäöàòü îäíà ìèíóòà';
    32: Result := Result + 'òðèäöàòü äâå ìèíóòû';
    33: Result := Result + 'òðèäöàòü òðè ìèíóòû';
    34: Result := Result + 'òðèäöàòü ÷åòûðå ìèíóòû';
    35: Result := Result + 'òðèäöàòü ïÿòü ìèíóò';
    36: Result := Result + 'òðèäöàòü øåñòü ìèíóò';
    37: Result := Result + 'òðèäöàòü ñåìü ìèíóò';
    38: Result := Result + 'òðèäöàòü âîñåìü ìèíóò';
    39: Result := Result + 'òðèäöàòü äåâÿòü ìèíóò';
    40: Result := Result + 'ñîðîê ìèíóò';
    41: Result := Result + 'ñîðîê îäíà ìèíóòà';
    42: Result := Result + 'ñîðîê äâå ìèíóòû';
    43: Result := Result + 'ñîðîê òðè ìèíóòû';
    44: Result := Result + 'ñîðîê ÷åòûðå ìèíóòû';
    45: Result := Result + 'ñîðîê ïÿòü ìèíóò';
    46: Result := Result + 'ñîðîê øåñòü ìèíóò';
    47: Result := Result + 'ñîðîê ñåìü ìèíóò';
    48: Result := Result + 'ñîðîê âîñåìü ìèíóò';
    49: Result := Result + 'ñîðîê äåâÿòü ìèíóò';
    50: Result := Result + 'ïÿòüäåñÿò ìèíóò';
    51: Result := Result + 'ïÿòüäåñÿò îäíà ìèíóòà';
    52: Result := Result + 'ïÿòüäåñÿò äâå ìèíóòû';
    53: Result := Result + 'ïÿòüäåñÿò òðè ìèíóòû';
    54: Result := Result + 'ïÿòüäåñÿò ÷åòûðå ìèíóòû';
    55: Result := Result + 'ïÿòüäåñÿò ïÿòü ìèíóò';
    56: Result := Result + 'ïÿòüäåñÿò øåñòü ìèíóò';
    57: Result := Result + 'ïÿòüäåñÿò ñåìü ìèíóò';
    58: Result := Result + 'ïÿòüäåñÿò âîñåìü ìèíóò';
    59: Result := Result + 'ïÿòüäåñÿò äåâÿòü ìèíóò';
  end;
end;

constructor TSpeechUnit.Create();
var 
  NumFound : DWord;
  ModeInfo : TTSModeInfo;
  res: HRESULT;
begin
  inherited;

  SpeechTimer := TTimer.Create(nil);
  SpeechTimer.Interval := 500;
  SpeechTimer.OnTimer := SpeechTextFromQueue;
  MessageQueue := TStringList.Create;
  VoicesList := TStringList.Create;

  // Èíèöèàëèçàöèÿ àóäèîóñòðîéñòâà
  res := CoCreateInstance(CLSID_MMAudioDest, nil, CLSCTX_ALL,  IID_IAudioMultiMediaDevice, fIAMM);
  if res = S_OK then
  begin
    // Ñîçäàíèå ïåðå÷èñëÿåìîãî îáúåêòà äëÿ ïåðåáîðà âñåõ äâèæêîâ â ñèñòåìå ñ ïîìîùüþ èíòåðôåéñà ITTSEnum
    res := CoCreateInstance(CLSID_TTSEnumerator, nil, CLSCTX_ALL, IID_ITTSEnum, aTTSEnum);
    if res = S_OK then
    begin
      // Ñáðàñûâàåì íà ïåðâûé
      res := aTTSEnum.Reset();
      if res = S_OK then
      begin
        // Ïîëó÷àåì ïåðâûé äâèæîê
        res := aTTSEnum.Next(1, ModeInfo, @NumFound);
        while (res = S_OK) and (NumFound > 0) do
        begin
          VoicesList.Add(String(ModeInfo.szModeName));
          // Ïîëó÷àåì îñòàëüíûå
          res := aTTSEnum.Next(1, ModeInfo, @NumFound);
        end;
      end;
    end;
  end;


  if VoicesList.Count > 0 then
    SelectVoiceEngine(0);
end;

destructor TSpeechUnit.Destroy;
begin
  if Assigned(fpModeInfo) then
  begin
    Dispose(fpModeInfo);
  end;
  FreeAndNil(VoicesList);
  FreeAndNil(MessageQueue);
  FreeAndNil(SpeechTimer);
  inherited;
end;

procedure TSpeechUnit.SpeechTextFromQueue(Sender: TObject);
begin
  if MessageQueue.Count > 0 then
  begin
    SpeechText(MessageQueue.Strings[0]);
    MessageQueue.Delete(0);
  end;
end;

function TSpeechUnit.GetVoicesList: TStringList;
begin
  Result := VoicesList;
end;

procedure TSpeechUnit.SelectVoiceEngine(EngineIndex: Integer);
var
  NumFound: DWord;
  ModeInfo : TTSModeInfo;
  res: HRESULT;
begin
  if EngineIndex < 0 then
    Exit;

  res := CoCreateInstance(CLSID_MMAudioDest, nil, CLSCTX_ALL,  IID_IAudioMultiMediaDevice, fIAMM);
  if res = S_OK then
  begin
    res := CoCreateInstance(CLSID_TTSEnumerator, nil, CLSCTX_ALL, IID_ITTSEnum, aTTSEnum);
    if res = S_OK then
    begin
      res := aTTSEnum.Reset;
      if res = S_OK then
      begin
        res := aTTSEnum.skip(EngineIndex);
        if res = S_OK then
        begin
          res := aTTSEnum.Next(1, ModeInfo, @NumFound);
          if Assigned(fpModeInfo) then
          begin
            // åñëè fpModeInfo íå ðàâåí nil
            Dispose(fpModeInfo);
            fpModeInfo := nil;
          end;
          if (res = S_OK) then
          begin
            New(fpModeInfo);
            fpModeInfo^ := ModeInfo;
            // çàãðóæàåì äâèæîê ïî åãî GUID
            aTTSEnum.Select(fpModeInfo^.gModeID, fITTSCentral, IUnknown(fIAMM));
          end;
        end;
      end;
    end;
  end;
end;

procedure TSpeechUnit.SpeechText(const AText: String);
var
  SData: TSData;
begin
  if Assigned(fITTSCentral) then
  begin
    SData.dwSize := Length(AText) + 1;
    SData.pData := PChar(AText);
    try
      fITTSCentral.TextData(CHARSET_TEXT, 0, SData, nil, IID_ITTSBufNotifySink);
    except
    end;
  end;
end;

procedure TSpeechUnit.AddSpeechText(const AText: String);
begin
  MessageQueue.Add(AText);
end;


end.