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: DIM SHARED Mouse$ 19: Mouse$ = SPACE$(57) 20: FOR i% = 1 TO 57 21: READ A$ 22: H$ = CHR$(VAL("&H" + A$)) 23: MID$(Mouse$, i%, 1) = H$ 24: NEXT i% 25: DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B 26: DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53 27: DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F 28: DATA 8B,5E,06,89,17,5D,CA,08,00 29: CLS 30: ms% = MouseInit% 31: IF NOT ms% THEN 32: PRINT "Mouse not found" 33: END 34: END IF 35: SCREEN 2 36: MouseShow 37: 1 MouseStatus lb%, rb%, x%, y% 38: LOCATE 1, 1: PRINT x%; y% 39: MouseRange 0, 100, 620, 100 40: 4 IF x% = 0 THEN MousePut 310, 100: CLS : DRAW "BM0,200 M100,320 M640,200 ": A = 1 41: IF x% = 620 THEN MousePut 310, 100 42: IF A = 1 GOTO 3 ELSE GOTO 1 43: 44: SUB MouseDriver (ax%, bx%, cx%, dx%) 45: DEF SEG = VARSEG(Mouse$) 46: Mouse% = SADD(Mouse$) 47: CALL Absolute(ax%, bx%, cx%, dx%, Mouse%) 48: END SUB 49: 50: SUB MouseHide 51: ax% = 2 52: MouseDriver ax%, 0, 0, 0 53: END SUB 54: 55: FUNCTION MouseInit% 56: ax% = 0 57: MouseDriver ax%, 0, 0, 0 58: MouseInit% = ax% 59: END FUNCTION 60: 61: SUB MousePut (x%, y%) 62: ax% = 4 63: cx% = x% 64: dx% = y% 65: MouseDriver ax%, 0, cx%, dx% 66: END SUB 67: 68: SUB MouseRange (x1%, y1%, x2%, y2%) 69: ax% = 7 70: cx% = x1% 71: dx% = x2% 72: MouseDriver ax%, 0, cx%, dx% 73: ax% = 8 74: cx% = y1% 75: dx% = y2% 76: MouseDriver ax%, 0, cx%, dx% 77: END SUB 78: 79: SUB MouseShow 80: ax% = 1 81: MouseDriver ax%, 0, 0, 0 82: END SUB 83: 84: SUB MouseStatus (lb%, rb%, xMouse%, yMouse%) 85: ax% = 3 86: MouseDriver ax%, bx%, cx%, dx% 87: lb% = ((bx% AND 1) <> 0) 88: rb% = ((bx% AND 2) <> 0) 89: xMouse% = cx% 90: yMouse% = dx% 91: END SUB 92: 93: SUB Pause 94: 'This sub used for demo, not needed for mouse calls 95: PRINT "Press any key to continue..." 96: G$ = INPUT$(1) 97: PRINT 98: END SUB 99: |