浏览器

开发平台：

Visual Basic

cActiveWebEvent.cls：源码内容

							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cActiveWebEvent"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'======================================================
'    作用:
'    在NavigateComplete2的时候捕获document ondragstart事件
'    并且在dragstart的时候使程序能捕获
'    body的ondrag , ondragleave, ondragend
'======================================================
Option Explicit
Private m_pDisp As Object
Private m_ParentForm As frmBrowser
Public Sub DefaultProc()
Attribute DefaultProc.VB_UserMemId = 0
On Error GoTo due
Dim tDrag As cOpenDragLink
WebDraging = True
Dim tDoc As MSHTML.HTMLDocument
Dim tEvent As MSHTML.IHTMLEventObj2
Set tDoc = m_pDisp.Document
With gSelfDrag
    Debug.Print "typeof:"; TypeOf m_pDisp Is SHDocVw.WebBrowser
    .Reset
    .SelfDraging = True
    .DragFormIndex = m_ParentForm.tagIndex
    Set tEvent = tDoc.parentWindow.event
    .SrcType = LCase(tEvent.srcElement.tagName)
    If .SrcType = "img" Then
        .SrcStr = tEvent.srcElement.src
    Else
        .SrcType = "text"
        .SrcStr = tEvent.dataTransfer.GetData("text")
    End If
    
    Set gSelfDrag.SelRange = tDoc.Selection.createRange
    
End With
If Not TypeOf m_pDisp.Document.body.ondragend Is cOpenDragLink Then
    Set tDrag = New cOpenDragLink
    tDrag.SetDoc tDoc
    tDoc.body.ondragend = tDrag
End If
Exit Sub
    
due:
    Debug.Print Err.Description
End Sub
Public Property Get pDisp() As Object
Set pDisp = m_pDisp
End Property
Public Property Let pDisp(ByVal vNewValue As Object)
Set m_pDisp = vNewValue
End Property
Public Property Get ParentForm() As frmBrowser
Set ParentForm = m_ParentForm
End Property
Public Property Let ParentForm(ByVal vNewValue As frmBrowser)
Set m_ParentForm = vNewValue
End Property
Private Sub Class_Initialize()
'Debug.Print "========= initialize ==========", ObjPtr(Me)
End Sub
Private Sub Class_Terminate()
On Error Resume Next
m_ParentForm.EnableSetWebEvent
'Debug.Print "=============terminate==============", ObjPtr(Me)
End Sub

						