Главная страница
    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.46 MB
Время: 0.036 c
1-41148
Layner
2003-11-03 11:55
2003.11.13
Подскажите, почему StringGrid не получается сменить цвет шрифта?


6-41852
SEvgeniy
2003-09-05 18:27
2003.11.13
ограничение трафика


1-41544
Palych
2003-10-21 18:31
2003.11.13
Fast Reports


1-41314
Владислав
2003-10-30 12:43
2003.11.13
BASM и длина кода процедуры.


1-41510
Rradion
2003-10-28 12:56
2003.11.13
EAccessViolation в алгоритме поиска...





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