1: DECLARE SUB PRINTH (t$) 2: DECLARE SUB FADE (ty%, tx%, text$) 3: 'QBASIC Mouse demo 4: 'Author : Dan Maxwell 5: 'Here is the routine that will add MOUSE functions to 6: 'your QBasic 1.0 that comes with MS-DOS 5.0 7: '(Works with Qbasic 1.1 too. - Adam) 8: 9: 10: 11: DECLARE SUB PAUSE () 12: DECLARE SUB MouseStatus (lb%, rb%, xMouse%, yMouse%) 13: DECLARE SUB MouseRange (x1%, y1%, x2%, y2%) 14: DECLARE SUB MousePut (x%, y%) 15: DECLARE SUB MouseHide () 16: DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%) 17: DECLARE SUB MouseShow () 18: DECLARE FUNCTION MouseInit% () 19: DIM SHARED CheckClick(1 TO 80, 1 TO 25) 20: DIM SHARED CheckLink$(1 TO 80, 1 TO 25) 21: SCREEN 0 22: DIM SHARED Mouse$ 23: Mouse$ = SPACE$(57) 24: FOR I% = 1 TO 57 25: READ A$ 26: H$ = CHR$(VAL("&H" + A$)) 27: MID$(Mouse$, I%, 1) = H$ 28: NEXT I% 29: DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B 30: DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53 31: DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F 32: DATA 8B,5E,06,89,17,5D,CA,08,00 33: CLS 34: ms% = MouseInit% 35: IF NOT ms% THEN 36: PRINT "Mouse not found" 37: END 38: END IF 39: MouseShow 40: PRINTH "This ~&IS&~ a hyperlink" 41: PRINTH "This ~&IS&~ a hyperlink" 42: 20 MouseStatus lb%, rb%, x%, y% 43: IF pstlb% = -1 AND lb% = -1 THEN GOTO 20 ELSE pstlb% = lb% 44: IF lb% = -1 AND CheckClick((x% / 8) + 1, (y% / 8) + 1) = -1 THEN PRINT "Hyper Link " + CheckLink$((x% / 8) + 1, (y% / 8) + 1) + " clicked"; Cnt: Cnt = Cnt + 1 45: GOTO 20 46: 47: DEFINT A-Z 48: SUB FADE (ty, tx, text$) 49: ScrollDelay = 5 50: LOCATE ty, tx: COLOR 15: PRINT text$ 51: FOR n = 1 TO (ScrollDelay * 5000): NEXT 52: LOCATE ty, tx: COLOR 7: PRINT text$ 53: FOR n = 1 TO (ScrollDelay * 5000): NEXT 54: LOCATE ty, tx: COLOR 8: PRINT text$ 55: FOR n = 1 TO (ScrollDelay * 5000): NEXT 56: 57: END SUB 58: 59: DEFSNG A-Z 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: 116: SUB PRINTH (t$) 117: COLOR 7, 0 118: FOR q = 1 TO LEN(t$) 119: hy = INSTR(q, t$, "~&") 120: IF hy = 0 THEN EXIT FOR 121: COLOR 7, 0: PRINT MID$(t$, q, hy - q); 122: hy2 = INSTR(hy, t$, "&~") 123: cp$ = UCASE$(MID$(t$, hy + 2, hy2 - hy - 2)) 124: CheckClick(POS(0), CSRLIN) = -1 125: FOR ss = 1 TO LEN(cp$) 126: CheckClick(((POS(0) + ss) MOD 79) + 1, CSRLIN + INT(ss / 80)) = -1 127: CheckLink$(((POS(0) + ss) MOD 79) + 1, CSRLIN + INT(ss / 80)) = cp$ 128: xx = POS(0): yy = CSRLIN 129: LOCATE 10, 1: PRINT ((xx + ss) MOD 79) + 1, yy + INT(ss / 80), xx, yy 130: LOCATE xx, yy 131: NEXT ss 132: Count = Count + 1 133: COLOR 15, 4: PRINT cp$; 134: q = hy 135: NEXT q 136: COLOR 7, 0: PRINT RIGHT$(t$, LEN(t$) - hy2 - 1); 137: PRINT 138: END SUB 139: |