home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-387-Vol-3of3.iso
/
s
/
svgamous.zip
/
MOUSE2.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-11-07
|
12KB
|
386 lines
'DECLARE SUB MouseCD (func%)
'DECLARE SUB MouseFunc (func%, IM AS ANY, OM AS ANY)
'
'DEFINT A-Z
SUB MouseCD (func)
'QB/EVGFX mouse cursor driver
'-- This routine requires DIM SHARED MouseBuffer(0 TO 128) AS INTEGER
'-- in the main module.
'This routine replaces MouseFunc() functions 1, 2, and 3. You cannot
'use MOUSE.COM/.SYS functions 1 and 2 (show & hide). You could use
'their func 3 (get cursor & button status) but you might as well use
'the one included here since it handles showing the mouse cursor.
'Note: The current MouseFunc() SUB is included with this file group.
'It must be used in conjunction with MouseCD(). Make calls to MouseFunc()
'as normal. Funcs 1-3 will be transfered here. This isn't all that fast
'but it's the fastest (and currently, only) way I know how to do it.
'Note: To create the mouse cursor a new GUISYS14.OBJ module is included.
'To update QBEVGFX3.LIB do the following:
'
'C>lib qbevgfx3 -+guisys14;
'Note: See the note on reinstating the default font below
STATIC CalledBefore AS INTEGER
STATIC mouseOn AS INTEGER
STATIC lastX AS INTEGER
STATIC lastY AS INTEGER
IF NOT CalledBefore THEN
lastX = -1
lastY = -1
END IF
SELECT CASE func
CASE 1
mouseOn = -1
CASE 2
mouseOn = 0
IF CalledBefore THEN
vseg = VARSEG(MouseBuffer(0))
voff = VARPTR(MouseBuffer(0))
PUTBLOCK 0, lastX, lastY, vseg, voff
CalledBefore = NOT CalledBefore
END IF
CASE 3
xreg.ax = 3
INTERRUPTX &H33, xreg, xreg
OM.bx = xreg.bx
OM.cx = xreg.cx
OM.dx = xreg.dx
IF mouseOn THEN
IF lastX <> OM.cx OR lastY <> OM.dx THEN
vseg = VARSEG(MouseBuffer(0))
voff = VARPTR(MouseBuffer(0))
IF CalledBefore THEN
PUTBLOCK 0, lastX, lastY, vseg, voff
ELSE
CalledBefore = -1
END IF
GETBLOCK 15, OM.cx, OM.dx, (OM.cx + 15), (OM.dx + 15), vseg, voff
strg1$ = CHR$(158) + CHR$(159) 'screen mask
strg2$ = CHR$(156) + CHR$(157) 'cursor mask
DGSTR.Length = 2
DGSTR.addr = VARPTR(DGSTR.strg)
FONTGUI14
DGSTR.strg = strg1$
nx = DRAWSTR(8, VARPTR(DGSTR), OM.cx, OM.dx, 15, 0, 8)
DGSTR.strg = strg2$
nx = DRAWSTR(24, VARPTR(DGSTR), OM.cx, OM.dx, 15, 0, 8)
'----------------------------------------------
'This should be changed to your default font.
'You may want to keep a running status of the current font
'in use and select the appropriate font to reinstate.
FONTSYS16
lastX = OM.cx
lastY = OM.dx
END IF
END IF
CASE ELSE
END SELECT
END SUB
SUB MouseFunc (func, IM AS MouseTYPE, OM AS MouseTYPE)
'mouse function routine
IF IsMouse = 0 AND func > 0 THEN EXIT SUB
IF func >= 1 AND func <= 3 THEN
MouseCD func
EXIT SUB
END IF
xreg.es = -1 'IM.ax used to pass ES segment register if needed
SELECT CASE func
CASE 1 'SHOW CURSOR
'set: nothing
'rtn: nothing
xreg.ax = 1
CASE 2 'HIDE CURSOR
'set: nothing
'rtn: nothing
xreg.ax = 2
CASE 0 'MOUSE RESET AND STATUS
'set: nothing
'rtn: ax=status (0=not found/not reset)
' bx=buttons
DEF SEG = 0
ms& = 256& * PEEK(207) + PEEK(206)
IF ms& > 32767 THEN ms& = ms& - 65536
MouseSeg = ms&
MouseOff = PEEK(204) + 256 * PEEK(205)
DEF SEG = MouseSeg
IsMouse = (MouseSeg <> 0 OR MouseOff <> 0) AND PEEK(MouseOff) <> &HCF
DEF SEG
IF IsMouse THEN
xreg.ax = 0
ELSE OM.ax = 0
EXIT SUB
END IF
CASE 3 'GET BUTTON STATUS AND MOUSE POS
'set: nothing
'rtn: bx=button status
' cx=horz cursor coor
' dx=vert cursor coor
xreg.ax = 3
CASE 4 'SET MOUSE CURSOR POS
'set: cx=new horz cursor pos
' dx=new vert cursor pos
'rtn: nothing
xreg.ax = 4
xreg.cx = IM.cx
xreg.dx = IM.dx
CASE 5 'GET BUTTON PRESS INFO
'set: bx=button
'rtn: ax=button status
' bx=number of button presses
' cx=horz cursor coor at last press
' dx=vert cursor coor at last press
xreg.ax = 5
xreg.bx = IM.bx
CASE 6 'GET BUTTON RELEASE INFO
'set: bx=button
'rtn: ax=button status
' bx=number of button releases
' cx=horz cursor coor at last release
' dx=vert cursor coor at last release
xreg.ax = 6
xreg.bx = IM.bx
CASE 7 'SET MIN AND MAX HORZ CURSOR POS
'set: cx=min pos
' dx=max pos
'rtn: nothing
xreg.ax = 7
xreg.cx = IM.cx
xreg.dx = IM.dx
CASE 8 'SET MIN AND MAX VERT CURSOR POS
'set: cx=min pos
' dx=max pos
'rtn: nothing
xreg.ax = 8
xreg.cx = IM.cx
xreg.dx = IM.dx
CASE 9 'SET GRAPHICS CURSOR BLOCK
'set: ax=segment of cursor mask (NEVER DEFAULT)
' bx=horz cursor hot spot
' cx=vert cursor hot spot
' dx=pointer to screen
'rtn: nothing
xreg.ax = 9
xreg.bx = IM.bx
xreg.cx = IM.cx
xreg.dx = IM.dx
xreg.es = IM.ax
CASE 10 'SET TEXT CURSOR
'set: bx=cursor select
' cx=screen mask value or scan line start
' dx=cursor mask value or scan line start
'rtn: nothing
xreg.ax = 10
xreg.bx = IM.bx
xreg.cx = IM.cx
xreg.dx = IM.dx
CASE 11 'READ MOUSE MOTION COUNTERS
'set: nothing
'rtn: cx=horz mickey count
' dx=vert mickey count
xreg.ax = 11
CASE 12 'SET INTERRUPT SUBROUTINE CALL MASK AND ADDRESS
'set: ax=segment of subroutine (NEVER DEFAULT)
' cx=call mask.........bit 0-cursor pos changed
' dx=offset of subroutine '1-left button pressed
'rtn: nothing '2-left button released
xreg.ax = 12 '3-right button pressed
xreg.cx = IM.cx '4-right button released
xreg.dx = IM.dx '5-15 not used
xreg.es = IM.ax
CASE 13 'LIGHT PEN EMULATION MODE ON
'set: nothing
'rtn: nothing
xreg.ax = 13
CASE 14 'LIGHT PEN EMULATION MODE OFF
'set: nothing
'rtn: nothing
xreg.ax = 14
CASE 15 'SET MICKEY/PIXEL RATIO
'set: cx=horz mickey to pixel ratio
' dx=vert mickey to pixel ratio
'rtn: nothing
xreg.ax = 15
xreg.cx = IM.cx
xreg.dx = IM.dx
CASE 16 'CONDITIONAL OFF
'set: ax=left x (slightly different than regular calling registers)
' bx=upper y
' cx=right x
' dx=lower y
'rtn: nothing
xreg.ax = 16
xreg.cx = IM.ax
xreg.dx = IM.bx
xreg.si = IM.cx
xreg.di = IM.dx
CASE 17, 18
CASE 19 'SET DOUBLE-SPEED THRESHOLD
'set: dx=threshold speed in mickeys/seconds
'rtn: nothing
xreg.ax = 19
xreg.dx = IM.dx
CASE 20 'SWAP INTERRUPT ROUTINES
'set: ax=segment of subroutine (NEVER DEFAULT)
' cx=call mask (as in func 12 above)
' dx=offset of subroutine ***********************
'rtn: bx=segment of old subroutine *Rtn values valid only*
' cx=call mask of old subroutine *if previous interrupt*
' dx=offset of old subroutine *was created *
xreg.ax = 20 '***********************
xreg.cx = IM.cx
xreg.dx = IM.dx
xreg.es = IM.ax
INTERRUPTX &H33, xreg, xreg
OM.ax = 0
OM.bx = xreg.es
OM.cx = xreg.cx
OM.dx = xreg.dx
EXIT SUB
CASE 21 'GET MOUSE DRIVER STATE STORAGE REQUIREMENTS
'set: nothing
'rtn: bx=buffer size in bytes
xreg.ax = 21
CASE 22 'SAVE MOUSE DRIVER STATE
'set: ax=segment of buffer
' dx=offset of buffer
'rtn: nothing
xreg.ax = 22
xreg.dx = IM.dx
xreg.es = IM.ax
CASE 23 'RESTORE MOUSE DRIVER STATE
'set: ax=segment of buffer
' dx=offset of buffer
'rtn: nothing
xreg.ax = 23
xreg.dx = IM.dx
xreg.es = IM.ax
CASE 24 'SET ALTERNATE SUBROUTINE CALL MASK AND ADDRESS
'set: ax=segment of user subroutine
' cx=call mask.........bit 0-cursor pos changed
' dx=offset of subroutine '1-left button pressed
'rtn: ax=error status (-1) '2-left button released
xreg.ax = 24 '3-right button pressed
xreg.cx = IM.cx '4-right button released
xreg.dx = IM.dx '5-shift key down w/button
xreg.es = IM.ax '6-ctrl key down w/button
'7-alt key down w/button
'8-15 not used
CASE 25 'GET USER ALTERNATE INTERRUPT ADDRESS
'set: cx=user interrupt call mask
'rtn: ax=error status (-1)
' bx=segment of user subroutine
' cx=call mask of user interrupt
' dx=offset of subroutine
xreg.ax = 25
xreg.cx = IM.cx
CASE 26 'SET MOUSE SENSITIVITY
'set: bx=horz mickey sensitivity (0 to 100) these all
' cx=vert mickey sensitivity (0 to 100) have default
' dx=threshold for double speed (0 to 100) values=50
'rtn: nothing
xreg.ax = 26
xreg.bx = IM.bx
xreg.cx = IM.cx
xreg.dx = IM.dx
CASE 27 'GET MOUSE SENSITIVITY
'set: nothing
'rtn: bx=horz mickey sensitivity (0 to 100)
' cx=vert mickey sensitivity (0 to 100)
' dx=threshold for double speed (0 to 100)
xreg.ax = 27
CASE 28 'SET MOUSE INTERRUPT RATE (InPort mouse ONLY)
'set: bx=rate number (0 (0/sec) to 4 (200/sec))
'rtn: nothing
xreg.ax = 28
xreg.bx = IM.bx
CASE 29 'SET CRT PAGE NUMBER
'set: bx=CRT page for mouse cursor display
'rtn: nothing
xreg.ax = 29
xreg.bx = IM.bx
CASE 30 'GET CRT PAGE NUMBER
'set: nothing
'rtn: bx=CRT page for current mouse cursor display
xreg.ax = 30
CASE 31 'DISABLE MOUSE DRIVER
'set: nothing
'rtn: ax=error status (-1)
' bx=segment of old int 33h
' dx=offset of old int 33h
xreg.ax = 31
INTERRUPTX &H33, xreg, xreg
OM.ax = xreg.ax
OM.bx = xreg.es
OM.cx = 0
OM.dx = xreg.bx
EXIT SUB
CASE 32 'ENABLE MOUSE DRIVER
'set: nothing
'rtn: nothing
xreg.ax = 32
CASE 33 'SOFTWARE RESET
'set: nothing
'rtn: ax=-1 (or 33 if mouse drive not installed)
' bx=2 (if ax=-1. Must=2 for a valid reset)
xreg.ax = 33
CASE 34 'SET LANGUAGE FOR MESSAGES (International MOUSE.xxx ONLY)
'set: bx=language number
'rtn: nothing
xreg.ax = 34
xreg.bx = IM.bx
CASE 35 'GET LANGUAGE NUMBER
'set: nothing
'rtn: bx=language number
xreg.ax = 35
CASE 36 'GET DRIVER VERSION,MOUSE TYPE,AND IRQ NUMBER
'set: nothing
'rtn: bx=mouse driver version number
' bh=major
' bl=minor
' cx=mouse type and IRQ number
' ch=mouse type (1=bus,2=serial,3=InPort,4=PS/2,5=HP)
' cl=IRQ number (0=PS/2, 2-5 or 7=mouse IRQ)
xreg.ax = 36
CASE ELSE
OM.ax = 0
OM.bx = 0
OM.cx = 0
OM.dx = 0
EXIT SUB
END SELECT
INTERRUPTX &H33, xreg, xreg
OM.ax = xreg.ax
OM.bx = xreg.bx
OM.cx = xreg.cx
OM.dx = xreg.dx
END SUB