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

Вниз

double click в EmbeddedWB   Найти похожие ветки 

 
nikkie   (2003-09-15 14:51) [0]

Хочу при double click на картинке открывать некоторый диалог. Думал, что получится, написав в OnGetHostInfo
pInfo.dwDoubleClick := DOCHOSTUIDBLCLK_PROPERTIES;
Result := S_OK;

получать нотификацию в OnProperties - но не работает :(
Точно так же ничего не происходит, если я выставляю DOCHOSTUIDBLCLK_SHOWCODE. Почему? Как еще перехватить doubleclick? Что-то других идей, кроме как перехватывать WM_LBUTTONDBLCLK, в голову не приходит, а это мне не очень нравится.


 
Тих   (2003-09-15 20:46) [1]

Я статейку про WebBrowser уже послал сюда, но ее чего-то не публикуют никака. Держи кусочек, думаю, поможет, взамен того ляпсуса, который я про проперти в COM выдал )

Вспомогательный класс.

unit Helper;

interface

uses
Windows, ComObj, ActiveX, projectMain_TLB, StdVcl, Dialogs, MSHTML_TLB;

type
THTMLBodyEvent = procedure(Sender: IHTMLElement) of object;
THelper = class(TAutoObject, IHelper)
private
FOnClick : THTMLBodyEvent;
FOnDblClick: THTMLBodyEvent;
protected
{ Protected declarations }
public
Doc : IHTMLDocument2;
property OnClick : THTMLBodyEvent read FOnClick write FOnClick;
property OnDblClick: THTMLBodyEvent read FOnDblClick write FOnDblClick;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; override; stdcall;
end;

implementation

uses ComServ;

{ THelper }

function THelper.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var ID: WideString;
begin
case DispId of
-600: if (Assigned(FOnClick )) then FOnClick (Doc.parentWindow.event.srcElement);
-601: if (Assigned(FOnDblClick)) then FOnDblClick(Doc.parentWindow.event.srcElement);
end;
result := inherited Invoke(DispId, IID, LocaleId, Flags, Params, varResult, ExcepInfo, ArgErr);
end;

initialization
TAutoObjectFactory.Create(ComServer, THelper, Class_Helper,
ciMultiInstance, tmApartment);
end.


Собственно код некоей формы

TFrmMain = class(TForm)
...
procedure OnBodyClick (Sender: IHTMLElement);
procedure OnBodyDblClick(Sender: IHTMLElement);
...


procedure TFrmMain.FormCreate(Sender: TObject);
begin
WB.Navigate(ExtractFilePath(Application.ExeName) + "index.htm");
FHelper := THelper.Create;
FHelper.OnClick := Self.OnBodyClick;
FHelper.OnDblClick := Self.OnBodyDblClick;
end;


// Привязываемся к событиям
procedure TFrmMain.WBNavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
pCont: IConnectionPointContainer;
pPoint: IConnectionPoint;
pUnk: IUnknown;
begin
FWBDoc := unassigned;
FWBDoc := WB.Document;
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);
end;

procedure TFrmMain.OnBodyClick(Sender: IHTMLElement);
begin
if (Sender.tagName = "H1") then ShowMessage("Its a Header with id "" + Sender.id + """);
if (Sender.tagName = "A") then ShowMessage("Its a Link with id "" + Sender.id + """);
end;

procedure TFrmMain.OnBodyDblClick(Sender: IHTMLElement);
begin
ShowMessage("DblClick " + Sender.id);
end;


 
nikkie   (2003-09-15 23:55) [2]

спасибо! HTMLDocumentEvents - это правильная мысль.



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

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

Наверх




Память: 0.45 MB
Время: 0.032 c
1-41461
Vladislav
2003-10-28 15:52
2003.11.13
Как вставить картинку в RxRichText?


6-41860
саф
2003-09-09 09:09
2003.11.13
строку через сокет на определенный комп


6-41823
oduvan
2003-09-01 13:35
2003.11.13
каким компонентом Indy можно пробить на открытый порт???


1-41504
Talla2k
2003-10-28 12:56
2003.11.13
Delphi and Excel


1-41604
Dmitry
2003-10-27 01:18
2003.11.13
Сменить курсор





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский