Skip to main content

AccessTr.neT


Mouse tekerleği sabitleme

Mouse tekerleği sabitleme

Çözüldü #1
Merhaba arkadaşlar benim sorunum farenin tekerleğini döndürünce kayıtlar arasında dolaşmasını engellemek istiyorum ama bunu diğerilen linklere baktım yapamadım.Yüzeysel bir bilgi var orda modüle yazıyorum o kodları sonra mouse diye bi modüle kaydet diyorum programa geçtiğimde halen mouse eskisi gibi çalışıyor.Ben sadece belli bir alanda çalışmasını istiyorum.Biraz daha ayrıntılı yazılırsa bu kodlar çok iyi olacak.Kod yazmada biraz zayıfım kusura bakmayın artık.
shopen66, 30-03-2009 tarihinden beri AccessTr.neT üyesidir.
Son Düzenleme: 30/04/2009, 09:26, Düzenleyen: shopen66.
Cevapla
Çözüldü #2
Bunun için tekrar konu açmanıza gerek yoktu. Size zaten ne yapmanız gerektiğini anlatan linkler verilmişti. Ama neyse, ben tek tek anlatmaya çalışayım:

1- Bir tane modül açıp bu kodları modüle yapıştırıyoruz. Kaydedip çıkıyoruz.
Kod:
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

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
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."
hLib = LoadLibrary("MouseHook.dll")
If hLib = 0 Then
    hLib = LoadLibrary(CurrentDBDir() & "MouseHook.dll")
    If hLib = 0 Then
        MsgBox s, vbOKOnly, "MISSING MOUSEHOOK.dll FILE"
        MouseWheelOFF = False
        Exit Function
    End If
End If
AccessThreadID = GetCurrentThreadId()
MouseWheelOFF = StopMouseWheel(Application.hWndAccessApp, AccessThreadID, GlobalHook)
End Function

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

2- Modülde kullandığımız fonksiyonu formumuza çağırmak için de formumuzun yüklendiğinde olayına şunu yapıştırıyoruz:
Kod:
Private Sub Form_Load()
Dim blRet As Boolean
blRet = MouseWheelOFF(False)
End Sub

Bu kod neyi ifade ediyor? Şunu:
Dim blRet As Boolean
blRet = MouseWheelOFF(False)

MouseWheelOFF değeri False olursa fare tekerleği hareket etmez.

Şimdi bunun aynısını formumuzun çıkışına tam tersi şekilde koyacak olursak ne olur? Tabii ki hareket etmeyen fare artık hareket etmeye başlar. Diğer bütün uygulamalar için de sorun teşkil etmemiş olur. Bunu da kaldırıldığında olaylarından birine koyarsanız sorun hallolmuş olur:

Kod:
Private Sub Form_Unload(Cancel As Integer)
Dim blRet As Boolean
blRet = MouseWheelON
End Sub

Şimdi bu kodlar sayesinde ne yapmış olduk:

1- Form yüklendiğinde fare tekerleğini engelledik. Böylece kayıtlar arasında dolaşmasını engellemiş olduk.
2- Form kaldırıldığında eski haline döndürdük. Böylece diğer uygulamalarda da engellememiş olduk...

Örnek ve Dll Dosyasını indirmek için tıklayın...
NZ Fonksiyonunun (İşlevinin) Ayrıntılı Anlatımı İçin Tıklayın...
DSum ve Sum Fonksiyonunun (İşlevinin) Ayrıntılı Anlatımı İçin Tıklayın...
DLookup Fonksiyonunun (İşlevinin) Ayrıntılı Anlatımı İçin Tıklayın...
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task