SHAHEEN_AKHTAR
asked on
TWebBrowser Event Capturing
I have a TWebBrowser control on my form. I want to grab the 'href' of the anchor element by capturing click event. I could achieve this in c#. I need to convert to its delphi equivalent. The c# code is appended. The problem with the c# code is after clicking the anchor element, I could grab the 'href' but the browser navigates to the href link. I dont want the Browser to navigate to the href. How can I control that.
Can some one give me the translated Delphi code alongwith the solution to the projected problem.
Thanks in advance.
Can some one give me the translated Delphi code alongwith the solution to the projected problem.
Thanks in advance.
private void Form1_Load(object sender, EventArgs e)
{
object null_obj_str = "";
System.Object null_obj = 0;
axWebBrowser1.Navigate("about:blank", ref null_obj,ref null_obj, ref null_obj_str, ref null_obj_str);
axWebBrowser2.Navigate("http://www.raftaar.com/IEToolBar/ToolBarTyper.html", ref null_obj, ref null_obj, ref null_obj_str, ref null_obj_str);
loadhtml();
}
private void loadhtml()
{
IHTMLDocument2 myDoc = new HTMLDocumentClass();
myDoc = (IHTMLDocument2)axWebBrowser1.Document;
myDoc.write("<marquee WIDTH=100% BEHAVIOR=SCROLL DIRECTION=left scrollamount=2 BGColor=yellow onmouseover=stop(); onmouseout=start();><a href=http://www.raftaar.com/>akhtar</a> </marquee>");
myDoc.close();
HTMLDocumentEvents2_Event htmlEvents = (HTMLDocumentEvents2_Event)myDoc;
htmlEvents.onclick += new HTMLDocumentEvents2_onclickEventHandler(htmlEvents_onclick);
}
private bool htmlEvents_onclick(IHTMLEventObj pEvtObj)
{
if (pEvtObj.srcElement.tagName == "A")
{
HTMLAnchorElementClass a = pEvtObj.srcElement as HTMLAnchorElementClass;
textBox1.Text = a.href;
}
return true;
}
ASKER
Thanks rllibby.
That one worked well. The only problem is the HTML is written again after the anchor is clicked. This is making the marquee to start again. I need your help for starting marquee from the position at which it was clicked.
Thanks a lot again.
That one worked well. The only problem is the HTML is written again after the anchor is clicked. This is making the marquee to start again. I need your help for starting marquee from the position at which it was clicked.
Thanks a lot again.
Thats not how questions work on EE... The original question has been answered, and this follow on belongs in its own thread. I will look at it later though, but I have no idea how you are determining that the html is "written again", as the only place the write is done is in when the document is loaded.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks rllibby,
Before your reply, I have done it through HTML that was passed to WebBrowser control. For the Anchor element, instead of adding href attribute, I have added the url in name attribute. This avoided non-navigating of the browser and continuation of the marquee.
Of course this is not the properway. I have impleted your code in D-2007. Thanks once again for your kind support.
Before your reply, I have done it through HTML that was passed to WebBrowser control. For the Anchor element, instead of adding href attribute, I have added the url in name attribute. This avoided non-navigating of the browser and continuation of the marquee.
Of course this is not the properway. I have impleted your code in D-2007. Thanks once again for your kind support.
First, its not too difficult to bind the DOM events to a delphi wrapped object, you just need to handle the IDispatch. See the source below for TEventObject as to how this works. Second, if you bind to the document's OnClick event, its too late to CancelBubble the event, as the Document will handle the click event (which causes navigation). It is better to bind to the element's OnClick event, which will allow you to cancel the event bubbling.. thus, no navigation. I am listing complete source below that is a conversion from the C# code, and also stops the navigation when the marquee link is clicked. Code was done in D5, so check the uses clause (you may need to include Variants)
Russell
----
unit Unit1;
interface
//////////////////////////
// Include units
//////////////////////////
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, OleCtrls, SHDocVw, MSHTML, ActiveX;
//////////////////////////
// Delphi callback for HTML element events
//////////////////////////
type
THtmlEvent = procedure(Window: IHTMLWindow2; HTMLEvent: IHTMLEventObj) of object;
//////////////////////////
// TEventObject (the tie that binds)
//////////////////////////
type
TEventObject = class(TInterfacedObject, IDispatch)
private
// Private declarations
FWindow: IHTMLWindow2;
FOnEvent: THtmlEvent;
protected
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
public
constructor Create(Window: IHTMLWindow2; OnEvent: THtmlEvent);
procedure BeforeDestruction; override;
property OnEvent: THtmlEvent read FOnEvent write FOnEvent;
end;
//////////////////////////
// Constants
//////////////////////////
const
WM_LOADPAGE = WM_USER + 500;
const
HTML_MARQUEE = '<marquee WIDTH=100% BEHAVIOR=SCROLL DIRECTION=left scrollamount=2 ' +
'BGColor=yellow onmouseover=stop(); onmouseout=start();><a ' +
'href=http://www.raftaar.com/>akhtar</a> </marquee>';
//////////////////////////
// Form to use for hosting the browser window and callback events
//////////////////////////
type
TForm1 = class(TForm)
wbMain: TWebBrowser;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure wbMainDocumentComplete(Sen
protected
// Protected declarations
procedure BindAnchors(Document: IHTMLDocument2);
procedure OnWMLoadPage(var Message: TMessage); message WM_LOADPAGE;
public
// Public declarations
procedure OnElementClick(Window: IHTMLWindow2; HTMLEvent: IHTMLEventObj);
end;
//////////////////////////
// Utility functions
//////////////////////////
function StrToSafeArray(Str: String): PSafeArray;
//////////////////////////
// Globals
//////////////////////////
var
Form1: TForm1;
implementation
{$R *.DFM}
//// TEventObject //////////////////////////
constructor TEventObject.Create(Window
begin
// Perform inherited
inherited Create;
// Save html window and event handler
FWindow:=Window;
FOnEvent:=OnEvent;
end;
procedure TEventObject.BeforeDestruc
begin
// Resource protection
try
// Release the window interface
FWindow:=nil;
finally
// Perform inherited
inherited BeforeDestruction;
end;
end;
function TEventObject.GetIDsOfNames
begin
// Not implemented
result:=E_NOTIMPL;
end;
function TEventObject.GetTypeInfo(I
begin
// Resource protection
try
// Clear pointer ref
Pointer(TypeInfo):=nil;
finally
// Not implemented
result:=E_NOTIMPL;
end;
end;
function TEventObject.GetTypeInfoCo
begin
// Resource protection
try
// Clear count
Count:=0;
finally
// Not implemented
result:=E_NOTIMPL;
end;
end;
function TEventObject.Invoke(DispID
begin
// Check the dispatch ID
if (DispID = DISPID_VALUE) then
begin
// Resource protection
try
// Check event and window, perform event method
if Assigned(FOnEvent) and Assigned(FWindow) then FOnEvent(FWindow, FWindow.event);
finally
// Success
result:=S_OK;
end;
end
else
// Unknown dispatch methof
result:=DISP_E_MEMBERNOTFO
end;
//// TForm1 //////////////////////////
procedure TForm1.FormCreate(Sender: TObject);
begin
// Post message to do the loading
PostMessage(Handle, WM_LOADPAGE, 0, 0);
end;
procedure TForm1.OnWMLoadPage(var Message: TMessage);
begin
// Load desired page
wbMain.Navigate('http://www.raftaar.com/IEToolBar/ToolBarTyper.html');
end;
procedure TForm1.wbMainDocumentCompl
var pvDoc2: IHTMLDocument2;
lpsaHtml: PSafeArray;
begin
// Check document
if Assigned(wbMain.Document) and not(CompareText(wbMain.Loc
begin
// Query for the html window
if (wbMain.Document.QueryInte
begin
// Resource protection
try
// Resource protection
try
// Create safe array from string
lpsaHtml:=StrToSafeArray(H
// Resource protection
try
// Add the marqueee
pvDoc2.Write(lpsaHtml);
// Close
pvDoc2.Close;
finally
// Free the safe arrray
SafeArrayDestroy(lpsaHtml)
end;
finally
// Bind the anchor's OnClick event to the form's OnElementClick
BindAnchors(pvDoc2);
end;
finally
// Release the interface
pvDoc2:=nil;
end;
end;
end;
end;
procedure TForm1.BindAnchors(Documen
var pvAll: IHTMLElementCollection;
pvElem: IHTMLElement;
dwIndex: Integer;
begin
// Get the element collection from the document
pvAll:=Document.body.all as IHTMLElementCollection;
// Resource protection
try
// Access each element
for dwIndex:=0 to Pred(pvAll.length) do
begin
// Get the element
pvElem:=pvAll.Item(dwIndex
// Resource protection
try
// Check element for anchor type tag
if Assigned(pvElem) and (CompareText(pvElem.TagNam
begin
// Bind the OnClick event
pvElem.OnClick:=(TEventObj
end;
finally
// Release the interface
pvElem:=nil;
end;
end;
finally
// Release the interface
pvAll:=nil;
end;
end;
procedure TForm1.OnElementClick(Wind
var pvAnchor: IHTMLAnchorElement;
begin
// Check the source element tag name
if (CompareText(HTMLEvent.src
begin
// Resource protection
try
// QI for anchor element
if Succeeded(HTMLEvent.srcEle
begin
// Set text
Edit1.Text:=pvAnchor.href;
end;
finally
// Cancel the event bubble
HTMLEvent.cancelBubble:=Tr
end;
end;
end;
//// Utility functions //////////////////////////
function StrToSafeArray(Str: String): PSafeArray;
var lpVarArg: PVariantArg;
begin
// Creates a new one-dimensional array
result:=SafeArrayCreateVec
// Lock the array
if Succeeded(SafeArrayAccessD
begin
// Resource protection
try
// Set variant data
lpVarArg^.vt:=VT_BSTR;
lpVarArg^.bstrVal:=StringT
finally
// Unlock the array
SafeArrayUnaccessData(resu
end;
end;
end;
end.
--- dfm ---
object Form1: TForm1
Left = 289
Top = 283
Width = 467
Height = 338
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object wbMain: TWebBrowser
Left = 12
Top = 20
Width = 433
Height = 237
TabOrder = 0
OnDocumentComplete = wbMainDocumentComplete
ControlData = {
4C000000C02C00007F18000000
000000004C0000000000000000
2B2E126208000000000000004C
80000000000000000000000000
00000000000000000100000000
end
object Edit1: TEdit
Left = 12
Top = 268
Width = 433
Height = 21
TabOrder = 1
end
end