home *** CD-ROM | disk | FTP | other *** search
- {TMonolog - A simple component for use with Monologue for WIndows}
- {Suggestions for improvement are appreciated - I am self taught }
- {And as such some of my coding might be a bit off ! }
- {This component does have exception handling to try and head off }
- {and potential GPF's but it's been my experience that you *MUST* }
- {have your monologue for windows directory in your path. }
- {Freeware by Derek Stutsman (dereks@metronet.com) }
-
- unit Monolog;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs;
-
- type
- TMonolog = class(TComponent)
- private
- glbLCB : longint;
- fPitch,fSpeed : Integer;
- fText : String;
- procedure SayText(Speech : String);
- { Private declarations }
- protected
- { Protected declarations }
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- published
- { Published declarations }
- property Pitch : Integer read fPitch write fPitch;
- property Speed : Integer read fSpeed write fSpeed;
- property Text : String read fText write SayText;
- end;
-
- procedure Register;
-
- implementation
-
- function OpenSpeech(HWND:Thandle;mode:Word;voicetype:Pchar) : Longint; far; external 'FB_SPCH.DLL';
- function Say(scb:longint;lpText:Pchar): Integer; far; external 'FB_SPCH.DLL';
- function Closespeech(SCB:Longint):integer; far; external 'FB_SPCH.DLL';
-
- procedure Register;
- begin
- RegisterComponents('Samples', [TMonolog]);
- end;
-
- constructor TMonolog.Create(Aowner: TComponent);
- begin
- inherited create(AOwner);
- try
- glbLCB := OpenSpeech(0,0,NIL);
- fPitch := 5;
- fSpeed := 5;
- except
- on EGPFault do application.messagebox('Monologue for Windows Error',
- 'Unable to start Monologue Engine. '+#13+#10+
- 'Make sure your Monologue Directory is in your path.',0);
- end;
- end;
-
- destructor TMonolog.Destroy;
- begin
- try
- closespeech(glbLCB);
- except
- on eGPFault do
- begin
- {Nothing, I just wanted to suppress the GP fault}
- end;
- end;
- inherited destroy;
- end;
-
- procedure TMonolog.Saytext(Speech : String);
- var saystring : String;
- psaystring : Pchar;
- ret : integer;
- begin
- saystring := '<<~P'+inttostr(fpitch)+'S'+inttostr(fspeed)+'>>'+Speech+#0;
- psaystring :=@saystring[1];
- try
- ret := say(glbLCB, psaystring);
- except
- on EGPFault do application.messagebox('Unable to say text; Monologue did not initialize','Speech Error!',0);
- end;
- ftext := '';
- end;
-
- end.
-