0

В TWebBrowser загружена html страница с кнопкой:

<button>Это кнопка</button>

Как при клике на кнопку, которая находится в TWebBrowser, выполнить процедуру в Delphi?

Я помню, можно как-то через OLE или IHtmlDocument2, но как, я не помню. Mожно пример кода?

1
  • Интересно, почему минус? Несмотря на эээ... краткость, вцелом это хороший вопрос про обратную связь веббраузера с приложением, которая реализуется через объект JS (емнип) external. Плохо, что этот объект существует только в IE, но и вопрос-то про WB, а не Chromium
    – kami
    9 окт 2018 в 6:45

2 ответа 2

0
  1. Сделать чтобы кнопка работала как ссылка (это вне рамок вопроса про delphi)
  2. Повесить обработчик события OnBeforeNavigate2
0
uses
 ..., OleCtrls, SHDocVw, mshtml;

type
  THTMLEventNotifyEvent = procedure(EventObject: IHTMLEventObj; EventType: string) of object;

  THTMLEvent = class(TInterfacedObject, IDispatch)
  private
    FDocument: IHTMLDocument2;
    FOnEvent: THTMLEventNotifyEvent;
    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;
    procedure DoEvent;
  public
    constructor Create(Document: IHTMLDocument2);
    property OnEvent: THTMLEventNotifyEvent read FOnEvent write FOnEvent;
  end;

  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Memo1: TMemo;
    ...
  private
    ...
    procedure KeyEvent(EventObject: IHTMLEventObj; EventType: string);
  public
    ...
  end;

...
implementation

function THTMLEvent.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Result := E_NOTIMPL
end;

function THTMLEvent.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
  Result := E_NOTIMPL
end;

function THTMLEvent.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL
end;

function THTMLEvent.Invoke(dispid: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
  DoEvent;
  Result := S_OK;
end;

constructor THTMLEvent.Create(Document: IHTMLDocument2);
begin
  inherited Create;
  FDocument := Document;
  FOnEvent := nil;
end;

procedure THTMLEvent.DoEvent;
var
  EventObj: IHTMLEventObj;
  EventType: string;
begin
  if Assigned(FOnEvent) then
  begin
    EventObj := nil;
    EventType := '';
    if Assigned(FDocument) and Assigned(FDocument.parentWindow) then
    begin
      EventObj := FDocument.parentWindow.event;
      if Assigned(EventObj) then
        EventType := EventObj.type_;
    end;
    FOnEvent(EventObj, EventType);
  end;
end;

{ TForm1 }

procedure TForm1.KeyEvent(EventObject: IHTMLEventObj; EventType: string);
var
  attr: OleVariant;
begin
  Memo1.Clear;
  Memo1.Lines.Add('Type of Event: ' + EventType);
  Memo1.Lines.Add('Element tagName: ' + EventObject.srcElement.tagName);
  attr := EventObject.srcElement.getAttribute('type', 0);
  if attr <> Null then
    Memo1.Lines.Add('Element type: ' + attr);
  EventObject.cancelBubble := true;
  EventObject.returnValue := false;
end;

procedure TForm1.<SomeProc>(Sender: TObject);
var
  Doc: IHTMLDocument2;
  EventHandler: THTMLEvent;
begin
  Memo1.Clear;
  WebBrowser1.Navigate('http://SomePage.ru');
  repeat
    application.ProcessMessages;
  until WebBrowser1.ReadyState >= READYSTATE_COMPLETE;
  Doc := WebBrowser1.Document as IHTMLDocument2;
  EventHandler := THTMLEvent.Create(Doc);
  EventHandler.OnEvent := KeyEvent;
  Doc.onclick := EventHandler as IDispatch;
  Doc.onkeydown := EventHandler as IDispatch;
  Doc.onkeypress := EventHandler as IDispatch;
  Doc.onkeyup := EventHandler as IDispatch;  //etc.
end;

Ваш ответ

Нажимая на кнопку «Отправить ответ», вы соглашаетесь с нашими условиями использования и подтверждаете, что прочитали и поняли наши политику конфиденциальности и нормы поведения.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.