How to detect MouseWheel in QB45

150 Views Asked by At

I am using the following code to trap Left/Right/Middle mouse button and mouse row/column in QB45:

(QB45 is Microsoft Quick Basic v4.5)

and I need a way to detect MouseWheel. I have looked at Ralf Brown's interrupt list without luck.

Any ideas? btw: I am using Int 0x33.

The code I am submitting is for the Microsoft Quickbasic IDE and requires the library file QB.QLB.

DECLARE SUB Mouse.Function (Var1, Var2)
DIM SHARED MouseX AS INTEGER, MouseY AS INTEGER

TYPE RegTypeX
  AX AS INTEGER
  BX AS INTEGER
  CX AS INTEGER
  DX AS INTEGER
  BP AS INTEGER
  SI AS INTEGER
  DI AS INTEGER
  Flags AS INTEGER
  DS AS INTEGER
  ES AS INTEGER
END TYPE

COMMON SHARED InregsX AS RegTypeX
COMMON SHARED OutregsX AS RegTypeX

DECLARE SUB InterruptX (N AS INTEGER, I AS RegTypeX, O AS RegTypeX)

 CALL Mouse.Function(0, 0) ' init mouse
 CALL Mouse.Function(1, 0) ' show mouse
 DO

 IF LEN(INKEY$) THEN
    CALL Mouse.Function(2, 0) ' hide mouse
    EXIT DO
 END IF

 ' read mouse button press
 CALL Mouse.Function(3, 0)

 Var2 = INT((OutregsX.CX - 1) / 8 + 1)
 Var3 = INT((OutregsX.DX - 1) / 8 + 1)

 IF Var3 <> Mouse.Row OR Var2 <> Mouse.Column THEN
    CALL Mouse.Function(2, 0) ' hide mouse
    Mouse.Row = Var3
    Mouse.Column = Var2
    PRINT Mouse.Row, Mouse.Column
    CALL Mouse.Function(1, 0) ' show mouse
 END IF

 Mouse.Button = False
 CALL Mouse.Function(5, 0)
 IF (OutregsX.AX AND 1) = 1 THEN
    IF OutregsX.BX > False THEN
       Mouse.Button = -1
       PRINT "Left-Click"
    END IF
 END IF
 Mouse.Button2 = False
 CALL Mouse.Function(5, 1)
 IF (OutregsX.AX AND 2) = 2 THEN
    IF OutregsX.BX > False THEN
       Mouse.Button2 = -1
       PRINT "Right-Click"
    END IF
 END IF
 Mouse.Button3 = False
 CALL Mouse.Function(5, 2)
 IF (OutregsX.AX AND 4) = 4 THEN
    IF OutregsX.BX > False THEN
       Mouse.Button3 = -1
       PRINT "Middle-Click"
    END IF
 END IF
 LOOP
 END

SUB Mouse.Function (Var1, Var2)
   InregsX.AX = Var1
   InregsX.BX = Var2
   CALL InterruptX(&H33, InregsX, OutregsX)
END SUB
0

There are 0 best solutions below