Кнопка и TWebBrowser

← →
parovoZZ © (2006-01-30 19:45) [0]

Извиняюсь за возможный повтор.
Как перехватить нажатие кнопки (<input type="button") в TWebBrowser? Постоянно её контролировать? Она же вроде никаких событий нам не передаёт. Как быть.

← →
Delphi_is_cool © (2006-01-31 09:32) [1]

Надо перехватовать событие wm_lbuttonup, а далее просто опредилить по какому обьекту кликнули ...

← →
Digitman © (2006-01-31 09:35) [2]

фрагмент HTML-кода ЭТОЙ страницы (описание кнопки "Ж" и назначение обработчика ее нажатия):

<input type="button" value="Ж" class="format_btn" title="Жирный" onclick="formatTag("B")" />

здесь formatTag() - JavaScript-функция

← →
easy © (2006-01-31 14:14) [3]

Unit1.pas
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, SHDocVw, mshtml, ComCtrls; 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; type TForm1 = class(TForm) WebBrowser1: TWebBrowser; Memo1: TMemo; StatusBar1: TStatusBar; procedure FormShow(Sender: TObject); private { Private declarations } procedure KeyEvent(EventObject: IHTMLEventObj; EventType: string); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} 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.FormShow(Sender: TObject); var Doc: IHTMLDocument2; EventHandler: THTMLEvent; begin Memo1.Clear; WebBrowser1.Navigate("http://ya.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; end.

Unit1.dfm
object Form1: TForm1 Left = 192 Top = 153 Width = 719 Height = 489 Caption = "Form1" Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = "MS Sans Serif" Font.Style = [] OldCreateOrder = False OnShow = FormShow PixelsPerInch = 96 TextHeight = 13 object WebBrowser1: TWebBrowser Left = 0 Top = 0 Width = 466 Height = 443 Align = alClient TabOrder = 0 ControlData = { 4C0000002A300000C92D00000000000000000000000000000000000000000000 000000004C000000000000000000000001000000E0D057007335CF11AE690800 2B2E126208000000000000004C0000000114020000000000C000000000000046 8000000000000000000000000000000000000000000000000000000000000000 00000000000000000100000000000000000000000000000000000000} end object Memo1: TMemo Left = 466 Top = 0 Width = 245 Height = 443 Align = alRight Lines.Strings = ( "Memo1") ScrollBars = ssVertical TabOrder = 1 end object StatusBar1: TStatusBar Left = 0 Top = 443 Width = 711 Height = 19 Panels = <> SimplePanel = False end end

← →
parovoZZ © (2006-01-31 22:51) [4]

easy

прямо в точку. только мне всего-то надо узнать параметр name (ну или id. Кстати, зачем так много идентификаторов одному элементу?)

И не понял: в textarea не работает перенос строки (клавиша enter). Почему?

← →
MetalFan © (2006-02-01 08:52) [5]

2ease
респект! спасибо! познавательно!

> в textarea не работает перенос строки (клавиша enter).
> Почему?

http://www.dfc.com.ru/faq/?base=internet&p=36

И откуда Вы всё знаете? Спасибочки.

Вот что странно. Загружаю HTML код из StringList в TWebBrowser - событие KeyEvent иногда не перехватывется до перезагрузки страницы. А вот если грузить страницу из файла - всё чики чики.

Кнопка и TWebBrowser Найти похожие ветки