Keskustelu: Koodit: QB: Hiirifunktioita

TYPE RegType
	 ax    AS INTEGER
	 bx    AS INTEGER
	 cx    AS INTEGER
	 dx    AS INTEGER
	 bp    AS INTEGER
	 si    AS INTEGER
	 di    AS INTEGER
	 flags AS INTEGER
END TYPE
DECLARE SUB Interrupt (intnum AS INTEGER, inreg AS RegType, outreg AS RegType)
DECLARE SUB XMouseBorder (x1%, y1%, x2%, y2%)
DECLARE SUB XMouseDriver (m0%, m1%, m2%, m3%)
DECLARE SUB XMouseHide ()
DECLARE SUB XMouseInit (ax%, bx%)
DECLARE SUB XMousePoll (XMouseX%, XMouseY%, lButton%, rButton%)
DECLARE SUB XMouseSetPos (X%, Y%)
DECLARE SUB XMouseShow ()
DIM SHARED XMousePresent AS INTEGER
DEFINT A-Z

CONST true = -1, false = 0
SCREEN 12
CLS
PAINT (1, 1), 4
XMouseInit mah, buts
IF mah THEN
	PRINT "Mouse Enabled, it has"; buts; "buttons."
ELSE
	PRINT "Mouse does not exist or mouse driver not loaded."
	END
END IF
XMouseShow
DO
XMousePoll X, Y, l, r
IF l THEN
	XMouseHide
	PSET (X, Y)
	XMouseShow
END IF
IF r THEN
	XMouseHide
	CLS
	XMouseShow
END IF
a$ = INKEY$
IF a$ = " " THEN
	XMouseHide
	XMouseSetPos 1, 1
	XMouseShow
ELSEIF a$ = CHR$(27) THEN
	XMouseHide
	END
END IF
LOOP

SUB XMouseBorder (x1, y1, x2, y2)
XMouseHide
XMouseDriver 7, 0, x1, x2
XMouseDriver 8, 0, y1, y2
XMouseShow
END SUB

SUB XMouseDriver (m0, m1, m2, m3)

	 DIM Regs AS RegType

	 IF XMouseChecked = false THEN
		  DEF SEG = 0

		  XMouseSegment& = 256& * PEEK(207) + PEEK(206)
		  XMouseOffset& = 256& * PEEK(205) + PEEK(204)

		  DEF SEG = XMouseSegment&

		  IF (XMouseSegment& = 0 AND XMouseOffset& = 0) OR PEEK(XMouseOffset&) = 207 THEN
				XMousePresent = false
				XMouseChecked = true
				DEF SEG
		  END IF
	 END IF

	 IF XMousePresent = false AND XMouseChecked = true THEN
		  EXIT SUB
	 END IF

	 ' =======================================================================
	 ' Calls interrupt 51 to invoke Mouse functions in the MS Mouse Driver.
	 ' =======================================================================

	 Regs.ax = m0
	 Regs.bx = m1
	 Regs.cx = m2
	 Regs.dx = m3

	 Interrupt 51, Regs, Regs

	 m0 = Regs.ax
	 m1 = Regs.bx
	 m2 = Regs.cx
	 m3 = Regs.dx

	 IF XMouseChecked THEN EXIT SUB


	 ' =======================================================================
	 ' Check for successful XMouse initialization
	 ' =======================================================================

	 IF m0 AND NOT XMouseChecked THEN
		  XMousePresent = true
		  DEF SEG
	 END IF

	 XMouseChecked = true

END SUB

SUB XMouseHide

	 ' =======================================================================
	 ' Decrements internal cursor flag
	 ' =======================================================================

	XMouseDriver 2, 0, 0, 0

END SUB

SUB XMouseInit (ax, bx)

	 ' =======================================================================
	 ' XMouse driver's initialization routine
	 ' =======================================================================
	 ax = 0
	 bx = 0
	 XMouseDriver ax, bx, 0, 0

END SUB

SUB XMousePoll (XMouseX, XMouseY, lButton, rButton)

	 ' =======================================================================
	 ' Polls XMouse driver, then sets parms correctly
	 ' =======================================================================

	 XMouseDriver 3, button, XMouseX, XMouseY
	 IF button AND 1 THEN
		  lButton = true
	 ELSE
		  lButton = false
	 END IF

	 IF button AND 2 THEN
		  rButton = true
	 ELSE
		  rButton = false
	 END IF

END SUB

SUB XMouseSetPos (X, Y)
XMouseDriver 4, 0, X, Y
END SUB

SUB XMouseShow

	 ' =======================================================================
	 ' Increments XMouse's internal cursor flag
	 ' =======================================================================

	 XMouseDriver 1, 0, 0, 0

END SUB