1: 'QBASIC Mouse demo 2: 'Author : Dan Maxwell 3: 'Here is the routine that will add MOUSE functions to 4: 'your QBasic 1.0 that comes with MS-DOS 5.0 5: '(Works with Qbasic 1.1 too. - Adam) 6: 7: 8: 9: DECLARE SUB Pause () 10: DECLARE SUB MouseStatus (lb%, rb%, xMouse%, yMouse%) 11: DECLARE SUB MouseRange (x1%, y1%, x2%, y2%) 12: DECLARE SUB MousePut (x%, y%) 13: DECLARE SUB MouseHide () 14: DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%) 15: DECLARE SUB Mouseshow () 16: DECLARE FUNCTION MouseInit% () 17: 18: SCREEN 12 19: DIM SHARED Mouse$ 20: Mouse$ = SPACE$(57) 21: FOR i% = 1 TO 57 22: READ A$ 23: H$ = CHR$(VAL("&H" + A$)) 24: MID$(Mouse$, i%, 1) = H$ 25: NEXT i% 26: DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B 27: DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53 28: DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F 29: DATA 8B,5E,06,89,17,5D,CA,08,00 30: CLS 31: ms% = MouseInit% 32: IF NOT ms% THEN 33: PRINT "Mouse not found" 34: END 35: END IF 36: 10 MouseStatus lb%, rb%, x%, y% 37: Mouseshow 38: 39: IF lb% = -1 THEN LET ZZ$ = "M" + STR$(x%) + "," + STR$(y%): SLEEP 1: DRAW "X" + VARPTR$(ZZ$) 40: IF QQ$ = "" THEN QQ$ = ZZ$ ELSE QQ$ = QQ$ + ZZ$ 41: kbd$ = INKEY$ 42: SELECT CASE kbd$ 43: CASE "w", "W": DRAW "U1" 44: CASE "s", "S": DRAW "D1" 45: CASE "a", "A": DRAW "L1" 46: CASE "d", "D": DRAW "R1" 47: CASE CHR$(0) + "H": DRAW "U1": U = U + 1: D = D - 1 48: CASE CHR$(0) + "P": DRAW "D1": D = D + 1: U = U - 1 49: CASE CHR$(0) + "K": DRAW "L1": L = L + 1: R = R - 1 50: CASE CHR$(0) + "M": DRAW "R1": R = R + 1: L = L - 1 51: CASE ELSE 52: END SELECT 53: DRAW "C4" 54: LOCATE 1, 1: IF U > 0 THEN PRINT U: LOCATE 2, 1: PRINT " " 55: LOCATE 2, 1: IF D > 0 THEN PRINT D: LOCATE 1, 1: PRINT " " 56: LOCATE 3, 1: IF L > 0 THEN PRINT L: LOCATE 4, 1: PRINT " " 57: LOCATE 4, 1: IF R > 0 THEN PRINT R: LOCATE 3, 1: PRINT " " 58: GOTO 10 59: 60: SUB MouseDriver (ax%, bx%, cx%, dx%) 61: DEF SEG = VARSEG(Mouse$) 62: Mouse% = SADD(Mouse$) 63: CALL Absolute(ax%, bx%, cx%, dx%, Mouse%) 64: END SUB 65: 66: SUB MouseHide 67: ax% = 2 68: MouseDriver ax%, 0, 0, 0 69: END SUB 70: 71: FUNCTION MouseInit% 72: ax% = 0 73: MouseDriver ax%, 0, 0, 0 74: MouseInit% = ax% 75: END FUNCTION 76: 77: SUB MousePut (x%, y%) 78: ax% = 4 79: cx% = x% 80: dx% = y% 81: MouseDriver ax%, 0, cx%, dx% 82: END SUB 83: 84: SUB MouseRange (x1%, y1%, x2%, y2%) 85: ax% = 7 86: cx% = x1% 87: dx% = x2% 88: MouseDriver ax%, 0, cx%, dx% 89: ax% = 8 90: cx% = y1% 91: dx% = y2% 92: MouseDriver ax%, 0, cx%, dx% 93: END SUB 94: 95: SUB Mouseshow 96: ax% = 1 97: MouseDriver ax%, 0, 0, 0 98: END SUB 99: 100: SUB MouseStatus (lb%, rb%, xMouse%, yMouse%) 101: ax% = 3 102: MouseDriver ax%, bx%, cx%, dx% 103: lb% = ((bx% AND 1) <> 0) 104: rb% = ((bx% AND 2) <> 0) 105: xMouse% = cx% 106: yMouse% = dx% 107: END SUB 108: 109: SUB Pause 110: 'This sub used for demo, not needed for mouse calls 111: PRINT "Press any key to continue..." 112: G$ = INPUT$(1) 113: PRINT 114: END SUB 115: |