Solved

TWebBrowser Event Capturing

Posted on 2008-06-18
5
2,894 Views
Last Modified: 2013-11-23
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.
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;

        }

Open in new window

0
Comment
Question by:SHAHEEN_AKHTAR
  • 3
  • 2
5 Comments
 
LVL 26

Expert Comment

by:Russell Libby
ID: 21813626
Pretty similar to a PAQ I worked on recently...

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(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  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: IHTMLWindow2; OnEvent: THtmlEvent);
begin

  // Perform inherited
  inherited Create;

  // Save html window and event handler
  FWindow:=Window;
  FOnEvent:=OnEvent;

end;

procedure TEventObject.BeforeDestruction;
begin

  // Resource protection
  try
     // Release the window interface
     FWindow:=nil;
  finally
     // Perform inherited
     inherited BeforeDestruction;
  end;

end;

function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin

  // Not implemented
  result:=E_NOTIMPL;

end;

function TEventObject.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin

  // Resource protection
  try
     // Clear pointer ref
     Pointer(TypeInfo):=nil;
  finally
     // Not implemented
     result:=E_NOTIMPL;
  end;

end;

function TEventObject.GetTypeInfoCount(out Count: Integer): HResult;
begin

  // Resource protection
  try
     // Clear count
     Count:=0;
  finally
     // Not implemented
     result:=E_NOTIMPL;
  end;

end;

function TEventObject.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
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_MEMBERNOTFOUND;

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.wbMainDocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
var  pvDoc2:        IHTMLDocument2;
     lpsaHtml:      PSafeArray;
begin

  // Check document
  if Assigned(wbMain.Document) and not(CompareText(wbMain.LocationName, 'about:blank') = 0) then
  begin
     // Query for the html window
     if (wbMain.Document.QueryInterface(IHTMLDocument2, pvDoc2) = S_OK) then
     begin
        // Resource protection
        try
           // Resource protection
           try
              // Create safe array from string
              lpsaHtml:=StrToSafeArray(HTML_MARQUEE);
              // 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(Document: IHTMLDocument2);
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, 0) as IHTMLElement;
        // Resource protection
        try
           // Check element for anchor type tag
           if Assigned(pvElem) and (CompareText(pvElem.TagName, 'a') = 0) then
           begin
              // Bind the OnClick event
              pvElem.OnClick:=(TEventObject.Create(Document.parentWindow, OnElementClick) as IDispatch);
           end;
        finally
           // Release the interface
           pvElem:=nil;
        end;
     end;
  finally
     // Release the interface
     pvAll:=nil;
  end;

end;

procedure TForm1.OnElementClick(Window: IHTMLWindow2; HTMLEvent: IHTMLEventObj);
var  pvAnchor:      IHTMLAnchorElement;
begin

  // Check the source element tag name
  if (CompareText(HTMLEvent.srcElement.tagName, 'a') = 0) then
  begin
     // Resource protection
     try
        // QI for anchor element
        if Succeeded(HTMLEvent.srcElement.QueryInterface(IHTMLAnchorElement, pvAnchor)) then
        begin
           // Set text
           Edit1.Text:=pvAnchor.href;
        end;
     finally
        // Cancel the event bubble
        HTMLEvent.cancelBubble:=True;
     end;
  end;

end;

//// Utility functions /////////////////////////////////////////////////////////
function StrToSafeArray(Str: String): PSafeArray;
var  lpVarArg:      PVariantArg;
begin

  // Creates a new one-dimensional array
  result:=SafeArrayCreateVector(VT_VARIANT, 0, 1);

  // Lock the array
  if Succeeded(SafeArrayAccessData(result, Pointer(lpVarArg))) then
  begin
     // Resource protection
     try
        // Set variant data
        lpVarArg^.vt:=VT_BSTR;
        lpVarArg^.bstrVal:=StringToOleStr(Str);
     finally
        // Unlock the array
        SafeArrayUnaccessData(result);
     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 = {
      4C000000C02C00007F1800000000000000000000000000000000000000000000
      000000004C000000000000000000000001000000E0D057007335CF11AE690800
      2B2E126208000000000000004C0000000114020000000000C000000000000046
      8000000000000000000000000000000000000000000000000000000000000000
      00000000000000000100000000000000000000000000000000000000}
  end
  object Edit1: TEdit
    Left = 12
    Top = 268
    Width = 433
    Height = 21
    TabOrder = 1
  end
end
0
 

Author Comment

by:SHAHEEN_AKHTAR
ID: 21819410
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.
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 21821373
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.
0
 
LVL 26

Accepted Solution

by:
Russell Libby earned 500 total points
ID: 21822036
My mistake, apologies. You also need to set the event returnvalue to false in order to get this to stop the loading.


procedure TForm1.OnElementClick(Window: IHTMLWindow2; HTMLEvent: IHTMLEventObj);
var  pvAnchor:      IHTMLAnchorElement;
begin

  // Check the source element tag name
  if (CompareText(HTMLEvent.srcElement.tagName, 'a') = 0) then
  begin
     // Resource protection
     try
        // QI for anchor element
        if Succeeded(HTMLEvent.srcElement.QueryInterface(IHTMLAnchorElement, pvAnchor)) then
        begin
           // Set text
           Edit1.Text:=pvAnchor.href;
        end;
     finally
        // Cancel the event bubble
        HTMLEvent.cancelBubble:=True;
        // Set return value
        HTMLEvent.returnValue:=False; // <-- addition
     end;
  end;

end;
0
 

Author Closing Comment

by:SHAHEEN_AKHTAR
ID: 31469407
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.
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
This tutorial covers a step-by-step guide to install VisualVM launcher in eclipse.
THe viewer will learn how to use NetBeans IDE 8.0 for Windows to perform CRUD operations on a MySql database.

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now