5748275 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n winbas.bas
   1: DECLARE SUB ChkClk (ys%, ye%, xs%, xe%, x%, y%, dl!)
   2: DECLARE SUB Pause ()
   3: DECLARE SUB MouseStatus (lb%, rb%, xMouse%, yMouse%)
   4: DECLARE SUB MouseRange (x1%, y1%, x2%, y2%)
   5: DECLARE SUB MousePut (x%, y%)
   6: DECLARE SUB MouseHide ()
   7: DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%)
   8: DECLARE SUB MouseShow ()
   9: DECLARE FUNCTION MouseInit% ()
  10: DECLARE SUB wndow (length%, height%, row%, column%)
  11: DIM SHARED Mouse$
  12: DIM SHARED clk
  13: Mouse$ = SPACE$(57)
  14: FOR i% = 1 TO 57
  15:   READ A$
  16:   H$ = CHR$(VAL("&H" + A$))
  17:   MID$(Mouse$, i%, 1) = H$
  18: NEXT i%
  19: DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
  20: DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
  21: DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
  22: DATA 8B,5E,06,89,17,5D,CA,08,00               
  23: DIM behind(1 TO 9999)
  24: CLS
  25: ms% = MouseInit%
  26: IF NOT ms% THEN
  27:   PRINT "Mouse not found"
  28:   END
  29: END IF
  30: SCREEN 12
  31: yy% = 180
  32: xx% = 80
  33: sxx% = 300
  34: syy% = 250
  35: ssx% = sxx%
  36: ssy% = syy%
  37: topr:
  38: wndow 300, 350, 30, 10
  39: GET (yy%, xx%)-(xx% + sxx%, yy% + syy%), behind: tmpx = xx%: tmpy = yy%
  40: wndow syy%, sxx%, xx%, yy%
  41: MouseShow
  42: 1 MouseStatus lb%, rb%, y%, x%
  43: IF clk = 1 THEN LOCATE 2, 1: PRINT "Menu": SLEEP 1: LOCATE 2, 1: PRINT "      ": clk = 0: END: GOTO 1
  44: IF clk = 2 THEN xx% = x%: yy% = y%: clk = 0: syy% = ssy%: sxx% = ssx%: PUT (tmpy, tmpx), behind, PSET: GET (yy%, xx%)-(xx% + sxx%, yy% + syy%), behind: tmpx = xx%: tmpy = yy%: wndow syy%, sxx%, x%, y%
  45: LOCATE 1, 1: PRINT y%; x%; lb%; rb%
  46: IF lb% = -1 OR rb% = -1 THEN ChkClk 13, 31, 33, 51, x%, y%, 1: ChkClk yy% + 4, yy% + 14, xx% + 4, xx% + 21, x%, y%, 1: ChkClk yy%, yy% + syy%, xx%, xx% + 3, x%, y%, 2
  47: GOTO 1
  48: 
  49: SUB ChkClk (ys%, ye%, xs%, xe%, x%, y%, dl)
  50: 21 FOR i = ys% TO ye%
  51: IF y% = i THEN GOTO 22
  52: NEXT i
  53: EXIT SUB
  54: 22 FOR i = xs% TO xe%
  55: IF x% = i THEN LOCATE 2, 1: clk = dl
  56: NEXT i
  57: END SUB
  58: 
  59: SUB MouseDriver (ax%, bx%, cx%, dx%)
  60:   DEF SEG = VARSEG(Mouse$)
  61:   Mouse% = SADD(Mouse$)
  62:   CALL Absolute(ax%, bx%, cx%, dx%, Mouse%)
  63: END SUB
  64: 
  65: SUB MouseHide
  66:  ax% = 2
  67:  MouseDriver ax%, 0, 0, 0
  68: END SUB
  69: 
  70: FUNCTION MouseInit%
  71:   ax% = 0
  72:   MouseDriver ax%, 0, 0, 0
  73:   MouseInit% = ax%
  74: END FUNCTION
  75: 
  76: SUB MousePut (x%, y%)
  77:   ax% = 4
  78:   cx% = x%
  79:   dx% = y%
  80:   MouseDriver ax%, 0, cx%, dx%
  81: END SUB
  82: 
  83: SUB MouseRange (x1%, y1%, x2%, y2%)
  84:   ax% = 7
  85:   cx% = x1%
  86:   dx% = x2%
  87:   MouseDriver ax%, 0, cx%, dx%
  88:   ax% = 8
  89:   cx% = y1%
  90:   dx% = y2%
  91:   MouseDriver ax%, 0, cx%, dx%
  92: END SUB
  93: 
  94: SUB MouseShow
  95:   ax% = 1
  96:   MouseDriver ax%, 0, 0, 0
  97: END SUB
  98: 
  99: SUB MouseStatus (lb%, rb%, xMouse%, yMouse%)
 100:   ax% = 3
 101:   MouseDriver ax%, bx%, cx%, dx%
 102:   lb% = ((bx% AND 1) <> 0)
 103:   rb% = ((bx% AND 2) <> 0)
 104:   xMouse% = cx%
 105:   yMouse% = dx%
 106: END SUB
 107: 
 108: SUB Pause
 109:   'This sub used for demo, not needed for mouse calls
 110:   PRINT "Press any key to continue..."
 111:   G$ = INPUT$(1)
 112:   PRINT
 113: END SUB
 114: 
 115: SUB wndow (length%, height%, row%, column%)
 116: LINE (column%, row%)-(column% + length%, row% + height%), 0, B
 117: FOR i% = 1 TO 2
 118: row% = row% + 1: column% = column% + 1: height% = height% - 1: length% = length% - 1
 119: LINE (column%, row%)-(column% + length%, row%), 7
 120: LINE (column%, row%)-(column%, row% + height%), 7
 121: NEXT i%
 122: row% = row% + 1: column% = column% + 1: height% = height% - 1: length% = length% - 1
 123: LINE (column%, row%)-(column% + length%, row%), 0
 124: LINE (column%, row%)-(column%, row% + height%), 0
 125: LINE (column%, row%)-(column% + 18, row% + 18), 7, BF
 126: LINE (column%, row%)-(column% + 18, row% + 18), 0, B
 127: LINE (column% + 18, row% - 2)-(column% + 18, row% + 5), 0
 128: LINE (column% - 2, row% + 18)-(column% + 5, row% + 18), 0
 129: LINE (column% + 5, row% + 7)-(column% + 13, row% + 9), 15, BF: LINE (column% + 5, row% + 7)-(column% + 13, row% + 9), 0, B
 130: LINE (column% + 14, row% + 7)-(column% + 14, row% + 9), 8
 131: LINE (column% + 6, row% + 10)-(column% + 14, row% + 10), 8, B
 132: LINE (column% + 18, row%)-(column% + length%, row% + 18), 1, BF
 133: LINE (column% + 18, row%)-(column% + length%, row% + 18), 0, B
 134: LINE (column% + length%, row% - 3)-(column% + length% + 2, row% + height%), 7, BF
 135: LINE (column% + length%, row% - 3)-(column% + length% + 3, row% + height%), 0, B
 136: LINE (column% + length%, row% - 2)-(column% + length%, row% - 1), 7
 137: LINE (column% + length% - 18, row% - 2)-(column% + length% - 18, row% - 1), 0
 138: LINE (column% + length%, row% + 18)-(column% + length% + 2, row% + 18), 0
 139: LINE (column%, row% + height% - 3)-(column% + length%, row% + height% - 3), 0, B
 140: LINE (column%, row% + height% - 2)-(column% + length% + 2, row% + height%), 7, BF
 141: LINE (column% - 2, row% + height%)-(column% + length% + 2, row% + height%), 0, B
 142: LINE (column% - 2, row% + height% - 18)-(column%, row% + height% - 18), 0
 143: LINE (column% + length% - 2, row% + height% - 18)-(column% + length% + 2, row% + height% - 18), 0
 144: LINE (column% + 18, row% + height%)-(column% + 18, row% + height% - 2), 0
 145: LINE (column% + length% - 18, row% + height%)-(column% + length% - 18, row% + height% - 2), 0
 146: LINE (column% + 1, row% + 19)-(column% + length% - 1, row% + height% - 4), 7, BF
 147: END SUB
 148: 
5748276 [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 21:11:02