กระทู้เก่าบอร์ด อ.Yeadram
2,529 7
URL.หัวข้อ /
URL
การควบคุม record ใน form
ผมเพิ่งหัดเขียนaccess ครับ รบกวนผู้รู้ทุกท่านครับ กับปัญหาที่เจอครับ
คือ เวลาเลื่อน scroll บน เมาส์ แล้ว record มันเลื่อนด้วย ผมต้องการไม่ให้มันเลื่อนหรือเปลี่ยน record ที่เรากำลังทำงาน จะทำอย่างไรครับ
คือ เวลาเลื่อน scroll บน เมาส์ แล้ว record มันเลื่อนด้วย ผมต้องการไม่ให้มันเลื่อนหรือเปลี่ยน record ที่เรากำลังทำงาน จะทำอย่างไรครับ
7 Reply in this Topic. Dispaly 1 pages and you are on page number 1
1 @R02555
http://www.thai-access.com/yeadram_view.php?topic_id=409
2 @R02559
ขอบคุณครับผมลองทำแบบ vba ใน access แล้ว แต่ยังคงเหมือนเดิม และเวลาเปิด-ปิด ฟอร์ม ก็จะขึ้น msgbox ตามในรูป ควรทำอย่างไรดี
(ทำแบบ Visual Basic ActiveX DLL ไม่เป็นครับ)
(ทำแบบ Visual Basic ActiveX DLL ไม่เป็นครับ)
3 @R02560
ไม่มีภาพ ผมเองไม่เคยทำ เพียงแต่ผมหาวิธีมาให้เท่านั้น เพราะโปรแกรมที่ผมทำให้ลูกค้า ผมชอบให้เขาใช้ Scroll ได้ เพราะสะดวกในการเลื่อนเรคอร์ดดี
4 @R02563
ของผมใช้วิธีนี้ครับ
1. ใช้กับ from ที่เปิด
Private Sub Form_Load()
Dim blRet As Boolean
blRet = MouseWheelOFF(False)
blRet = MouseWheelOFF
End Sub
2. สร้างโมดูลใหม่ แล้วนำ Code นี้ไปวาง
Option Compare Database
Option Explicit
Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long
Private Declare Function StopMouseWheel Lib "MouseHook" _
(ByVal hwnd As Long, ByVal AccessThreadID As Long, Optional ByVal blIsGlobal As Boolean = False) As Boolean
Private Declare Function StartMouseWheel Lib "MouseHook" _
(ByVal hwnd As Long) As Boolean
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
' Instance returned from LoadLibrary call
Private hLib As Long
Public Function MouseWheelON() As Boolean
MouseWheelON = StartMouseWheel(Application.hWndAccessApp)
If hLib <> 0 Then
hLib = FreeLibrary(hLib)
End If
End Function
Public Function MouseWheelOFF(Optional GlobalHook As Boolean = False) As Boolean
Dim S As String
Dim blRet As Boolean
Dim AccessThreadID As Long
On Error Resume Next
' Our error string
S = "Sorry...cannot find the MouseHook.dll file" & vbCrLf
S = S & "Please copy the MouseHook.dll file to your Windows System folder or into the same folder as this Access MDB."
' OK Try to load the DLL assuming it is in the Window System folder
hLib = LoadLibrary("MouseHook.dll")
If hLib = 0 Then
' See if the DLL is in the same folder as this MDB
' CurrentDB works with both A97 and A2K or higher
hLib = LoadLibrary(CurrentDBDir() & "MouseHook.dll")
If hLib = 0 Then
MsgBox S, vbOKOnly, "MISSING MOUSEHOOK.dll FILE"
MouseWheelOFF = False
Exit Function
End If
End If
' Get the ID for this thread
AccessThreadID = GetCurrentThreadId()
' Call our MouseHook function in the MouseHook dll.
' Please not the Optional GlobalHook BOOLEAN parameter
' Several developers asked for the MouseHook to be able to work with
' multiple instances of Access. In order to accomodate this request I
' have modified the function to allow the caller to
' specify a thread specific(this current instance of Access only) or
' a global(all applications) MouseWheel Hook.
' Only use the GlobalHook if you will be running multiple instances of Access!
MouseWheelOFF = StopMouseWheel(Application.hWndAccessApp, AccessThreadID, GlobalHook)
End Function
'******************** Code Begin ****************
'Code courtesy of
'Terry Kreft & Ken Getz
'
Function CurrentDBDir() As String
Dim strDBPath As String
Dim strDBFile As String
strDBPath = CurrentDb.Name
strDBFile = Dir(strDBPath)
CurrentDBDir = left$(strDBPath, Len(strDBPath) - Len(strDBFile))
End Function
'******************** Code End ****************
3. แล้วนำ 2 ไฟล์ข้างล่างนี้ ไปวางไว้ในโฟเดอร์ที่โปรแกรมอยู่ครับ
MouseHook
MouseWheel
1. ใช้กับ from ที่เปิด
Private Sub Form_Load()
Dim blRet As Boolean
blRet = MouseWheelOFF(False)
blRet = MouseWheelOFF
End Sub
2. สร้างโมดูลใหม่ แล้วนำ Code นี้ไปวาง
Option Compare Database
Option Explicit
Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long
Private Declare Function StopMouseWheel Lib "MouseHook" _
(ByVal hwnd As Long, ByVal AccessThreadID As Long, Optional ByVal blIsGlobal As Boolean = False) As Boolean
Private Declare Function StartMouseWheel Lib "MouseHook" _
(ByVal hwnd As Long) As Boolean
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
' Instance returned from LoadLibrary call
Private hLib As Long
Public Function MouseWheelON() As Boolean
MouseWheelON = StartMouseWheel(Application.hWndAccessApp)
If hLib <> 0 Then
hLib = FreeLibrary(hLib)
End If
End Function
Public Function MouseWheelOFF(Optional GlobalHook As Boolean = False) As Boolean
Dim S As String
Dim blRet As Boolean
Dim AccessThreadID As Long
On Error Resume Next
' Our error string
S = "Sorry...cannot find the MouseHook.dll file" & vbCrLf
S = S & "Please copy the MouseHook.dll file to your Windows System folder or into the same folder as this Access MDB."
' OK Try to load the DLL assuming it is in the Window System folder
hLib = LoadLibrary("MouseHook.dll")
If hLib = 0 Then
' See if the DLL is in the same folder as this MDB
' CurrentDB works with both A97 and A2K or higher
hLib = LoadLibrary(CurrentDBDir() & "MouseHook.dll")
If hLib = 0 Then
MsgBox S, vbOKOnly, "MISSING MOUSEHOOK.dll FILE"
MouseWheelOFF = False
Exit Function
End If
End If
' Get the ID for this thread
AccessThreadID = GetCurrentThreadId()
' Call our MouseHook function in the MouseHook dll.
' Please not the Optional GlobalHook BOOLEAN parameter
' Several developers asked for the MouseHook to be able to work with
' multiple instances of Access. In order to accomodate this request I
' have modified the function to allow the caller to
' specify a thread specific(this current instance of Access only) or
' a global(all applications) MouseWheel Hook.
' Only use the GlobalHook if you will be running multiple instances of Access!
MouseWheelOFF = StopMouseWheel(Application.hWndAccessApp, AccessThreadID, GlobalHook)
End Function
'******************** Code Begin ****************
'Code courtesy of
'Terry Kreft & Ken Getz
'
Function CurrentDBDir() As String
Dim strDBPath As String
Dim strDBFile As String
strDBPath = CurrentDb.Name
strDBFile = Dir(strDBPath)
CurrentDBDir = left$(strDBPath, Len(strDBPath) - Len(strDBFile))
End Function
'******************** Code End ****************
3. แล้วนำ 2 ไฟล์ข้างล่างนี้ ไปวางไว้ในโฟเดอร์ที่โปรแกรมอยู่ครับ
MouseHook
MouseWheel
5 @R02564
ใน http://www.lebans.com/mousewheelonoff.htm ผมโหลดเอาตัวอย่างที่เขาทำมาให้แล้ว คือไฟล์ MouseWheelHookA2K.zip ก็พบว่ามัันทำงานได้ครับ
6 @R03133
7 @R03145
ผมแนะนำให้กด Tab แทนใช้ scroll bar ครับแต่การใช้ Tab ต้องเข้าไปกำหนดคุณสมบัติในฟอร์มเลือก Other >>วนรอบ กำหนดเป็น Current reccord แล้วจะไม่เลื่อนครับ
Time: 0.3208s