/* Testing Harbour keyboard input. */ /* Donated to the public domain on 2001-03-08 by David G. Holm Modularization and display improvements by Alejandro de Garate */ #include "inkey.ch" #ifndef __HARBOUR__ #define hb_ntos( n ) LTrim( Str( n ) ) #endif PROCEDURE Main( cSkip, cExt ) AltD( 0 ) IF Empty( cSkip ) TEST1() NextTest() TEST2() NextTest() TEST3() NextTest() TEST4() NextTest() TEST5() NextTest() TEST6() NextTest() ENDIF TEST7( cSkip, cExt ) ? RETURN PROCEDURE Results() ? "Wait 2 seconds or press most any key to see the results of this test." Inkey( 2 ) RETURN PROCEDURE NextTest() ? "Press any key to continue on to the next test." Inkey( 0 ) RETURN FUNCTION TEST( cText ) LOCAL cResult := "" Inkey( 2 ) KEYBOARD cText DO WHILE NextKey() != 0 #ifdef __HARBOUR__ cResult += hb_keyChar( Inkey() ) #else cResult += Chr( Inkey() ) #endif ENDDO RETURN "'" + cResult + "'" PROCEDURE TEST1 CLS ? ? "Testing the KEYBOARD and CLEAR TYPEAHEAD commands and the" ? "Inkey(), NextKey(), and LastKey() functions." ? ? "For the first test, the keyboard will be stuffed with the" ? "text 'AB' and then Inkey() will be called twice." ? ? "The result should be: 65 66" ? Results() ? KEYBOARD "AB" ? Inkey(), Inkey() ? RETURN PROCEDURE TEST2 CLS ? ? "For the second test, the keyboard will be stuffed with the" ? "text 'HELLO', then the typeahead will be cleared, and then" ? "Inkey() will be called once." ? ? "The result should be: 0" ? Results() ? KEYBOARD "HELLO" CLEAR TYPEAHEAD ? Inkey() ? RETURN PROCEDURE TEST3 CLS ? ? "For the third test, the keyboard will be stuffed with the" ? "text 'AB', then NextKey() will be called twice and finally" ? "Inkey() will be called twice." ? ? "The result should be: 65 65 65 66" ? Results() ? KEYBOARD "AB" ? NextKey(), NextKey(), Inkey(), Inkey() ? RETURN PROCEDURE TEST4 CLS ? ? "For the fourth test, the keyboard will be stuffed with the" ? "Text 'AB', then Inkey() will be called once, LastKey() will" ? "be called twice, NextKey() will be called once, and finally" ? "Inkey() will be called once." ? ? "The result should be: 65 65 65 66 66" ? Results() ? KEYBOARD "AB" ? Inkey(), LastKey(), LastKey(), NextKey(), Inkey() ? RETURN PROCEDURE TEST5 LOCAL cText CLS cText := "THIS IS A TEST. THIS IS ONLY A TEST. DO NOT PANIC!" ?? "For the fifth test, the keyboard will be stuffed with the" ? "Text '" + cText + "'" ? "with the typeahead buffer set to the default size, then 25" ? "then 16, then 0. After each attempt to stuff the buffer," ? "the buffer will be emptied using NextKey() and Inkey() and" ? "the ASCII text that was extracted will be displayed." ? ? "For the default size, which is 50, all but '" + Right( cText, Len( cText ) - 49 ) + "' should be" ? "displayed. For size 25, '" + Left( cText, 24 ) + "' should" ? "be displayed. Size 16 should display '" + Left( cText, 15 ) + "'," ? "while size 0 should display ''." ? ? "Default TYPEAHEAD (50)" ? TEST( cText ) ? ? "SET TYPEAHEAD TO 25" SET TYPEAHEAD TO 25 ? TEST( cText ) ? ? "SET TYPEAHEAD TO 16" SET TYPEAHEAD TO 16 ? TEST( cText ) ? ? "SET TYPEAHEAD TO 0" SET TYPEAHEAD TO 0 ? TEST( cText ) RETURN PROCEDURE TEST6 CLS ? "For the sixth test" ? "The typeahead is now being set to a value greater than the maximum," ? "which is 4096 and is the value that will both be used and reported." ? "SET TYPEAHEAD TO 5000" ? SET TYPEAHEAD TO 5000 ? Set( _SET_TYPEAHEAD ) ? RETURN PROCEDURE TEST7( cSkip, cExt ) LOCAL nKey, nMask CLS ? "For the last test, a loop is started and all keyboard and mouse" ? "events are allowed. Each event will be displayed. Press the TAB" ? "key to exit. Try moving the mouse, holding and releasing the mouse" ? "buttons as well as double-clicking the mouse buttons." ? ? "Press any key." nMask := HB_INKEY_ALL IF ! Empty( cExt ) IF "E" $ Upper( cExt ) nMask += HB_INKEY_EXT ENDIF ENDIF Set( _SET_EVENTMASK, nMask ) IF ! Empty( cSkip ) IF Upper( cSkip ) == "BREAK" SetCancel( .T. ) AltD( 1 ) Tone( 440, 6 ) ELSE SetCancel( .F. ) AltD( 0 ) Tone( 660, 6 ) ENDIF ENDIF DO WHILE ( nKey := Inkey( 0, nMask ) ) != K_TAB DO CASE CASE nKey == K_MOUSEMOVE ? "The mouse moved." CASE nKey == K_LBUTTONDOWN ? "The left mouse button was pushed." CASE nKey == K_LBUTTONUP ? "The left mouse button was released." CASE nKey == K_RBUTTONDOWN ? "The right mouse button was pushed." CASE nKey == K_RBUTTONUP ? "The right mouse button was released." CASE nKey == K_LDBLCLK ? "The left mouse button was double-clicked." CASE nKey == K_RDBLCLK ? "The right mouse button was double-clicked." OTHERWISE #ifdef __HARBOUR__ ? "A keyboard key was pressed: ", nKey, hb_keyChar( nKey ) #else ? "A keyboard key was pressed: ", nKey, ; iif( nKey >= 32 .AND. nKey <= 255, Chr( nKey ), "" ) #endif ENDCASE ENDDO ? "The TAB key (" + hb_ntos( nKey ) + ") was pressed. Exiting..." RETURN