浏览器

开发平台：
Visual Basic

cMouseEvent.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 = "cMouseEvent"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'鼠标手势等数据,操作
Option Explicit
Private Const DescriptionHead As String = "鼠标手势: "
Private Type mMouseHandInfo
    Hand(0 To 2) As Byte
    HandStr As String
    Description As String
    CallSub As cCallByName
End Type
Private mMouseHand() As mMouseHandInfo
Private mMouseHandCnt As Long
Private DirFlag(0 To 4) As String
Public Function GetHandCount() As Long
GetHandCount = mMouseHandCnt
End Function
Public Sub AddHand()
mMouseHandCnt = mMouseHandCnt + 1
ReDim Preserve mMouseHand(0 To mMouseHandCnt)
With mMouseHand(mMouseHandCnt)
    .Description = DescriptionHead
    Set .CallSub = New cCallByName
End With
End Sub
Public Function RemoveHand(index&) As Boolean
Dim i&
Dim rtn As Boolean
On Error Resume Next
rtn = False
If index > 0 And index <= mMouseHandCnt Then
    Set mMouseHand(index).CallSub = Nothing
    For i = index To mMouseHandCnt - 1
        mMouseHand(i) = mMouseHand(i + 1)
    Next i
    mMouseHandCnt = mMouseHandCnt - 1
    ReDim Preserve mMouseHand(0 To mMouseHandCnt)
    rtn = True
End If
RemoveHand = rtn
End Function
Public Sub Execute(nKey As String, Optional nObject As Object = Nothing)
Dim index&
index = FindByHandStr(nKey)
If index > 0 Then
    mMouseHand(index).CallSub.Execute nObject
End If
End Sub
'获得鼠标手势的"表示",复制的方式
Public Function GetHand(index&, ptrHand&) As Boolean
Dim rtn As Boolean
rtn = False
If index > 0 And index <= mMouseHandCnt Then
    CopyMemory ByVal ptrHand, ByVal VarPtr(mMouseHand(index).Hand(0)), 3
    rtn = True
End If
GetHand = rtn
End Function
Public Function GetDescription(index&) As String
If index > 0 And index <= mMouseHandCnt Then
    GetDescription = mMouseHand(index).Description
End If
End Function
Public Sub GetInfo_ByIndex(index&, nDescription$, _
        nHandShow$, nInsideIndex&, nEventText$)
If index > 0 And index <= mMouseHandCnt Then
    With mMouseHand(index)
        nDescription = .Description
        nHandShow = DirFlag(.Hand(0)) & DirFlag(.Hand(1)) & DirFlag(.Hand(2))
        nInsideIndex = .CallSub.InsideIndex
        nEventText = .CallSub.EventText
    End With
End If
End Sub
'获得CallObject
Public Function GetCallObject_ByIndex(index As Long) As cCallByName
If index > 0 And index <= mMouseHandCnt Then
    Set GetCallObject_ByIndex = mMouseHand(index).CallSub
End If
End Function
Public Function GetCallObject_ByKey(nKey As String) As cCallByName
Dim index&
index = FindByHandStr(nKey)
If index > 0 Then
    Set GetCallObject_ByKey = GetCallObject_ByIndex(index)
End If
End Function
Public Function GetCallObject_ByKey2(nKeyArr() As Byte) As cCallByName
Dim index&
Dim tKey$
tKey = Replace(Str(nKeyArr(0)) & Str(nKeyArr(1)) & Str(nKeyArr(2)), " ", "")
index = FindByHandStr(tKey)
If index > 0 Then
    Set GetCallObject_ByKey2 = GetCallObject_ByIndex(index)
End If
End Function
'=========================================
'改变鼠标手势,两种方式
Public Function ChangeHand_ByKey(nKey As String, nPtrHand As Long) As Boolean
Dim index&
Dim rtn As Boolean
rtn = False
index = FindByHandStr(nKey)
If index > 0 Then
    rtn = ChangeHand_ByIndex(index, nPtrHand)
End If
ChangeHand_ByKey = rtn
End Function
Public Function ChangeHand_ByIndex(index&, nPtrHand As Long) As Boolean
Dim tHand(0 To 2) As Byte, tHandStr$
Dim rtn As Boolean
Dim tIndex&
rtn = False
If index > 0 And index <= mMouseHandCnt Then
    With mMouseHand(index)
        CopyMemory ByVal VarPtr(tHand(0)), ByVal nPtrHand, 3
        tHandStr = Replace(Str(tHand(0)) & Str(tHand(1)) & Str(tHand(2)), " ", "")
        tIndex = FindByHandStr(tHandStr)
        If tIndex = 0 Or tIndex = index Then
            CopyMemory ByVal VarPtr(.Hand(0)), ByVal nPtrHand, 3
            .HandStr = tHandStr
            .Description = DescriptionHead & DirFlag(.Hand(0)) & DirFlag(.Hand(1)) & DirFlag(.Hand(2))
            rtn = True
        End If
    End With
End If
ChangeHand_ByIndex = rtn
End Function
'=======================================
Private Function FindByHandStr(nStr As String) As Long
Dim rtn&, i&
rtn = 0
For i = 1 To mMouseHandCnt
    If nStr = mMouseHand(i).HandStr Then
        rtn = i
        Exit For
    End If
Next i
FindByHandStr = rtn
End Function
Private Sub Class_Initialize()
DirFlag(0) = ""
DirFlag(1) = "→"
DirFlag(2) = "↑"
DirFlag(3) = "←"
DirFlag(4) = "↓"
End Sub
Public Sub Save(nfile As String)
Dim tIniFile As cINIFile
Dim i&
Dim tstr$
Set tIniFile = New cINIFile
With tIniFile
    .IniFile = nfile
    Call .DeleteSection("MouseHand")
    Call .WriteKey("MouseHand", "MouseHandCount", Str(mMouseHandCnt))
    For i = 1 To mMouseHandCnt
        'tstr = mMouseHand(i).HandStr & Format(mMouseHand(i).CallSub.InsideIndex, "0000") & _
            Format(mMouseHand(i).CallSub.ScriptIndex, "0000")
        tstr = mMouseHand(i).HandStr & Format(mMouseHand(i).CallSub.InsideIndex, "0000") & _
            Format(mMouseHand(i).CallSub.PluginIndex, "0000")
        Call .WriteKey("MouseHand", "mh" & LTrim(Str(i)), tstr)
    Next i
End With
End Sub
'共3+4+4=11位
'头3位是鼠标手势,接着4位是InsideIndex,接着是执行脚本index
Public Sub Load(nfile As String)
On Error GoTo due
Dim tIniFile As cINIFile
Dim i&
Dim tstr$
Set tIniFile = New cINIFile
With tIniFile
    .IniFile = nfile
    mMouseHandCnt = Val(.ReadKey("MouseHand", "MouseHandCount", "0"))
    If mMouseHandCnt <= 0 Then mMouseHandCnt = 0
    ReDim mMouseHand(0 To mMouseHandCnt)
    
    For i = 1 To mMouseHandCnt
        tstr = .ReadKey("MouseHand", "mh" & LTrim(Str(i)), String(3 + 4 + 4, "0"))
        If Len(tstr) <> 3 + 4 + 4 Then tstr = String(3 + 4 + 4, "0")
        
        With mMouseHand(i)
            .Hand(0) = Val(Mid(tstr, 1, 1))
            .Hand(1) = Val(Mid(tstr, 2, 1))
            .Hand(2) = Val(Mid(tstr, 3, 1))
            .HandStr = Replace(Str(.Hand(0)) & Str(.Hand(1)) & Str(.Hand(2)), " ", "")
            .Description = DescriptionHead & DirFlag(.Hand(0)) & DirFlag(.Hand(1)) & DirFlag(.Hand(2))
            Set .CallSub = New cCallByName
            .CallSub.InsideIndex = Val(Mid(tstr, 4, 4))
            '.CallSub.ScriptIndex = Val(Mid(tstr, 8, 4))
            .CallSub.PluginIndex = Val(Mid(tstr, 8, 4))
        End With
    Next i
End With
Exit Sub
due:
    mMouseHandCnt = 0
    ReDim mMouseHand(0 To mMouseHandCnt)
End Sub

						