PDA

Vollständige Version anzeigen : Scroll-Rad bei einer Maus


Hightower
28.02.2001, 16:35
Hi,

habe da noch einmal eine Frage zum Thema Scroll-Rad bei einer Maus, wie kann ich diese in einem Formular deaktieviren.

Bis dann Hightower

Sascha Trowitzsch
28.02.2001, 17:25
...Gar nicht! Der Maus-Treiber setzt die Radbewegung in Messages an den Scrollbalken um und den kann man nicht deaktivieren.
Andererseits: Ist es ein einzelnes Formular oder ein Datenblattformular? Bei ersterem führt das Rad ja zum Durchlaufen der Datensätze, nicht zum Scrollen, und das wiederum könnte man schon ausschalten.

Ciao, Sascha

Johann Pumhösl
28.02.2001, 23:03
Hallo!

Damit das Steuerrad keine Meldungen mehr an das Fenster senden kann, zb zum Datensatzwechsel oder scrollen kann man die Messages WM_WHEELMOUSE per Subclassing auf das entsprechende Form abfangen und so nicht weiterbearbeiten lassen.

Vielleicht interessant dazu VBA Tips+Tricks Code-Beispiel #24 auf http://members.aon.at/millpartner

Sascha Trowitzsch
28.02.2001, 23:22
... Tja, da geht's verdammt tief in die WinAPI-Programmierung... Ob er's wohl hinkriegt? Ich kenne kein fertiges Snippet dazu. Aber ich bin immer wieder erstaunt, welche Verrenkungen manche Programmierer anstellen, um in Access die wunderlichsten Sachen zu veranstalten ;-)
Mir wär's zu anstrengend, nur um das Wheel abzustellen.

Ciao bis morgen, Sascha

Johann Pumhösl
01.03.2001, 00:58
Hallo Sascha,

ein >fast< Snippet gibts davon auch:
Tips+Tricks Code#28

BTW: ich glaube nicht das subclassing eine "verrenkung" ist und als C++ programmierer meistens tagesordnungspunkt. trivial ist das thema allerdings nicht, da gebe ich dir recht. ob er's wohl schafft... naja vielleicht lasst er uns es ja wissen...

gruss johann
URL: http://www.millstore.at

tosc
01.03.2001, 07:42
hi,

schau doch mal dort nach:

Der DS-Wechsel kann durch das Abfangen der Mausbefehle mit API-Funktionen verhindert werden. http://www.mvps.org/access/api/api0036.htm

Das wilde DS-Springen mit der Intellimouse wird lt. MS vom SR2 zu O97 bzw. durch neue Maustreiber gefixt: http://www.microsoft.com/IntlKB/Germany/Support/kb/D36/D36771.htm http://support.microsoft.com/support/kb/articles/Q177/2/74.asp

cu
tosc

Sascha Trowitzsch
01.03.2001, 12:33
Hallo Johann, kleine Anmerkung: der Tip#28 auf deiner Seite ist nicht richtig? verlinkt. (Anker auf #32 gesetzt).

Ich geb's zu: Schöne kleine Lösung!

Gruß, Sascha

Claudia Fürstenhöfer
01.03.2001, 19:31
Hallo Johann,

ich habe mir den Code von deiner Website geholt, werde aber nicht ganz schlau daraus.
Wo muß ich den Code genau einbauen und wie und wo wird die Function "SubWindowFormProc" aufgerufen???

' == MODUL ============================================
Public Function SubWindowFormProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Fensterfunktion des Formulars, Subclassing!

On Error Resume Next

If uMsg = WM_MOUSEWHEEL Then
' nichts zu tun hier
SubWindowFormProc = 1
Exit Function
End If

'return to the message original proc
SubWindowFormProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)

End Function

------------------
Tschüß
Claudia
Ich beantworte keine Fragen per Mail!

klemens
01.03.2001, 20:45
nimm superkleber, damit ist das problem ein für alle mal behoben. ( ok, sr1 oder 2 von A97 sollen das problem auch beheben, zumindest das unkontrolierte wilde scrollen )

Johann Pumhösl
01.03.2001, 21:15
Hallo Claudia!

SubWindowFormProc ist eine Subclass-Funktion auf das Formular, heisst nichts anderes als das alle Nachrichten die an dieses Form weitergeleitet werden, vorab diese Prozedur
durchlaufen. Daher hat man auch die Möglichkeit die Messages (wie zb WM_WHEELMOUSE) in geänderte Form an die ursprüngliche Fensterprozedur weiterzuleiten, oder sie eben in unserem speziellen Fall nicht weiterzuleiten.

Damit die Funktion auch ausgeführt wird, ist es notwendig ein Subclassing auf das entsprechende Handle (in unserem Fall auf das Formular selbst) mit der Funktion HookMe() einzurichten:

' == IM MODUL ================
Public lpPrevWndProc As Long
Public Const GWL_WNDPROC = (-4)

' == API's =============================
Public Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&) As Long

Public Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, _
ByVal wParam&, ByVal lParam&) As Long

' == FUNCTIONS ========================
Public Function SubWindowProc(ByVal hWnd&, ByVal uMsg&, ByVal wP&, ByVal lP&) As Long
' Fensterfunktion des Formulars / Controls

On Error Resume Next

' Messages hier bearbeiten
If uMsg = WM_MOUSEWHEEL Then
' nichts zu tun hier
SubWindowProc = 1
Exit Function
End If

'return to the message original proc
SubWindowProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)

End Function

Public Sub HookMe(hw&)
' Subclass by the given handle
' Aufruf zb aus Form_Load() mit
' Call HookMe(Me.hwnd)

' in Access 97: mangels AddressOf Operator das work-around AddrOf verwenden!
lpPrevWndProc = SetWindowLong(hw&, GWL_WNDPROC, AddrOf("SubWindowProc"))

' in Access 2K
' lpPrevWndProc = SetWindowLong(hw&, GWL_WNDPROC, AddressOf "SubWindowProc")

End Function

Public Sub UnHookMe(hw&)
' Unhook the given handle
' Aufruf zb aus Form_UnLoad() mit
' Call UnHookMe(Me.hwnd)
If lpPrevWndProc& <> 0 Then: Call SetWindowLong(hw&, GWL_WNDPROC, lpPrevWndProc&)
lpPrevWndProc = 0
End Sub

Die Funktion UnHookMe() beendet das Subclassing auf das Form wieder.

Claudia Fürstenhöfer
01.03.2001, 21:42
Lieber Johann,

danke für deine Geduld, aber ich habe es immer noch nicht kapiert. Macht nichts, ich lasse es nun sein. Habe gerade ca. 30m Minuten versucht den Code einzubauen, aber es geht nicht. Entweder bekomme ich Fehler, das Variablen nicht gefunden werden oder die Datensätze werden bein Drehen des Mausrads immer noch geblättert.

Dein Code ist mir auch etwas zu hoch, dazu bin ich zu wenig Programmiererin.

Nochmals Danke.

------------------
Tschüß
Claudia
Ich beantworte keine Fragen per Mail!

Johann Pumhösl
01.03.2001, 21:55
Hallo Claudia!

Wenn es dir hilft schick mir deine DB gezippt. Ich baue dir das als Beispiel in einem Form ein.

<geht nicht, gibts nicht!>

Sascha Trowitzsch
02.03.2001, 01:24
Hi Johann,

vielleicht hat Claudia ja tatsächlich Acc97 und dann funktioniert's nicht, weil sie nicht ahnen kann, dass man den Code von AddrOf unter: http://www.officevba.com/features/1998/05/vba199805kg_f/vba199805kg_f.asp
findet?

Ciao, Sascha

Sascha Trowitzsch
02.03.2001, 12:04
...Und noch was:

AdressOf in Acc2000 verlangt die Prozedur selbst, nicht einen String, also

lpPrevWndProc = SetWindowLong(hw&, GWL_WNDPROC, AddressOf SubWindowProc)

Ciao, Sascha

Claudia Fürstenhöfer
02.03.2001, 13:03
Hallo Johann,

danke dir für die tolle Hilfe, es hat super geklappt.

Für alle Anderen, hier einige Infos damit es auch mit Access97 läuft:

Man benötigt zwei Module:

Inhalt für das Modul "bas_AddrOf"

Option Compare Database
Option Explicit

Private Declare Function GetCurrentVbaProject Lib "vba332.dll" Alias "EbGetExecutingProj" (hProject&) As Long
Private Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId" (ByVal hProject&, ByVal strFunctionName$, ByRef strFunctionId$) As Long
Private Declare Function GetAddr Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" (ByVal hProject&, ByVal strFunctionId$, ByRef lpfn&) As Long

Public Function AddrOf&(strFuncName$)
Dim hProject&, lResult&, lpfn&
Dim strID$, strFuncNameUnicode$

Const NO_ERROR = 0
AddrOf = 0

strFuncNameUnicode = StrConv(strFuncName, vbUnicode)

Call GetCurrentVbaProject(hProject)

If hProject <> 0 Then
lResult = GetFuncID(hProject, strFuncNameUnicode, strID)
If lResult = NO_ERROR Then
lResult = GetAddr(hProject, strID, lpfn)
If lResult = NO_ERROR Then: AddrOf = lpfn
End If
End If

End Function


Inhalt für das Modul "bas_MOUSEWHEEL"

Option Compare Database
Option Explicit

Public lpPrevWndProc As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_MOUSEWHEEL = &H20A

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&) As Long

Public Function SubWindowProc(ByVal hWnd&, ByVal uMsg&, ByVal wP&, ByVal lP&) As Long
On Error Resume Next

If uMsg = WM_MOUSEWHEEL Then
SubWindowProc = 1
Exit Function
End If

SubWindowProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wP, lP)

End Function

Public Sub HookMe(hw&)

' in Access 97: mangels AddressOf Operator das work-around AddrOf verwenden!
lpPrevWndProc = SetWindowLong(hw&, GWL_WNDPROC, AddrOf("SubWindowProc"))

' in Access 2K
' lpPrevWndProc = SetWindowLong(hw&, GWL_WNDPROC, AddressOf "SubWindowProc")

End Sub

Public Sub UnHookMe(hw&)
If lpPrevWndProc& <> 0 Then: Call SetWindowLong(hw&, GWL_WNDPROC, lpPrevWndProc&)
lpPrevWndProc = 0
End Sub


In das Formular, in welchem das Mausrad deaktiviert werden soll, muss folgender Code rein:

Private Sub Form_Load()
Call HookMe(Me.hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnHookMe(Me.hWnd)
End Sub


Viel Spaß
Claudia