home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
PROG_BAS
/
MOSNHOS.ZIP
/
HOTSPOT.BAS
< prev
next >
Wrap
BASIC Source File
|
1994-01-15
|
5KB
|
182 lines
DECLARE SUB Button1 ()
DECLARE SUB CoolSpot (text$, row, col, attr)
DECLARE SUB CursorChoice (shape)
DECLARE SUB HotSpot (text$, row, col, attr)
DECLARE SUB Mouse (ax%, bx%, cx%, dx%)
DECLARE SUB MouseHide ()
DECLARE SUB MousePaws (Squeeks)
DECLARE SUB MouseQuit ()
DECLARE SUB MouseStart ()
DECLARE SUB MouseThere ()
DECLARE SUB MouseSpeed (speed)
DECLARE SUB QWK (text$, row, col, attr)
DECLARE SUB Demo ()
' $INCLUDE: 'C:\QB\QB.BI'
' Above statement vital to operation of program; path setting up to you
LOCATE , , 0 'control hard cursor
MouseQuit 'erase cursor from any lingering mouse operations
Mouse ax%, bx%, cx%, dx% 'call the mouse
MouseThere 'check to see if mouse present
MouseStart 'if present, start mouse operation
MouseSpeed 15 'mouse movement setting
CursorChoice 0 'select text cursor shape; 0 = default cursor
Demo ' call sub
SUB Button1
' Demonstration of passing mouse control from one sub to another
QWK "╔" + STRING$(11, 205) + "╗", 5, 3, 78
FOR x = 1 TO 8
QWK "║" + SPACE$(11) + "║", x + 5, 3, 78
QWK "╚" + STRING$(11, 205) + "╝", 13, 3, 78
NEXT
QWK "CLICK", 7, 5, 78
QWK "ANYWHERE", 8, 5, 78
QWK "INSIDE", 9, 5, 78
QWK "THIS BOX", 10, 5, 78
QWK "TO EXIT", 11, 5, 78
DO
Mouse 3, bx%, cx%, dx% 'tap into Mouse 3 function
IF bx% > 0 THEN 'button control
column = cx% / 8 + 1 'column control
row = dx% / 8 + 1 'row control
END IF
IF row > 5 AND row < 13 THEN 'control over a range of rows
SELECT CASE column
CASE 3 TO 15 'control limited to cols 3 to 15
Demo 'call the sub
END SELECT
END IF
LOOP UNTIL INKEY$ = CHR$(27)
END SUB
SUB CoolSpot (text$, row, col, attr)
QWK CHR$(17) + "■" + CHR$(16), row, col, 8
MousePaws 15
QWK CHR$(17) + "■" + CHR$(16), row, col, attr
MousePaws 15
END SUB
SUB CursorChoice (shape)
SELECT CASE shape
CASE 0: Mouse 10, 0, &H0, &H7700
CASE 1: MouseChar = 4
CASE 2: MouseChar = 8
CASE 3: MouseChar = 15
CASE 4: MouseChar = 23
CASE 5: MouseChar = 24
CASE 6: MouseChar = 25
CASE 7: MouseChar = 26
CASE 8: MouseChar = 27
CASE 9: MouseChar = 35
CASE 10: MouseChar = 36
CASE 11: MouseChar = 48
CASE 12: MouseChar = 63
CASE 13: MouseChar = 88
CASE 14: MouseChar = 178
CASE 15: MouseChar = 197
CASE 16: MouseChar = 220
CASE 17: MouseChar = 237
CASE 18: MouseChar = 239
CASE 19: MouseChar = 251
CASE 20: MouseChar = 254
END SELECT
dx% = &H7000 + MouseChar
Mouse 10, 0, &H0, dx%
END SUB
SUB Demo
CLS
MouseQuit 'erase any lingering cursors
QWK STRING$(2000, 0), 1, 1, 33 'window dressing
QWK "╔" + STRING$(14, 205) + "╗", 5, 25, 120 'box around hotspot buttons
FOR x = 1 TO 8
QWK "║" + SPACE$(14) + "║", x + 5, 25, 120
NEXT
QWK "╚" + STRING$(14, 205) + "╝", 14, 25, 120
HotSpot "BUTTON 1", 7, 27, 31 'button settings
HotSpot "EXIT ", 11, 27, 31
MouseStart 'start mouse operations
DO
Mouse 3, bx%, cx%, dx% 'tap into Mouse 3 function
IF bx% > 0 THEN 'button control
column = cx% / 8 + 1 'column control
row = dx% / 8 + 1 'row control
END IF
SELECT CASE column
CASE 27 TO 29
IF row = 7 THEN CoolSpot "BUTTON 1", 7, 27, 78: Button1 'call a sub
IF row = 11 THEN CoolSpot "EXIT", 11, 27, 78: END 'exit to SYSTEM
END SELECT
LOOP UNTIL INKEY$ = CHR$(27) 'escape route
END SUB
SUB HotSpot (text$, row, col, attr)
QWK CHR$(17) + "■" + CHR$(16), row, col, 78
QWK SPACE$(1) + text$, row, col + 3, attr
END SUB
SUB Mouse (ax%, bx%, cx%, dx%)
DIM inregs AS RegType, outregs AS RegType
inregs.ax = ax%
inregs.bx = bx%
inregs.cx = cx%
inregs.dx = dx%
INTERRUPT &H33, inregs, outregs
ax% = outregs.ax
bx% = outregs.bx
cx% = outregs.cx
dx% = outregs.dx
END SUB
SUB MouseHide
Mouse 2, bx%, cx%, dx%
END SUB
SUB MousePaws (Squeeks)
DEF SEG = 0
FOR I = 1 TO Squeeks
Now = PEEK(&H46C)
DO: LOOP WHILE PEEK(&H46C) = Now
NEXT
END SUB
SUB MouseQuit
Mouse 0, bx%, cx%, dx%
END SUB
SUB MouseSpeed (speed)
cx% = speed
dx% = speed * 2
Mouse 15, 0, cx%, dx%
END SUB
SUB MouseStart
Mouse 1, 0, 0, 0
END SUB
SUB MouseThere
ax% = 0
Mouse ax%, bx%, cx%, dx%
IF NOT ax% THEN
CLS
QWK " Mouse not installed -- Press any key to exit program ", 10, 15, 78
WHILE INKEY$ = "": WEND
SYSTEM
END IF
END SUB
SUB QWK (text$, row, col, attr)
DIM ireg AS RegTypeX, oreg AS RegTypeX
ireg.ax = &H1300
ireg.bx = attr
ireg.cx = LEN(text$)
ireg.dx = (row - 1) * 256 + (col - 1)
ireg.bp = SADD(text$)
ireg.es = VARSEG(text$)
INTERRUPTX &H10, ireg, oreg
END SUB