! cursor1.f90 - Sample showing use of a hook procedure to
! turn off the cursor or change its shape.  This example is
! the simplest of the three provided - it globally affects
! the cursor and its visibility
!
!
!  This sample illustrates the use of a callback procedure (hook)
!  set by using SetWindowsHookEx. This hook procedure is called after
!  every windows message is processed.  See the online help for
!  SetWindowsHookEx with WH_CALLWNDPROCRET for more details.
!=======================================================================
!
!       Compile/Load Input Line for QuickWin application
!
!       f90 /libs:qwin cursor1.f90
!
!  Program to illustrate how to turn off the cursor and 
!  how to change the cursor's shape.
!=======================================================================
	program cursor1
	use dflib
	use dfwin
	implicit none

	integer, parameter :: WH_CALLWNDPROCRET = 12      
	integer(4) status
	integer(4) hookhandle, primarythreadid, cursor
	common hookhandle, primarythreadid, cursor
!--------set up name for our callback routine 
    interface
      integer(4) function CallWndRetProc(nCode, wParam, lParam) 
	  !DEC$ IF DEFINED (_X86_)
	  !DEC$ ATTRIBUTES STDCALL, ALIAS: '_CallWndRetProc@12' :: CallWndRetProc
	  !DEC$ else
	  !DEC$ ATTRIBUTES STDCALL, ALIAS: '_CallWndRetProc' :: CallWndRetProc
	  !DEC$ endif 
	  integer(4) nCode           ! hook code 
	  integer(4) wParam          ! current process flag 
	  integer(4) lParam          ! address of message data structure
      end function CallWndRetProc
    end interface
!--------Set up standard arrow cursor in COMMON block.
!--------Our callback routine will use the cursor handle in "cursor"
    cursor = LoadCursor(0, IDC_ARROW) 
!--------set hook for mouse events
    hookhandle = SetWindowsHookEX(WH_CALLWNDPROCRET,  &
	  loc(CallWndRetProc), 0, primarythreadid)                        
    if(hookhandle .eq. 0) print *,'ERROR: could not set hook'
	
!Predefined Cursor Shapes
! IDC_APPSTARTING  Standard arrow and small hourglass 
! IDC_ARROW        Standard arrow 
! IDC_CROSS        Crosshair 
! IDC_IBEAM        Text I-beam 
! IDC_NO           Slashed circle 
! IDC_SIZEALL      Four-pointed arrow 
! IDC_SIZENESW     Double-pointed arrow pointing northeast and southwest 
! IDC_SIZENS       Double-pointed arrow pointing north and south 
! IDC_SIZENWSE     Double-pointed arrow pointing northwest and southeast 
! IDC_SIZEWE       Double-pointed arrow pointing west and east 
! IDC_UPARROW      Vertical arrow 
! IDC_WAIT         Hour glass

    write(*,*) 'The cursor will now be changed to the default wait shape'
    cursor = LoadCursor(0, IDC_WAIT) 
    status = SetCursor(cursor) 
    read(*,*)
      
    write(*,*) 'The cursor will now be changed to a cross-hair shape'
    cursor = LoadCursor(0, IDC_CROSS) 
    status = SetCursor(cursor) 
    read(*,*)

    write(*,*) 'The cursor will now be turned off'
    status = ShowCursor(.FALSE.)       
    read(*,*)

    write(*,*) 'The cursor will now be turned on'
    status  =ShowCursor(.TRUE.) 
    read(*,*)

    ! free hook resources before quitting
    status = UnhookWindowsHookEx(hookhandle) 
    end


    integer(4) function CallWndRetProc(nCode, wParam, lParam) 
	!DEC$ IF DEFINED (_X86_)
	!DEC$ ATTRIBUTES STDCALL, ALIAS: '_CallWndRetProc@12' :: CallWndRetProc
	!DEC$ else
	!DEC$ ATTRIBUTES STDCALL, ALIAS: '_CallWndRetProc' :: CallWndRetProc
	!DEC$ endif 
	use dflib
	use dfwin
	implicit none
	integer(4) nCode           ! hook code 
	integer(4) wParam          ! current process flag 
	integer(4) lParam          ! address of message data structure
				  ! of type (CWPRETSTRUCT)
    type CWPRETSTRUCT 
       integer(4) lResult ! result of WndProc 
       integer(4) lParam  ! info with message
       integer(4) wParam  ! info with message
       integer(4) message ! the message
       integer(4) hwnd    ! window that processed message
       end type CWPRETSTRUCT; 

	integer(4) i, status
 
	integer(4) hookhandle, primarythreadid, cursor
	common hookhandle, primarythreadid, cursor

    type (CWPRETSTRUCT) msgdat
	pointer(msgptr,msgdat) 

    msgptr = lParam  ! not used, here for information
		       ! typical reference is msgdat%hwnd
	
	! check ok to process  
	if (nCode .eq. HC_ACTION) then
	! may process this
	  !Because QwickWin sets the class cursor to
	  !IDC_ARROW, it is necessary to always set
	  !the cursor on EVERY windows message.  
	  
	  status = SetCursor(cursor) 
	  CallWndRetProc = 0   
	else if(nCode .lt. 0 ) then
	  CallWndRetProc=CallNextHookEx(hookhandle, nCode, wParam, lParam)
	else
	  CallWndRetProc = 0
    endif

    return
    end function CallWndRetProc

    logical(4) function initialsettings()
    use dfwin
	implicit none
    integer(4) hookhandle, primarythreadid, cursor
    common hookhandle, primarythreadid, cursor
      !we must use this tricky way to get the thread id
      !of the primary thread that handles the windows
      !messages.
    primarythreadid = GetCurrentThreadId()
    initialsettings = .true.
    end