Download zip file
#COMPILE EXE
#COMPILER PBWIN 8
#DEBUG ERROR ON
#TOOLS ON
#DIM ALL
#RESOURCE "cur_test.pbr"
%USEMACROS = 1
#INCLUDE "win32api.inc"
%CurMoveLft = 0
%CurMoveRgt = 1
%CurStopLft = 2
%CurStopRgt = 3
GLOBAL gInstance AS DWORD
'
'------------------------------------------------------------------------------
'
SUB SetMyCursor ( hCur() AS DWORD, _
BYVAL Stoped AS LONG )
DIM hCurs AS STATIC DWORD
DIM X AS STATIC LONG
DIM tP AS LOCAL POINTL
IF Stoped = 0 THEN
GetCursorPos tP
IF tP.X <> X THEN
hCurs = IIF(tP.X < X,hCur(%CurMoveLft),hCur(%CurMoveRgt))
X = tP.X
END IF
ELSEif hCurs = hCur(%CurMoveLft) THEN
hCurs = hCur(%CurStopLft)
ELSEif hCurs = hCur(%CurMoveRgt) THEN
hCurs = hCur(%CurStopRgt)
END IF
SetCursor hCurs
END SUB
'
'------------------------------------------------------------------------------
'
CALLBACK FUNCTION CursorTest_CB()
DIM hCur(3) AS STATIC DWORD
DIM CurStopped AS STATIC LONG
DIM CurNbr AS STATIC LONG
DIM CurTimeOut AS STATIC LONG
DIM CurTimer AS STATIC LONG
DIM hWndSaveFocus AS STATIC DWORD
DIM Working AS STATIC LONG
DIM C AS LOCAL LONG
DIM tP AS LOCAL POINTL
DIM zTxt AS LOCAL ASCIIz * 100
IF Working THEN
FUNCTION = 1
EXIT FUNCTION
END IF
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG : CurTimer = 9837 ' most any number will do
CurTimeOut = 1000 ' 1 second
PostMessage CBHNDL, %WM_COMMAND, 1000, %BN_CLICKED
CASE %WM_NCACTIVATE : IF ISFALSE CBWPARAM THEN
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_TIMER : CurStopped = 1 ' set the
SetMyCursor hCur(), CurStopped '
FUNCTION = 1
CASE %WM_SETCURSOR : IF CurStopped THEN
KillTimer CBHNDL, CurTimer
CurStopped = 0
ELSE
SetTimer CBHNDL, CurTimer, CurTimeOut, 0
END IF
SetMyCursor hCur(), CurStopped
FUNCTION = 1
EXIT FUNCTION
CASE %WM_DESTROY : FOR C = 0 TO 3
IF hCur(C) > 0 THEN DeleteObject hCur(C)
NEXT
MOUSEPTR 1
Working = 0
CASE %WM_COMMAND : SELECT CASE AS LONG CBCTL
CASE 2 : DIALOG END CBHNDL, 0
CASE 1000 : IF CBCTLMSG = %BN_CLICKED THEN
Working = 1
KillTimer CBHNDL, CurTimer
IF CurNbr = 4000 THEN
zTxt = "Chick Cursors"
CurNbr = 3000
ELSE
zTxt = "Dozer Cursors"
CurNbr = 4000
END IF
CONTROL SET TEXT CBHNDL, 1000, zTxt
FOR C = 0 TO 3
IF hCur(C) > 0 THEN DeleteObject hCur(C)
zTxt = FORMAT$(CurNbr+C,"\#0000")
hCur(C) = LoadCursor(gInstance,zTxt)
NEXT
Working = 0
GetCursorPos tP ' move the cursor to force a change
DECR tP.X
SetCursorPos tP.X, tP.Y
END IF
END SELECT
END SELECT
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION WINMAIN ( BYVAL hInstance AS DWORD , _
BYVAL hPrevInst AS DWORD , _
BYVAL lpszCmdLine AS ASCIIZ PTR, _
BYVAL nCmdShow AS LONG ) AS LONG
DIM hDlg AS LOCAL DWORD
gInstance = hInstance
DIALOG NEW %HWND_DESKTOP, "Cursor Test", , , 200, 120, %WS_POPUP Or %WS_BORDER Or %WS_DLGFRAME Or %WS_SYSMENU Or %WS_CLIPSIBLINGS Or %WS_VISIBLE Or %DS_MODALFRAME Or %DS_3DLOOK Or %DS_NOFAILCREATE Or %DS_SETFONT, %WS_EX_CONTROLPARENT Or _
%WS_EX_LEFT Or %WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR, To hDlg
CONTROL ADD BUTTON, hDlg, 1000, "", 5, 5, 85, 15
DIALOG SHOW MODAL hDlg, CALL CursorTest_CB
END FUNCTION