! cursor2.f90 - Example illustrating using hook procedures
! to change a cursor's shape and visibility.  This version
! shows how to affect the cursor shape within a specified
! window only - the visibility is still globally affected.
!
!
!  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 cursor2.f90
!
!  Program to illustrate how to turn off the cursor and 
!  how to change the cursor's shape.
!=======================================================================
	program cursor2
	use dflib
	use dfwin
    implicit none
	save

    integer, parameter :: WH_CALLWNDPROCRET = 12      
	integer(4) status
	integer(4) hookhandle, primarythreadid, cursor, cursorwnd
	common hookhandle, primarythreadid, cursor, cursorwnd
!--------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
!--------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) 

!-------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(8,*) 'The cursor will now be changed to the default wait 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'
	status = ShowCursor(.FALSE.)       
	read(8,*)

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

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


    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, cursorwnd
	common hookhandle, primarythreadid, cursor, cursorwnd

    type (CWPRETSTRUCT) msgdat
	pointer(msgptr,msgdat) 

    msgptr = lParam
	
	! check ok to process  
	if ((nCode .eq. HC_ACTION).and.(msgdat.hwnd.eq.cursorwnd)) 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.  
	  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, cursorwnd
    common hookhandle, primarythreadid, cursor, cursorwnd
    !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 function initialsettings