Zarko Gajic демонстрирует, как получить URL-адрес гиперссылки, когда мышь перемещается над документом TWebBrowser, в следующей статье и демонстрации: http://delphi.about.com/od/vclusing/a/wbsinkevents.htm Эта демонстрация работает хорошо, пока WebBrowser не будет установлен на designmode = 'on'то событие OnMouseMove не выполняется.Можно ли улучшить демонстрацию, чтобы событие OnMouseMove выполнялось, когда DesignMode = 'on'?Если нет, то есть ли другой способ создания события Document.OnMouseMove?Я использую Delphi 2010.
[Редактировать] Больше кода было запрошено, поэтому вот реализация
procedure TForm1.DesignMode1Click( Sender: TObject );
var
iDocument: MSHTML.IHTMLDocument2;
begin
if Assigned( WebBrowser1 ) then
begin
iDocument := htmlDoc; //( WebBrowser1.Document as IHTMLDocument2 );
if Assigned( iDocument ) then
begin
if DesignMode1.Checked then
iDocument.DesignMode := 'On'
else
iDocument.DesignMode := 'Off';
WebBrowser1.Refresh2;
end;
end;
end;
procedure TForm1.Document_OnMouseOver;
var
element: IHTMLElement;
begin
if htmlDoc = nil then
Exit;
element := htmlDoc.parentWindow.event.srcElement;
elementInfo.Clear;
if LowerCase( element.tagName ) = 'a' then
begin
elementInfo.Lines.Add( 'LINK info...' );
elementInfo.Lines.Add( Format( 'HREF : %s', [ element.getAttribute( 'href', 0 ) ] ) );
end
else if LowerCase( element.tagName ) = 'img' then
begin
elementInfo.Lines.Add( 'IMAGE info...' );
elementInfo.Lines.Add( Format( 'SRC : %s', [ element.getAttribute( 'src', 0 ) ] ) );
end
else
begin
elementInfo.Lines.Add( Format( 'TAG : %s', [ element.tagName ] ) );
end;
end; (* Document_OnMouseOver *)
procedure TForm1.FormCreate( Sender: TObject );
begin
WebBrowser1.Navigate( 'http://delphi.about.com' );
elementInfo.Clear;
elementInfo.Lines.Add( 'Move your mouse over the document...' );
end; (* FormCreate *)
procedure TForm1.WebBrowser1BeforeNavigate2( ASender: TObject; const pDisp: IDispatch;
var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool );
begin
htmlDoc := nil;
end; (* WebBrowser1BeforeNavigate2 *)
procedure TForm1.WebBrowser1DocumentComplete( ASender: TObject; const pDisp: IDispatch; var URL: OleVariant );
begin
if Assigned( WebBrowser1.Document ) then
begin
htmlDoc := WebBrowser1.Document as IHTMLDocument2;
htmlDoc.onmouseover := ( TEventObject.Create( Document_OnMouseOver ) as IDispatch );
end;
end; (* WebBrowser1DocumentComplete *)
{ TEventObject }
constructor TEventObject.Create( const OnEvent: TObjectProcedure );
begin
inherited Create;
FOnEvent := OnEvent;
end;
function TEventObject.GetIDsOfNames( const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer;
DispIDs: Pointer ): HResult;
begin
Result := E_NOTIMPL;
end;
function TEventObject.GetTypeInfo( Index, LocaleID: Integer; out TypeInfo ): HResult;
begin
Result := E_NOTIMPL;
end;
function TEventObject.GetTypeInfoCount( out Count: Integer ): HResult;
begin
Result := E_NOTIMPL;
end;
function TEventObject.Invoke( DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params;
VarResult, ExcepInfo, ArgErr: Pointer ): HResult;
begin
if ( DispID = DISPID_VALUE ) then
begin
if Assigned( FOnEvent ) then
FOnEvent;
Result := S_OK;
end
else
Result := E_NOTIMPL;
end;
end.
[Исправить] Я понялтот WebBrowser1DocumentComplete не был выполнен после установки webbrowser для designmode, поэтому я изменил DesignMode1Click, и это решило проблему.Я публикую это, чтобы другие тоже могли это увидеть:
procedure TForm1.DesignMode1Click( Sender: TObject );
begin
// the following is unsafe because you may click on the
// check box even if you don't have any page navigated
-- htmlDoc := WebBrowser1.Document as IHTMLDocument2;
// htmlDoc will be assigned from the OnDocumentComplete
// fired by Navigate procedure
if Assigned( htmlDoc ) then
begin
if DesignMode1.Checked then
htmlDoc.DesignMode := 'On'
else
htmlDoc.DesignMode := 'Off';
// switching to design mode takes some time and if there
// are some pages which doesn't fire OnDocumentComplete
// event when you are switching to design mode, like
// http://delphi.about.com do, then I would wait for
// web browser to be ready
while WebBrowser1.ReadyState < READYSTATE_COMPLETE do
Application.ProcessMessages;
// release the previous "document instance"
htmlDoc := nil;
// assign the new one and attach the event
htmlDoc := WebBrowser1.Document as IHTMLDocument2;
htmlDoc.OnMouseOver := ( TEventObject.Create( Document_OnMouseOver ) as IDispatch );
end;
end;