! dirkeys2.for - Shows how to use hook procedures to intercept ! INSERT, DELETE and CTRL-C in QuickWin/Standard Graphics applications ! ! The PASSDIRKEYSQQ procedure currently does not trap the INSERT, DELETE, ! or CTRL-C keys. To trap these keys, this sample illustrates the use ! of a callback procedure (hook) using SetWindowsHookEx for ! keyboard events. Whenever a message of this class arrives, this ! callback is invoked. See the online help for SetWindowsHookEx for ! more details. !======================================================================= ! ! Compile/Load Input Line for Regular Graphics Full Screen Window ! ! f90 /libs:qwins dirkeys2.f90 ! ! Program to illustrate how to get almost every character ! from the keyboard in QuickWin or Standard Graphics mode. ! ! The following code was put together to use the ! hooking method to get Control-C, Insert, and ! Delete as well as the others via passdirkeys. ! The version below is for standard graphics ! applications (/libs:qwins), and you get control ! C free but not escape. In a QuickWin app, ! you don't get control-C free, but you get ! escape. ! ! If you are doing a standard graphics app, ! control C will come in as a #03 as well ! as being hooked. You probably should ! remove the "cases" for control C so it won't ! get hooked and just check for #03, and ! exit if you get it. Maybe issue a warning ! first like as is done in the code below. ! Doing passdirkeysqq(.true.) once is enough. It's a ! sticky toggle, and won't change until you call ! passdirkeysqq again with a .false. argument. ! See below for a better idea of what's going on. ! ! ! passdirkeys controls whether ! getcharqq gets ! -------------------- ! directions keys, ! i.e. arrows, page up, ! page down, home, and end. ! INSERT and DELETE are not ! caught. ! ! getcharqq normally gets ! ----------------------- ! f1-f9 function keys, alphanumerics, ! punctuation, most control ! characters, but NOT escape. ! Control-C comes through ! in standard graphics mode but ! not in quickwin mode. ! ! SetWindowsHook will allow ! --------------------------- ! getting almost every key if ! need be but can be tedious to ! setup for more than a few ! chars. ! !======================================================================= use dflib use dfwin ! implicit none save integer(4) status real*4 xlow,xhigh,xwidth,ylow,yhigh,ywidth,xstat character*1 key1,key2,ch1 !-------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 !------------------callback initialization !--------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 !-------set hook for keyboard events hookhandle = SetWindowsHookEX(WH_KEYBOARD, & loc(KeyBoardProc), 0, primarythreadid) if(hookhandle .eq. 0) print *,'ERROR: could not set hook' !-----below required to keep whole screen appearance !-----for standard graphics write(*,*) 'Keyboard Initialized' !---------------------- done callback initializing------------------------------------ !don't do this for standard graphics application !status = deletemenuqq(1,3) ! stop quickwin from getting control C !-------define max. allowed window dimensions status = getwsizeqq(qwin$framewindow,qwin$sizemax,winfo) !-------set window to max. dimensions winfo.type = QWin$MAX status = setwsizeqq(qwin$framewindow,winfo) !-------focus on main window status = focusqq(qwin$framewindow) !-------define (x,y) raster limits of Window to insure everything !-------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 !-------set up to pass all keys to window (except insert/delete/control C) xstat = passdirkeysqq(.true.) !======================================================================= ! ! read and print characters ! !======================================================================= 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 to exit, or any other char 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