home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / mouse / mhse10 / boxed.bas next >
Encoding:
BASIC Source File  |  1994-01-15  |  4.4 KB  |  163 lines
  1. DECLARE SUB Button (text$, row, col, attr)
  2. DECLARE SUB CursorChoice (shape)
  3. DECLARE SUB Mouse (ax%, bx%, cx%, dx%)
  4. DECLARE SUB MousePaws (Squeeks)
  5. DECLARE SUB MouseQuit ()
  6. DECLARE SUB MouseSpeed (speed)
  7. DECLARE SUB MouseStart ()
  8. DECLARE SUB MouseThere ()
  9. DECLARE SUB qwk (text$, row, col, attr)
  10. DECLARE SUB UnButton (text$, row, col, char, attr, battr)
  11. 'Example of how to set up  Boxed buttons to give them a 3-D look
  12.  
  13. ' $INCLUDE: 'C:\QB\QB.BI'
  14. ' Above statement vital to operation of program; path setting up to you
  15.  
  16. LOCATE , , 0              'control hard cursor
  17. qwk STRING$(2000, 178), 1, 1, 95   'background setting
  18. MouseQuit                 'erase cursor from any lingering mouse operations
  19. Mouse ax%, bx%, cx%, dx%  'call the mouse
  20. MouseThere                'check to see if mouse present
  21. MouseStart                'if present, start mouse operation
  22. MouseSpeed 15             'mouse movement setting
  23. CursorChoice 20            'select text cursor shape; 20 = ASCII 254
  24.  
  25.  
  26. Button "BUTTON 1", 5, 22, 31    'button setups
  27. Button "EXIT ", 5, 52, 31
  28.  
  29.  
  30. DO
  31. Mouse 3, bx%, cx%, dx%          'tap into Mouse 3 function
  32. IF bx% > 0 THEN                 'button control
  33. Column = cx% / 8 + 1            'column control
  34. row = dx% / 8 + 1               'row control
  35. END IF
  36. IF row = 5 THEN                 'limit control to row 5
  37. SELECT CASE Column
  38. CASE 21 TO 30                   'limit control to columns 21 to 30
  39. UnButton "BUTTON 1", 5, 22, 178, 31, 95
  40. '                            |    |   |
  41. 'ASCII character of background    |   |
  42. '            button color attribute   |
  43. '            background color attribute
  44. END   'code to call other subs would be placed here
  45.  
  46. CASE 51 TO 57                     'limit control to columns 51 to 57
  47. UnButton "EXIT ", 5, 52, 178, 31, 95
  48. '                         |    |   |
  49. 'ASCII character of background |   |
  50. '                              |   |
  51. '         button color attribute   |
  52. '                                  |
  53. '         background color attribute
  54. END
  55. END SELECT
  56. END IF
  57. LOOP UNTIL INKEY$ = CHR$(27)  'escape route
  58.  
  59.  
  60.  
  61. SUB Button (text$, row, col, attr)
  62. qwk "┌" + STRING$(LEN(text$) + 2, "─") + "┐", row - 1, col, attr
  63. qwk "│" + SPACE$(1) + text$ + SPACE$(1) + "│", row, col, attr
  64. qwk "└" + STRING$(LEN(text$) + 2, "─") + "┘", row + 1, col, attr
  65. qwk STRING$(LEN(text$) + 2, 220), row + 1, col + 1, attr
  66. END SUB
  67.  
  68. SUB CursorChoice (shape)
  69. SELECT CASE shape
  70. CASE 0: Mouse 10, 0, &H0, &H7700
  71. CASE 1: MouseChar = 4
  72. CASE 2: MouseChar = 8
  73. CASE 3: MouseChar = 15
  74. CASE 4: MouseChar = 23
  75. CASE 5: MouseChar = 24
  76. CASE 6: MouseChar = 25
  77. CASE 7: MouseChar = 26
  78. CASE 8: MouseChar = 27
  79. CASE 9: MouseChar = 35
  80. CASE 10: MouseChar = 36
  81. CASE 11: MouseChar = 48
  82. CASE 12: MouseChar = 63
  83. CASE 13: MouseChar = 88
  84. CASE 14: MouseChar = 178
  85. CASE 15: MouseChar = 197
  86. CASE 16: MouseChar = 220
  87. CASE 17: MouseChar = 237
  88. CASE 18: MouseChar = 239
  89. CASE 19: MouseChar = 251
  90. CASE 20: MouseChar = 254
  91. END SELECT
  92. dx% = &H7000 + MouseChar
  93. Mouse 10, 0, &H0, dx%
  94. END SUB
  95.  
  96. SUB Mouse (ax%, bx%, cx%, dx%)
  97. DIM inregs AS RegType, outregs AS RegType
  98. inregs.ax = ax%
  99. inregs.bx = bx%
  100. inregs.cx = cx%
  101. inregs.dx = dx%
  102. INTERRUPT &H33, inregs, outregs
  103. ax% = outregs.ax
  104. bx% = outregs.bx
  105. cx% = outregs.cx
  106. dx% = outregs.dx
  107. END SUB
  108.  
  109. SUB MousePaws (Squeeks)
  110. DEF SEG = 0
  111. FOR I = 1 TO Squeeks
  112. Now = PEEK(&H46C)
  113. DO: LOOP WHILE PEEK(&H46C) = Now
  114. NEXT
  115. END SUB
  116.  
  117. SUB MouseQuit
  118. Mouse 0, bx%, cx%, dx%
  119. END SUB
  120.  
  121. SUB MouseSpeed (speed)
  122. cx% = speed
  123. dx% = speed * 2
  124. Mouse 15, 0, cx%, dx%
  125. END SUB
  126.  
  127. SUB MouseStart
  128. Mouse 1, 0, 0, 0
  129. END SUB
  130.  
  131. SUB MouseThere
  132. ax% = 0
  133. Mouse ax%, bx%, cx%, dx%
  134. IF NOT ax% THEN
  135. CLS
  136. qwk " Mouse not installed -- Press any key to exit program ", 10, 15, 78
  137. WHILE INKEY$ = "": WEND
  138. SYSTEM
  139. END IF
  140. END SUB
  141.  
  142. SUB qwk (text$, row, col, attr)
  143. DIM ireg AS RegTypeX, oreg AS RegTypeX
  144. ireg.ax = &H1300
  145. ireg.bx = attr
  146. ireg.cx = LEN(text$)
  147. ireg.dx = (row - 1) * 256 + (col - 1)
  148. ireg.bp = SADD(text$)
  149. ireg.es = VARSEG(text$)
  150. INTERRUPTX &H10, ireg, oreg
  151. END SUB
  152.  
  153. SUB UnButton (text$, row, col, char, attr, battr)
  154. qwk SPACE$(1) + text$ + SPACE$(1), row, col + 1, 8
  155. qwk "└" + STRING$(LEN(text$) + 2, "─") + "┘", row + 1, col, attr
  156. qwk CHR$(char), row + 2, col + LEN(text$) + 4, battr
  157. MousePaws 12
  158. qwk STRING$(LEN(text$) + 2, 220), row + 1, col + 1, attr
  159. qwk SPACE$(1) + text$ + SPACE$(1), row, col + 1, attr
  160. MousePaws 12
  161. END SUB
  162.  
  163.