What is the equivalent of the piece of code below for zooming with the new TEdgeBrowser delphi component?
This is how I used the old TWebBrowser component.
procedure ApplyZoom(ZoomValue: Integer);
var
pvaIn, pvaOut: OLEVariant;
begin
pvaIn := ZoomValue;
pvaOut := Null;
WebBrowser.ControlInterface.ExecWB($0000003F, OLECMDEXECOPT_DONTPROMPTUSER, pvaIn, pvaOut);
end;
Related
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.
I'm using Delphi 10 Seattle to build a multi device project with firemonkey.
My project has a ListBox, and I fill it runtime with ListBoxItems. I want to add the LongTap gesture to the ListBoxItems.
I have already tried this:
gestureManager := TGestureManager.Create(nil);
listBoxItem.Touch.GestureManager := gestureManager;
listBoxItem.Touch.InteractiveGestures := [TInteractiveGesture.LongTap];
listBoxItem.OnGesture := ListBoxItemGesture;
But the onGesture method doesn't get called. If I add the gestureManager to the Form in the designer and call the same onGesture method it does get called.
Gestures don't work with controls inside ScrollBox and descendants (I don't know, why). You should use ListBox.Touch, ListBox.OnGesture and analyze Selected property:
ListBox1.Touch.GestureManager := FmyGestureManager;
ListBox1.Touch.InteractiveGestures := [TInteractiveGesture.LongTap];
ListBox1.OnGesture := ListBox1Gesture;
procedure THeaderFooterForm.ListBox1Gesture(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
if (Sender = ListBox1) and Assigned(ListBox1.Selected) then
begin
lblMenuToolBar.Text := 'Handled' + ListBox1.Selected.Text;
Handled := True;
end;
end;
Or, more complex method - find item by gesture location:
procedure THeaderFooterForm.ListBox1Gesture(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean);
var
c: IControl;
ListBox: TListBox;
lbxPoint: TPointF;
ListBoxItem: TListBoxItem;
begin
c := ObjectAtPoint(EventInfo.Location);
if Assigned(c) then
if Assigned(c.GetObject) then
if c.GetObject is TListBox then
begin
ListBox := TListBox(c.GetObject);
lbxPoint := ListBox.AbsoluteToLocal(EventInfo.Location);
ListBoxItem := ListBox.ItemByPoint(lbxPoint.X, lbxPoint.Y);
if Assigned(ListBoxItem) then
lblMenuToolBar.Text := 'Handled ' + ListBoxItem.Text;
Handled := True;
end;
end;
The right solution is much more banal:
for i:=0 to pred(ListBox1.items.count)do
begin
ListBox1.ItemByIndex(i).Touch.GestureManager:=GestureManager1;
ListBox1.ItemByIndex(i).Touch.InteractiveGestures :=
[TInteractiveGesture.LongTap, TInteractiveGesture.DoubleTap];
ListBox1.ItemByIndex(i).OnGesture := ListBoxitemGesture;
ListBox1.ItemByIndex(i).HitTest:=true;
end;
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!
What I'm trying:
I need a TWebBrowser which is always zoomed in (~140%) AND keeps all links in the same webbrowser (ie. _BLANK links should be opened in the same browser control).
How I'm doing that:
I have set the FEATURE_BROWSER_EMULATION in registry to 9999, so the webpages are rendered with IE9. I have confirmed that this is working. Furthermore, I'm running the compiled program on a fresh install of Windows 7 with IE9, fully updated through Windows Update.
Zoom:
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OLEVariant;
begin
ZoomFac := 140;
WebBrowser1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
This works perfectly.
Open new windows in the same browser control:
By default, TWebBrowser opens a new IE, when it encounters a link set to be opened in a new window. I need it to stay in my program/webbrowser.
I have tried many things here. This works for me:
procedure TFormWeb.WebBrowser1NewWindow3(ASender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool; dwFlags: Cardinal;
const bstrUrlContext, bstrUrl: WideString);
begin
Cancel := True;
WebBrowser1.Navigate(bstrUrl);
end;
I cancel the new window, and instead just navigate to the same URL.
Other sources on various pages on the Internet suggests that I don't cancel and instead set ppDisp to various things such as WebBrowser1.DefaultDispath or WebBrowser1.Application and variations of them. This does not work for me. When I click a _BLANK link, nothing happens. This is tested on two computers (both Win7 and IE9). I don't know why it doesn't work, because this seems to be working for other people on the Internet. Maybe this will solve the problem?
Now the problem:
When I combine these 2 pieces of code, it breaks!
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://wbm.dk/test.htm');
// This is a test page, that I created. It just contains a normal link to google.com
end;
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OLEVariant;
begin
ZoomFac := 140;
WebBrowser1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
procedure TForm1.WebBrowser1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
bstrUrl: WideString);
begin
Cancel := True;
WebBrowser1.Navigate(bstrUrl);
end;
When clicking a link (no matter if it is normal or _BLANK) in the webbrowser at runtime, it produces this error:
First chance exception at $75F1B9BC. Exception class EOleException with message 'Unspecified error'. Process Project1.exe (3288)
If I remove either part of the code, it works (without the removed code, obviously).
Can anybody help me get both things working at the same time?
Thanks for your time!
Update:
This is now a matter of correctly trapping the new window and keep it in the same browser control. The zooming code in OnDocumentComplete has, as far as I can tell, nothing to do with it. It's the zoom in general. If the WebBrowser control has been zoomed (once is enough), the code in NewWindow3 will fail with "Unspecified error". Resetting the zoom level to 100% doesn't help.
By using the zoom code (ExecWB) something changes "forever" in the WebBrowser, which makes it incompatible with the code in NewWindow3.
Can anybody figure it out?
New code:
procedure TForm1.Button1Click(Sender: TObject);
var
ZoomFac: OLEVariant;
begin
ZoomFac := 140;
WebBrowser1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://www.wbm.dk/test.htm');
end;
procedure TForm1.WebBrowser1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
bstrUrl: WideString);
begin
Cancel := True;
WebBrowser1.Navigate(bstrUrl);
end;
Try clicking the link both before and after clicking Button1. After zooming it fails.
You can set ppDisp to a new instance of IWebBrowser2 in the OnNewWindow2 event e.g:
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://wbm.dk/test.htm');
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OleVariant;
begin
// the top-level browser
if pDisp = TWebBrowser(Sender).ControlInterface then
begin
ZoomFac := 140;
TWebBrowser(Sender).ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
end;
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
var
NewWindow: TForm1;
begin
// ppDisp is nil; this will create a new instance of TForm1:
NewWindow := TForm1.Create(self);
NewWindow.Show;
ppDisp := NewWindow.Webbrowser1.DefaultDispatch;
end;
It is also suggested by Microsoft to set RegisterAsBrowser to true.
You could change this code to open a TWebBrowser in a new tab inside a Page control.
We can not set ppDisp to the current instance of the TWebBrowser - so using this simple code:
ppDisp := WebBrowser1.DefaultDispatch; dose not work.
We need to "recreate" the current/active TWebBrowser, if we want to maintain the UI flow - note that in the following example the TWebBrowser is created on the fly e.g.:
const
CM_WB_DESTROY = WM_USER + 1;
OLECMDID_OPTICAL_ZOOM = 63;
type
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
function CreateWebBrowser: TWebBrowser;
procedure WebBrowserDocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedure WebBrowserNewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
procedure CMWebBrowserDestroy(var Message: TMessage); message CM_WB_DESTROY;
public
WebBrowser: TWebBrowser;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser := CreateWebBrowser;
end;
function TForm1.CreateWebBrowser: TWebBrowser;
begin
Result := TWebBrowser.Create(Self);
TWinControl(Result).Parent := Panel1;
Result.Align := alClient;
Result.OnDocumentComplete := WebBrowserDocumentComplete;
Result.OnNewWindow2 := WebBrowserNewWindow2;
Result.RegisterAsBrowser := True;
end;
procedure TForm1.WebBrowserDocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OleVariant;
begin
// the top-level browser
if pDisp = TWebBrowser(Sender).ControlInterface then
begin
ZoomFac := 140;
TWebBrowser(Sender).ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
end;
procedure TForm1.WebBrowserNewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
var
NewWB: TWebBrowser;
begin
NewWB := CreateWebBrowser;
ppDisp := NewWB.DefaultDispatch;
WebBrowser := NewWB;
// just in case...
TWebBrowser(Sender).Stop;
TWebBrowser(Sender).OnDocumentComplete := nil;
TWebBrowser(Sender).OnNewWindow2 := nil;
// post a delayed message to destory the current TWebBrowser
PostMessage(Self.Handle, CM_WB_DESTROY, Integer(TWebBrowser(Sender)), 0);
end;
procedure TForm1.CMWebBrowserDestroy(var Message: TMessage);
var
Sender: TObject;
begin
Sender := TObject(Message.WParam);
if Assigned(Sender) and (Sender is TWebBrowser) then
TWebBrowser(Sender).Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser.Navigate('http://wbm.dk/test.htm');
end;
I think the problem is that sometimes OnDocumentComplete can fire multiple times on document load (pages with frames).
Here is the way to implement it properly.
I'm using the SHAutoComplete() function from the Shell Lightweight Utility Functions
library to enable path auto completion for edit fields in a modal dialog.
The dialog should close when the Esc key is pressed, but only if auto completion is not active.
How can I check whether a completion list is currently shown for the focused edit control?
Edit:
I'm using Delphi 2009 on Windows XP 64. The code posted by David
procedure TMyForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_ESCAPE then
ModalResult := mrCancel;
end;
does not work for me - the dialog gets closed.
I have tried on several systems, with strange results:
on my PC with Windows XP 64 the dialog closes while the list is dropped down
on Windows XP Pro in a VMware virtual machine the dialog closes too
but
on my laptop with Windows 7 the dialog does not close
on Windows 2000 Pro in a VMware virtual machine the dialog does not close
Since this is so erratic I chose to write a small component that forces the correct behaviour even if the OS doesn't provide it.
The component can be used like this:
procedure TForm2.FormCreate(Sender: TObject);
const
SHACF_FILESYS_DIRS = $00000020;
begin
SHAutoComplete(Edit1.Handle, SHACF_FILESYS_DIRS or SHACF_USETAB);
fAutoSuggestDropdownChecker := TAutoSuggestDropdownChecker.Create(Self);
end;
procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_ESCAPE then begin
if not fAutoSuggestDropdownChecker.DroppedDown then
ModalResult := mrCancel;
end;
end;
but it is important that the Cancel button does not have the Cancel property set.
The component itself works by hooking into application message handling and using window enumeration for the current thread to check for a visible window with the "Auto-Suggest Dropdown" class name. If this exists and is visible then the auto completion list is dropped down.
unit uAutoSuggestDropdownCheck;
interface
uses
Windows, Classes, Messages, Forms;
type
TAutoSuggestDropdownChecker = class(TComponent)
private
fDroppedDown: boolean;
fSaveMessageEvent: TMessageEvent;
procedure AppOnMessage(var AMsg: TMsg; var AHandled: Boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property DroppedDown: boolean read fDroppedDown;
end;
implementation
////////////////////////////////////////////////////////////////////////////////
function EnumThreadWindowsProc(AWnd: HWND; AParam: LPARAM): BOOL; stdcall;
var
WndClassName: string;
FoundAndVisiblePtr: PInteger;
begin
SetLength(WndClassName, 1024);
GetClassName(AWnd, PChar(WndClassName), Length(WndClassName));
WndClassName := PChar(WndClassName);
if WndClassName = 'Auto-Suggest Dropdown' then begin
FoundAndVisiblePtr := PInteger(AParam);
FoundAndVisiblePtr^ := Ord(IsWindowVisible(AWnd));
Result := False;
end else
Result := True;
end;
function IsAutoSuggestDropdownVisible: boolean;
var
FoundAndVisible: integer;
begin
FoundAndVisible := 0;
EnumThreadWindows(GetCurrentThreadId, #EnumThreadWindowsProc,
LParam(#FoundAndVisible));
Result := FoundAndVisible > 0;
end;
////////////////////////////////////////////////////////////////////////////////
// TAutoSuggestDropdownChecker
////////////////////////////////////////////////////////////////////////////////
constructor TAutoSuggestDropdownChecker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fSaveMessageEvent := Application.OnMessage;
Application.OnMessage := AppOnMessage;
end;
destructor TAutoSuggestDropdownChecker.Destroy;
begin
if (TMethod(fSaveMessageEvent).Code = TMethod(Application.OnMessage).Code)
and (TMethod(fSaveMessageEvent).Data = TMethod(Application.OnMessage).Data)
then begin
Application.OnMessage := fSaveMessageEvent;
end;
fSaveMessageEvent := nil;
inherited;
end;
procedure TAutoSuggestDropdownChecker.AppOnMessage(var AMsg: TMsg;
var AHandled: Boolean);
begin
if ((AMsg.message >= WM_KEYFIRST) and (AMsg.message <= WM_KEYLAST))
or ((AMsg.message >= WM_MOUSEFIRST) and (AMsg.message <= WM_MOUSELAST))
or (AMsg.message = WM_CANCELMODE)
then
fDroppedDown := IsAutoSuggestDropdownVisible
end;
end.
The code as posted here is only proof-of-concept but could serve as starting point for those struggling with the same problem.
I can't reproduce your problem. The following OnKeyDown handler, combined with KeyPreview := True gives the desired behaviour in an otherwise empty form.
procedure TMyForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=VK_ESCAPE then
ModalResult := mrCancel;
end;
I guess there is something else in your form that is closing the dialog.