1: DECLARE SUB FADE (ty%, tx%, text$) 2: 'QBASIC Mouse demo 3: 'Author : Dan Maxwell 4: 'Here is the routine that will add MOUSE functions to 5: 'your QBasic 1.0 that comes with MS-DOS 5.0 6: '(Works with Qbasic 1.1 too. - Adam) 7: 8: 9: 10: DECLARE SUB PAUSE () 11: DECLARE SUB MouseStatus (lb%, rb%, xMouse%, yMouse%) 12: DECLARE SUB MouseRange (x1%, y1%, x2%, y2%) 13: DECLARE SUB MousePut (x%, y%) 14: DECLARE SUB MouseHide () 15: DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%) 16: DECLARE SUB MouseShow () 17: DECLARE FUNCTION MouseInit% () 18: SCREEN 0 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: SCREEN 12 37: 100 LOCATE 2, 1: PRINT "ΙΝΝΝΝΝΝΝ»" 38: PRINT "Ί CLEAR Ί" 39: PRINT "ΘΝΝΝΝΝΝΝΌ" 40: MouseShow 41: 10 MouseStatus lb%, rb%, x2%, y2% 42: IF lb% = -1 THEN GOTO 20 43: GOTO 10 44: 20 MouseStatus lb%, rb%, x%, y% 45: FOR I = 6 TO 64 46: IF x% = I THEN GOTO 3 47: NEXT I 48: 32 MouseStatus lb%, rb%, x1%, y1% 49: IF rb% = -1 THEN GOTO 40 50: GOTO 32 51: 3 FOR V = 21 TO 51 52: IF y% = V THEN GOTO 30 53: NEXT V 54: GOTO 10 55: 30 CLS 56: GOTO 100 57: 40 r% = x2% - x1% 58: IF r% < 0 THEN LET r% = r% - (r% * 2) 59: SLEEP 1 60: CIRCLE (x2%, y2%), r% 61: GOTO 100 62: 63: DEFINT A-Z 64: SUB FADE (ty, tx, text$) 65: ScrollDelay = 5 66: LOCATE ty, tx: COLOR 15: PRINT text$ 67: FOR n = 1 TO (ScrollDelay * 5000): NEXT 68: LOCATE ty, tx: COLOR 7: PRINT text$ 69: FOR n = 1 TO (ScrollDelay * 5000): NEXT 70: LOCATE ty, tx: COLOR 8: PRINT text$ 71: FOR n = 1 TO (ScrollDelay * 5000): NEXT 72: 73: END SUB 74: 75: DEFSNG A-Z 76: SUB MouseDriver (ax%, bx%, cx%, dx%) 77: DEF SEG = VARSEG(Mouse$) 78: Mouse% = SADD(Mouse$) 79: CALL Absolute(ax%, bx%, cx%, dx%, Mouse%) 80: END SUB 81: 82: SUB MouseHide 83: ax% = 2 84: MouseDriver ax%, 0, 0, 0 85: END SUB 86: 87: FUNCTION MouseInit% 88: ax% = 0 89: MouseDriver ax%, 0, 0, 0 90: MouseInit% = ax% 91: END FUNCTION 92: 93: SUB MousePut (x%, y%) 94: ax% = 4 95: cx% = x% 96: dx% = y% 97: MouseDriver ax%, 0, cx%, dx% 98: END SUB 99: 100: SUB MouseRange (x1%, y1%, x2%, y2%) 101: ax% = 7 102: cx% = x1% 103: dx% = x2% 104: MouseDriver ax%, 0, cx%, dx% 105: ax% = 8 106: cx% = y1% 107: dx% = y2% 108: MouseDriver ax%, 0, cx%, dx% 109: END SUB 110: 111: SUB MouseShow 112: ax% = 1 113: MouseDriver ax%, 0, 0, 0 114: END SUB 115: 116: SUB MouseStatus (lb%, rb%, xMouse%, yMouse%) 117: ax% = 3 118: MouseDriver ax%, bx%, cx%, dx% 119: lb% = ((bx% AND 1) <> 0) 120: rb% = ((bx% AND 2) <> 0) 121: xMouse% = cx% 122: yMouse% = dx% 123: END SUB 124: 125: SUB PAUSE 126: 'This sub used for demo, not needed for mouse calls 127: PRINT "Press any key to continue..." 128: G$ = INPUT$(1) 129: PRINT 130: END SUB 131: |