5140570 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n mouse8.bas
   1: DECLARE SUB Lightup (sm!, x%, y%)
   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: 
  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"; MS%
  34:   END
  35: END IF
  36: SCREEN 1
  37: MouseShow
  38: CLS
  39: LOCATE 4, 1: PRINT "4"
  40: LOCATE 5, 1: PRINT "5"
  41: LOCATE 6, 1: PRINT "6"
  42: LOCATE 7, 1: PRINT "7"
  43: LOCATE 8, 1: PRINT "8"
  44: LOCATE 9, 1: PRINT "9"
  45: LOCATE 10, 1: PRINT "10"
  46: LOCATE 11, 1: PRINT "11"
  47: LOCATE 12, 1: PRINT "12"
  48: LOCATE 13, 1: PRINT "13"
  49: LOCATE 14, 1: PRINT "14"
  50: LOCATE 15, 1: PRINT "15"
  51: LOCATE 16, 1: PRINT "16"
  52: LOCATE 17, 1: PRINT "17"
  53: LOCATE 18, 1: PRINT "18"
  54: LOCATE 19, 1: PRINT "19"
  55: LOCATE 20, 1: PRINT "20"
  56: LOCATE 21, 1: PRINT "21"
  57: LOCATE 22, 1: PRINT "22"
  58: LOCATE 23, 1: PRINT "1234567890"
  59: 1 MouseStatus lb%, rb%, y%, x%
  60: IF lb% = -1 THEN lb$ = "Left: Pressed " ELSE lb$ = "Left: Released"
  61: IF rb% = -1 THEN rb$ = "Right: Pressed " ELSE rb$ = "Right: Released "
  62: le% = CINT(x% / (199 / 26))
  63: LOCATE 1, 1: PRINT lb$; "  "; rb$
  64: LOCATE 2, 1: PRINT y%; x%
  65: LOCATE 3, 1: PRINT "Line:"; le%; "  "; "Row:"; 199 / 26
  66: GOTO 1
  67: 
  68: SUB Lightup (sm, x%, y%)
  69: AAA = 176
  70: IF sm = 0 GOTO ZERO
  71: IF sm = 12 GOTO TW
  72: TW:
  73: LOCATE x% / 15, y% / 8: PRINT CHR$(AAA)
  74: AAA = AAA + 1
  75: IF AAA > 179 THEN A = 219
  76: IF AAA = 220 GOTO 2222
  77: GOTO TW
  78: ZERO:
  79: LOCATE x% / 7.5, y% / 7.8: PRINT CHR$(AAA)
  80: AAA = AAA + 1
  81: IF AAA > 179 THEN A = 219
  82: IF AAA = 220 GOTO 2222
  83: GOTO ZERO
  84: 2222 END SUB
  85: 
  86: SUB MouseDriver (ax%, bx%, cx%, dx%)
  87:   DEF SEG = VARSEG(Mouse$)
  88:   Mouse% = SADD(Mouse$)
  89:   CALL Absolute(ax%, bx%, cx%, dx%, Mouse%)
  90: END SUB
  91: 
  92: SUB MouseHide
  93:  ax% = 2
  94:  MouseDriver ax%, 0, 0, 0
  95: END SUB
  96: 
  97: FUNCTION MouseInit%
  98:   ax% = 0
  99:   MouseDriver ax%, 0, 0, 0
 100:   MouseInit% = ax%
 101: END FUNCTION
 102: 
 103: SUB MousePut (x%, y%)
 104:   ax% = 4
 105:   cx% = x%
 106:   dx% = y%
 107:   MouseDriver ax%, 0, cx%, dx%
 108: END SUB
 109: 
 110: SUB MouseRange (x1%, y1%, x2%, y2%)
 111:   ax% = 7
 112:   cx% = x1%
 113:   dx% = x2%
 114:   MouseDriver ax%, 0, cx%, dx%
 115:   ax% = 8
 116:   cx% = y1%
 117:   dx% = y2%
 118:   MouseDriver ax%, 0, cx%, dx%
 119: END SUB
 120: 
 121: SUB MouseShow
 122:   ax% = 1
 123:   MouseDriver ax%, 0, 0, 0
 124: END SUB
 125: 
 126: SUB MouseStatus (lb%, rb%, xMouse%, yMouse%)
 127:   ax% = 3
 128:   MouseDriver ax%, bx%, cx%, dx%
 129:   lb% = ((bx% AND 1) <> 0)
 130:   rb% = ((bx% AND 2) <> 0)
 131:   xMouse% = cx%
 132:   yMouse% = dx%
 133: END SUB
 134: 
 135: SUB Pause
 136:   'This sub used for demo, not needed for mouse calls
 137:   PRINT "Press any key to continue..."
 138:   G$ = INPUT$(1)
 139:   PRINT
 140: END SUB
 141: 
5140571 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 16:05:29