speechthreadunit.pas

采用多线程方式朗读中文文档

unit SpeechThreadUnit;

interface

uses
  Classes,def,Windows,Dialogs,Forms,SysUtils;

type
  TSpeechThread = class(TThread)
  private
    { Private declarations }
    FbRead     :boolean;
    FcSpeech   :PChar;
    FLength    :Integer;
    FsList     :TStrings;
    LibHandle    : HINST;
    TtsInit      : TTtsInit;
    TtsFree      : TTtsFree;
    StartReading : TStartReading;
    StopReading  : TStopReading;
    IsReading    : TIsReading;
  protected
    procedure Execute; override;
  public

    bCanRead  :boolean;
    procedure SetSpeechList(aList:TStrings);
    function GetBRead():boolean;
    function IsbReading():boolean;
    procedure StopSpeech();
    procedure SpeechSentence(StrSen:String);
    function LoadSpeechLibrary():boolean;
    procedure FreeSpeechLibrary();
    constructor Create(CreateSupspend:boolean);
    destructor Destroy;override;
  published
    property bReading :boolean Read GetBRead;
  end;

implementation

{ Important: Methods and properties of objects in VCL or CLX can only be used
  in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TSpeechThread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ TSpeechThread }




constructor TSpeechThread.Create(CreateSupspend:boolean);
begin
  FsList:=TStringlist.Create ;
  bCanRead:=LoadSpeechLibrary();
  Inherited Create(CreateSupspend);
  FreeOnTerminate := true;  
end;

destructor TSpeechThread.Destroy ;
begin
  FsList.Free ;
  FreeSpeechLibrary();
  inherited Destroy;
end;
 
procedure TSpeechThread.SetSpeechList(aList:TStrings);
begin
  if (aList=nil)or FbRead then exit;
  if aList.Count <=0 then exit;
  FsList.Assign(aList);
  FbRead:=true;
end;

procedure TSpeechThread.Execute;
var
  i:Integer;
  Str:String;
begin
  { Place thread code here }
  FbRead:=false;
  while not Terminated do
  begin
    if not FbRead then
    begin
      Sleep(10);
      Continue;
    end;
    for i:=0 to FsList.Count -1 do
    begin
      Str:=Trim(FsList.Strings[i]);
      FLength:=Length(Str);
      if FLength<=0 then continue;
      FcSpeech   :=PChar(Str);
      StartReading(FcSpeech,FLength);
      while IsReading() do
      begin
        Sleep(10);
        if not FbRead then break;
      end;
      if not FbRead then break;
    end;
    FbRead:=false;
  end;
  FbRead:=false;
end;

procedure TSpeechThread.SpeechSentence(StrSen:String);
var
  Str:String;
begin
  Str:=Trim(StrSen);
  FLength:=Length(Str);
  if FLength<=0 then Exit;
  FcSpeech   :=PChar(Str);
  FbRead:=true;
 
end;

procedure TSpeechThread.StopSpeech();
begin
  FbRead:= false;
  if not bCanRead then exit;
  if IsReading() then StopReading();
  
end;
function TSpeechThread.GetBRead():boolean;
begin
  Result:= FbRead;
end;

function TSpeechThread.IsbReading():boolean;
begin
 Result:= IsReading();
end;
//------------------------------------------------------------------------------
//功能：  装载语音库
//参数：
//返回值：无
function TSpeechThread.LoadSpeechLibrary():boolean;
begin
    Result:=false;
    LibHandle:= LoadLibrary('ctts.dll');
    if LibHandle = 0 then exit;
        

    @TtsInit:= GetProcAddress(LibHandle, 'TtsInit');
    if @TtsInit = nil then exit;

    @TtsFree:= GetProcAddress(LibHandle, 'TtsFree');
    if @TtsFree = nil then exit;

    @StartReading:= GetProcAddress(LibHandle, 'StartReading');
    if @StartReading = nil then exit;

    @StopReading:= GetProcAddress(LibHandle, 'StopReading');
    if @StopReading = nil then exit;

    @IsReading:= GetProcAddress(LibHandle, 'IsReading');
    if @IsReading = nil then exit;

    TtsInit(Application.Handle);
    Result:=true;
    if GetLastError()>0 then
    begin
      //g_bHaveYuYinTiShi :=false;
      Result:=false;
      MessageDlg('您需要安装DirectX 7以上版本的DirectX.',mtInformation, [mbOk], 0);
    end;
end;
//释放语音库
procedure TSpeechThread.FreeSpeechLibrary();
begin
  if LibHandle <> 0 then
  begin
    TtsFree();
    FreeLibrary(LibHandle);
  end;
end;
end.