DECLARE SUB PRINTH (t$)
DECLARE SUB FADE (ty%, tx%, text$)
'QBASIC Mouse demo                             
'Author : Dan Maxwell               
'Here is the routine that will add MOUSE functions to
'your QBasic 1.0 that comes with MS-DOS 5.0    
'(Works with Qbasic 1.1 too. - Adam)



DECLARE SUB PAUSE ()
DECLARE SUB MouseStatus (lb%, rb%, xMouse%, yMouse%)
DECLARE SUB MouseRange (x1%, y1%, x2%, y2%)
DECLARE SUB MousePut (x%, y%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%)
DECLARE SUB MouseShow ()
DECLARE FUNCTION MouseInit% ()
DIM SHARED CheckClick(1 TO 80, 1 TO 25)
DIM SHARED CheckLink$(1 TO 80, 1 TO 25)
SCREEN 0
DIM SHARED Mouse$
Mouse$ = SPACE$(57)
FOR I% = 1 TO 57
  READ A$
  H$ = CHR$(VAL("&H" + A$))
  MID$(Mouse$, I%, 1) = H$
NEXT I%
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00                
CLS
ms% = MouseInit%
IF NOT ms% THEN
  PRINT "Mouse not found"
  END
END IF
MouseShow
PRINTH "This ~&IS&~ a hyperlink"
PRINTH "This ~&IS&~ a hyperlink"
20 MouseStatus lb%, rb%, x%, y%
IF pstlb% = -1 AND lb% = -1 THEN GOTO 20 ELSE pstlb% = lb%
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
GOTO 20

DEFINT A-Z
SUB FADE (ty, tx, text$)
ScrollDelay = 5
    LOCATE ty, tx: COLOR 15: PRINT text$
    FOR n = 1 TO (ScrollDelay * 5000): NEXT
    LOCATE ty, tx: COLOR 7: PRINT text$
    FOR n = 1 TO (ScrollDelay * 5000): NEXT
    LOCATE ty, tx: COLOR 8: PRINT text$
    FOR n = 1 TO (ScrollDelay * 5000): NEXT

END SUB

DEFSNG A-Z
SUB MouseDriver (ax%, bx%, cx%, dx%)
  DEF SEG = VARSEG(Mouse$)
  Mouse% = SADD(Mouse$)
  CALL Absolute(ax%, bx%, cx%, dx%, Mouse%)
END SUB

SUB MouseHide
 ax% = 2
 MouseDriver ax%, 0, 0, 0
END SUB

FUNCTION MouseInit%
  ax% = 0
  MouseDriver ax%, 0, 0, 0
  MouseInit% = ax%
END FUNCTION

SUB MousePut (x%, y%)
  ax% = 4
  cx% = x%
  dx% = y%
  MouseDriver ax%, 0, cx%, dx%
END SUB

SUB MouseRange (x1%, y1%, x2%, y2%)
  ax% = 7
  cx% = x1%
  dx% = x2%
  MouseDriver ax%, 0, cx%, dx%
  ax% = 8
  cx% = y1%
  dx% = y2%
  MouseDriver ax%, 0, cx%, dx%
END SUB

SUB MouseShow
  ax% = 1
  MouseDriver ax%, 0, 0, 0
END SUB

SUB MouseStatus (lb%, rb%, xMouse%, yMouse%)
  ax% = 3
  MouseDriver ax%, bx%, cx%, dx%
  lb% = ((bx% AND 1) <> 0)
  rb% = ((bx% AND 2) <> 0)
  xMouse% = cx%
  yMouse% = dx%
END SUB

SUB PAUSE
  'This sub used for demo, not needed for mouse calls
  PRINT "Press any key to continue..."
  G$ = INPUT$(1)
  PRINT
END SUB

SUB PRINTH (t$)
COLOR 7, 0
FOR q = 1 TO LEN(t$)
hy = INSTR(q, t$, "~&")
IF hy = 0 THEN EXIT FOR
COLOR 7, 0: PRINT MID$(t$, q, hy - q);
hy2 = INSTR(hy, t$, "&~")
cp$ = UCASE$(MID$(t$, hy + 2, hy2 - hy - 2))
CheckClick(POS(0), CSRLIN) = -1
FOR ss = 1 TO LEN(cp$)
CheckClick(((POS(0) + ss) MOD 79) + 1, CSRLIN + INT(ss / 80)) = -1
CheckLink$(((POS(0) + ss) MOD 79) + 1, CSRLIN + INT(ss / 80)) = cp$
xx = POS(0): yy = CSRLIN
LOCATE 10, 1: PRINT ((xx + ss) MOD 79) + 1, yy + INT(ss / 80), xx, yy
LOCATE xx, yy
NEXT ss
Count = Count + 1
COLOR 15, 4: PRINT cp$;
q = hy
NEXT q
COLOR 7, 0: PRINT RIGHT$(t$, LEN(t$) - hy2 - 1);
PRINT
END SUB