GetCursor, LoadCursor, SetCursor

option explicit

'Author:     Todd Hardin, Customer Systems Inc.
'Date:       January 11, 2004
'Release:    Released to public domain 
'Disclaimer: No warranty is expresed nor implied
'            Use at own risk


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

' Standard Cursor IDs
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_SIZE = 32640&
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_APPSTARTING = 32650&

Public vbCRLF as String

sub main
    on error goto errMain
    dim lhCursorOrig as Long
    dim lhVoid as Long

    'init global helper variables
    vbCRLF = chr$(13) & chr$(10)

    SetPropertyOf "edtStatus", "Text", "Step 1..."
    ProcessWindowMessages

    'retrieve original cursor to use during clean-up at end of process
    lhCursorOrig = GetCursor

    'Set cursor to Wait (i.e. Hour Glass)
    SetCursorWait

    'process is never yielded, so this edit box property update will not be seen on the view.
    SetPropertyOf "edtStatus", "Text", "Step 2..."
    'ProcessWindowMessages  '<-- un-comment to update display
    'SetCursorWait		 '<-- note that you must un-comment as well to reset cursor to HourGlass

    'An  "busy" loop 
    'demonstrates that hour glass cursor will continue to display during uninterupted operations.
    dim j as Long
    dim i as Long
    for i = 1 to 32000
	 j = j + i

        'process is never yielded, so this edit box property update will not be seen on the view.
        SetPropertyOf "edtStatus", "Text", "Step 3 - " & CStr(j)
    next  'busy loop...

    'yield process
    ProcessWindowMessages

    'As soon as you yield your process, the cursor will/may (usually, but not always) 
    'change back to whatever cursor the SLX view has defined 
    '(i.e. usually the arrow pointer since we cannot manipulate cursors on legacy views).
    'Ending the script instance will have the same effect as this yields the script process.
    SetPropertyOf "edtStatus", "Text", "Step 4 - Finished"

    'RESET Cursor State
    'just like a good camper... put everything back the way you found it ... pack it in / pack it out
    lhVoid = SetCursor(lhCursorOrig)


'general SLX LogixErrors handler
'check before exiting routine
If LogixErrors Then
   msgbox "SLX API error occured: " & vbCRLF & _
	   "Error Code: " & LogixErrorCode & vbCRLF & _
	   "Error Description: " & vbCRLF & _
	   LogixErrorText
end if
Exit Sub  '<-- normail exit

errMain:
    msgbox "debug - an error occured." & err.description
end sub

sub SetCursorWait()
    dim lhCursorWait as Long
    dim lhCursorPrev as Long

    'Load an instance of the desired cursor to use
    'when loading special system cursors, use hInstance value of zero and retrieve cursor by number
    lhCursorWait = LoadCursorBynum(Clng(0), IDC_WAIT)
    lhCursorPrev = SetCursor(lhCursorWait)

    'most efficient / compact version
    'dim lhVoid   
    'lhVoid = SetCursor(LoadCursorBynum(0&, 32514&))

Exit Sub  '<-- normal exit
errSlxSetCursor:
    msgbox "debug - an error occured." & err.description
End sub