VBA SubClassing mit Modeless Userform?

31/05/2010 - 09:15 von Andreas Killer | Report spam
Juhu. :-)

Ich habe mir ein Modul geschrieben mit dem ich auf jeder Userform das
Mausrad "aktivieren" kann um die Steuerelemente damit zu scrollen.

Es ergibt sich jedoch die winzige Schwierigkeit das das ganze nur 100%
funktioniert wenn die Userform gebunden angezeigt wird.

Wird sie ungebunden angezeigt, geht es nur solange der Cursor in der
Clientarea bleibt.

Sobald man den Cursor auf die Titelleiste bewegt steigt die Systemlast
des Task auf 100%. Bewegt man den Cursor wieder runter geht die
Systemlast auf normal zurück.

Klick man auf die Titelleiste, dann muss man zu einem anderen Task und
zurück wechseln, sonst hàngt's.

Hier mal ein Beispiel auf das wesentliche reduziert:
http://rapidshare.com/files/3935385...g.xls.html

Also hàngt das ganze Problem wohl daran das die Nachrichten nicht
verarbeitet werden?
Kann mir da jemand einen Tip geben wo es hapert?

Alles was sich mit Google so finden làßt heißt nur: "Geht gar nicht."
Aber das ist ja nicht so ganz richtig.

Andreas.
 

Lesen sie die antworten

#1 Andreas Killer
01/06/2010 - 12:29 | Warnen spam
On 31 Mai, 09:15, Andreas Killer wrote:

Also hàngt das ganze Problem wohl daran das die Nachrichten nicht
verarbeitet werden?


Nach etlichem Suchen habe ich zwar keinen Code gefunden, aber den
entscheidenen Hinweis zur Lösung:

Sobald der Mauscursor die Clientarea verlàßt feuert Windows die
WM_NCHITTEST Nachricht um festzustellen welches Fenster sich unter dem
Mauscursor befindet.

Das passiert bei un-/gebundenen Userforms gleichermaßen, jedoch bei
ungebundenen Userforms kommt diese Nachricht so schnell das VB hier
einfach zu langsam ist um diese zu verarbeiten. Wer hàtte das
gedacht. :-)

Die Lösung ist so simpel wie trickreich zugleich:

Kommt in der WindowProc die WM_NCHITTEST Nachricht, dann entfernt man
die WindowProc, ruft DoEvents damit die Nachrichten verarbeitet werden
können und etabliert direkt danach die WindowProc wieder.

Wenn man nun den Mauscursor auf die Titelleiste einer Modeless-
Userform bewegt bleibt die Systemlast bei nahezu 0, "schüttelt" man
die Maus auf der Titelleiste, dann geht die Systemlast kurzfristig
hoch, weil jetzt nun wieder vermehrt die WindowProc angesprungen wird.

Andreas.

Option Explicit

Private Const GWL_WNDPROC = (-4)
Private hWnd As Long
Private PrevProc As Long

Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private 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

Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_NCHITTEST = &H84

Public Sub HookForm(F As UserForm)
hWnd = FindWindow("ThunderDFrame", F.Caption)
If hWnd = 0 Then Exit Sub
PrevProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf _
WindowProc)
End Sub

Public Sub UnHookForm()
SetWindowLong hWnd, GWL_WNDPROC, PrevProc
End Sub

Private Sub RestartSubClassing(ByVal hWnd As Long)
Dim I As Long
I = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Function WindowProc( _
ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim I As Long
Select Case uMsg
Case WM_NCHITTEST
'Vorübergehend die Kontrolle zurückgeben
I = SetWindowLong(hWnd, GWL_WNDPROC, PrevProc)
'Die Kommandos ausführen lassen
DoEvents
'Die Kontrolle wieder übernehmen
RestartSubClassing hWnd
Case WM_MOUSEWHEEL
'Steuerelemente selber scrollen
End Select
If PrevProc <> 0 Then _
WindowProc = CallWindowProc( _
PrevProc, hWnd, uMsg, wParam, lParam)
End Function

Sub Test()
UserForm1.Show vbModeless
End Sub

Ähnliche fragen