Mehrere MouseDown-Ereignisse empfangen

04/01/2008 - 15:27 von Jürgen Müller | Report spam
Hallo NG,

wie kann ich solange MouseDown-Ereignisse bekommen, wie ich mit der Maus auf
einen Button gedrückt halte?


Danke!
 

Lesen sie die antworten

#1 Christian Zimmermann
04/01/2008 - 16:06 | Warnen spam
Hallo Jürgen,

Jürgen Müller schrieb:

wie kann ich solange MouseDown-Ereignisse bekommen, wie ich mit der Maus auf
einen Button gedrückt halte?



Anders als beim Prellen der Tastatur wird nicht erneut ein MouseDown
oder gar ein MouseClick-Ereignis ausgelöst. Das mußt du selbst
bewerkstelligen, indem du z. B. das Standardverhalten von
Scrollbar-Buttons nachbildest. D. h. mit dem MouseDown beginnt sich der
Balken zu bewegen und hört beim MouseUp auf oder auch, wenn unterhalb
des MouseCursors nicht mehr der Button liegt. Zu Test hier mal etwas
Code (Form1, Command1, Timer1).

' Code Anfang
Option Explicit

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As
POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint
As Long, ByVal yPoint As Long) As Long

Dim p As POINTAPI, lhwnd As Long

Private Sub TuWas()
Debug.Print Now
End Sub

Private Sub Command1_Click()
Debug.Print "Click"
End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
Timer1.Enabled = True
Debug.Print "MouseDown"
End Sub

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
If Timer1.Enabled Then
' Prüfen, ob unter der Maus noch der CommandButton liegt
GetCursorPos p
lhwnd = WindowFromPoint(p.X, p.Y)
If lhwnd <> Command1.hwnd Then Timer1.Enabled = False
End If
End Sub

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
Timer1.Enabled = False
Debug.Print "MouseUp"
End Sub

Private Sub Form_Load()
Timer1.Enabled = False
Timer1.Interval = 100
End Sub

Private Sub Timer1_Timer()
' Prüfen, ob unter der Maus noch der CommandButton liegt
GetCursorPos p
lhwnd = WindowFromPoint(p.X, p.Y)
If lhwnd <> Command1.hwnd Then
Timer1.Enabled = False
Exit Sub
End If
Call TuWas
End Sub
' Code Ende

Gruß

Christian

Ähnliche fragen