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