Power-Programmierung/CD1.mdf/basic/library/qb_pds/mouse/mhse10/features.bas

BASIC Source File | 1994-01-17 | 6.2 KB | 267 lines

DECLARE SUB BoxDraw (text$, length!, deep!, row!, col!, attr!)
DECLARE SUB Button (text$, row, col, attr)
DECLARE SUB CursorChoice (shape)
DECLARE SUB Features ()
DECLARE SUB Mouse (ax%, bx%, cx%, dx%)
DECLARE SUB MouseHide ()
DECLARE SUB MousePaws (Squeeks)
DECLARE SUB MousePlace (row%, col%)
DECLARE SUB MouseQuit ()
DECLARE SUB MouseSpeed (speed)
DECLARE SUB MouseStart ()
DECLARE SUB MouseThere ()
DECLARE SUB MouseTrap (ulc%, lrc%, ulr%, lrr%)
DECLARE SUB Placer ()
DECLARE SUB qwk (text$, row, col, attr)
DECLARE SUB Speeder ()
DECLARE SUB Trap ()
DECLARE SUB UnButton (text$, row, col, char, attr, battr)
' $INCLUDE: 'C:\QB\QB.BI'
' Above statement vital to operation of program; path setting up to you

LOCATE , , 0              'control hardware cursor
MouseQuit                 'erase soft 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

Features                  'call the sub

SUB BoxDraw (text$, length, deep, row, col, attr)
qwk "┌" + STRING$(length, "─") + "┐", row, col, attr
FOR x = 1 TO deep
qwk "│" + SPACE$(length) + "│", x + row, col, attr
NEXT
qwk text$, row + 1, col + 1, attr
qwk "└" + STRING$(length, "─") + "┘", row + deep, col, attr
END SUB

SUB Button (text$, row, col, attr)
qwk "┌" + STRING$(LEN(text$) + 2, "─") + "┐", row - 1, col, attr
qwk "│" + SPACE$(1) + text$ + SPACE$(1) + "│", row, col, attr
qwk "└" + STRING$(LEN(text$) + 2, "─") + "┘", row + 1, col, attr
qwk STRING$(LEN(text$) + 2, 220), row + 1, col + 1, attr
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 Features
MouseQuit                 'erase cursor from any lingering mouse operations
MouseHide
MouseStart                'if present, start mouse operation
CursorChoice 2            'select text cursor shape; 20 = ASCII 254
qwk STRING$(80, 177), 1, 1, 47
FOR x = 1 TO 23
qwk "▒" + SPACE$(78) + "▒", x + 1, 1, 47
NEXT
qwk STRING$(80, 177), 24, 1, 47

Button "MOUSEPLACE", 4, 12, 31
Button "MOUSESPEED", 4, 29, 31
Button "MOUSETRAP", 4, 46, 31
Button "EXIT", 4, 62, 31
MouseStart
char = 0
attr = 31
battr = 47
DO
Mouse 3, bx%, cx%, dx%
IF bx% > 0 THEN
column = cx% / 8 + 1
row = dx% / 8 + 1
END IF
IF row = 4 THEN
SELECT CASE column
CASE 11 TO 22
UnButton "MOUSEPLACE", 4, 12, char, attr, battr
Placer
CASE 28 TO 39
UnButton "MOUSESPEED", 4, 29, char, attr, battr
Speeder
CASE 45 TO 55
UnButton "MOUSETRAP", 4, 46, char, attr, battr
Trap
CASE 61 TO 66
UnButton "EXIT", 4, 62, char, attr, battr
END
END SELECT
END IF
LOOP UNTIL INKEY$ = CHR$(27)
END
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 MousePlace (row%, col%)
Mouse 4, bx%, row%, col%
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 MouseTrap (ulc%, lrc%, ulr%, lrr%)
Mouse 7, bx%, ulc%, ulr%
Mouse 8, bx%, lrc%, lrr%
END SUB

SUB Placer
MouseQuit
BoxDraw "", 40, 7, 13, 20, 0
MouseStart
MousePlace 310, 105
qwk " CURSOR PLACED AT ROW 13, COLUMN 35 ", 16, 22, 78
qwk " CLICK INSIDE DARK AREA TO EXIT ", 18, 24, 78
DO
Mouse 3, bx%, cx%, dx%
IF bx% > 0 THEN
column = cx% / 8 + 1
row = dx% / 8 + 1
END IF
IF row > 11 AND row < 21 THEN
SELECT CASE column
CASE 20 TO 60
Features
END SELECT
END IF
LOOP
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

SUB Speeder
BoxDraw " Mouse Speed = 10 ", 18, 2, 10, 4, 78
BoxDraw " Mouse Speed = 25 ", 18, 2, 10, 30, 78
BoxDraw " Mouse Speed = 50 ", 18, 2, 10, 56, 78
qwk "  CLICK INSIDE BOX TO CHANGE SPEED  ", 16, 25, 31
qwk "    PRESS ESC TO EXIT MOUSE SPEED   ", 17, 25, 31
DO
Mouse 3, bx%, cx%, dx%
IF bx% > 0 THEN
column = cx% / 8 + 1
row = dx% / 8 + 1
END IF
IF row > 9 AND row < 13 THEN
SELECT CASE column
CASE 4 TO 23
MouseSpeed 10
CASE 30 TO 49
MouseSpeed 25
CASE 56 TO 75
MouseSpeed 50
END SELECT
END IF
LOOP UNTIL INKEY$ = CHR$(27)
Features
END SUB

SUB Trap
BoxDraw "", 70, 12, 7, 5, 120
BoxDraw " CLICK TO TRAP CURSOR INSIDE BIG BOX; ESC TO EXIT ", 50, 2, 12, 15, 31
DO
Mouse 3, bx%, cx%, dx%
IF bx% > 0 THEN
column = cx% / 8 + 1
row = dx% / 8 + 1
END IF
IF row > 6 AND row < 20 THEN
SELECT CASE column
CASE 5 TO 75
MouseTrap 600, 53, 33, 150
END SELECT
END IF
LOOP UNTIL INKEY$ = CHR$(27)
Features
END SUB

SUB UnButton (text$, row, col, char, attr, battr)
qwk SPACE$(1) + text$ + SPACE$(1), row, col + 1, 8
qwk "└" + STRING$(LEN(text$) + 2, "─") + "┘", row + 1, col, attr
qwk CHR$(char), row + 2, col + LEN(text$) + 4, battr
MousePaws 12
qwk STRING$(LEN(text$) + 2, 220), row + 1, col + 1, attr
qwk SPACE$(1) + text$ + SPACE$(1), row, col + 1, attr
MousePaws 12
END SUB