c=======================================================================
c
c dirkeys2.for
c
c  The PASSDIRKEYS procedure currently does not trap the INSERT, DELETE,
c  or CTRL-C keys.  To trap these keys, this sample illustrates the use
c  of a callback procedure (hook) using SetWindowsHookEx for 
c   keyboard events.  Whenever a message of this class arrives, this
c   callback is invoked.  See the online help for SetWindowsHookEx for
c   more details.
c=======================================================================
c
c       Compile/Load Input Line for Regular Graphics Full Screen Window
c
c       f90 /extend_source /libs:qwins dirkeys2.f90
c
c  Program to illustrate how to get almost every character
c  from the keyboard in QuickWin or Standard Graphics mode.
c
c  The following code was put together to use the
c  hooking method to get Control-C, Insert, and
c  Delete as well as the others via passdirkeys.
c  The version below is for standard graphics 
c  applications (/MWs), and you get control
c  C free but not escape.  In a QuickWin app,
c  you don't get control-C free, but you get
c  escape.
c
c  If you are doing a standard graphics app,
c  control C will come in as a #03 as well
c  as being hooked.  You probably should
c  remove the "cases" for control C so it won't
c  get hooked  and just check for #03, and
c  exit if you get it.  Maybe issue a warning
c  first like as is done in the code below.

c  Doing passdirkeysqq(.true.) once is enough. It's a
c  sticky toggle, and won't change until you call
c  passdirkeysqq again with a .false. argument. 
c  See below for a better idea of what's going on. 
c
c
c  passdirkeys controls whether
c  getcharqq gets
c  --------------------
c  directions keys,
c  i.e. arrows, page up,
c  page down, home, and end.
c  INSERT and DELETE are not
c  caught.
c
c  getcharqq normally gets
c  -----------------------
c  f1-f9 function keys, alphanumerics,
c  punctuation, most control
c  characters, but NOT escape.
c  Control-C comes through
c  in standard graphics mode but
c  not in quickwin mode.
c
c  SetWindowsHook will allow
c  ---------------------------
c  getting almost every key if
c  need be but can be tedious to
c  setup for more than a few
c  chars.
c
c=======================================================================
	use dflib
	use dfwin
!	implicit none
	save
	
	integer(4) status
	real*4 xlow,xhigh,xwidth,ylow,yhigh,ywidth,xstat
	character*1 key1,key2,ch1
c-------window information
	type (qwinfo) winfo
	
	integer*4, parameter :: VK_INSERT_ALIAS = 16#85  !F22
	integer*4, parameter :: VK_DELETE_ALIAS = 16#86  !F23 
	integer*4, parameter :: VK_CANCEL_ALIAS = 16#87  !F24

	integer*4 hookhandle, primarythreadid
	common hookhandle, primarythreadid
c------------------callback initialization
c--------set up name for our callback routine 
	external KeyBoardProc
	!DEC$ IF DEFINED (_X86_)
	!DEC$ ATTRIBUTES ALIAS: '_KeyBoardProc@12' :: KeyBoardProc
	!DEC$ else
	!DEC$ ATTRIBUTES ALIAS: '_KeyBoardProc' :: KeyBoardProc
	!DEC$ endif 
c-------set hook for keyboard events
	hookhandle = SetWindowsHookEX(WH_KEYBOARD, 
     &   loc(KeyBoardProc), 0, primarythreadid)                        
      if(hookhandle .eq. 0) print *,'ERROR: could not set hook'
c-----below required to keep whole screen appearance 
c-----for standard graphics
      write(*,*) 'Keyboard Initialized' 
c---------------------- done callback initializing------------------------------------
	!don't do this for standard grapics application
	!status = deletemenuqq(1,3) ! stop quickwin from getting control C

	
c-------define max. allowed window dimensions
	status = getwsizeqq(qwin$framewindow,qwin$sizemax,winfo)
c-------set window to max. dimensions
	winfo.type = QWin$MAX
	status = setwsizeqq(qwin$framewindow,winfo)
c-------focus on main window
	status = focusqq(qwin$framewindow)
c-------define (x,y) raster limits of Window to insure everything
c-------is initially on screen.
	xlow   = winfo.x + 2
	xwidth = winfo.w - 22
	xhigh  = xlow + xwidth
	ylow   = winfo.y + 2
	ywidth = winfo.h - 20
	yhigh  = ylow + ywidth
c-------set up to pass all keys to window (except insert/delete/control C)        
	xstat  = passdirkeysqq(.true.)
c=======================================================================
c
c     read and print characters
c
c=======================================================================
   10 key1 = getcharqq()
      select case (ichar(key1)) 

	case (VK_INSERT_ALIAS)
	      write(*,11) ichar(key1)
	      goto 10
   11 format(1x,i12,' Insert typed')

	case (VK_DELETE_ALIAS)
	      write(*,12) ichar(key1)
	      goto 10
   12 format(1x,i12,' Delete typed')

	case (VK_CANCEL_ALIAS)
	  write(*,*) 'Control C trapped'
	  write(*,*) "Really want to quit?"
	  write(*,*) "Type Y <cr> to exit, or any other char <cr> to continue."
	  read(*,*) ch1
	  if(ch1.eq."y" .or. ch1.eq."Y") goto 30
	  goto 10
	case default
	   !Do nothing  
      endselect
      
      if(ichar(key1).eq.0) then ! function key?
      key2 = getcharqq()
      write(*,15) ichar(key1),ichar(key2),key2
   15 format(1x,2i12,1x,a1,' function key')
      else
      if(ichar(key1).eq.224) then ! direction key?
      key2 = getcharqq()
      write(*,16) ichar(key1),ichar(key2),key2
   16 format(1x,2i12,1x,a1,' direction key')
      else
      write(*,20) key1,ichar(key1)  ! normal key
   20 format(1x,a1,i11)
      endif
      endif
      go to 10
      ! free hook resources before quitting
   30 status = UnhookWindowsHookEx(hookhandle) 
      stop
      end

      integer*4 function KeyBoardProc(nCode, wParam, lParam) 
	!DEC$ IF DEFINED (_X86_)
	!DEC$ ATTRIBUTES STDCALL, ALIAS: '_KeyBoardProc@12' :: KeyBoardProc
	!DEC$ else
	!DEC$ ATTRIBUTES STDCALL, ALIAS: '_KeyBoardProc' :: KeyBoardProc
	!DEC$ endif 
	use dflib
	use dfwin
	integer*4 nCode           ! hook code 
	integer*4 wParam          ! virtual-key code 
	integer*4 lParam          ! keystroke message information

	integer*4 i
 
	integer*4 hookhandle, primarythreadid
	common hookhandle, primarythreadid

	integer*4, parameter :: VK_INSERT_ALIAS = 16#85  !F22
	integer*4, parameter :: VK_DELETE_ALIAS = 16#86  !F23 
	integer*4, parameter :: VK_CANCEL_ALIAS = 16#87  !F24

	! check ok to process and key-up from bit31 
	if (nCode .ge. 0 .and. iand(lParam,16#80000000) .ne. 0) then
	! may process this

	select case (wParam) 

	case (VK_INSERT)
	i = SendMessage(GetHWndQQ(0), WM_CHAR, VK_INSERT_ALIAS, lParam )
	KeyBoardProc = 1 ! non zero to stop further processing  
	return
	   
	case (VK_DELETE)
	i = SendMessage(GetHWndQQ(0), WM_CHAR, VK_DELETE_ALIAS, lParam )
	KeyBoardProc = 1 ! non zero to stop further processing  
	return

	case (16#00000043) ! do we have a c

	if(iand(GetKeyState(VK_CONTROL),16#00008000).ne.0) then

	  !note: to stop QuickWin from intercepting this
	  !      and killing the program, the "exit" item
	  !      must be removed from the file menu.
	i = SendMessage(GetHWndQQ(0), WM_CHAR, VK_CANCEL_ALIAS, lParam )
	KeyBoardProc = 1 ! non zero to stop further processing  
	return
       endif  
		      
       case DEFAULT
       ! do nothing 
      end select ! end switch 
      endif

      !!KeyboardProc = CallNextHookEx(hookhandle, nCode, wParam, loc(lParam))
      KeyboardProc = 0

      return
      end function KeyBoardProc

      logical*4 function initialsettings()
      use dfwin
      integer*4 hookhandle, primarythreadid
      common hookhandl, primarythreadid
      !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
