Link to home
Start Free TrialLog in
Avatar of SHAHEEN_AKHTAR
SHAHEEN_AKHTARFlag for India

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.
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

Avatar of Russell Libby
Russell Libby
Flag of United States of America image

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
Avatar of SHAHEEN_AKHTAR

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.
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
Avatar of Russell Libby
Russell Libby
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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.