'===========================================================================
' Subject: FREEWARE MOUSE ROUTINES            Date: 11-22-96 (21:52)       
'  Author: Mike Ginger                        Code: QB, PDS                
'  Origin: FidoNet QUIK_BAS Echo            Packet: MOUSE.ABC
'===========================================================================
' Note that you will need to invoke QuickBASIC with the '/L' option, ie:
'  QB /L
'$INCLUDE: 'c:\qb\qb.bi'
' Freeware from Mike Ginger

'---------------------------------------------------------------------

' *****************************************************************
' MOUSE Routines
' *****************************************************************

' First, determine if a Mouse is installed.
DECLARE FUNCTION MouseInstalled% ()

' ********************************************************
' Only if a Mouse IS Installed, may you use the following:
' ********************************************************

' Get the Number of Buttons.
DECLARE FUNCTION MouseButtons% ()

' Get the Driver Version Number.
DECLARE FUNCTION MouseVersion! ()

' Determine the Adaptor Type.
DECLARE FUNCTION MouseType$ ()

' Get the IRQ Number.
DECLARE FUNCTION MouseIRQ% ()

' Returns what Mouse Button(s) is being pressed.
DECLARE FUNCTION MouseGetButtonStatus! ()

' This SUB allows you to position the Mouse Cursor anywhere on the Screen.
DECLARE SUB MouseSetPosition (MX!, MY!)

' Allows you to turn the Mouse Cursor Off, when done.
DECLARE SUB MouseCursorOff ()

' To make the Mouse Cursor Visible, before displaying.
DECLARE SUB MouseCursorOn ()

' Allows you to set the Screen Limits, if you wish.
DECLARE SUB MouseSetLimits (MinX!, MinY!, MaxX!, MaxY!)

' Get the Cursor's Horizontal position.
DECLARE FUNCTION MouseGetXPos! ()

' Get the Cursor's Vertical position.
DECLARE FUNCTION MouseGetYPos! ()

' To ReSet the Mouse Cursor, before starting.
DECLARE SUB MouseReset ()

'---------------------------------------------------------------------

mouse:

CLS

LOCATE 3, 1

 ' Is a Mouse Installed?

 ' Don't even think about using the other MouseXXXXX SUBS and
 ' FUNCTIONS unless 'MouseInstalled%' returns True.

  PRINT "Is a Mouse Installed?    ";
 
  IF MouseInstalled% THEN       ' Yes, it is Installed.
	PRINT "Yes"
	PRINT
	PRINT "No. of Buttons:         "; MouseButtons%
	PRINT "Mouse Driver Version No."; MouseVersion!
	PRINT "Mouse Type               "; MouseType$
	PRINT "Mouse IRQ               "; MouseIRQ%

	MouseReset              ' Reset the Mouse Screen Position.

	WHILE pause$ <> CHR$(27)
	pause$ = INKEY$
	LOCATE 10, 1

	MouseCursorOn           ' Make the Mouse Cursor visible.

	PRINT "X Position (Column)  =  "; MouseGetXPos
	PRINT "Y Position (Row)     =  "; MouseGetYPos

	PRINT "Button(s) being Pressed: ";
	IF MouseGetButtonStatus = 1 THEN
		PRINT "Left             "
	ELSEIF MouseGetButtonStatus = 2 THEN
		PRINT "Right            "
	ELSEIF MouseGetButtonStatus = 3 THEN
		PRINT "Both Left & Right"
	ELSEIF MouseGetButtonStatus = 4 THEN
		PRINT "Middle           "
	ELSE
		PRINT "None             "
	END IF

	WEND

  MouseCursorOff                  ' When done, turn off the Mouse Cursor.

  ELSE
	PRINT "No "

	WHILE pause$ <> CHR$(27)
	pause$ = INKEY$
	WEND

  END IF

'GOTO MainMenu

'---------------------------------------------------------------------

FUNCTION MouseButtons%

   DIM InRegs AS RegType
   DIM OutRegs AS RegType


   IF (mouseg OR (mouse% - 2)) AND PEEK(mouse% - 2) <> 207 THEN

	InRegs.ax = &H0
	CALL INTERRUPT(&H33, InRegs, OutRegs)

	IF OutRegs.ax = &HFFFF THEN
		MouseButton% = VAL(HEX$(OutRegs.bx))
		
		SELECT CASE MouseButton%
		CASE 0: MouseButtons% = 3
		CASE 2: MouseButtons% = 2
		CASE 3: MouseButtons% = 3
		CASE 256: MouseButtons% = 2
		CASE ELSE: MouseButtons% = 0
		END SELECT

	END IF

   END IF

END FUNCTION

'*****************************************************************************
'**  This SUB turns the cursor off.                                         **
'*****************************************************************************
SUB MouseCursorOff
  DIM InRegs AS RegTypeX
  DIM OutRegs AS RegTypeX

  InRegs.ax = 2
  INTERRUPTX &H33, InRegs, OutRegs
 
END SUB

'*****************************************************************************
'**  This SUB turns the cursor on
'*****************************************************************************
SUB MouseCursorOn
  DIM InRegs AS RegTypeX
  DIM OutRegs AS RegTypeX
 
  InRegs.ax = 1
  INTERRUPTX &H33, InRegs, OutRegs

END SUB

'*****************************************************************************
'**  This SUB returns which button is being pressed.                        **
'**  Returns : 1    Left Button                                             **
'**            2    Right Button                                            **
'**            3    Both Buttons                                            **
'**            4    Middle Button                                           **
'*****************************************************************************
FUNCTION MouseGetButtonStatus
  DIM InRegs AS RegTypeX
  DIM OutRegs AS RegTypeX
 
  InRegs.ax = 3
  INTERRUPTX &H33, InRegs, OutRegs

  MouseGetButtonStatus = OutRegs.bx

END FUNCTION

'*****************************************************************************
'**  This SUB returns the current mouse XPosition                           **
'**  For graphics screens this returns a pixel position                     **
'**  It also returns a quasi-pixel position in text mode, to get the text   **
'**  position just divide this number by 8                                  **
'*****************************************************************************
FUNCTION MouseGetXPos
  DIM InRegs AS RegTypeX
  DIM OutRegs AS RegTypeX
 
  InRegs.ax = 3
  INTERRUPTX &H33, InRegs, OutRegs
  MouseGetXPos = OutRegs.cx

END FUNCTION

'*****************************************************************************
'**  This SUB returns the current mouse XPosition                           **
'**  For graphics screens this returns a pixel position                     **
'**  It also returns a quasi-pixel position in text mode, to get the text   **
'**  position just divide this number by 8                                  **
'*****************************************************************************
FUNCTION MouseGetYPos
  DIM InRegs AS RegTypeX
  DIM OutRegs AS RegTypeX
 
  InRegs.ax = 3
  INTERRUPTX &H33, InRegs, OutRegs
  MouseGetYPos = OutRegs.dx

END FUNCTION

FUNCTION MouseInstalled%

 ' Is a Mouse Installed?

 DEF SEG = 0

	p207 = PEEK(207): p206 = PEEK(206): p205 = PEEK(205): p204 = PEEK(204)
	mouseg = 256 * p207 + p206
	mouse% = 256 * p205 + p204 + 2
	DEF SEG = mouseg
	IF (mouseg OR (mouse% - 2)) AND PEEK(mouse% - 2) <> 207 THEN
	MouseInstalled% = 1
	END IF

DEF SEG

END FUNCTION

FUNCTION MouseIRQ%


   DIM InRegs AS RegType
   DIM OutRegs AS RegType

	InRegs.ax = &H24
	CALL INTERRUPT(&H33, InRegs, OutRegs)

   IF OutRegs.ax <> &HFFFF THEN
	  
	MouseIRQ% = VAL(HEX$(OutRegs.cx AND &HFF))

   END IF

END FUNCTION

  '*******************************************************************
  '**  This SUB resets the mouse driver and must be called before   **
  '**  you do any other mouse functions.  If not called the results **
  '**  are unpredictable                                            **
  '*******************************************************************
SUB MouseReset
 
  DIM InRegs AS RegTypeX
  DIM OutRegs AS RegTypeX
 
  SHARED NumberofButtons
  InRegs.ax = 0
  INTERRUPTX &H33, InRegs, OutRegs
  NumberofButtons = OutRegs.bx

END SUB

  '****************************************************************
  '**  This lets you define the area that the mouse can move in. **
  '**  The default is the entire screen                          **
  '****************************************************************
SUB MouseSetLimits (MinX, MinY, MaxX, MaxY)
 
  DIM InRegs AS RegTypeX
  DIM OutRegs AS RegTypeX
 
  InRegs.ax = 7
  InRegs.cx = MinX
  InRegs.dx = MaxX
  INTERRUPTX &H33, InRegs, OutRegs
  InRegs.ax = 8
  InRegs.cx = MinY
  InRegs.dx = MaxY
  INTERRUPTX &H33, InRegs, OutRegs

END SUB

  '************************************************************
  '**  This SUB allows you to put the mouse cursor anywhere  **
  '**  on the screen that you want.                          **
  '************************************************************
SUB MouseSetPosition (MX, MY)
 
  DIM InRegs AS RegTypeX
  DIM OutRegs AS RegTypeX
 
  InRegs.ax = 4
  InRegs.cx = MX
  InRegs.dx = MY
  INTERRUPTX &H33, InRegs, OutRegs

END SUB

FUNCTION MouseType$

   DIM InRegs AS RegType
   DIM OutRegs AS RegType

	InRegs.ax = &H24
	CALL INTERRUPT(&H33, InRegs, OutRegs)

   IF OutRegs.ax <> &HFFFF THEN
	  
	MousType% = VAL(HEX$(OutRegs.cx \ 256))
	 SELECT CASE MousType%
	  CASE 1: MouseType$ = "Bus"
	  CASE 2: MouseType$ = "Serial"
	  CASE 3: MouseType$ = "InPort"
	  CASE 4: MouseType$ = "PS/2"
	  CASE 5: MouseType$ = "HP"
	  CASE ELSE: MouseType$ = "Unknown"
	 END SELECT

   END IF

END FUNCTION

FUNCTION MouseVersion!

   DIM InRegs AS RegType
   DIM OutRegs AS RegType

	InRegs.ax = &H24
	CALL INTERRUPT(&H33, InRegs, OutRegs)

	IF OutRegs.ax <> &HFFFF THEN
    
	MouseMajVer = OutRegs.bx \ &H100
	MouseMinVer = OutRegs.bx AND &HFF
	MouseVersion! = (MouseMinVer + (100 * MouseMajVer)) / 100

	END IF

END FUNCTION