StatusBar в TWebbrowser

← →
Dennisius (2004-06-05 13:41) [0]

Здрасти собственно как припаять StatusBar к TWebbrowser-у.
если точнее то функцию отображения урла ссылки при наведении на нее мышкой, ну как EI, подкините идею а еще лучше кодик. Заранее благодарен

← →
Ломброзо © (2004-06-05 15:26) [1]

unit HTMLHelper;

interface

uses
ComObj, ActiveX, kaf46_TLB, StdVcl, MSHTML_TLB;

type

THTMLBrowserMouseEvent = procedure(const pEvtObj: IHTMLEventObj) of object;

TKaf46HTMLHelper = class(TAutoObject, IKaf46HTMLHelper)
private
FOnClick : THTMLBrowserMouseEvent;
FOnDblClick: THTMLBrowserMouseEvent;
FOnMouseUp: THTMLBrowserMouseEvent;
FOnMouseDown: THTMLBrowserMouseEvent;
FOnMouseMove: THTMLBrowserMouseEvent;
protected
{ Protected declarations }
public
Doc : IHTMLDocument2;
property OnClick : THTMLBrowserMouseEvent read FOnClick write FOnClick;
property OnDblClick: THTMLBrowserMouseEvent read FOnDblClick write FOnDblClick;
property OnMouseDown: THTMLBrowserMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: THTMLBrowserMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseMove: THTMLBrowserMouseEvent read FOnMouseMove write FOnMouseMove;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; override; stdcall;
end;

implementation

uses ComServ;

{ TKaf46HTMLHelper }

function TKaf46HTMLHelper.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var pResult: WordBool;
pParam: DISPPARAMS;
iParamsCnt: integer;
vEvtObj: tagVARIANT;
dEvtObj: IDispatch;
pEvtObj: IHTMLEventObj;
begin
if ((-DispId >=600) and (-DispId <= 607)) then
begin
pParam := DISPPARAMS(Params);
iParamsCnt := pParam.cArgs;
vEvtObj := pParam.rgvarg[0];
dEvtObj := IDispatch(vEvtObj.dispVal);
pEvtObj := dEvtObj as IHTMLEventObj;
dEvtObj := nil;
case DispId of
-600: if (Assigned(FOnClick )) then FOnClick (pEvtObj);
-601: if (Assigned(FOnDblClick)) then FOnDblClick(pEvtObj);
-605: if (Assigned(FOnMouseDown)) then FOnMouseDown(pEvtObj);
-606: if Assigned(FOnMouseMove) then FOnMouseMove(pEvtObj);
-607: if (Assigned(FOnMouseUp)) then FOnMouseUp(pEvtObj);
end;
pEvtObj := nil;
end;
result := inherited Invoke(DispId, IID, LocaleId, Flags, Params, varResult, ExcepInfo, ArgErr);
end;

initialization
TAutoObjectFactory.Create(ComServer, TKaf46HTMLHelper, Class_Kaf46HTMLHelper,
ciSingleInstance, tmApartment);
end.

procedure TFrmWeekly.FormCreate(Sender: TObject);
begin
FHelper := TKaf46HTMLHelper.Create;
wb.Navigate("about:blank");
end;

procedure TFrmWeekly.wbNavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
pCont: IConnectionPointContainer;
pPoint: IConnectionPoint;
pUnk: IUnknown;
FCookie: integer;
begin
if not FBrowserInit then
begin
FBrowserInit := true;
FDoc := WB.Document as IHTMLDocument2;
FHelper.Doc := FDoc;
FBody := FDoc.body as IHTMLBodyElement;
pCont := FDoc as IConnectionPointContainer;
pCOnt.FindConnectionPoint(HTMLDocumentEvents2, pPoint);
pPoint.Advise(FHelper, FCookie);
FHelper.OnClick := Self.OnBodyClick;
FHelper.OnDblClick := Self.OnBodyDblClick;
FHelper.OnMouseDown := Self.OnBodyMouseDown;
FHelper.OnMouseMove := Self.OnBodyMouseMove;
FHelper.OnMouseUp := Self.OnBodyMouseUp;
end;
end;

procedure TFrmWeekly.OnBodyMouseMove(const pEvtObj: IHTMLEventObj);
begin
// здесь анализируем pEvtObj и, если srcElement - ссылка, выводим в StatusBar аттрибут href
end;

TKaf46HTMLHelper: для его создания нужно вызывать мастер создания Automation Object.

← →
nikkie © (2004-06-05 19:32) [2]

эта... OnStatusTextChange.

← →
Ломброзо © (2004-06-05 19:38) [3]

>nikkie © (05.06.04 19:32) [2]

Да? )

Может эта... в FAQ?

← →
nikkie © (2004-06-06 01:28) [4]

>Ломброзо
я могу и в гугл послать... :))

твой кодик (® - см. первый пост) полезный весьма, и мне пришелся в свое время кстати очень. но для реализации статусбара есть и попроще средство. или как?

← →
Dennisius (2004-06-06 09:04) [5]

VCL Reference
TWebBrowser.OnStatusTextChange

Not used in TWebBrowser.

property OnStatusTextChange: TWebBrowserStatusTextChange;

Description

Do not use this event. It is included in the TWebBrowser interface because the IWebBrowser2 interface is shared with Internet Explorer. OnStatusTextChange occurs when the text displayed in the Internet Explorer’s status bar changes.(Как собственно и сам StatusBar :)

Спасибо конечно всем, но будут еще предложения по реализации
Спасибо

> Ломброзо

но видтмо из всего кода мне нужно будет, получение итерфейса :))
FDoc := WB.Document as IHTMLDocument2; FHelper.Doc := FDoc; FBody := FDoc.body as IHTMLBodyElement; pCont := FDoc as IConnectionPointContainer; pCOnt.FindConnectionPoint(HTMLDocumentEvents2, pPoint); pPoint.Advise(FHelper, FCookie); FHelper.OnClick := Self.OnBodyClick; FHelper.OnDblClick := Self.OnBodyDblClick; FHelper.OnMouseDown := Self.OnBodyMouseDown; FHelper.OnMouseMove := Self.OnBodyMouseMove; FHelper.OnMouseUp := Self.OnBodyMouseUp;
Я так понял WB - это ВебьБроузерь. Еще раз спасиба.

P.S. Где можно самому почитать про интерфейсы, где вы ВСЕ ЭТО берете.

чтение справки безусловно похвальное занятие.
но конкретно про TWebBrowser дельфийская справка конкретно вешает лапшу.
например, она предлагает изменять параметр Url в событии OnBeforeNavigate2.
приведенный текст - еще один пример.

StatusBar в TWebbrowser Найти похожие ветки