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: LOCATE 2, 1: PRINT "ÉÍÍÍÍÍÍÍ»" 38: PRINT "ºWINDOWSº" 39: PRINT "ÈÍÍÍÍÍÍͼ" 40: MouseShow 41: 10 MouseStatus lb%, rb%, x%, y% 42: IF lb% = -1 THEN GOTO 20 43: IF rb% = -1 THEN GOTO 20 44: GOTO 10 45: 20 MouseStatus lb%, rb%, x%, y% 46: FOR I = 6 TO 64 47: IF x% = I THEN GOTO 3 48: NEXT I 49: GOTO 10 50: 3 FOR V = 21 TO 51 51: IF y% = V THEN GOTO 30 52: NEXT V 53: GOTO 10 54: 30 FADE 6, 1, "Sorry !!!!!!!" 55: FADE 7, 1, "Can not load Windows" 56: SHELL "CD \WINDOWS" 57: SHELL "COPY WIN.COM C:\RUN.COM" 58: LOCATE 8, 1: PRINT " " 59: SYSTEM 60: 61: DEFINT A-Z 62: SUB FADE (ty, tx, text$) 63: ScrollDelay = 5 64: LOCATE ty, tx: COLOR 15: PRINT text$ 65: FOR n = 1 TO (ScrollDelay * 5000): NEXT 66: LOCATE ty, tx: COLOR 7: PRINT text$ 67: FOR n = 1 TO (ScrollDelay * 5000): NEXT 68: LOCATE ty, tx: COLOR 8: PRINT text$ 69: FOR n = 1 TO (ScrollDelay * 5000): NEXT 70: 71: END SUB 72: 73: DEFSNG A-Z 74: SUB MouseDriver (ax%, bx%, cx%, dx%) 75: DEF SEG = VARSEG(Mouse$) 76: Mouse% = SADD(Mouse$) 77: CALL Absolute(ax%, bx%, cx%, dx%, Mouse%) 78: END SUB 79: 80: SUB MouseHide 81: ax% = 2 82: MouseDriver ax%, 0, 0, 0 83: END SUB 84: 85: FUNCTION MouseInit% 86: ax% = 0 87: MouseDriver ax%, 0, 0, 0 88: MouseInit% = ax% 89: END FUNCTION 90: 91: SUB MousePut (x%, y%) 92: ax% = 4 93: cx% = x% 94: dx% = y% 95: MouseDriver ax%, 0, cx%, dx% 96: END SUB 97: 98: SUB MouseRange (x1%, y1%, x2%, y2%) 99: ax% = 7 100: cx% = x1% 101: dx% = x2% 102: MouseDriver ax%, 0, cx%, dx% 103: ax% = 8 104: cx% = y1% 105: dx% = y2% 106: MouseDriver ax%, 0, cx%, dx% 107: END SUB 108: 109: SUB MouseShow 110: ax% = 1 111: MouseDriver ax%, 0, 0, 0 112: END SUB 113: 114: SUB MouseStatus (lb%, rb%, xMouse%, yMouse%) 115: ax% = 3 116: MouseDriver ax%, bx%, cx%, dx% 117: lb% = ((bx% AND 1) <> 0) 118: rb% = ((bx% AND 2) <> 0) 119: xMouse% = cx% 120: yMouse% = dx% 121: END SUB 122: 123: SUB PAUSE 124: 'This sub used for demo, not needed for mouse calls 125: PRINT "Press any key to continue..." 126: G$ = INPUT$(1) 127: PRINT 128: END SUB 129: |