"Внутренние" события [D7]
yahaha © (2006-05-09 16:45:00)
Doc: IHTMLDocument2;
...
Doc.onclick:=...
Doc.onmousedown:=...
А как оформить события в картинках, таблицах и т.п.?
Например:
- браузер в режиме DesignMode='On', я подвожу мышь к
картинке, нажимаю кнопку, картинка выделяется.
- точно так же выделяю таблицу.
В обоих случаях событие Doc.onmousedown ничего не даёт. Он
срабатывает, но кроме него есть ещё какое-то событие...
Вопрос: какое?
easy (2006-05-10 09:13:00) [1]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
procedure WebBrowser1BeforeNavigate2(Sender:
TObject;
const pDisp: IDispatch; var URL, Flags,
TargetFrameName, PostData,
Headers: OleVariant; var Cancel:
WordBool);
procedure FormCreate(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender:
TObject;
const pDisp: IDispatch; var URL:
OleVariant);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FNewWndProc, FOldWndProc: Pointer;
h: HWND;
Defined: boolean;
procedure NewWndProc(var Message: TMessage);
procedure DefineWndProc;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.DefineWndProc;
begin
h := GetWindow(GetWindow(WebBrowser1.Handle, GW_CHILD),
GW_CHILD); // This was level 1
FNewWndProc := Classes.MakeObjectInstance(NewWndProc);
FOldWndProc := Pointer(GetWindowLong(h, GWL_WNDPROC));
SetWindowLong(h, GWL_WNDPROC, Longint(FNewWndProc));
Defined := true;
end;
procedure TForm1.NewWndProc(var Message: TMessage);
var
Doc, elem: oleVariant;
begin
case Message.Msg of
WM_LBUTTONDOWN: begin
Doc :=
WebBrowser1.OleObject.document;
elem :=
LowerCase(Doc.elementFromPoint(Message.LParamLo,
Message.LParamHi).tagName);
if (elem = 'img') or (elem = 'td')
or (elem = 'table') then
exit;
end;
end;
Message.Result := CallWindowProc(FOldWndProc, h,
Message.Msg,
Message.WParam, Message.LParam);
end;
procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags,
TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
begin
if Defined then
SetWindowLong(h, GWL_WNDPROC,
Longint(FOldWndProc));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('
http://yandex.ru');
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
DefineWndProc;
WebBrowser1.OleObject.document.DesignMode := 'On';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Defined then
SetWindowLong(h, GWL_WNDPROC,
Longint(FOldWndProc));
end;
end.
Наверх 
ЧАТ |
Орешник |
|
