开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > 浏览器 > 查看源码
mdlWebHook.bas
资源名称：IE_VB.rar　[点击查看]
上传用户：davilee3
上传日期：2015-04-22
资源大小：986k
文件大小：4k
源码类别：

浏览器

开发平台：

Visual Basic

mdlWebHook.bas：源码内容
  1. Attribute VB_Name = "mWebHook"
  2. 'Option Explicit
  3. '
  4. '
  5. ''Global lpPrevWebProc As Long
  6. ''Public gHWeb As Long
  7. ''Public gWebMsg As Long
  8. '
  9. '
  10. 'Public mHookAllForms As New Collection
  11. 'Dim pX As Long, pY As Long
  12. 'Dim afterBF As Boolean
  13. '
  14. 'Dim nowCur As Integer
  15. 'Dim hPreCur As Long
  16. '
  17. 'Private Const bigGap As Integer = 7
  18. 'Private Const smallGap As Integer = 4
  19. 'Private Const mGap As Integer = 2
  20. '
  21. '
  22. ' '以下过程为消息循环处理
  23. 'Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  24. '
  25. 'Dim tC As frmBrowser
  26. 'Set tC = mHookAllForms.Item(Str(hw))
  27. 'tC.hMsg = uMsg
  28. 'Dim xpos As Long, ypos As Long, cx As Long, cy As Long
  29. 'Dim isBF As Boolean
  30. 'Select Case uMsg
  31. '    Case WM_LBUTTONUP
  32. '        tC.nTimer = Timer
  33. '    Case WM_LBUTTONDOWN
  34. '        tC.nTimer = Timer
  35. '    Case WM_MOUSEMOVE
  36. '        If wParam = MK_RBUTTON Then
  37. '            Call getXY(lParam, xpos, ypos)
  38. '            cx = xpos - pX: cy = ypos - pY
  39. '            isBF = False
  40. '            If cx > bigGap And Abs(cy) < cx Then 'And nowCur <> 1 Then
  41. '                Call SetCursor(po_webmouseright.Handle)
  42. '            ElseIf cx < -bigGap And Abs(cy) < -cx Then 'And nowCur <> 2 Then
  43. '                Call SetCursor(po_webmouseleft.Handle)
  44. '            ElseIf cy > bigGap And Abs(cx) < cy Then 'And nowCur <> 3 Then
  45. '                Call SetCursor(po_webmousedown.Handle)
  46. '            ElseIf cy < -bigGap And Abs(cx) < -cy Then 'And nowCur <> 4 Then
  47. '                Call SetCursor(po_webmouseup.Handle)
  48. '            ElseIf Abs(cx) <= bigGap And Abs(cy) <= bigGap Then
  49. '                Call SetCursor(hPreCur)
  50. '            End If
  51. '        End If
  52. '    Case WM_RBUTTONDOWN
  53. '        Select Case wParam
  54. '            Case MK_RBUTTON
  55. '                hPreCur = GetCursor()
  56. '                SetCapture hw
  57. '                Call getXY(lParam, pX, pY)
  58. ''            Case MK_RBUTTON + MK_LBUTTON, MK_RBUTTON + MK_CONTROL
  59. ''                MDIFrmMain.unloadBrowser tC.tagIndex
  60. '                'uMsg = 0 ': wParam = 0: lParam = 0
  61. '        End Select
  62. '    Case WM_RBUTTONUP
  63. ''        If (GetAsyncKeyState(VK_MENU) And &H8000) <> 0 _
  64. ''            And (GetAsyncKeyState(VK_CONTROL) And &H8000) <> 0 Then
  65. ''            MDIFrmMain.unloadBrowser tC.tagIndex
  66. ''        End If
  67. '
  68. '
  69. '
  70. '        Select Case wParam
  71. '            Case 0
  72. '                Call SetCursor(hPreCur)
  73. '                Call getXY(lParam, xpos, ypos)
  74. '                cx = xpos - pX: cy = ypos - pY
  75. '                isBF = False
  76. '                If cx > bigGap And Abs(cy) < cx Then
  77. '                    Call tC.callGo(1)
  78. '                    isBF = True
  79. '                ElseIf cx < -bigGap And Abs(cy) < -cx Then
  80. '                    Call tC.callGo(-1)
  81. '                    isBF = True
  82. '                ElseIf cy > bigGap And Abs(cx) < cy Then
  83. '                    Call MDIFrmMain.NextLastTab(True)
  84. '                    isBF = True
  85. '                ElseIf cy < -bigGap And Abs(cx) < -cy Then
  86. '                    Call MDIFrmMain.NextLastTab(False)
  87. '                    isBF = True
  88. '                End If
  89. '
  90. '                If isBF Then
  91. '                    uMsg = 0
  92. '                    'wParam = 0: lParam = 0 ': afterBF = True
  93. '                End If
  94. '            Case MK_LBUTTON, MK_CONTROL
  95. '                MDIFrmMain.unloadBrowser tC.tagIndex
  96. '        End Select
  97. '
  98. '        Call ReleaseCapture
  99. '
  100. '
  101. '
  102. '    'Case WM_MBUTTONDBLCLK
  103. '     '   MDIFrmMain.unloadBrowser tC.tagIndex
  104. '    Case WM_MBUTTONDOWN
  105. '        uMsg = WM_LBUTTONDOWN
  106. '    Case WM_MBUTTONUP
  107. '        uMsg = WM_LBUTTONUP
  108. 'End Select
  109. 'WindowProc = CallWindowProc(tC.lpPrevWebProc, hw, uMsg, wParam, lParam)
  110. 'End Function
  111. '
  112. 'Public Sub webHook(gHWeb As Long, lpPrevWebProc As Long) '将程序勾入消息环中
  113. ' '利用AddressOf取得消息处理函数WindowProc的指针，并将其传给SetWindowLong
  114. ' 'lpPrevWndProc用来存储原窗口的指针
  115. ' lpPrevWebProc = SetWindowLong(gHWeb, GWL_WNDPROC, AddressOf WindowProc)
  116. 'End Sub
  117. '
  118. 'Public Sub webUnhook(gHWeb As Long, lpPrevWebProc As Long)
  119. ''将程序从消息环退出。用原窗口的指针替换WindowProc函数的指针，即关闭子类、退出消息循环
  120. ' Dim temp As Long
  121. ' temp = SetWindowLong(gHWeb, GWL_WNDPROC, lpPrevWebProc)
  122. 'End Sub
  123. '
  124. 'Private Function getXY(lParam As Long, xpos As Long, ypos As Long) As Boolean
  125. 'xpos = lParam And &H8000FFFF
  126. 'ypos = (lParam And &HFFFF0000) / &H10000
  127. 'End Function
  128. '
  129. '