VBA Tipp: Mauszeiger mit eigenem Icon

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte den Standard-Mauszeiger ändern, z.B., wenn ich die Maus über einem Steuerelement bewege (MouseMove-Ereignis).

Lösung 1

Dazu kann man eine der folgenden Codes in ein globales VBA-Modul kopieren.

Nur für Microsoft Access 32-Bit geeignet

Private Declare Function LoadCursorFromFile Lib "user32" _
   Alias "LoadCursorFromFileA" ( _
   ByVal lpFileName As String _
   ) As Long
 
Private Declare Function SetCursor Lib "user32" ( _
   ByVal hCursor As Long) As Long
 
Public Sub MauszeigerAendern(ByVal Dateipfad As String)
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Dim lngCursor As Long
 
   lngCursor = LoadCursorFromFile(Dateipfad)
   If lngCursor Then Call SetCursor(lngCursor)
End Sub

Für Microsoft Access 32 und 64-Bit geeignet

Wiki hinweis.png Hinweis: Verwendet Bedingte Kompilierung
#If VBA7 Then
 
Private Declare PtrSafe Function LoadCursorFromFile Lib "user32" _
   Alias "LoadCursorFromFileA" ( _
   ByVal lpFileName As String) As LongPtr
 
Private Declare PtrSafe Function SetCursor Lib "user32" ( _
   ByVal hCursor As LongPtr) As LongPtr
 
#Else
 
Private Declare Function LoadCursorFromFile Lib "user32" _
   Alias "LoadCursorFromFileA" ( _
   ByVal lpFileName As String _
   ) As Long
 
Private Declare Function SetCursor Lib "user32" ( _
   ByVal hCursor As Long) As Long
 
#End If
 
Public Sub MauszeigerAendern(ByVal Dateipfad As String)
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   If VBA7 Then
      Dim lngCursor As LongPtr
   #Else
      Dim lngCursor As Long
   #End If
 
   lngCursor = LoadCursorFromFile(Dateipfad)
 
   If lngCursor Then Call SetCursor(lngCursor)
 
End Sub

Aufruf

Im MouseMove-Ereignis eines Bezeichnungsfeldes eines Formulars:
Erlaubte Dateitypen:

  • .cur Cursor
  • .ani Animierter Cursor
  • .ico Symbol (Icon)

Weitere Cursordateien sind im Verzeichnis C:\Windows\Cursors zu finden.

Private Sub Bezeichnungsfeld1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
   Dim strPfadCursor As String
 
   'Pfad zur Cursor-Datei "aero_link.cur" (Hand-Symbol) im Verzeichnis C:\Windows\Cursors
   strPfadCursor = Environ("WINDIR") & "\Cursors\aero_link.cur"
 
   'Alternativ: Pfad zu einer .ico-Datei
   'strPfadCursor = CurrentProject.Path & "\favicon.ico"
 
   Call MauszeigerAendern(strPfadCursor)
 
End Sub

Lösung 2

Dazu kann man eine der folgenden Codes in ein globales VBA-Modul kopieren.

Nur für Microsoft Access 32-Bit geeignet

' nIndex-Konstanten für SetClassLong
Private Const GCL_HCURSOR    As Long = -12     ' ermittelt das Handle des Cursors der Klasse
 
' lpCursorName-Konstanten für LoadCursor
Public Const IDC_APPSTARTING As Long = 32650   ' Blauer, sich drehender Kreis
' (früher: Pfeil und Sanduhr, "Anwendung starten")
Public Const IDC_ARROW       As Long = 32512   ' Standardpfeil
Public Const IDC_CROSS       As Long = 32515   ' Kreuz, Fadenkreuz
Public Const IDC_HAND        As Long = 32649   ' Hand
Public Const IDC_HELP        As Long = 32651   ' Pfeil mit Fragezeichen
Public Const IDC_IBEAM       As Long = 32513   ' Textcursor (Einfügemarke)
Public Const IDC_ICON        As Long = 32641   ' -
Public Const IDC_NO          As Long = 32648   ' roter Kreis mit Schrägstrich ("Nicht ablegen")
Public Const IDC_SiZE        As Long = 32640   ' -
Public Const IDC_SIZEALL     As Long = 32646   ' Kreuz mit Pfeilen
Public Const IDC_SIZENESW    As Long = 32643   ' Pfeil von Nordost nach Südwest
Public Const IDC_SIZENS      As Long = 32645   ' Pfeil von Nord nach Süd
Public Const IDC_SIZENWSE    As Long = 32642   ' Pfeil von Nordwest nach Südost
Public Const IDC_SIZEWE      As Long = 32644   ' Pfeil von West nach Ost
Public Const IDC_UPARROW     As Long = 32516   ' Pfeil nach oben
Public Const IDC_WAIT        As Long = 32514   ' Blauer, sich drehender Kreis
                                               ' vormals: Sanduhr, "Warten")
 
Private Declare Function LoadCursor Lib "user32.dll" _
   Alias "LoadCursorA" ( _
   ByVal hInstance As Long, _
   ByVal lpCursorName As Any) As Long
 
Private Declare Function GetCursor Lib "user32.dll" () As Long
 
Private Declare Function SetClassLong Lib "user32" _
   Alias "SetClassLongA" ( _
   ByVal hwnd As Long, _
   ByVal nIndex As Long, _
   ByVal dwNewLong As Long) As Long
 
' =============================================================================
 
Private hCurAlt As Long
 
Public Sub MauszeigerAendern(ByVal cCursor As Long)
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
      Dim hCur As Long
 
   If hCurAlt = 0 Then
      ' Aktuellen Cursor ermitteln
      hCurAlt = GetCursor
 
      ' Neuen Cursor laden
      hCur = LoadCursor(0, cCursor)
 
      ' Neuen Cursor zuweisen
      Call SetClassLong(Screen.ActiveForm.hwnd, GCL_HCURSOR, hCur)
      DoEvents
   End If
End Sub
 
Public Sub MauszeigerZuruecksetzen()
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   If hCurAlt Then
      ' Alten Cursor wiederherstellen
      Call SetClassLong(Screen.ActiveForm.hwnd, GCL_HCURSOR, hCurAlt)
      DoEvents
 
      hCurAlt = 0
   End If
End Sub

Für Microsoft Access 32 und 64-Bit geeignet

Wiki hinweis.png Hinweis: Verwendet Bedingte Kompilierung
' nIndex-Konstanten für SetClassLong
Private Const GCL_HCURSOR    As Long = -12     ' ermittelt das Handle des Cursors der Klasse
 
' lpCursorName-Konstanten für LoadCursor
Public Const IDC_APPSTARTING As Long = 32650   ' Blauer, sich drehender Kreis
' (früher: Pfeil und Sanduhr, "Anwendung starten")
Public Const IDC_ARROW       As Long = 32512   ' Standardpfeil
Public Const IDC_CROSS       As Long = 32515   ' Kreuz, Fadenkreuz
Public Const IDC_HAND        As Long = 32649   ' Hand
Public Const IDC_HELP        As Long = 32651   ' Pfeil mit Fragezeichen
Public Const IDC_IBEAM       As Long = 32513   ' Textcursor (Einfügemarke)
Public Const IDC_ICON        As Long = 32641   ' -
Public Const IDC_NO          As Long = 32648   ' roter Kreis mit Schrägstrich ("Nicht ablegen")
Public Const IDC_SiZE        As Long = 32640   ' -
Public Const IDC_SIZEALL     As Long = 32646   ' Kreuz mit Pfeilen
Public Const IDC_SIZENESW    As Long = 32643   ' Pfeil von Nordost nach Südwest
Public Const IDC_SIZENS      As Long = 32645   ' Pfeil von Nord nach Süd
Public Const IDC_SIZENWSE    As Long = 32642   ' Pfeil von Nordwest nach Südost
Public Const IDC_SIZEWE      As Long = 32644   ' Pfeil von West nach Ost
Public Const IDC_UPARROW     As Long = 32516   ' Pfeil nach oben
Public Const IDC_WAIT        As Long = 32514   ' Blauer, sich drehender Kreis
                                               ' vormals: Sanduhr, "Warten")
 
#If VBA7 Then
 
Private Declare PtrSafe Function LoadCursor Lib "user32" _
   Alias "LoadCursorA" ( _
   ByVal hInstance As LongPtr, _
   ByVal lpCursorName As String) As LongPtr
 
Private Declare PtrSafe Function GetCursor Lib "user32" () As LongPtr
 
#If Win64 Then
 
Private Declare PtrSafe Function SetClassLong Lib "user32" _
   Alias "SetClassLongPtrA" ( _
   ByVal hwnd As LongPtr, _
   ByVal nIndex As Long, _
   ByVal dwNewLong As LongPtr) As LongPtr
 
#Else ' Win32
 
Private Declare PtrSafe Function SetClassLong Lib "user32" _
   Alias "SetClassLongA" ( _
   ByVal hwnd As LongPtr, _
   ByVal nIndex As Long, _
   ByVal dwNewLong As LongPtr) As LongPtr
 
#End If
 
#Else ' VBA6
 
Private Declare Function LoadCursor Lib "user32.dll" _
   Alias "LoadCursorA" ( _
   ByVal hInstance As Long, _
   ByVal lpCursorName As Any) As Long
 
Private Declare Function GetCursor Lib "user32.dll" () As Long
 
Private Declare Function SetClassLong Lib "user32" _
   Alias "SetClassLongA" ( _
   ByVal hwnd As Long, _
   ByVal nIndex As Long, _
   ByVal dwNewLong As Long) As Long
 
#End If
 
' =============================================================================
 
#If VBA7 Then
Private hCurAlt As LongPtr
#Else
Private hCurAlt As Long
#End If
 
 
#If VBA7 Then
Public Sub MauszeigerAendern(ByVal cCursor As LongPtr)
#Else
Public Sub MauszeigerAendern(ByVal cCursor As Long)
#End If
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   #If VBA7 Then
      Dim hCur As LongPtr
   #Else
      Dim hCur As Long
   #End If
 
   If hCurAlt = 0 Then
      ' Aktuellen Cursor ermitteln
      hCurAlt = GetCursor
 
      ' Neuen Cursor laden
      hCur = LoadCursor(0, cCursor)
 
      ' Neuen Cursor zuweisen
      Call SetClassLong(Screen.ActiveForm.hwnd, GCL_HCURSOR, hCur)
      DoEvents
   End If
End Sub
 
Public Sub MauszeigerZuruecksetzen()
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   If hCurAlt Then
      ' Alten Cursor wiederherstellen
      Call SetClassLong(Screen.ActiveForm.hwnd, GCL_HCURSOR, hCurAlt)
      DoEvents
 
      hCurAlt = 0
   End If
End Sub

Aufruf

  • Im MouseMove-Ereignis eines Bezeichnungsfeldes im Detailbereich eines Formulars wird der Mauszeiger geändert.
  • Im MouseMove-Ereignis des Detailbereichs des Formulars wird der Mauszeiger wieder auf die Standardansicht zurückgesetzt.
Private Sub Bezeichnungsfeld1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
   'Mauszeiger in Hand-Symbol ändern
   Call MauszeigerAendern(IDC_HAND)
 
End Sub
 
Private Sub Detailbereich_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
   Call MauszeigerZuruecksetzen
 
End Sub
Wiki hinweis.png Anmerkung: Lösung 2 funktioniert nicht für Textfelder, Kombinations- und Listenfelder.


Weblinks