1/17/11

Mouse Pointer Hover Function

These are the standard Access cursors and can be set in code. The problem with this is once set the cursor remains this way until reset to another value

Screen.MousePointer = 1 'Standard Cursor
Screen.MousePointer = 3 ' I Beam
Screen.MousePointer = 7 'Double Arrow Vertical
Screen.MousePointer = 9 'Double Arrow Horizontal
Screen.MousePointer = 11 'Hour Glass

The function below allows you to change a cursor only when it hovers over a label or command button. It resets th e cursor when it leaves the control. Goto Modules in the Objects Dialog box and click on NEW. Then enter this code:


‘*********************** Code Starts Here **********************************
Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'=====================================================================
' Globals for cursor handling
Global Const GCL_HCURSOR = (-12)
Global hSwapCursor As Long
Global hAniCursor As Long

'=====================================================================

Public Const IDC_ARROW = 32512&
Public Const IDC_IBEAM = 32513&
Public Const IDC_WAIT = 32514&
Public Const IDC_CROSS = 32515&
Public Const IDC_UPARROW = 32516&
Public Const IDC_ICON = 32641&
Public Const IDC_SIZENWSE = 32642&
Public Const IDC_SIZENESW = 32643&
Public Const IDC_SIZEWE = 32644&
Public Const IDC_SIZENS = 32645&
Public Const IDC_SIZEALL = 32646&
Public Const IDC_NO = 32648&
Public Const IDC_HAND = 32649&
Public Const IDC_APPSTARTING = 32650&

Declare Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" _
(ByVal hInstance As Long, ByVal lpCursorName As Long) As Long

Declare Function LoadCursorFromFile Lib "user32" Alias _
"LoadCursorFromFileA" (ByVal lpFileName As String) As Long

Declare Function SetCursor Lib "user32" _
(ByVal hCursor As Long) As Long
'
Public Function Arrow_Pointer()
Screen.MousePointer = 1
End Function

Function ChangeCursor(strPathToCursor As String)

On Error GoTo Error_On_ChangeCursor

' Example :
' ChangeCursor ("C:\Program Files\Microsoft Office\Office\Hand.cur")

If Dir(strPathToCursor) <> "" Then
Dim lngRet As Long
lngRet = LoadCursorFromFile(strPathToCursor)
lngRet = SetCursor(lngRet)
End If

Exit_ChangeCursor:

Exit Function

Error_On_ChangeCursor:

Resume Exit_ChangeCursor

End Function

Public Function Default_Pointer()
Screen.MousePointer = 0
End Function

Public Function IBeam_Pointer()
Screen.MousePointer = 3
End Function

Function MouseCursor(CursorType As Long)

' Example: =MouseCursor(32512) ' using Public Constants from above

Dim lngRet As Long
lngRet = LoadCursorBynum(0&, CursorType)
lngRet = SetCursor(lngRet)
End Function

Public Function Replace_Cursor(PathToFile As String)

' Return handle from animated cursor

' Original - hAniCursor = LoadCursorFromFile("C:\WINDOWS\CURSORS\GLOBE.ANI")

hAniCursor = LoadCursorFromFile(PathToFile)
' Swap current mouse pointer with new animated cursor :
hSwapCursor = SetClassLong(Screen.ActiveForm.hWnd, GCL_HCURSOR, hAniCursor)


End Function

Public Function Restore_Cursor()

' Remove animated cursorand replace with saved index :

hSwapCursor = SetClassLong(Screen.ActiveForm.hWnd, GCL_HCURSOR, hSwapCursor)

End Function
‘*********************** Code End Here **********************************

When Prompted name the module modMousePointers

To change a pointer when the cursor moves over a control, goto the control’s

Properties – Events – On Mouse Move and in the MouseMove Property enter

=MouseCursor(xxxxx)

where xxxxx is the number without the ampersand

Public Const IDC_ARROW = 32512&
Public Const IDC_IBEAM = 32513&
Public Const IDC_WAIT = 32514&
Public Const IDC_CROSS = 32515&
Public Const IDC_UPARROW = 32516&
Public Const IDC_ICON = 32641&
Public Const IDC_SIZENWSE = 32642&
Public Const IDC_SIZENESW = 32643&
Public Const IDC_SIZEWE = 32644&
Public Const IDC_SIZENS = 32645&
Public Const IDC_SIZEALL = 32646&
Public Const IDC_NO = 32648&
Public Const IDC_HAND = 32649&
Public Const IDC_APPSTARTING = 32650&


http://bytes.com/topic/access/answers/662035-changing-mouse-cursor

No comments: