! cursor3.f90 - Illustrates uising hook procedures to change
! the cursor's shape and visibility.  This version affects
! both the shape and visibility within a specific window
!
!
!  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 cursor3.f90
!
!  Program to illustrate how to turn off the cursor and 
!  how to change the cursor's shape.
!=======================================================================
	program cursor3
	use dflib
	use dfwin
    implicit none

    integer, parameter :: WH_CALLWNDPROCRET = 12      
	integer(4) status
	integer(4) hookhandle, primarythreadid, cursor, cursorwnd,  cursoron
	common hookhandle, primarythreadid, cursor, cursorwnd,  cursoron
!--------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 
	  use dflib
	  use dfwin
	  integer(4) nCode           ! hook code 
	  integer(4) wParam          ! current process flag 
	  integer(4) lParam          ! address of message data structure
      end function CallWndRetProc
	end interface
!--------Open the window in which the cursor can be changed.
!--------By adding cursor1, cursorwnd1, etc and duplicating
!--------the code below, several windows can have their own
!--------cursor.
	open(8,file='user')
	cursorwnd = GetHwndQQ(8)
!--------Set up standard arrow cursor in COMMON block.
!--------Our callback routine will use the cursor handle in "cursor"
!--------for the window in cursorwnd
    cursor = LoadCursor(0, IDC_ARROW) 
    cursoron = .TRUE.

!-------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_ICON         obsolete for applications marked version 4.0 or later. 
! IDC_NO           Slashed circle 
! IDC_SIZE         Obsolete for applications marked version 4.0 or later. Use IDC_SIZEALL. 
! 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(8,*) 'The cursor will now be changed to an hour glass shape'
    cursor = LoadCursor(0, IDC_WAIT) 
	status = SetCursor(cursor) 
	read(8,*)
      
    write(8,*) 'The cursor will now be changed to a cross-hair shape'
    cursor = LoadCursor(0, IDC_CROSS) 
	status = SetCursor(cursor) 
	read(8,*)

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

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

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


    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 T_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 T_CWPRETSTRUCT; 

	integer(4) i, status
	Logical(4) lok

	integer(4) hookhandle, primarythreadid, cursor, cursorwnd,  cursoron
	common hookhandle, primarythreadid, cursor, cursorwnd,  cursoron

    type (T_CWPRETSTRUCT) msgdat
	pointer(msgptr,msgdat) 
	
    type (T_RECT) winrect
    type (T_POINT) curpos

    msgptr = lParam
    status = GetWindowRect(cursorwnd,winrect)
    status = GetCursorPos(curpos)
    lok =((curpos.x .le. winrect.right .and. curpos.x .ge. winrect.left)&   
      .and. (curpos.y .le. winrect.bottom .and. curpos.y .ge. winrect.top))
	! check ok to process  
	if ((nCode .eq. HC_ACTION) .and. lok) then
	! may process this

	  !Because QwickWin sets the class cursor to
	  !IDC_ARROW, it is necessary to always set
	  !the curor on EVERY windows message.  See
	  !below at the DEFAULT case.  
	  status = SetCursor(cursor) 
	  if(cursoron) then
100     status = ShowCursor(.true.)     
	    if(status.lt.0) goto 100
	    if(status.gt.0) status = ShowCursor(.false.) ! not needed???
	  else
200     status = ShowCursor(.false.)
	    if(status.ge.0) goto 200
	    if(status.lt.(-1)) status = ShowCursor(.true.) ! not needed???
	  endif
	  CallWndRetProc = 0   
	else if(nCode .lt. 0 ) then
	  CallWndRetProc=CallNextHookEx(hookhandle, nCode, wParam, lParam)
	else
	  if(.not. lok) then
300     status = ShowCursor(.true.)     
	    if(status.lt.0) goto 300
	    if(status.gt.0) status = ShowCursor(.false.) ! not needed????
	  endif
	  CallWndRetProc = 0
    endif

    return
    end function CallWndRetProc

    logical(4) function initialsettings()
    use dfwin
	implicit none
    integer(4) hookhandle, primarythreadid, cursor, cursorwnd,  cursoron
    common hookhandle, primarythreadid, cursor, cursorwnd,  cursoron
      !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