设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 964|回复: 5
打印 上一主题 下一主题

[窗体] 光于鼠票滚轮问题

[复制链接]
跳转到指定楼层
1#
发表于 2007-12-20 10:07:01 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
在做好的窗体内如果用鼠票滚动,数据就会切换,怎么样才能阻止窗体内数据滚动?而且不影响窗体的滚动条滚动,还可以使用上一项记录,后一项记录及一些按钮的正常使用呢?
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2007-12-20 10:46:26 | 只看该作者
如何在 Access 中直接写类模块来检测并禁止鼠标滚轮
下面示例如何在 Access 中直接写类模块来检测并禁止鼠标滚轮。(再说一遍:请先备份)

1、打开 Access ,并打开示例数据库 Northwind.mdb.
2、在 VBE 界面建立一个新的模块,并加入以下代码:
Option Compare Database
Option Explicit

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc As Long, _
     ByVal hwnd As Long, _
     ByVal msg As Long, _
     ByVal wParam As Long, _
     ByVal lParam As Long) As Long
     
     
Public Const GWL_WNDPROC = -4
Public Const WM_MouseWheel = &H20A
Public lpPrevWndProc As Long
Public Cmouse As CMouseWheel

Public Function WindowProc(ByVal hwnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

    'Look at the message passed to the window. If it is
    'a mouse wheel message, call the FireMouseWheel procedure
    'in the CMouseWheel class, which in turn raises the MouseWheel
    'event. If the Cancel argument in the form event procedure is
    'set to False, then we process the message normally, otherwise
    'we ignore it.  If the message is something other than the mouse
    'wheel, then process it normally
    Select Case uMsg
        Case WM_MouseWheel
            Cmouse.FireMouseWheel
            If Cmouse.MouseWheelCancel = False Then
                WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
            End If
           
            
        Case Else
           WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
    End Select
End Function

3、保存类,名为:basSubClassWindow
4、建立一个类模块,并且加入以下代码:

Option Compare Database
Option Explicit

Private frm As Access.Form
Private intCancel As Integer
Public Event MouseWheel(Cancel As Integer)

Public Property Set Form(frmIn As Access.Form)
    'Define Property procedure for the class which
    'allows us to set the Form object we are
    'using with it. This property is set from the
    'form class module.
    Set frm = frmIn
End Property

Public Property Get MouseWheelCancel() As Integer
    'Define Property procedure for the class which
    'allows us to retrieve whether or not the Form
    'event procedure canceled the MouseWheel event.
    'This property is retrieved by the WindowProc
    'function in the standard basSubClassWindow
    'module.

    MouseWheelCancel = intCancel
End Property

Public Sub SubClassHookForm()
    'Called from the form's OnOpen or OnLoad
    'event. This procedure is what "hooks" or
    'subclasses the form window. If you hook the
    'the form window, you must unhook it when completed
    'or Access will crash.
   
    lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, _
                                    AddressOf WindowProc)
      Set Cmouse = Me
   End Sub

Public Sub SubClassUnHookForm()
    'Called from the form's OnClose event.
    'This procedure must be called to unhook the
    'form window if the SubClassHookForm procedure
    'has previously been called. Otherwise, Access will
    'crash.

    Call SetWindowLong(frm.hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Public Sub FireMouseWheel()

    'Called from the WindowProc function in the
    'basSubClassWindow module. Used to raise the
    'MouseWheel event when the WindowProc function
    'intercepts a mouse wheel message.
    RaiseEvent MouseWheel(intCancel)
End Sub

5、保存类模块,名字为:CMouseWheel
6、打开 form_Customers 类,加入以下代码:

Option Compare Database
Option Explicit

'Declare a module level variable as the custom class
'and give us access to the class's events
Private WithEvents clsMouseWheel As CMouseWheel

Private Sub Form_Load()
    'Create a new instance of the class,
    'and set the class's Form property to
    'the current form  
    Set clsMouseWheel = New CMouseWheel
    Set clsMouseWheel.Form = Me

    'Subclass the current form by calling
    'the SubClassHookForm method in the class
    clsMouseWheel.SubClassHookForm
End Sub

Private Sub Form_Close()
    'Unhook the form by calling the
    'SubClassUnhook form method in the
    'class, and then destroy the object
    'variable
  
    clsMouseWheel.SubClassUnHookForm
    Set clsMouseWheel.Form = Nothing
    Set clsMouseWheel = Nothing
End Sub

Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)
     'This is the event procedure where you can
     'decide what to do when the user rolls the mouse.
     'If setting Cancel = True, we disable the mouse wheel
     'in this form.

     MsgBox "You cannot use the mouse wheel to scroll through records."
     Cancel = True
End Sub

7、保存,并关闭。

注意:
不要立即打开窗体验证代码是否正确,否则你的access将陷入长时间的停顿,因为 VBE 已经被加载了。
立即退出 Access ,然后重新打开数据库,滚动滚轮,你将看到以下提示:
You cannot use the mouse wheel to scroll through records.
并且记录没有更改。

载自:www.accessbbs.cn
作者:一生一世
3#
 楼主| 发表于 2007-12-20 16:06:38 | 只看该作者
form_Customers 类是什么?我怎么找不到?
4#
 楼主| 发表于 2007-12-20 16:13:05 | 只看该作者
添加了,不过一滚动的话就出现一句话,能不能不让出现这一句,还有就是滚动条也不能用啦?
5#
发表于 2008-8-9 20:12:28 | 只看该作者
就是,我也找不到.....
6#
发表于 2008-8-9 20:19:01 | 只看该作者
form_Customers 类????
那只眼睛能找到???请指教????
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-18 20:25 , Processed in 0.081477 second(s), 29 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表