การควบคุม record ใน form
กระทู้เก่าบอร์ด อ.Yeadram

 2,529   7
URL.หัวข้อ / URL
การควบคุม record ใน form

ผมเพิ่งหัดเขียนaccess ครับ รบกวนผู้รู้ทุกท่านครับ กับปัญหาที่เจอครับ
คือ เวลาเลื่อน scroll บน เมาส์ แล้ว record มันเลื่อนด้วย ผมต้องการไม่ให้มันเลื่อนหรือเปลี่ยน record ที่เรากำลังทำงาน จะทำอย่างไรครับ

7 Reply in this Topic. Dispaly 1 pages and you are on page number 1

1 @R02555
2 @R02559
ขอบคุณครับผมลองทำแบบ vba ใน access แล้ว แต่ยังคงเหมือนเดิม และเวลาเปิด-ปิด ฟอร์ม ก็จะขึ้น msgbox ตามในรูป ควรทำอย่างไรดี
(ทำแบบ 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
5 @R02564
ใน http://www.lebans.com/mousewheelonoff.htm ผมโหลดเอาตัวอย่างที่เขาทำมาให้แล้ว คือไฟล์ MouseWheelHookA2K.zip ก็พบว่ามัันทำงานได้ครับ
6 @R03133
7 @R03145
ผมแนะนำให้กด Tab แทนใช้ scroll bar ครับแต่การใช้ Tab ต้องเข้าไปกำหนดคุณสมบัติในฟอร์มเลือก Other >>วนรอบ กำหนดเป็น Current reccord แล้วจะไม่เลื่อนครับ
@ ประกาศใช้งานเว็บบอร์ดใหม่ => บอร์ดเรียนรู้ Access สำหรับคนไทย
แล้วจะใส่ลิ้งอ้างอิงมาที่โพสต์เก่านี้หรือไม่ก็ตามสะดวกครับ
Time: 0.3208s