DECLARE FUNCTION IsMono% ()
DECLARE FUNCTION Rand% (MaxValue%)
DECLARE SUB DspButtons (Buttons%, PX%, PY%)
DECLARE SUB Normal ()
DECLARE SUB PrintMsg (PosX%, PosY%, PrintTxt$)
DECLARE SUB Reverse ()
DECLARE SUB SetUpGrid ()

'Program:   Call Mouse Demo Program
'           CALMOUSE.BAS

DEFINT A-Z

'$INCLUDE: 'QB.BI'
'$INCLUDE: 'MOUSE.BI'

DIM SHARED SWidth, VideoAddr
DIM SHARED PrL, PrR, PrLr, PrM
DIM SHARED PrLM, PrMR, PrAll, PrNone
DIM SHARED ForeGround, BackGround, HiLight
DIM SHARED ButtonLeft, ButtonRight, ButtonMiddle

True = -1: False = 0: SWidth = 80

'Mouse button press definitions

	PrL = 1: PrR = 2: PrLr = 3: PrM = 4
	PrLM = 5: PrMR = 6: PrAll = 7: PrNone = 0

'Button definitions
  
	ButtonLeft = 0
	ButtonRight = 1
	ButtonMiddle = 2

	IF IsMono THEN
		ForeGround = 7: BackGround = 0
	ELSE
		ForeGround = 3: BackGround = 0
	END IF

	SCREEN 0: CLS : SetUpGrid

	IF ThereIsAMouse THEN
		PrintMsg 24, 1, "Mouse Installed"
		SLEEP (1)
		IF NOT MouseReset THEN
			PrintMsg 24, 1, "No mouse reset"
			END
		ELSE
			PrintMsg 24, 1, "Mouse Reset"
		END IF
	ELSE
		PrintMsg 24, 1,_
		   "Sorry, there's no mouse on this system"
		END
	END IF
  
	LOCATE 25, 1: Reverse: PRINT SPACE$(80);
	LOCATE 25, 1
	PRINT "(Press Left Button to change mouse,";
	PRINT " Right Button to Quit)";
	MouseOn
	ClearButton ButtonLeft
  
	DO WHILE Buttons <> PrR
		Buttons = GetMouseStatus(MPosX, MPosY)
		DspButtons Buttons, MPosX, MPosY
		IF Buttons = PrL THEN
			MouseCharacter = Rand(255)
			IF IsMono THEN
				SetMouseSoftCursor MouseCharacter,7,0
			ELSE
				FGColor = Rand(7)
				BGColor = Rand(7)
				SetMouseSoftCursor_
				   MouseCharacter, FGColor, BGColor
			END IF
			MouseOn
			PrintMsg 2, 40, "MouseCharacter: "_
			   + STR$(MouseCharacter)
			PrintMsg 3, 40, "MouseFGColor: "_
			   + STR$(FGColor)
			PrintMsg 4, 40, "MouseBGColor: "_
			   + STR$(BGColor)
			ClearButton ButtonLeft
		END IF
	LOOP

	MouseOff
	END

SUB DspButtons (Buttons, PX, PY)
	Reverse
	LOCATE 24, 42: PRINT "Buttons: ";
	SELECT CASE Buttons
		CASE PrNone
			PRINT "None          ";
		CASE PrL
			PRINT "Left          ";
		CASE PrR
			PRINT "Right         ";
		CASE PrLr
			PRINT "Left & right  ";
		CASE PrM
			PRINT "Middle        ";
		CASE PrLM
			PRINT "Left & middle ";
		CASE PrMR
			PRINT "Middle & right";
		CASE PrAll
			PRINT "All           ";
		CASE ELSE
			PRINT "Unknown " + STR$(Buttons);
	END SELECT
	LOCATE 24, 66: PRINT USING "XPos=## "; PX;
	LOCATE 24, 74: PRINT USING "YPos=##"; PY;
	Normal
END SUB

FUNCTION IsMono
	DIM InRegs AS RegType
	InRegs.AX = &HF00
	INTERRUPT &H10, InRegs, OutRegs
	IsMono = (OutRegs.AX MOD 256 = 7)
END FUNCTION

SUB Normal
	COLOR ForeGround, BackGround
END SUB

SUB PrintMsg (PosX, PosY, PrintTxt$)
	LOCATE PosX, PosY: Reverse
	PRINT LEFT$(PrintTxt$ + STRING$(40, " "), 40);
	Normal
END SUB

FUNCTION Rand (MaxValue)
	Rand = INT((MaxValue + 1) * RND)
END FUNCTION

SUB Reverse
	COLOR BackGround, ForeGround
END SUB

SUB SetUpGrid
	LOCATE 1, 1
	FOR I = 1 TO 80
		PRINT RIGHT$(STR$(I), 1);
	NEXT I
	LOCATE 2, 1
	FOR I = 2 TO 25
		LOCATE I, 1
		PRINT USING "##"; I;
	NEXT I
	Reverse
	LOCATE 24, 1: PRINT SPACE$(80);
	Normal
END SUB