Set user's cursor

[Cosmos75]

Is there a way to change the user's default normal select, busy, and working in background Windows cursor to a cursor I provide and then have it change pack to the user's default after they are done using the database?

Does it matter if they use WIN 98, WIN NT, WIN 2000 or WIN XP?

 

[chenn]

I yanked this off a website a couple months ago.

It is a series of api calls that will change the users cursor. The way this is set up is that your cursors must be in the same directory as your db - but that should be easy enough to change...

'Change The Mouse Pointer (taken from the AccWebFAQ MDB
'Copyright from Douglas J. Taylor
Private Const IDC_APPSTARTING = 32650&
Private Const IDC_ARROW = 32512&
Private Const IDC_CROSS = 32515&
Private Const IDC_IBEAM = 32513&
Private Const IDC_ICON = 32641&
Private Const IDC_NO = 32648&
Private Const IDC_SIZE = 32640&
Private Const IDC_SIZEALL = 32646&
Private Const IDC_SIZENESW = 32643&
Private Const IDC_SIZENS = 32645&
Private Const IDC_SIZENWSE = 32642&
Private Const IDC_SIZEWE = 32644&
Private Const IDC_UPARROW = 32516&
Private Const IDC_WAIT = 32514&

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

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

Private Declare Function apiSetCursor Lib "user32" _
Alias "SetCursor" _
(ByVal hCursor As Long) _
As Long

Public Sub ChangeCursor()
'based on the AccWebFAQ by Douglas Taylor
Dim strDBPath As String
Dim lngRet As Long
Const curNAME = "Cursor1.CUR"

strDBPath = CurrentDb.Name
strDBPath = Left(strDBPath, InStr(strDBPath, Dir(strDBPath)) - 1)
If Len(Dir(strDBPath & curNAME)) > 0 Then
lngRet = apiLoadCursorFromFile(strDBPath & curNAME)
lngRet = apiSetCursor(lngRet)
'PointM (strDBPath & curNAME)
End If
End Sub

 

[Cosmos75]

chenn,

Thanks for the reply.

Public Sub ChangeCursor()
'based on the AccWebFAQ by Douglas Taylor
Dim strDBPath As String
Dim lngRet As Long
Const curNAME = "Cursor1.CUR"

strDBPath = CurrentDb.Name
strDBPath = Left(strDBPath, InStr(strDBPath, Dir(strDBPath)) - 1)
If Len(Dir(strDBPath & curNAME)) > 0 Then
lngRet = apiLoadCursorFromFile(strDBPath & curNAME)
lngRet = apiSetCursor(lngRet)
'PointM (strDBPath & curNAME)
End If
End Sub

Is curName a name I give to the cursor?
How do I know which one is the busy or working in background cursor? Or do I have to include the full set of cursors for Window? Does it reset each indivudual cursor one at a time or all cursor to the ones in the db folder?


I'm not sure but does this reset the cursors back to the user's default cursors that the user set?

 

[chenn]

If you have your own cursors you want to use, use this function. Actually I would create a new function that you can pass the cursor name.

Public Sub ChangeCursor(strCursorName As String)
'based on the AccWebFAQ by Douglas Taylor
Dim strDBPath As String
Dim lngRet As Long

strDBPath = CurrentDb.Name
strDBPath = Left(strDBPath, InStr(strDBPath, Dir(strDBPath)) - 1)
If Len(Dir(strDBPath & strCursorName)) > 0 Then
lngRet = apiLoadCursorFromFile(strDBPath & strCursorName)
lngRet = apiSetCursor(lngRet)
End If
End Sub

If you use this, make sure that you place a copy of the cursor in the same directory as the database. If you want to use some predifined access cursors use this function...

Public Sub ChangeCursor_NEW(strCurName As String)
'based on the AccWebFAQ by Douglas Taylor
Dim lngRet As Long
Dim hInstance As Long
lngRet = apiLoadCursorBynum(hInstance, strCurName)
lngRet = apiSetCursor(lngRet)
End Sub

You can pass the constants defined in beginning of my previous post. The cursor will stay changed as long as the code is executing. After that it will change back.

 

[chenn]

Calling function....

Sub test()
Dim intCount As Long
ChangeCursor_NEW (IDC_WAIT)

For intCount = 1 To 1000000000
'just wait a little bit so we can see the change and the change back
Next
End Sub