Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2004.08.08;
Скачать: [xml.tar.bz2];

Вниз

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. Где можно самому почитать про интерфейсы, где вы ВСЕ ЭТО берете.


 
nikkie ©   (2004-06-06 13:47) [6]

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



Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2004.08.08;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.031 c
14-1090237386
ИдиотЪ
2004-07-19 15:43
2004.08.08
слабо обмануть начальство?


4-1088181167
m2003
2004-06-25 20:32
2004.08.08
Блокировка Windows


1-1090603641
DeScriptor
2004-07-23 21:27
2004.08.08
Многократный запуск собственного потока


14-1090610914
Opilki_Inside
2004-07-23 23:28
2004.08.08
В эту субботу поезд....


14-1089112226
zamkom
2004-07-06 15:10
2004.08.08
Ночной дозор





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский