5748267 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n winbas2.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 16000)
  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% - 5, xx% - 5)-(yy% + syy% + 5, xx% + sxx% + 5), behind: tmpx = xx%: tmpy = yy%
  40: wndow syy%, sxx%, xx%, yy%
  41: MouseShow
  42: ON ERROR GOTO erro
  43: 1 MouseStatus lb%, rb%, y%, x%
  44: IF clk = 1 THEN LOCATE 2, 1: PRINT "Menu": SLEEP 1: LOCATE 2, 1: PRINT "      ": clk = 0: END: GOTO 1
  45: IF clk = 2 THEN xx% = x%: yy% = y%: clk = 0: syy% = ssy%: sxx% = ssx%: PUT (tmpy - 5, tmpx - 5), behind, PSET: GET (yy% - 5, xx% - 5)-(yy% + syy% + 5, xx% + sxx% + 5), behind: tmpx = xx%: tmpy = yy%: wndow syy%, sxx%, x%, y%
  46: LOCATE 1, 1: PRINT y%; x%; lb%; rb%; tmpx; tmpy
  47: 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
  48: GOTO 1
  49: erro:
  50: RESUME NEXT
  51: 
  52: SUB ChkClk (ys%, ye%, xs%, xe%, x%, y%, dl)
  53: 21 FOR i = ys% TO ye%
  54: IF y% = i THEN GOTO 22
  55: NEXT i
  56: EXIT SUB
  57: 22 FOR i = xs% TO xe%
  58: IF x% = i THEN LOCATE 2, 1: clk = dl
  59: NEXT i
  60: END SUB
  61: 
  62: SUB MouseDriver (ax%, bx%, cx%, dx%)
  63:   DEF SEG = VARSEG(Mouse$)
  64:   Mouse% = SADD(Mouse$)
  65:   CALL Absolute(ax%, bx%, cx%, dx%, Mouse%)
  66: END SUB
  67: 
  68: SUB MouseHide
  69:  ax% = 2
  70:  MouseDriver ax%, 0, 0, 0
  71: END SUB
  72: 
  73: FUNCTION MouseInit%
  74:   ax% = 0
  75:   MouseDriver ax%, 0, 0, 0
  76:   MouseInit% = ax%
  77: END FUNCTION
  78: 
  79: SUB MousePut (x%, y%)
  80:   ax% = 4
  81:   cx% = x%
  82:   dx% = y%
  83:   MouseDriver ax%, 0, cx%, dx%
  84: END SUB
  85: 
  86: SUB MouseRange (x1%, y1%, x2%, y2%)
  87:   ax% = 7
  88:   cx% = x1%
  89:   dx% = x2%
  90:   MouseDriver ax%, 0, cx%, dx%
  91:   ax% = 8
  92:   cx% = y1%
  93:   dx% = y2%
  94:   MouseDriver ax%, 0, cx%, dx%
  95: END SUB
  96: 
  97: SUB MouseShow
  98:   ax% = 1
  99:   MouseDriver ax%, 0, 0, 0
 100: END SUB
 101: 
 102: SUB MouseStatus (lb%, rb%, xMouse%, yMouse%)
 103:   ax% = 3
 104:   MouseDriver ax%, bx%, cx%, dx%
 105:   lb% = ((bx% AND 1) <> 0)
 106:   rb% = ((bx% AND 2) <> 0)
 107:   xMouse% = cx%
 108:   yMouse% = dx%
 109: END SUB
 110: 
 111: SUB Pause
 112:   'This sub used for demo, not needed for mouse calls
 113:   PRINT "Press any key to continue..."
 114:   G$ = INPUT$(1)
 115:   PRINT
 116: END SUB
 117: 
 118: SUB wndow (length%, height%, row%, column%)
 119: LINE (column%, row%)-(column% + length%, row% + height%), 0, B
 120: FOR i% = 1 TO 2
 121: row% = row% + 1: column% = column% + 1: height% = height% - 1: length% = length% - 1
 122: LINE (column%, row%)-(column% + length%, row%), 7
 123: LINE (column%, row%)-(column%, row% + height%), 7
 124: NEXT i%
 125: row% = row% + 1: column% = column% + 1: height% = height% - 1: length% = length% - 1
 126: LINE (column%, row%)-(column% + length%, row%), 0
 127: LINE (column%, row%)-(column%, row% + height%), 0
 128: LINE (column%, row%)-(column% + 18, row% + 18), 7, BF
 129: LINE (column%, row%)-(column% + 18, row% + 18), 0, B
 130: LINE (column% + 18, row% - 2)-(column% + 18, row% + 5), 0
 131: LINE (column% - 2, row% + 18)-(column% + 5, row% + 18), 0
 132: LINE (column% + 5, row% + 7)-(column% + 13, row% + 9), 15, BF: LINE (column% + 5, row% + 7)-(column% + 13, row% + 9), 0, B
 133: LINE (column% + 14, row% + 7)-(column% + 14, row% + 9), 8
 134: LINE (column% + 6, row% + 10)-(column% + 14, row% + 10), 8, B
 135: LINE (column% + 18, row%)-(column% + length%, row% + 18), 1, BF
 136: LINE (column% + 18, row%)-(column% + length%, row% + 18), 0, B
 137: LINE (column% + length%, row% - 3)-(column% + length% + 2, row% + height%), 7, BF
 138: LINE (column% + length%, row% - 3)-(column% + length% + 3, row% + height%), 0, B
 139: LINE (column% + length%, row% - 2)-(column% + length%, row% - 1), 7
 140: LINE (column% + length% - 18, row% - 2)-(column% + length% - 18, row% - 1), 0
 141: LINE (column% + length%, row% + 18)-(column% + length% + 2, row% + 18), 0
 142: LINE (column%, row% + height% - 3)-(column% + length%, row% + height% - 3), 0, B
 143: LINE (column%, row% + height% - 2)-(column% + length% + 2, row% + height%), 7, BF
 144: LINE (column% - 2, row% + height%)-(column% + length% + 2, row% + height%), 0, B
 145: LINE (column% - 2, row% + height% - 18)-(column%, row% + height% - 18), 0
 146: LINE (column% + length% - 2, row% + height% - 18)-(column% + length% + 2, row% + height% - 18), 0
 147: LINE (column% + 18, row% + height%)-(column% + 18, row% + height% - 2), 0
 148: LINE (column% + length% - 18, row% + height%)-(column% + length% - 18, row% + height% - 2), 0
 149: LINE (column% + 1, row% + 19)-(column% + length% - 1, row% + height% - 4), 7, BF
 150: END SUB
 151: 
5748268 [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:04