Delphi How To Use Microsoft Speech Recognition API - delphi

I need some help with my code, my application supposed to get my voice and write everything i say in a TMemo component, but it's simply doesn't do anything
Here is my code:
Am using SAPI 5.4 Microsoft Speech Object Library
procedure TForm1.initRecognizer;
begin
// Create Voice Handler
SpVoice := TSpVoice.Create(nil);
//**//
// Create Reconizer Context
SpInProcRecoContext := TSpInProcRecoContext.Create(nil);
SpInProcRecoContext.OnHypothesis := SpInProcRecoContextHypothesis;
SpInProcRecoContext.OnRecognition := SpInProcRecoContextRecognition;
//**//
// Create Grammar Rule
RecoGrammar := SpInProcRecoContext.CreateGrammar(0);
RecoGrammar.DictationSetState(SGDSActive);
//**//
end;
procedure TForm1.SpInProcRecoContextHypothesis(ASender: TObject;
StreamNumber: Integer; StreamPosition: OleVariant;
const Result: ISpeechRecoResult);
begin
Memo1.Text := Result.PhraseInfo.GetText(0,-1,true);
end;
procedure TForm1.SpInProcRecoContextRecognition(ASender: TObject;
StreamNumber: Integer; StreamPosition: OleVariant;
RecognitionType: SpeechRecognitionType; const Result: ISpeechRecoResult);
begin
SpInProcRecoContext.Recognizer.AudioInput := Result;
Memo1.Text := Result.PhraseInfo.GetText(0,-1,true);
end;
Please If there's a fix Will appreciate it, thanks in advance.

Related

Launch HTML Help as Separate Process

I am using XE7 64 and I am looking for a strategy to solve several problems I am having when displaying HTMLHelp files from within my applications (I have added the HTMLHelpViewer to my uses clause). The issues are the following: 1) Ctrl-c does not copy text from topics; 2) The helpviewer cannot be accessed when a modal dialog is active.
The source of the problems are presumably attributable to the htmlhelpviewer running in the same process as the application. Is there a way to have the built-in htmlhelpviewer launch a new process? If not, then will I need to launch HH.EXE with Createprocess?
You could launch the help file viewer as a separate process, but I think that will make controlling it even more complex. My guess is that the supplied HTML help viewer code is the root cause of your problems. I've always found that code to be extremely low quality.
I deal with that by implementing an OnHelp event handler that I attach to the Application object. This event handler calls the HtmlHelp API directly. I certainly don't experience any of the problems that you describe.
My code looks like this:
unit Help;
interface
uses
SysUtils, Classes, Windows, Messages, Forms;
procedure ShowHelp(HelpContext: THelpContext);
procedure CloseHelpWindow;
implementation
function RegisterShellHookWindow(hWnd: HWND): BOOL; stdcall; external user32;
function DeregisterShellHookWindow(hWnd: HWND): BOOL; stdcall; external user32;
procedure ShowHelp(HelpContext: THelpContext);
begin
Application.HelpCommand(HELP_CONTEXTPOPUP, HelpContext);
end;
type
THelpWindowManager = class
private
FMessageWindow: HWND;
FHelpWindow: HWND;
FHelpWindowLayoutPreference: TFormLayoutPreference;
function ApplicationHelp(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean;
protected
procedure WndProc(var Message: TMessage);
public
constructor Create;
destructor Destroy; override;
procedure RestorePosition;
procedure StorePosition;
procedure StorePositionAndClose;
end;
{ THelpWindowManager }
constructor THelpWindowManager.Create;
function DefaultRect: TRect;
var
i, xMargin, yMargin: Integer;
Monitor: TMonitor;
begin
Result := Rect(20, 20, 1000, 700);
for i := 0 to Screen.MonitorCount-1 do begin
Monitor := Screen.Monitors[i];
if Monitor.Primary then begin
Result := Monitor.WorkareaRect;
xMargin := Monitor.Width div 20;
yMargin := Monitor.Height div 20;
inc(Result.Left, xMargin);
dec(Result.Right, xMargin);
inc(Result.Top, yMargin);
dec(Result.Bottom, yMargin);
break;
end;
end;
end;
begin
inherited;
FHelpWindowLayoutPreference := TFormLayoutPreference.Create('Help Window', DefaultRect, False);
FMessageWindow := AllocateHWnd(WndProc);
RegisterShellHookWindow(FMessageWindow);
Application.OnHelp := ApplicationHelp;
end;
destructor THelpWindowManager.Destroy;
begin
StorePositionAndClose;
Application.OnHelp := nil;
DeregisterShellHookWindow(FMessageWindow);
DeallocateHWnd(FMessageWindow);
FreeAndNil(FHelpWindowLayoutPreference);
inherited;
end;
function THelpWindowManager.ApplicationHelp(Command: Word; Data: THelpEventData; var CallHelp: Boolean): Boolean;
var
hWndCaller: HWND;
HelpFile: string;
DoSetPosition: Boolean;
begin
CallHelp := False;
Result := True;
//argh, WinHelp commands
case Command of
HELP_CONTEXT,HELP_CONTEXTPOPUP:
begin
hWndCaller := GetDesktopWindow;
HelpFile := Application.HelpFile;
DoSetPosition := FHelpWindow=0;//i.e. if the window is not currently showing
FHelpWindow := HtmlHelp(hWndCaller, HelpFile, HH_HELP_CONTEXT, Data);
if FHelpWindow=0 then begin
//the topic may not have been found because the help file isn't there...
if FileExists(HelpFile) then begin
ReportError('Cannot find help topic for selected item.'+sLineBreak+sLineBreak+'Please report this error message to Orcina.');
end else begin
ReportErrorFmt(
'Cannot find help file (%s).'+sLineBreak+sLineBreak+'Reinstalling the program may fix this problem. '+
'If not then please contact Orcina for assistance.',
[HelpFile]
);
end;
end else begin
if DoSetPosition then begin
RestorePosition;
end;
HtmlHelp(hWndCaller, HelpFile, HH_DISPLAY_TOC, 0);//ensure that table of contents is showing
end;
end;
end;
end;
procedure THelpWindowManager.RestorePosition;
begin
if FHelpWindow<>0 then begin
RestoreWindowPosition(FHelpWindow, FHelpWindowLayoutPreference);
end;
end;
procedure THelpWindowManager.StorePosition;
begin
if FHelpWindow<>0 then begin
StoreWindowPosition(FHelpWindow, FHelpWindowLayoutPreference);
end;
end;
procedure THelpWindowManager.StorePositionAndClose;
begin
if FHelpWindow<>0 then begin
StorePosition;
SendMessage(FHelpWindow, WM_CLOSE, 0, 0);
FHelpWindow := 0;
end;
end;
var
WM_SHELLHOOKMESSAGE: UINT;
procedure THelpWindowManager.WndProc(var Message: TMessage);
begin
if (Message.Msg=WM_SHELLHOOKMESSAGE) and (Message.WParam=HSHELL_WINDOWDESTROYED) then begin
//need cast to HWND to avoid range errors
if (FHelpWindow<>0) and (HWND(Message.LParam)=FHelpWindow) then begin
StorePosition;
FHelpWindow := 0;
end;
end;
Message.Result := DefWindowProc(FMessageWindow, Message.Msg, Message.wParam, Message.lParam);
end;
var
HelpWindowManager: THelpWindowManager;
procedure CloseHelpWindow;
begin
HelpWindowManager.StorePositionAndClose;
end;
initialization
if not ModuleIsPackage then begin
Application.HelpFile := ChangeFileExt(Application.ExeName, '.chm');
WM_SHELLHOOKMESSAGE := RegisterWindowMessage('SHELLHOOK');
HelpWindowManager := THelpWindowManager.Create;
end;
finalization
FreeAndNil(HelpWindowManager);
end.
Include that unit in your project and you will be hooked up to handle help context requests. Some comments on the code:
The implementation of the OnHelp event handler is limited to just my needs. Should you need more functionality you'd have to add it yourself.
You won't have TFormLayoutPrefernce. It's one of my preference classes that manages per-user preferences. It stores away the window's bounds rectangle, and whether or not the window was maximised. This is used to ensure that the help window is shown at the same location as it was shown in the previous session. If you don't want such functionality, strip it away.
ReportError and ReportErrorFmt are my helper functions to show error dialogs. You can replace those with calls to MessageBox or similar.
Based on David's comments that he calls HtmlHelp directly and does not encounter the problems noted above, I tried that approach and it solved the problems. Example of calling HTMLHelp directly to open a topic by id:
HtmlHelp(Application.Handle,'d:\help study\MyHelp.chm',
HH_HELP_CONTEXT, 70);

Firemonkey TEdit Uppercase

I am having problem with Firemonkey TEdit Uppercase in Android.
Code:
procedure TFormMain.Edit1KeyDown(Sender: TObject; var Key: Word;
var KeyChar: Char; Shift: TShiftState);
begin
KeyChar := UpCase(KeyChar);
end;
In Win32 it works but in Android it's not working.
You have to use ChangeTracking event. It works fine
This code works on Android
procedure TFormMain.Edit1Typing(Sender: TObject);
begin
Edit1.Text:=AnsiUpperCase(Edit1.Text);
Edit1.GoToTextEnd;
end;
This code works on windows:
procedure TFormMain.Edit1ChangeTracking(Sender: TObject);
var
thetext: String;
begin
thetext := Edit1.Text;
Edit1.OnChangeTracking := nil;
Edit1.Text := '';
Edit1.Text := AnsiUpperCase(thetext);
Edit1.OnChangeTracking := Edit1ChangeTracking;
Edit1.GoToTextEnd;
end;
Use ToUpper (Documentation) or AnsiUpperCase (Documentation) for strings.
UPDATE: Why are you using OnKeyDown? According to Documentation you must use OnChangeTracking: "This event provides the first opportunity to respond to modifications the user brought to the text of the edit control."
So put in OnChangeTracking something like
procedure TFormMain.Edit1ChangeTracking(Sender: TObject);
begin
Edit1.text:= AnsiUpperCase(Edit1.text);
end;

How to set the default audio input for Delphi?

I wonder how I can to set my default audio capture device (microphone) through Delphi.
I'm trying to use the functions of mmsystem api, following my code
procedure TForm1.Button1Click(Sender: TObject);
var
DevOutCaps: TWaveOutCaps;
DevInCaps: TWaveInCaps;
n, i: Integer;
s: String;
begin
n := waveInGetNumDevs;
for i := 0 to n-1 do
begin
waveInGetDevCaps(i, #DevInCaps, SizeOf(DevInCaps));
s := PChar(#DevInCaps.szPname);
ListBox1.Items.Add(s);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Ndev : Integer;
Adev : Integer;
begin
Ndev := AudioInDeviceNameToDeviceID(ListBox1.Items.Strings[ListBox1.ItemIndex]);
Adev := GetWaveInDevice;
ShowMessage( IntToStr(Adev) );
ShowMessage(ListBox1.Items.Strings[ListBox1.ItemIndex]);
ShowMessage( IntToStr(Ndev) );
if waveInMessage(HWAVEIN(WAVE_MAPPER), DRVM_MAPPER_PREFERRED_SET, Adev, Ndev) = MMSYSERR_NOTSUPPORTED then
begin
MessageDlg('NOT SUPPORTED', mtInformation, [mbOK], 0);
end;
Preferably no third party components.
Thank you
The WinMM API would seem to be the way to go, using the DRVM_MAPPER_PREFERRED_SET message Apparently, it is supported although undocumented under Win32 :-
WinMM API

Delphi: Detect when a new form has been created

I'd like to detect when a new form has been created.
Now I use the Screen.ActiveFormChange event and check for new forms in Screen.CustomForms but ActiveFormChange is fired after the OnShow event of the form.
I'd like to detect the form even before OnShow was fired. Is there any way to do this without modifying the Vcl.Forms unit?
I'd like to detect all forms (also Delphi modal messages etc.) therefore inheriting all forms from a custom class is not possible (correct me if I am wrong).
Alternatively, is it possible to detect that a new component was added to some TComponent.FComponents list?
You can use the SetWindowsHookEx function to install a WH_CBT Hook, then you must implement a CBTProc callback function and finally intercept one of the possible code values for this hook. in this case you can try with HCBT_ACTIVATE or HCBT_CREATEWND.
Check this sample for the HCBT_ACTIVATE Code.
var
hhk: HHOOK;
function CBT_FUNC(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
const
ClassNameBufferSize = 1024;
var
hWindow: HWND;
RetVal : Integer;
ClassNameBuffer: Array[0..ClassNameBufferSize-1] of Char;
begin
Result := CallNextHookEx(hhk, nCode, wParam, lParam);
if nCode<0 then exit;
case nCode of
HCBT_ACTIVATE:
begin
hWindow := HWND(wParam);
if (hWindow>0) then
begin
RetVal := GetClassName(wParam, ClassNameBuffer, SizeOf(ClassNameBuffer));
if RetVal>0 then
begin
//do something
OutputDebugString(ClassNameBuffer);
end;
end;
end;
end;
end;
Procedure InitHook();
var
dwThreadID : DWORD;
begin
dwThreadID := GetCurrentThreadId;
hhk := SetWindowsHookEx(WH_CBT, #CBT_FUNC, hInstance, dwThreadID);
if hhk=0 then RaiseLastOSError;
end;
Procedure KillHook();
begin
if (hhk <> 0) then
UnhookWindowsHookEx(hhk);
end;
initialization
InitHook();
finalization
KillHook();
end.
Note : if you uses the HCBT_CREATEWND code instead you will
intercept any window created by the system not just "forms".
Track Screen.CustomFormCount in Application.OnIdle:
private
FPrevFormCount: Integer;
end;
procedure TForm1.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
if Screen.CustomFormCount > FPrevFormCount then
Caption := Caption + ' +1';
if Screen.CustomFormCount <> FPrevFormCount then
FPrevFormCount := Screen.CustomFormCount;
end;
procedure TForm1.TestButton1Click(Sender: TObject);
begin
TForm2.Create(Self).Show;
end;
procedure TForm1.TestButton2Click(Sender: TObject);
begin
ShowMessage('Also trackable?'); // Yes!
end;
procedure TForm1.TestButton3Click(Sender: TObject);
begin
OpenDialog1.Execute; // Doesn't update Screen.CustomFormCount
end;
Native dialogs managed and shown by Windows (TOpenDialog, TFontDialog, etc...) are created apart from the VCL and to track them also, you need a hacking unit. Try this one then.
Thanks to David I found a solution: The clue is to replace Screen.AddForm method with your own. The way how to do it is described in these SO answers:
How I can patch a private method of a delphi class?
How to change the implementation (detour) of an externally declared function
Patch routine call in delphi
Thanks again!

Start program and dock with an existing program Delphi 2010

Is there a way in Delphi 2010 to start an application using ShellExecute then dock that application inside another?
I.e. Program A written in Delphi contains 1 form. When the form is shown, Program B, written in C# is started up and docked client into Program A's form?
Paul
Yes you can do this. You need to get hold of the window handle of the main form in the other process (call EnumWindows). Then call SetParent to make that window a child of your window.
You'll likely want to modify window style, position etc. Also call WaitForInputIdle before trying to find a window handle in the new process. You've got to give the new process a chance to get started.
What you now have is a pretty queer beast. Inside one container you have two processes. Each process has its own UI thread. You can show and interact with two modal dialogs at once. There's really no end to the fun you can have with this!
EDIT
Just for a bit of fun I had a go at writing a simple Delphi app to do this. It's rather brittle and only seems to work for very basic apps. I think you could spend a long time trying to make this work well and still end up with an unsatisfactory result. If I were you I'd look for other solutions, especially as you have the source for this C# app. Surely you could expose its functionality as an ActiveX?
Anyway, for your amusement I offer the following exceedingly un-polished piece of code:
program AppHost;
uses
Windows, Messages, SysUtils, Forms, Controls, ComCtrls;
{$R *.res}
procedure ResizePage(Page: TTabSheet);
var
hwnd: Windows.HWND;
Rect: TRect;
begin
hwnd := Page.Tag;
Rect := Page.ClientRect;
MoveWindow(hwnd, Rect.Left, Rect.Top, Rect.Right-Rect.Left, Rect.Bottom-Rect.Top, True);
end;
type
PEnumData = ^TEnumData;
TEnumData = record
ProcessID: DWORD;
hwnd: HWND;
end;
function EnumWindowsProc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
ProcessId: DWORD;
EnumData: PEnumData;
begin
EnumData := PEnumData(lParam);
GetWindowThreadProcessId(hwnd, ProcessId);
if EnumData.ProcessID=ProcessID then begin
EnumData.hwnd := hwnd;
Result := False;
exit;
end;
Result := True;
end;
procedure Absorb(PageControl: TPageControl; const App: string; StartupInfo: TStartupInfo);
var
Page: TTabSheet;
ProcessInformation: TProcessInformation;
EnumData: TEnumData;
begin
Page := TTabSheet.Create(PageControl);
Page.PageControl := PageControl;
Page.Caption := ChangeFileExt(ExtractFileName(App), '');
CreateProcess(PChar(App), nil, nil, nil, False, 0, nil, nil, StartupInfo, ProcessInformation);
WaitForInputIdle(ProcessInformation.hProcess, INFINITE);
EnumData.ProcessID := ProcessInformation.dwProcessId;
EnumData.hwnd := 0;
EnumWindows(#EnumWindowsProc, LPARAM(#EnumData));
Page.Tag := Integer(EnumData.hwnd);
SetParent(HWND(Page.Tag), Page.Handle);
ResizePage(Page);
end;
type
TEventProvider = class
private
FForm: TForm;
FPageControl: TPageControl;
procedure FormResize(Sender: TObject);
public
constructor Create(Form: TForm; PageControl: TPageControl);
end;
{ TEventProvider }
constructor TEventProvider.Create(Form: TForm; PageControl: TPageControl);
begin
inherited Create;
FForm := Form;
FPageControl := PageControl;
FForm.OnResize := FormResize;
end;
procedure TEventProvider.FormResize(Sender: TObject);
var
i: Integer;
begin
for i := 0 to FPageControl.PageCount-1 do begin
ResizePage(FPageControl.Pages[i]);
end;
end;
procedure Main(Form: TForm);
var
StartupInfo: TStartupInfo;
PageControl: TPageControl;
begin
Form.ClientHeight := 600;
Form.ClientWidth := 800;
Form.Caption := 'All your processes are belong to us';
PageControl := TPageControl.Create(Form);
PageControl.Parent := Form;
PageControl.Align := alClient;
StartupInfo.cb := SizeOf(StartupInfo);
GetStartupInfo(StartupInfo);
Absorb(PageControl, 'C:\Windows\Notepad.exe', StartupInfo);
Absorb(PageControl, 'C:\Program Files\CommandLine\depends.exe', StartupInfo);
TEventProvider.Create(Form, PageControl);
end;
var
Form: TForm;
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm, Form);
Main(Form);
Application.Run;
Form.Free;
end.
Yes I have access to the C# program
I need a solution that works irrespective of the language, but any program that is loaded in this way will be one that we write
GetProcessID returns 0?
All I have done for now is to produce 2 programs in Delphi, 1 calls the other
I then want to get dockapp2 to dock inside of dockapp1 and for the user to have no idea that this is a seperate program.
Having GetProcessID returning 0 is not ideal!
procedure TForm2.BitBtn1Click(Sender: TObject);
var
n: Integer;
n2: Integer;
begin
n := ShellExecute(0, 'open', PChar('c:\temp\dockapp2\dockapp2.exe'), nil, nil, SW_SHOWNORMAL);
n2:= GetProcessId(n);
Caption := IntToStr(n2);
end;

Resources