'===========================================================================
' Subject: QB-KEYBLAST                       Date: 02-07-99 (23:46)       
' Author:  Marc van den Dikkenberg           Code: QB, QBasic, PDS        
' Origin:  excel@xs4all.nl                 Packet: KEYBOARD.ABC
'===========================================================================
'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
'º   QB-KEYBlast -- (C) 1999 By Marc van den Dikkenberg   º
'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹
'º                The PowerBasic Archives                 º
'º           http://www.xs4all.nl/~excel/pb.html          º
'º           http://www.basicguru.com/dikkenberg          º
'º                 http://come.to/pbdos                   º
'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹
'º                    excel@xs4all.nl                     º
'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ

type keyStruc
   CursUp as integer
   CursRight as integer
   CursDown as integer
   CursLeft as integer
   F1 as integer
   F2 as integer
   F3 as integer
   F4 as integer
   F5 as integer
   F6 as integer
   F7 as integer
   F8 as integer
   F9 as integer
   F10 as integer
   F11 as integer
   F12 as integer
   CTRL as integer
   LCTRL as integer
   RCTRL as integer
   SHIFTKEY as integer
   LSHIFT as integer
   RSHIFT as integer
   ALT as integer
   RALT as integer
   LALT as integer
   CAPSLock as integer
   CAPS as integer
   InsLock as integer
   Ins as integer
   ScrollLock as integer
   Scroll as integer
   NumLock as integer
   Num as integer
   ESC as integer
   DEL as integer
   Home as integer
   PageUp as integer
   PageDown as integer
   EndKey as integer
   Printscreen as integer
   Center as integer
   Enter as integer
   Colon as integer
   Quote as integer
   Comma as integer
   Period as integer
   Tilde as integer
   TabKey as integer
   Hyphen as integer
   Slash as integer
   BackSlash as integer
   Plus as integer
   Minus as integer
   Asterisk as integer

   A as integer
   B as integer
   C as integer
   D as integer
   E as integer
   F as integer
   G as integer
   H as integer
   I as integer
   J as integer
   K as integer
   L as integer
   M as integer
   N as integer
   O as integer
   P as integer
   Q as integer
   R as integer
   S as integer
   T as integer
   U as integer
   V as integer
   W as integer
   X as integer
   Y as integer
   Z as integer
   no1 as integer
   no2 as integer
   no3 as integer
   no4 as integer
   no5 as integer
   no6 as integer
   no7 as integer
   no8 as integer
   no9 as integer
   no0 as integer
end type

DIM SHARED keys AS keystruc
DECLARE FUNCTION keycode ()
DECLARE SUB specialkeys ()


CLS
DIM SHARED oldseg AS LONG
DIM SHARED KeyBlast, Previous1, Previous2

DO

f = keycode ' Call the actual Function. All variables are set in here!
				' Just call this one, and check the variable to see if the
				' key if currently pressed: IF KEYS.A THEN... ("a" is pressed)
				' The actual scancode is returned by the function as well.

LOCATE 1, 1
PRINT "Up    :", keys.CursUp, "QB-KeyBlast 1.0"
PRINT "Right :", keys.CursRight
PRINT "Down  :", keys.CursDown, "Try pressing multiple keys!"
PRINT "Left  :", keys.CursLeft
PRINT "F1    :", keys.F1, "F5    :", keys.F5, "F9    : "; keys.F9
PRINT "F2    :", keys.F2, "F6    :", keys.F6, "F10   : "; keys.F10
PRINT "F3    :", keys.F3, "F7    :", keys.F7, "F11   : "; keys.F11
PRINT "F4    :", keys.F4, "F8    :", keys.F8, "F12   : "; keys.F12
PRINT "CapsLk:", keys.capslock, "ScrLck:", keys.ScrollLock, "InsLck: "; keys.InsLock
PRINT "Caps  :", keys.caps, "Scroll:", keys.Scroll, "Ins   : "; keys.Ins
PRINT "Shift :", keys.shiftkey, "CTRL  :", keys.ctrl, "ALT   : "; keys.alt
PRINT "RShift:", keys.rshift, "RCTRL :", keys.rctrl, "RALT  : "; keys.ralt
PRINT "LShift:", keys.lshift, "LCTRL :", keys.lctrl, "LALT  : "; keys.lalt
PRINT "NumLck:", keys.NumLock, "Home  :", keys.home, "PageUp: "; keys.pageup
PRINT "Num   :", keys.Num, "End   :", keys.endkey, "PageDn: "; keys.pagedown
PRINT "ESCape:", keys.esc, "Delete:", keys.del, "PrnScr: "; keys.printscreen
PRINT "Center:", keys.center, "Enter :", keys.enter
PRINT "A     :", keys.a, "B     :"; keys.b

PRINT "Scancode: "; f; "  "

LOOP

FUNCTION keycode

keycode = 0
Previous2 = Previous1
Previous1 = KeyBlast

IF Previous1 = Previous2 AND Previous1 = 170 THEN
			keys.CursUp = 0
			keys.CursDown = 0
			keys.CursRight = 0
			keys.CursLeft = 0
			keys.home = 0
			keys.endkey = 0
			keys.pageup = 0
			keys.pagedown = 0
			keys.center = 0
			keys.del = 0
ELSEIF Previous1 = Previous2 THEN
	IF Previous1 > 127 AND Previous2 > 127 THEN
		IF a > 127 THEN
			keys.F1 = 0
			keys.F2 = 0
			keys.F3 = 0
			keys.F4 = 0
			keys.F5 = 0
			keys.F6 = 0
			keys.F7 = 0
			keys.F8 = 0
			keys.F9 = 0
			keys.F10 = 0
			keys.F11 = 0
			keys.F12 = 0
			keys.CursUp = 0
			keys.CursDown = 0
			keys.CursRight = 0
			keys.CursLeft = 0
			keys.esc = 0
			keys.home = 0
			keys.pageup = 0
			keys.pagedown = 0
			keys.del = 0
			keys.endkey = 0
			keys.printscreen = 0
			keys.a = 0: keys.b = 0: keys.c = 0: keys.d = 0: keys.e = 0: keys.f = 0

			specialkeys
			keycode = 0
			Previous1 = 0: Previous2 = 0
			EXIT FUNCTION
		END IF
	END IF
END IF

KeyBlast = INP(&H60)

oldseg = pbvdefseg
DEF SEG = 0
POKE 1050, 30
POKE 1052, 30
DEF SEG = oldseg

specialkeys

SELECT CASE KeyBlast
	CASE 72: keys.CursUp = 1
	CASE 77: keys.CursRight = 1
	CASE 80: keys.CursDown = 1
	CASE 75: keys.CursLeft = 1

	CASE 0: keycode = 0: EXIT FUNCTION
	CASE 1: keys.esc = 1
	CASE 41: keys.tilde = 1
	CASE 43: keys.BackSlash = 1
	CASE 55: keys.printscreen = 1: keys.asterisk = 1
	CASE 51: keys.comma = 1
	CASE 52: case.period = 1
	CASE 53: case.slash = 1
	CASE 59: keys.F1 = 1
	CASE 60: keys.F2 = 1
	CASE 61: keys.F3 = 1
	CASE 62: keys.F4 = 1
	CASE 63: keys.F5 = 1
	CASE 64: keys.F6 = 1
	CASE 65: keys.F7 = 1
	CASE 66: keys.F8 = 1
	CASE 67: keys.F9 = 1
	CASE 68: keys.F10 = 1
	CASE 74: keys.minus = 1
	CASE 87: keys.F11 = 1
	CASE 88: keys.F12 = 1
	CASE 71: keys.home = 1
	CASE 73: keys.pageup = 1
	CASE 76: keys.center = 1
	CASE 78: keys.plus = 1
	CASE 81: keys.pagedown = 1
	CASE 83: keys.del = 1
	CASE 79: keys.endkey = 1
	CASE 2: keys.no1 = 1
	CASE 3: keys.no2 = 1
	CASE 4: keys.no3 = 1
	CASE 5: keys.no4 = 1
	CASE 6: keys.no5 = 1
	CASE 7: keys.no6 = 1
	CASE 8: keys.no7 = 1
	CASE 9: keys.no8 = 1
	CASE 10: keys.no9 = 1
	CASE 11: keys.no0 = 1
	CASE 12: keys.hyphen = 1
	CASE 15: keys.TabKey = 1
	CASE 16: keys.q = 1
	CASE 17: keys.w = 1
	CASE 18: keys.e = 1
	CASE 19: keys.r = 1
	CASE 20: keys.t = 1
	CASE 21: keys.y = 1
	CASE 22: keys.u = 1
	CASE 23: keys.i = 1
	CASE 24: keys.o = 1
	CASE 25: keys.p = 1
	CASE 30: keys.a = 1
	CASE 31: keys.s = 1
	CASE 32: keys.d = 1
	CASE 33: keys.f = 1
	CASE 34: keys.g = 1
	CASE 35: keys.h = 1
	CASE 36: keys.j = 1
	CASE 37: keys.k = 1
	CASE 38: keys.l = 1
	CASE 39: keys.colon = 1
	CASE 40: keys.quote = 1
	CASE 44: keys.z = 1
	CASE 45: keys.x = 1
	CASE 46: keys.c = 1
	CASE 47: keys.v = 1
	CASE 48: keys.b = 1
	CASE 49: keys.n = 1
	CASE 50: keys.m = 1
	CASE 28: keys.enter = 1
'----------------------
	CASE 129: keys.esc = 0
	CASE 143: keys.TabKey = 0
	CASE 200: keys.CursUp = 0
	CASE 205: keys.CursRight = 0
	CASE 208: keys.CursDown = 0
	CASE 203: keys.CursLeft = 0
	CASE 170: keys.CursUp = 0
				 keys.CursDown = 0
				 keys.CursLeft = 0
				 keys.CursRight = 0
				 keys.printscreen = 0
	CASE 169: keys.tilde = 0
	CASE 171: keys.BackSlash = 0
	CASE 179: keys.comma = 0
	CASE 180: keys.comma = 0
	CASE 181: keys.Slash = 0
	CASE 183: keys.printscreen = 0: keys.asterisk = 0
	CASE 187: keys.F1 = 0
	CASE 188: keys.F2 = 0
	CASE 189: keys.F3 = 0
	CASE 190: keys.F4 = 0
	CASE 191: keys.F5 = 0
	CASE 192: keys.F6 = 0
	CASE 193: keys.F7 = 0
	CASE 194: keys.F8 = 0
	CASE 195: keys.F9 = 0
	CASE 196: keys.F10 = 0
	CASE 215: keys.F11 = 0
	CASE 216: keys.F12 = 0
	CASE 199: keys.home = 0
	CASE 201: keys.pageup = 0
	CASE 202: keys.minus = 0
	CASE 204: keys.center = 0
	CASE 206: keys.plus = 0
	CASE 209: keys.pagedown = 0
	CASE 211: keys.del = 0
	CASE 207: keys.endkey = 0
	CASE 130: keys.no1 = 0
	CASE 131: keys.no2 = 0
	CASE 132: keys.no3 = 0
	CASE 133: keys.no4 = 0
	CASE 134: keys.no5 = 0
	CASE 135: keys.no6 = 0
	CASE 136: keys.no7 = 0
	CASE 137: keys.no8 = 0
	CASE 138: keys.no9 = 0
	CASE 139: keys.no0 = 0
	CASE 140: keys.hyphen = 0
	CASE 144: keys.q = 0
	CASE 145: keys.w = 0
	CASE 146: keys.e = 0
	CASE 147: keys.r = 0
	CASE 148: keys.t = 0
	CASE 149: keys.y = 0
	CASE 150: keys.u = 0
	CASE 151: keys.i = 0
	CASE 152: keys.o = 0
	CASE 153: keys.p = 0
	CASE 156: keys.enter = 0
	CASE 158: keys.a = 0
	CASE 159: keys.s = 0
	CASE 160: keys.d = 0
	CASE 161: keys.f = 0
	CASE 162: keys.g = 0
	CASE 163: keys.h = 0
	CASE 164: keys.j = 0
	CASE 165: keys.k = 0
	CASE 166: keys.l = 0
	CASE 167: keys.colon = 0
	CASE 168: keys.quote = 0
	CASE 172: keys.z = 0
	CASE 173: keys.x = 0
	CASE 174: keys.c = 0
	CASE 175: keys.v = 0
	CASE 176: keys.b = 0
	CASE 177: keys.n = 0
	CASE 178: keys.m = 0
END SELECT

	specialkeys
	keycode = KeyBlast
END FUNCTION

SUB specialkeys
	DEF SEG = 0
	Plop% = PEEK(&H417)
	plop2% = PEEK(&H418)
	IF (Plop% AND 2) THEN keys.lshift = 1 ELSE keys.lshift = 0
	IF (Plop% AND 1) THEN keys.rshift = 1 ELSE keys.rshift = 0

	IF (Plop% AND 4) THEN
		keys.ctrl = 1
		 IF (plop2% AND 1) THEN
			keys.lctrl = 1
		ELSE
			keys.lctrl = 0
			keys.rctrl = 1
		END IF
	ELSE
		keys.rctrl = 0
		keys.lctrl = 0
		keys.ctrl = 0
	END IF

	 IF (Plop% AND 8) THEN
		keys.alt = 1
		IF (plop2% AND 2) THEN
			keys.lalt = 1
		ELSE
			keys.lalt = 0
			keys.ralt = 1
		END IF
	ELSE
		keys.ralt = 0
		keys.lalt = 0
		keys.alt = 0
	END IF

	IF (Plop% AND 16) THEN
		keys.ScrollLock = 1
		keys.Scroll = 1
	ELSE
		keys.ScrollLock = 0
	END IF
	IF (plop2% AND 16) THEN
		keys.Scroll = 1
	ELSE
		keys.Scroll = 0
	END IF

	IF (Plop% AND 128) THEN
		keys.Ins = 1
		keys.InsLock = 1
	ELSE
		keys.InsLock = 0
	END IF

	IF (plop2% AND 128) THEN
		keys.Ins = 1
	ELSE
		keys.Ins = 0
	END IF

	IF (Plop% AND 32) THEN
		keys.Num = 1
		keys.NumLock = 1
	ELSE
		keys.NumLock = 0
	END IF

	IF (plop2% AND 32) THEN
		keys.Num = 1
	ELSE
		keys.Num = 0
	END IF

	IF (Plop% AND 64) THEN
		keys.capslock = 1
		keys.caps = 1
	ELSE
		keys.capslock = 0
	END IF
	IF (plop2% AND 64) THEN
		keys.caps = 1
	ELSE
		keys.caps = 0
	END IF

	IF keys.rshift = 1 OR keys.lshift = 1 THEN
		keys.shiftkey = 1
	ELSE
		keys.shiftkey = 0
	END IF
END SUB