如何实现在WebBrowser控件中拖拽打开新窗口？

[happy_sea]

在傲游中，只要轻轻拖拽一下链接就会在新窗口中打开，用WebBrowser如何实现呢？即：
1、如何获取这个拖拽事件？
2、如何获取拖拽的链接地址？

[happy_sea]

还有一个问题，用WebBrowser1.Setfocus并不能使WebBrowser支持鼠标滚轮，还必须在WebBrowser中点一下才可以，是因为虽然WebBrowser获得了焦点，但是里面的document没获得焦点的原因吗？如何解决这个问题？或者下面的delphi代码如何改成vb的？结贴时会加分。

procedure SetFocusToDoc;
begin
if Wbe1.Document <> nil then
with Wbe1.Application as IOleobject do
DoVerb(OLEIVERB_UIACTIVATE, nil, Self, 0, Handle, GetClientRect);
end;

[hpygzhx520]

至于拖拽打开新窗口，要实现一些接口。正确的做法可以看看 VB资源 版块里面的LE浏览器的代码，很复杂。至于链接的地址，你不用自己处理，你可以拖放到文本框等控件里面看看（记得要设置编辑框的拖放模式）。

[Hassle]

WebBrowser1.Document.activeElement.focus

[happy_sea]

如果可以拖拽到其他控件那就好办了，问题是只是轻轻地拽一下，而WebBrowser控件是没有oledrag的。

[happy_sea]

to Hassle():
WebBrowser1.Document.activeElement.focus并未解决可以让WebBrowser支持鼠标滚轮的问题

[Hassle]

win2000sp4下调试通过

窗体上放一个TextBox和一个WebBrowser和一个按钮
TextBox的TabIndex=0
按钮的TabIndex=1
WebBrowser的TabIndex=2

Option Explicit

Private Sub WebBrowser1_DownloadComplete()
WebBrowser1.Document.body.innerHTML = "1<br>2<br>3<br>4<br>5<br>6<br>7<br>8<br>9<br>10<br>11<br>12<br>13<br>14<br>15<br>16<br>"
End Sub

Private Sub Command1_Click()
WebBrowser1.Document.activeElement.focus
'WebBrowser1.Document.focus
End Sub

Private Sub Form_Load()
WebBrowser1.navigate "about:blank"
End Sub

[happy_sea]

to Hassle():
不好意思，怪我没把我的具体情况说清楚。我是这样的，在form1中用form2.show 1,me来打开form2，在form2的form_load中webbrowser1.navigate一个网址，然后在webbrowser_documentcomplete事件中使webbrowser支持鼠标滚轮，我先用webbrowser1.setfocus发现不成功，用了你提供的WebBrowser1.Document.activeElement.focus也不行，可是我在测试你第二次回复的代码时发现可以，而且用webbrowser1.setfocus其实也可以，但是我是不允许有command1_click这个动作的，而是要在webbrowser_documentcomplete中实现，这个可不可以做到呢？

[happy_sea]

第一个问题自己解决了，写出来分享一下:

当然要引用Microsoft HTML Object Library

Dim WithEvents o As HTMLDocument

Private Function o_ondragstart() As Boolean
Debug.Print o.activeElement
End Function

Private Sub Web_DownloadComplete()
Set o = Web.Document
End Sub

Private Sub Form_Load()
Web.Navigate "http://www.baidu.com"
End Sub

就这么简单，在网上也没搜到答案，还好自己研究出来了。

那个webbrowser无法支持鼠标滚轮的问题继续请教。。。

[Hassle]

Form1：

Option Explicit

Private m_bInit As Boolean

Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
If m_bInit = True Then
Cancel = True
Form2.m_sURL = URL & vbNullChar
Form2.Show
End If
End Sub

Private Sub WebBrowser1_DownloadComplete()
If m_bInit = False Then
m_bInit = True
WebBrowser1.Document.body.innerHTML = "<a href=""http://www.hao123.com"">Test</a>"
End If
End Sub

Private Sub Form_Load()
m_bInit = False
WebBrowser1.navigate "about:blank"
End Sub

Form2：

Option Explicit

Public m_sURL As String

Private Sub Form_Load()
WebBrowser1.navigate m_sURL
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
WebBrowser1.Document.activeElement.focus
End Sub

[Hassle]

WebBrowser1.Document.activeElement.focus
好像不要也可以
WebBrowser1.Document.body.innerHTML = "<a href=""http://community.csdn.net/"">Test</a>"

[Hassle]

WebBrowser1.Document.body.innerHTML = "<a href=""http://community.csdn.net/Expert/topic/5067/5067025.xml?temp=.8208734"">Test</a>"

不要WebBrowser1.Document.activeElement.focus不行

[happy_sea]

to Hassle():
我测试你的代码还是不成功啊，难道是我的系统(XP sp2)或者鼠标驱动（系统自带）的问题？

[Hassle]

刚在WinXP SP2下测试过了

WebBrowser1.Document.activeElement.focus没有问题

WebBrowser1.SetFocus不行

[hpygzhx520]

你解决拖放的功能在多框架网页下无效……

[happy_sea]

to Hassle():
在我的机子上（包括家里的一台机子和办公室的两台机子），
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
WebBrowser1.Document.activeElement.focus
End Sub
是无效的，但是用我刚发现的拖拽的方法，即：
Private Function doc1_ondragstart() As Boolean
form2!Web1.Navigate doc1.activeElement
form2.Show 1, Me
End Function
却无需用Web1.Document.activeElement.focus即可支持鼠标滚轮操作，真是百思不得其解！ -_-!!!

[Hassle]

不会是有鼠标钩子之类的东西吧

[happy_sea]

没有，我是新建工程来测试你的代码的。

[happy_sea]

最新测试结果：
如果用http://community.csdn.net/Expert/topic/5067/5067025.xml?temp=.8208734这个地址，那么在form2中不加WebBrowser1.Document.activeElement.focus都可以用滚轮，而用其他的地址做测试，加了WebBrowser1.Document.activeElement.focus也不行，看来是http://community.csdn.net/Expert/topic/5067/5067025.xml?temp=.8208734这个网页的问题

[Hassle]

因为我原来的系统(WinXP SP2)里同时安装了VS05和VS98，我刚才重新安装了系统(WinXP SP2)，

只安装VS98, 编译后发现了一个错误

Form1的Private Sub WebBrowser1_DownloadComplete()
应改为Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

即

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If m_bInit = False Then
m_bInit = True
WebBrowser1.Document.body.innerHTML = "<a href=""http://community.csdn.net/Expert/topic/5067/5067025.xml?temp=.8208734"">Test</a>"
End If
End Sub

但测试的结果仍是相同的