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

Question

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

Answer 1

还有一个问题，用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;

Answer 2

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

Answer 3

WebBrowser1.Document.activeElement.focus

Answer 4

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

Answer 5

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

Answer 6

win2000sp4下调试通过窗体上放一个TextBox和一个WebBrowser和一个按钮
TextBox的TabIndex=0
按钮的TabIndex=1
WebBrowser的TabIndex=2Option ExplicitPrivate 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 SubPrivate Sub Command1_Click()
    WebBrowser1.Document.activeElement.focus
    'WebBrowser1.Document.focus 
End SubPrivate Sub Form_Load()
    WebBrowser1.navigate "about:blank"
End Sub

Answer 7

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中实现，这个可不可以做到呢？

Answer 8

第一个问题自己解决了，写出来分享一下:当然要引用Microsoft HTML Object LibraryDim WithEvents o As HTMLDocumentPrivate Function o_ondragstart() As Boolean
    Debug.Print o.activeElement
End FunctionPrivate Sub Web_DownloadComplete()
    Set o = Web.Document
End SubPrivate Sub Form_Load()
    Web.Navigate "http://www.baidu.com"
End Sub就这么简单，在网上也没搜到答案，还好自己研究出来了。那个webbrowser无法支持鼠标滚轮的问题继续请教

Answer 9

Form1：Option ExplicitPrivate m_bInit As BooleanPrivate 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 SubPrivate 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 SubPrivate Sub Form_Load()
    m_bInit = False
    WebBrowser1.navigate "about:blank"
End SubForm2：Option ExplicitPublic m_sURL As StringPrivate Sub Form_Load()
    WebBrowser1.navigate m_sURL
End SubPrivate Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    WebBrowser1.Document.activeElement.focus
End Sub

Answer 10

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

Answer 11

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

Answer 12

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

Answer 13

刚在WinXP SP2下测试过了WebBrowser1.Document.activeElement.focus没有问题WebBrowser1.SetFocus不行

Answer 14

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即可支持鼠标滚轮操作，真是百思不得其解！ -_-!!!

Answer 15

因为我原来的系统(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但测试的结果仍是相同的

Answer 16

最新测试结果：
如果用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这个网页的问题