home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1995 September / Image.iso / pcplus / handson / wilfw107 / buttons2.bas next >
Encoding:
BASIC Source File  |  1995-06-22  |  3.7 KB  |  215 lines
  1. DECLARE SUB BasicInt (IntType AS INTEGER)
  2. '
  3. ' Demonstration of Mouse-controlled Buttons
  4. '
  5. '++++++++++++++++++++++++
  6. ' NEW CODE
  7. DECLARE SUB InPath (Field$)
  8. DIM SHARED BAD$
  9. ON ERROR GOTO RESUMENEXT
  10. RESUMENEXT:
  11.  IF ERR = 255 THEN
  12.   CLS
  13.   BEEP
  14.   PRINT "Cannot find BASICINT.OVL"
  15.   SLEEP
  16.   SYSTEM
  17.  END IF
  18.  IF ERR THEN
  19.   BAD$ = "X"
  20.   RESUME NEXT
  21.  END IF
  22. ' END NEW CODE
  23. '++++++++++++++++++++++++
  24. TYPE REGISTERS
  25.  AX AS INTEGER
  26.  BX AS INTEGER
  27.  CX AS INTEGER
  28.  DX AS INTEGER
  29.  DS AS INTEGER
  30.  SI AS INTEGER
  31.  ES AS INTEGER
  32.  DI AS INTEGER
  33.  FL AS INTEGER
  34. END TYPE
  35. DIM SHARED REGS AS REGISTERS
  36.  
  37. '*************************************
  38. SCREEN 9
  39. COLOR 8, 7
  40. CLS
  41. '************************
  42.  
  43. Choice% = 1
  44. GOSUB PaintButtons
  45.  
  46.  
  47.  
  48.  
  49. ' test for presence of a mouse
  50.  
  51. REGS.AX = 0
  52. CALL BasicInt(&H33)
  53. IF REGS.AX THEN
  54.  Mouse% = 1
  55.  REGS.AX = 4
  56.  REGS.CX = 315
  57.  REGS.DX = 35
  58.  CALL BasicInt(&H33)
  59.  REGS.AX = 1
  60.  CALL BasicInt(&H33)
  61. END IF
  62.  
  63. ' handle both keys and mouse clicks
  64.  
  65. WHILE Choice% <> 7
  66.  x$ = ""
  67.  WHILE LEN(x$) = 0
  68.   Counter! = TIMER
  69.   WHILE LEN(x$) = 0
  70.    x$ = INKEY$
  71.    IF Mouse% THEN
  72.     REGS.AX = 3
  73.     CALL BasicInt(&H33)
  74.     IF (REGS.BX AND 1) THEN
  75.      IF REGS.CX > 300 AND REGS.CX < 331 THEN
  76.       IF (REGS.DX MOD 42) > 21 THEN
  77.        OldChoice% = Choice%
  78.        Choice% = 1 + INT(REGS.DX / 42)
  79.        IF Choice% = OldChoice% THEN
  80.         IF TIMER - Counter! < .3 THEN
  81.          IF NoGap% = 0 THEN
  82.           x$ = CHR$(13)
  83.          END IF
  84.         END IF
  85.        ELSE
  86.         GOSUB PaintButtons
  87.        END IF
  88.        Counter! = TIMER
  89.        NoGap% = 1
  90.       END IF
  91.      END IF
  92.     ELSE
  93.      NoGap% = 0
  94.     END IF
  95.    END IF
  96.   WEND
  97.   IF LEN(x$) = 2 THEN
  98.    IF RIGHT$(x$, 1) = "H" THEN
  99.     Choice% = Choice% - 1
  100.    END IF
  101.    IF RIGHT$(x$, 1) = "P" THEN
  102.     Choice% = Choice% + 1
  103.    END IF
  104.    IF Choice% = 0 THEN Choice% = 1
  105.    IF Choice% = 8 THEN Choice% = 7
  106.    GOSUB PaintButtons
  107.   END IF
  108.   IF x$ <> CHR$(13) THEN x$ = ""
  109.  WEND
  110.  LINE (150, 0)-(250, 349), 0, BF
  111.  LINE (150, 42 * Choice% - 18)-(250, 42 * Choice% + 4), 12, BF
  112. WEND
  113.  
  114. IF Mouse% THEN
  115.  REGS.AX = 2
  116.  CALL BasicInt(&H33)
  117. END IF
  118.  
  119. TimeStart! = TIMER
  120. WHILE TIMER - TimeStart! < 2
  121. WEND
  122.  
  123.  
  124.  
  125. STOP
  126.  
  127.  
  128.  
  129.  
  130. '************************
  131. ' Subroutine to paint the buttons
  132. '
  133. PaintButtons:
  134.  IF Mouse% THEN
  135.   REGS.AX = 2
  136.   CALL BasicInt(&H33)
  137.  END IF
  138.  FOR i% = 1 TO 7
  139.   LOCATE 3 * i%, 39
  140.   IF i% = Choice% THEN Hue% = 15 ELSE Hue% = 8
  141.  
  142. ' Sculpted buttons:
  143. '   OFF = grey on north and west, +white on south and east
  144. '   ON  = grey on south and east, +white on north and west
  145.  
  146.   COLOR 8
  147.   PRINT i%
  148.   LINE (300, 42 * i% - 18)-(329, 42 * i% - 18), (Hue% XOR 7)
  149.   LINE (300, 42 * i% - 18)-(300, 42 * i% + 4), (Hue% XOR 7)
  150.   LINE (330, 42 * i% - 18)-(330, 42 * i% + 4), Hue%
  151.   LINE (301, 42 * i% + 4)-(330, 42 * i% + 4), Hue%
  152.  
  153.  NEXT
  154.  IF Mouse% THEN
  155.   REGS.AX = 1
  156.   CALL BasicInt(&H33)
  157.  END IF
  158.  
  159.  
  160.  
  161.  RETURN
  162.  
  163. SUB BasicInt (IntType AS INTEGER) STATIC
  164.  
  165.  
  166. DIM ASM%(54)
  167. DEF SEG = VARSEG(ASM%(0))
  168.  
  169. IF ASM%(1) = 0 THEN
  170. '++++++++++++++++++++++++
  171. ' NEW CODE
  172.  
  173.  Field$ = "BASICINT.OVL"
  174.  CALL InPath(Field$)
  175.  IF Field$ = "" THEN ERROR 255
  176.  BLOAD Field$, VARPTR(ASM%(0))
  177.  
  178. ' END NEW CODE
  179. '++++++++++++++++++++++++
  180. END IF
  181.  
  182. CALL ABSOLUTE(REGS, IntType, VARPTR(ASM%(0)))
  183.  
  184. DEF SEG
  185.  
  186. END SUB
  187.  
  188. SUB InPath (Field$)
  189.  
  190.  x$ = ".;" + ENVIRON$("PATH")
  191.  IF RIGHT$(x$, 1) <> ";" THEN x$ = x$ + ";"
  192.  i% = 1
  193.  DO
  194.   J% = INSTR(i%, x$, ";")
  195.   IF J% THEN
  196.    Y$ = UCASE$(MID$(x$, i%, J% - i%))
  197.    i% = J% + 1
  198.    IF RIGHT$(Y$, 1) <> "\" THEN Y$ = Y$ + "\"
  199.    F$ = Y$ + Field$
  200.    BAD$ = ""
  201.    OPEN "I", 1, F$
  202.    IF BAD$ = "" THEN
  203.     CLOSE 1
  204.     EXIT DO
  205.    END IF
  206.    F$ = ""
  207.   END IF
  208.  LOOP WHILE J%
  209.  BAD$ = ""
  210.  Field$ = F$
  211.  
  212.  
  213. END SUB
  214.  
  215.