{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       TnrSpeech class (VCL)                           }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 09 Dec 2006                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrspeech;
interface
uses nrclasses, nrcommtapi, nrsapi, nrwin32, nrwavebase, windows, classes;

Const
  ntecSAPIInit = 1;
  nteSAPIInit  = 'nrSpeech Error: Microsoft Speech API initialization is failed.';


Type

  TnrSpeech=class(TnrCustomWave)
  private
    fText:TStrings;
    ispVoice:ISpeechVoice;
    ispMem:ISpeechMemoryStream;
    //fSpeaking: boolean;
    vBuff:OleVariant;
    BuffSize:integer;
    sTxt:string;
    fBits: integer;
    fHz: integer;
    fChannels: integer;
    fVoices:TStringList;
    fVoiceIndex:integer;
    ispEnum:IEnumSpObjectTokens;
    fRate:integer;
    fVolume:integer;
    procedure SetText(const Value: TStrings);
    function CheckSAPI:boolean;
    function GetSpeaking: boolean;
    function GetBits: integer;
    function GetChannels: integer;
    function GetHz: integer;
    function GetText: TStrings;
    procedure SetBits(const Value: integer);
    procedure SetChannels(const Value: integer);
    procedure SetHz(const Value: integer);
    procedure LoadVoiceList;
    function GetVoiceCount: integer;
    function GetVoice(Index: integer): string;
    procedure SetVoiceIndex(const Value: integer);
    function GetCurrentVoiceToken:ISpeechObjectToken;
    function GetRate: integer;
    function GetVolume: integer;
    procedure SetRate(const Value: integer);
    procedure SetVolume(const Value: integer);
  protected
    function OpenPlaySrc:boolean; override;
    procedure ClosePlaySrc; override;
    function BlockRead(P:pointer;MaxSz:integer):integer;override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Speak;
    procedure Stop;
    property Speaking:boolean read GetSpeaking;
    property Voices[Index:integer]:string read GetVoice;
    property VoiceIndex:integer read fVoiceIndex write SetVoiceIndex;
    property VoiceCount:integer read GetVoiceCount;
  published
    property Text:TStrings read GetText write SetText;
    property Log;
    property nrCommTAPI;
    property OnFatalError;
    property AfterPlay;
    property Channels:integer read GetChannels write SetChannels;
    property PlayOptions;
    property Hz:integer read GetHz write SetHz;
    property Bits:integer read GetBits write SetBits;
    property Volume:integer read GetVolume write SetVolume;
    property Rate:integer read GetRate write SetRate;
    property OnBufferPlay;
  end;

implementation
uses ComObj,
     {$IFDEF GEN6}
     variants,
     {$ENDIF}
     mmsystem;

{ TnrSpeech }

constructor TnrSpeech.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fText:=TStringList.Create;
  fVoices:=TStringList.Create;
  fChannels:=1;
  fHz:=8000;
  fBits:=16;
  LoadVoiceList;
  fVoiceIndex:=0;
  fRate:=0;
  fVolume:=50;
end;

{$IFDEF TRIAL}
var  ecx:integer = $5622FD60;
{$ENDIF}

destructor TnrSpeech.Destroy;
begin
  fVoices.Free;
  fText.Free;
  inherited Destroy;
end;

procedure TnrSpeech.SetText(const Value: TStrings);
begin
  if Assigned(Value) then fText.Assign(Value)
                     else fText.Clear;
end;

function TnrSpeech.GetSpeaking: boolean;
begin
  Result:=fIsPlaying;
end;

function TnrSpeech.CheckSAPI: boolean;
begin
  if ispVoice=nil then
    try
      ispVoice:=CreateComObject(CLASS_SpVoice) as ISpeechVoice;
    except
      ispVoice:=nil;
    end;

  if ispMem=nil then
    try
      ispMem:=CreateComObject(CLASS_SpMemoryStream)as ISpeechMemoryStream;
    except
      ispVoice:=nil;
      ispMem:=nil;
    end;

  Result:=(ispVoice<>nil)and(ispMem<>nil);

//  if not Result
//    then DoFatalErrors(ErrorTypeSpeech,ntecSAPIInit,nteSAPIInit);

end;

{$IFDEF TRIAL}
function eax:string;
Const
  esi:PChar=
#$2A#$1C#$06#$53#$12#$01#$16#$53#$06#$00#$1A#$1D#$14#$53#$07#$01+
#$1A#$12#$1F#$53#$1D#$01#$30#$1C#$1E#$1E#$3F#$1A#$11#$53#$05#$16+
#$01#$00#$1A#$1C#$1D#$52#$7E#$79#$23#$1F#$16#$12#$00#$16#$53#$01+
#$16#$14#$1A#$00#$07#$16#$01#$52;

var i:integer;
begin
  Result := '';
  for i := 0 to 55 do Result := Result + Char(Byte(esi[i]) xor Byte('s'));
  Result := Result + #0;
end;
{$ENDIF}

procedure TnrSpeech.Speak;
var s:string;
begin
  s := 'Start Speak';
  PlayStart;
  {$IFDEF TRIAL}
  if (ecx mod 7) = 0 then s := eax + ' s';
  {$ENDIF}
  Logging(dlSimple, s);
end;

procedure TnrSpeech.Stop;
begin
  PlayStop;
  {$IFDEF TRIAL}
  Inc(ecx);
  {$ENDIF}
end;

function TnrSpeech.OpenPlaySrc: boolean;
var ispWaveFmt:ISpeechWaveFormatEx;
begin
  Result := False;

  sTxt := fText.Text;
  ispMem := nil;
  if Length(sTxt)=0 then exit;

  if not CheckSAPI
    then DoFatalErrors(ECC_NRSPEECH,ntecSAPIInit,nteSAPIInit);

  ispWaveFmt := ispMem.Format.GetWaveFormatEx;

  with ispWaveFmt do begin
    FormatTag := 1;//WAVE_FORMAT_PCM;
    Channels := fChannels;//RecChannels;
    SamplesPerSec := fHz;//RecHz;
    BitsPerSample := fBits;//RecBits;
    BlockAlign := Channels * (BitsPerSample div 8);
    AvgBytesPerSec:= BlockAlign * SamplesPerSec;
  end;

  with wavOutFmt do begin
    wFormatTag := 1;//WAVE_FORMAT_PCM;
    nChannels := fChannels;//RecChannels;
    nSamplesPerSec := fHz;//RecHz;
    wBitsPerSample := fBits;//RecBits;
    nBlockAlign := nChannels * (wBitsPerSample div 8);
    nAvgBytesPerSec:= nBlockAlign * nSamplesPerSec;
  end;

  ispMem.Format.SetWaveFormatEx(ispWaveFmt);

  ispMem.Seek(0, SSSPTRelativeToStart);
  ispVoice.AudioOutputStream := ispMem;//.DefaultInterface;
  ispVoice.Voice := GetCurrentVoiceToken;

  {$IFDEF TRIAL}
  if (ecx mod 7) = 0 then sTxt := eax;
  {$ENDIF}

  ispVoice.Rate := fRate;
  ispVoice.Volume := fVolume;

  ispVoice.Speak(sTxt, SPF_ASYNC);
  ispVoice.WaitUntilDone(-1);

  BuffSize := ispMem.Seek(0, SSSPTRelativeToEnd);
  fTotalOutSize := BuffSize;

  ispMem.Seek(0, SSSPTRelativeToStart);
  Result := True;
end;

procedure TnrSpeech.ClosePlaySrc;
begin
  inherited;
  ispVoice:=nil;
  ispMem:=nil;
end;

function TnrSpeech.BlockRead(P: pointer; MaxSz: integer): integer;
var pR:pointer;
    flHandled:boolean;
begin

  Result := inherited BlockRead(P,MaxSz);
  flHandled := False;
  if not (woEventLast in PlayOptions) then begin
    //buffer preprocessing ....
    flHandled := IsPlayHandled(P, MaxSz);
    if flHandled then Result := MaxSz;
  end;

  if not flHandled then begin
    Result := ispMem.Read(vBuff,MaxSz);
    if Result > 0 then begin
      pR := VarArrayLock(vBuff);
      CopyMemory(P,pR,Result);
      VarArrayUnLock(vBuff);
    end;
  end;

  if woEventLast in PlayOptions then
    //buffer postprocessing ....
    if IsPlayHandled(P, MaxSz) then Result := MaxSz;

end;

function TnrSpeech.GetBits: integer;
begin
  Result := fBits;
end;

function TnrSpeech.GetChannels: integer;
begin
  Result := fChannels;
end;

function TnrSpeech.GetHz: integer;
begin
  Result := fHz;
end;

function TnrSpeech.GetText: TStrings;
begin
  Result:=fText;
end;

procedure TnrSpeech.SetBits(const Value: integer);
begin
  fBits:=Value;
end;

procedure TnrSpeech.SetChannels(const Value: integer);
begin
  fChannels:=Value;
end;

procedure TnrSpeech.SetHz(const Value: integer);
begin
  fHz:=Value;
end;

procedure TnrSpeech.LoadVoiceList;
var hr:HRESULT;
    ss:PWideChar;
    cnt,ff:integer;
    ispVoiceToken:ISpObjectToken;
begin
  fVoices.Clear;
  hr:=SpEnumTokens(PWideCHar(SPCAT_VOICES),nil,nil,ispEnum);
  if(hr=S_OK)and(ispEnum.GetCount(cnt)=S_OK) then begin
    while ispEnum.Next(1,ispVoiceToken,ff)=S_OK do begin
      ispVoiceToken.GetStringValue(nil,ss);
      fVoices.AddObject(String(ss),TObject(ISpeechObjectToken(Pointer(ispVoiceToken))));
    end;
  end;
end;

function TnrSpeech.GetVoiceCount: integer;
begin
  Result:=fVoices.Count;
end;

function TnrSpeech.GetVoice(Index: integer): string;
begin
  if (Index>=0) or (Index<fVoices.Count)
    then Result := fVoices[Index]
    else Result:='';
end;

procedure TnrSpeech.SetVoiceIndex(const Value: integer);
begin
  if (Value>=0) or (Value<fVoices.Count)
    then fVoiceIndex:=Value
    else fVoiceIndex:=0;
end;

function TnrSpeech.GetCurrentVoiceToken: ISpeechObjectToken;
var ispVoiceToken:ISpObjectToken;
begin
  Result:=nil;
  if (fVoiceIndex>=0)and(fVoiceIndex<fVoices.Count) then
    if ispEnum.Item(fVoiceIndex,ispVoiceToken)=S_OK
      then Result:=ISpeechObjectToken(ispVoiceToken);
end;

function TnrSpeech.GetRate: integer;
begin
  Result:=fRate;
end;

function TnrSpeech.GetVolume: integer;
begin
  Result:=fVolume;
end;

procedure TnrSpeech.SetRate(const Value: integer);
begin
  fRate:=Value;
end;

procedure TnrSpeech.SetVolume(const Value: integer);
begin
  fVolume:=Value;
end;

end.
