Black Box 4/BlackBox.cdr/progbas/qbnws202.arj/RODENT.ZIP/MOUSE.MOU

Text File | 1991-06-01 | 15.3 KB | 390 lines

' ===========================================================================
'   FILE: MOUSE.MOU
'
'   Microsoft (tm) Compatible Mouse Driver and Support routines
'   for QuickBASIC 4.5.
'
'           Copyright (c) 1991
'           Daniel R. Berry (Traveller Software)
'           All Rights Reserved
'
'   This code is released to the Public Domain for distribution with the
'   QBNews.
'
'   Daniel R. Berry
'   3110-C S. Gen McMullen
'   San Antonio, TX  78226
'
' $INCLUDE: 'MOUSE.BI'
'
DECLARE SUB Mouse (M1%, M2%, M3%, M4%)
DECLARE SUB MouseLimits (MouseX1%, MouseY1%, MouseX2%, MouseY2%)
DECLARE SUB MouseStatus (Left%, Right%, MouseX%, MouseY%)
DECLARE SUB MouseCheck (Flag%)
DECLARE SUB MouseLocate (MouseX%, MouseY%)
DECLARE SUB MouseLeft (LCount%, LMouseX%, LMouseY%)
DECLARE SUB MouseRight (RCount%, RMouseX%, RMouseY%)
DECLARE SUB GetHighLow (Number%, High%, Low%)

' ===========================================================================
'   SUBPROGRAM: Mouse - QBUTIL
'   Version 1.0  By: Dan Bery (c) Traveller Software 1991
' ============================ Mouse SubProgram =============================
SUB Mouse (M1%, M2%, M3%, M4%)
    DEFINT A-Z
'
'   This utility drives all mouse functions for the mouse routines.
'   Functions Currently Supported by this Library:
'
'       00h - Reset Mouse and Get Status
'       01h - Show Mouse Cursor
'       02h - Hide Mouse Cursor
'       03h - Get Mouse Position and Button Status
'       04h - Set Mouse Cursor Position
'       05h - Get Button Press Information
'       06h - Get Button Release Information
'       07h - Set Horizontal Limits for Mouse Cursor
'       08h - Set Vertical Limits for Mouse Cursor
'       0Bh - Read Mouse Motion Counters
'       0Dh - Turn On Light-Pen Emulation
'       0Eh - Turn Off Light-Pen Emulation
'       1Ah - Set Mouse Sensitivity
'       1Bh - Get Mouse Sensitivity
'       1Dh - Select Mouse Cursor Page
'       1Eh - Get Mouse Cursor Page
'       24h - Get Mouse Information
'
'   Note: There are other functions not currently supported.
'
    DIM Reg AS RegType
'
'   Setup for INT 33H/Mouse Interrupt - Functions are determined by M1
'
    Reg.ax = M1: Reg.bx = M2: Reg.cx = M3: Reg.dx = M4
    CALL INTERRUPT(&H33, Reg, Reg)
'
'   Convert Registers back to usable format
'
    M1 = Reg.ax: M2 = Reg.bx: M3 = Reg.cx: M4 = Reg.dx
' ========================= End of Mouse SubProgram =========================
END SUB

DEFSNG A-Z
' ===========================================================================
'   SUBPROGRAM: MouseCheck  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' ========================== MouseCheck SubProgram ==========================
SUB MouseCheck (Flag%) STATIC
    DEFINT A-Z
'
'   If Flag = -1 then check to see if the mouse is available and install it.
'   However, if MFlag = 1 then skip this step, the mouse is already
'   installed and should only be reset by calling MouseReset.
'
    IF Flag = -1 AND MFlag = 0 THEN
        MFlag = 0
        CALL Mouse(MFlag, 0, 0, 0)
        MouseStat = 0
    '
    '   If the Mouse is available then set MFlag to 1.
    '
        IF MFlag <> 0 THEN MFlag = 1
    END IF
'
'   If Flag = -2 then disable the mouse.
'
    IF Flag = -2 THEN
        MFlag = 0
        CALL Mouse(0, 0, 0, 0)  ' We reset the mouse in order to turn it off.
        MouseStat = 0
    END IF
'
'   Note: Since this routine is STATIC the value of MFlag is held in memory
'   for future reference for use by other mouse utilities.
'
    Flag = MFlag
    MouseChk% = MFlag ' Set the COMMON MouseChk variable
' ====================== End of MouseCheck SubProgram =======================
    END SUB

DEFSNG A-Z
' ===========================================================================
'   SUBPROGRAM: MouseCRT  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' ============================ MouseCRT SubProgram ==========================
SUB MouseCRT (CRT%, Flag%)
    IF MouseChk% = 0 THEN EXIT SUB ' Is the MouseChk variable set?
    IF Flag% = 1 THEN
            CALL Mouse(30, CRT%, 0, 0)  '   Get the Mouse Display Page
        ELSE
            CALL Mouse(29, CRT%, 0, 0)  '   Set the Mouse Display Page
    END IF
' ====================== End of MouseCRT SubProgram ======================
    END SUB

' ===========================================================================
'   SUBPROGRAM: MouseInformation
'   Version 1.0  By: Dan Berry (c) Traveller Software 1991
' ======================== MouseInformaton SubProgram =======================
SUB MouseInformation (MouseVer$, MouseType%, MouseType$)
    DEFINT A-Z
    IF MouseChk = 0 THEN EXIT SUB ' Is the MouseChk variable set?
'
'   Get Mouse Information
'
    CALL Mouse(36, MouseVersion, MType, 0)
'
'   Convert Version to readable format
'
    CALL GetHighLow(MouseVersion, MajorVer, MinorVer)
    MouseVer$ = LTRIM$(STR$(MajorVer)) + "." + LTRIM$(STR$(MinorVer))
'
'   Get MouseType
'
    CALL GetHighLow(MType, MouseType, M)
    MouseType$ = "Undefined"
    IF MouseType = 1 THEN MouseType$ = "Bus Mouse"
    IF MouseType = 2 THEN MouseType$ = "Serial Mouse"
    IF MouseType = 3 THEN MouseType$ = "InPort Mouse"
    IF MouseType = 4 THEN MouseType$ = "PS/2 Mouse"
    IF MouseType = 5 THEN MouseType$ = "HP Mouse"
' ==================== End of MouseInformaton SubProgram ====================
END SUB

DEFSNG A-Z
' ===========================================================================
'   SUBPROGRAM: MouseLeft  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' ========================== MouseLeft SubProgram ===========================
SUB MouseLeft (LCount%, LMouseX%, LMouseY%)
    IF MouseChk% = 0 THEN EXIT SUB  ' Is the MouseChk variable set?
    '
    '   Determine position of mouse at left button depression.
    '
    LCount% = 0: CALL Mouse(5, LCount%, LMouseX%, LMouseY%)
' ====================== End of MouseLeft SubProgram ========================
    END SUB

' ===========================================================================
'   SUBPROGRAM: MouseLeftRC  -  QBUTIL
'   Version 1.0  By: Dan Berry (c) Traveller Software 1990
' ========================= MouseLeftRC SubProgram ==========================
SUB MouseLeftRC (LCount%, Row%, Col%)
    DEFINT A-Z
    IF MouseChk = 0 THEN EXIT SUB   ' Is the MouseChk variable set?
    CALL MouseLeft(LCount, MouseX, MouseY)  ' Get the mouse status
'
'   Determine cursor Row and Column of the mouse position.
'
    Col = INT(MouseX / 8) + 1: Row = INT(MouseY / 8) + 1
' ===================== End of MouseLeftRC SubProgram =======================
END SUB

DEFSNG A-Z
' ===========================================================================
'   SUBPROGRAM: MouseLightPen  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' ========================= MouseLightPen SubProgram ========================
SUB MouseLightPen (Status%)
    IF MouseChk% = 0 THEN EXIT SUB  ' Is the MouseChk variable set?
    '
    '   Enable/Disable Light Pen Emulation
    '
    IF Status% = 1 THEN MFlag% = 13 ELSE MFlag% = 14
    CALL Mouse(MFlag%, 0, 0, 0)
' ===================== End of MouseLightPen SubProgram =====================
    END SUB

' ===========================================================================
'   SUBPROGRAM: MouseLimits  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' ========================== MouseLimits SubProgram =========================
SUB MouseLimits (MouseX1%, MouseY1%, MouseX2%, MouseY2%)
    IF MouseChk% = 0 THEN EXIT SUB  ' Is the MouseChk variable set?
    '
    '   Set the limits of the mouse movements
    '
    CALL Mouse(7, 0, MouseX1%, MouseX2%)
    CALL Mouse(8, 0, MouseY1%, MouseY2%)
' ====================== End of MouseLimits SubProgram ======================
    END SUB

' ===========================================================================
'   SUBPROGRAM: MouseLimitsRC  -  QBUTIL
'   Version 1.0  By: Dan Berry (c) Traveller Software 1989
' ========================= MouseLimitsRC SubProgram ========================
SUB MouseLimitsRC (Row1%, Col1%, Row2%, Col2%)
'
'   Set mouse limits according to row and column
'
    CALL MouseLimits(Col1% * 8 - 8, Row1% * 8 - 8, Col2% * 8 - 8, Row2% * 8 - 8)
' ===================== End of MouseLimitsRC SubProgram =====================
    END SUB

' ===========================================================================
'   SUBPROGRAM: MouseLocate  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' ========================== MouseLocate SubProgram =========================
SUB MouseLocate (MouseX%, MouseY%)
    IF MouseChk% = 0 THEN EXIT SUB ' Is the MouseChk variable set?
    CALL Mouse(4, 0, MouseX%, MouseY%) ' Locate the Mouse at Desired Location
' ====================== End of MouseLocate SubProgram ======================
    END SUB

' ===========================================================================
'   SUBPROGRAM: MouseLocateRC  -  QBUTIL
'   Version 1.0  By: Dan Berry (c) Traveller Software 1989
' ========================= MouseLocateRC SubProgram ========================
SUB MouseLocateRC (Row%, Col%)
    CALL MouseLocate(Col% * 8 - 8, Row% * 8 - 8)
' ===================== End of MouseLocateRC SubProgram =====================
    END SUB

' ===========================================================================
'   SUBPROGRAM: MouseMotion  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' ========================== MouseMotion SubProgram =========================
SUB MouseMotion (Horz%, Vert%)
    IF MouseChk% = 0 THEN EXIT SUB ' Is the MouseChk variable set?
    '
    '   Returns motion counts since last call to this routine.
    '
    CALL Mouse(11, 0, Horz%, Vert%)
' ====================== End of MouseMotion SubProgram ======================
    END SUB

' ===========================================================================
'   SUBPROGRAM: MouseOff  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' =========================== MouseOff SubProgram ===========================
SUB MouseOff
    DEFINT A-Z
'
'   Is the MouseChk variable set or is the Mouse Cursor Off?
'
    IF MouseChk = 0 OR MouseStat = 0 THEN EXIT SUB
    CALL Mouse(2, 0, 0, 0)   '   Turn the Mouse Cursor Off
    MouseStat = 0 ' Set COMMON Mouse On/Off Flag to Off
' ======================= End of MouseOff SubProgram ========================
    END SUB

DEFSNG A-Z
' ===========================================================================
'   SUBPROGRAM: MouseOn  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' =========================== MouseOn SubProgram ============================
SUB MouseOn
    DEFINT A-Z
'
'   Is the MouseChk variable set or is the Mouse Cursor On?
'
    IF MouseChk = 0 OR MouseStat = 1 THEN EXIT SUB
    CALL Mouse(1, 0, 0, 0)  '   Turn the Mouse Cursor On
    MouseStat = 1   ' Set COMMON Mouse On/Off Flag to ON
' ======================= End of MouseOn SubProgram =========================
    END SUB

DEFSNG A-Z
' ===========================================================================
'   SUBPROGRAM: MouseRelease  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' ========================= MouseRelease SubProgram =========================
SUB MouseRelease (Button%, Count%, MouseX%, MouseY%)
    IF MouseChk% = 0 THEN EXIT SUB  ' Is the MouseChk variable set?
    '
    '   Returns the position of the mouse after the button requested was last
    '   released.
    '
    Count% = Button%: CALL Mouse(6, Count%, MouseX%, MouseY%)
    MouseStat = 0 ' Set COMMON Mouse On/Off Flag to Off
' ===================== End of MouseRelease SubProgram ======================
END SUB

' ===========================================================================
'   SUBPROGRAM: MouseReset  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' ========================== MouseReset SubProgram ==========================
SUB MouseReset
    IF MouseChk% = 0 THEN EXIT SUB  ' Is the MouseChk variable set?
    CALL Mouse(0, 0, 0, 0)  ' Reset the Mouse
    MouseStat% = 0  ' The Mouse cursor is off
' ====================== End of MouseReset SubProgram =======================
    END SUB

' ===========================================================================
'   SUBPROGRAM: MouseRight  -  QBUTIL
'   Version 1.0  By: Dan Berry (c) Traveller Software 1989
' ========================== MouseRight SubProgram ==========================
SUB MouseRight (RCount%, RMouseX%, RMouseY%)
    IF MouseChk% = 0 THEN EXIT SUB  ' Is the MouseChk variable set?
    '
    '   Determine position of mouse at right button depression
    '
    RCount% = 1: CALL Mouse(5, RCount%, RMouseX%, RMouseY%)
' ====================== End of MouseRight SubProgram =======================
    END SUB

' ===========================================================================
'   SUBPROGRAM: MouseRightRC  -  QBUTIL
'   Version 1.0  By: Dan Berry (c) Traveller Software 1990
' ======================== MouseRightRC SubProgram ==========================
SUB MouseRightRC (RCount%, Row%, Col%)
    DEFINT A-Z
    IF MouseChk = 0 THEN EXIT SUB   ' Is the MouseChk variable set?
    CALL MouseRight(RCount, MouseX, MouseY) ' Get the mouse status
'
'   Determine cursor Row and Column of the mouse position.
'
    Col = INT(MouseX / 8) + 1: Row = INT(MouseY / 8) + 1
' ==================== End of MouseRightRC SubProgram =======================
END SUB

DEFSNG A-Z
' ===========================================================================
'   SUBPROGRAM: MouseSensitivity
'   Version 1.0  By: Dan Berry (c) Traveller Software 1991
' ===================== MouseSensitivity SubProgram =========================
SUB MouseSensitivity (GetSet%, HMickey%, VMickey%, DoubleSpeed%)
    DEFINT A-Z
    IF MouseChk = 0 THEN EXIT SUB ' Is the MouseChk variable set?
    IF GetSet = 1 THEN ' Set Mouse Sensitivity
            CALL Mouse(26, HMickey, VMickey, DoubleSpeed)
        ELSE ' Get Mouse Sensitivity
            CALL Mouse(27, HMickey, VMickey, DoubleSpeed)
    END IF
' =================== End of MouseSensitivity SubProgram ====================
END SUB

DEFSNG A-Z
' ===========================================================================
'   SUBPROGRAM: MouseStatus  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' ========================= MouseStatus SubProgram ==========================
SUB MouseStatus (Left%, Right%, MouseX%, MouseY%)
    DEFINT A-Z
    IF MouseChk = 0 THEN EXIT SUB   ' Is the MouseChk variable set?
    '
    '   Determine Mouse Status to include Position and Buttons Depressed
    '
    CALL Mouse(3, Buttons, MouseX, MouseY)
    Left = ((Buttons AND 1) <> 0): Right = ((Buttons AND 2) <> 0)
' ===================== End of MouseStatus SubProgram =======================
    END SUB

DEFSNG A-Z
' ===========================================================================
'   SUBPROGRAM: MouseStatusRC  -  QBUTIL
'   Version 2.0  By: Dan Berry (c) Traveller Software 1989 - 1990
' ======================== MouseStatusRC SubProgram =========================
SUB MouseStatusRC (Left%, Right%, Row%, Col%)
    DEFINT A-Z
    IF MouseChk = 0 THEN EXIT SUB   ' Is the MouseChk variable set?
    CALL MouseStatus(Left, Right, MouseX, MouseY)   ' Get the Mouse status
'
'   Determine cursor Row and Column of the mouse position.
'
    Col = INT(MouseX / 8) + 1: Row = INT(MouseY / 8) + 1
' ==================== End of MouseStatusRC SubProgram ======================
    END SUB