ASSpeech.pas

unit ASSpeech;

interface

uses
  SysUtils, Windows, Variants, Messages, Types, UITypes, Classes, ComObj;

type
  TASSpeech = class
  strict private
  const
    SPF_ASYNC = 1;
  var
    __Voice: Variant;
    function GetVoice: Variant;
  protected
    property Voice: Variant read GetVoice;
  public
    procedure Speak(const AText: string; ABlock: Boolean = False); overload;
    procedure Speak(const AText: string; AAbortEvent, APauseEvent: THandle;
      AAbortProc, APauseProc: TProc); overload;
    procedure Pause;
    procedure Resume;
  end;

implementation

uses
  ASNum, ASObjects;

{ TASSpeech }

function TASSpeech.GetVoice: Variant;
begin
  if VarIsClear(__Voice) then
    __Voice := CreateOleObject('SAPI.SpVoice');
  Result := __Voice;
end;

procedure TASSpeech.Pause;
begin
  Voice.Pause;
end;

procedure TASSpeech.Resume;
begin
  Voice.Resume;
end;

procedure TASSpeech.Speak(const AText: string; AAbortEvent, APauseEvent: THandle;
  AAbortProc, APauseProc: TProc);
const
  WO_ABORT = 0;
  WO_PAUSE = 1;
  WO_COMPLETE = 2;
var
  LCompleteEvent: THandle;
  Events: TArray<THandle>;
begin
  Voice.Speak(AText, SPF_ASYNC);
  LCompleteEvent := Voice.SpeakCompleteEvent;
  Events := [AAbortEvent, APauseEvent, LCompleteEvent];
  while True do
    case WaitForMultipleObjects(Length(Events), @Events[0], False, INFINITE) of
      WO_ABORT:
        begin
          Voice.Pause;
          AAbortProc();
          Break;
        end;
      WO_PAUSE:
        begin
          Voice.Pause;
          APauseProc();
          Voice.Resume;
        end;
      WO_COMPLETE:
        Break;
    else
      Voice.Pause;
      Break;
    end;
end;

procedure TASSpeech.Speak(const AText: string; ABlock: Boolean = False);
begin
  if ABlock then
    Voice.Speak(AText, 0)
  else
    Voice.Speak(AText, SPF_ASYNC)
end;

end.