Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Mapping screen for mouse
#28
I updated my previous code to be more in line to what @Bplus pointed out that SDLBasic used.

@grymmjack you may find this updated version better suited for your needs. Much cleaner and simpler to use.

There's a few more commands available documented within the subroutines and functions as to their use.

This version is much cleaner than the quick and dirty I posted yesterday.

Code: (Select All)
OPTION _EXPLICIT

CONST FALSE = 0, TRUE = NOT FALSE ' truth detectors
CONST SWIDTH = 800, SHEIGHT = 600 ' main screen dimensions

TYPE TYPE_POINT '                   POINT PROPERTIES
    x AS INTEGER '                  x coordinate
    y AS INTEGER '                  y coordinate
END TYPE

TYPE TYPE_AREA '                    AREA PROPERTIES
    min AS TYPE_POINT '             upper left coordinate
    max AS TYPE_POINT '             lower right coordinate
END TYPE

TYPE TYPE_ZONE '                    ZONE PROPERTIES
    Area AS TYPE_AREA '             area within zone
    Active AS INTEGER '             this zone is available to mouse (t/f)
END TYPE

TYPE TYPE_MOUSE '                   MOUSE PROPERTIES
    x AS INTEGER '                  x location
    y AS INTEGER '                  y location
    ZoneTrap AS INTEGER '           zone area mouse trapped in (0 for none)
    Hovering AS INTEGER '           zone area mouse is hovering over (0 for none)
    Area AS TYPE_AREA '             trapped mouse area
END TYPE

REDIM Zone(0) AS TYPE_ZONE '        zone area array
DIM Mouse AS TYPE_MOUSE '           mouse properties
DIM MouseIMG AS LONG '              mouse pointer image
DIM Cursor AS STRING '              pointer creation variables
DIM CursorPos AS INTEGER
DIM x AS INTEGER
DIM y AS INTEGER
DIM Zone1 AS INTEGER '              defined mouse zones
DIM Zone2 AS INTEGER
DIM Zone3 AS INTEGER
DIM Zone4 AS INTEGER
DIM Zone5 AS INTEGER

'+------------------------+
'| Create a mouse pointer |
'+------------------------+

Cursor = Cursor + "0           " ' quick and dirty mouse cursor
Cursor = Cursor + "00          "
Cursor = Cursor + "010         "
Cursor = Cursor + "0110        "
Cursor = Cursor + "01110       "
Cursor = Cursor + "011110      "
Cursor = Cursor + "0111110     "
Cursor = Cursor + "01111110    "
Cursor = Cursor + "011111110   "
Cursor = Cursor + "0111111110  "
Cursor = Cursor + "01111111110 "
Cursor = Cursor + "011111111110"
Cursor = Cursor + "011111100000"
Cursor = Cursor + "01110110    "
Cursor = Cursor + "0110 0110   "
Cursor = Cursor + "010  0110   "
Cursor = Cursor + "00    0110  "
Cursor = Cursor + "      0110  "
Cursor = Cursor + "       0110 "
Cursor = Cursor + "       0110 "
Cursor = Cursor + "        00  "
MouseIMG = _NEWIMAGE(12, 21, 32) ' mouse icon image holder
_DEST MouseIMG '                   draw on icon image
CursorPos = 0
FOR y = 0 TO 20
    FOR x = 0 TO 11
        CursorPos = CursorPos + 1
        SELECT CASE MID$(Cursor, CursorPos, 1)
            CASE "0"
                PSET (x, y), _RGB32(0, 0, 0)
            CASE "1"
                PSET (x, y), _RGB32(255, 255, 255)
        END SELECT
    NEXT x
NEXT y
_DEST 0

'+-------------------+
'| Define zone areas |
'+-------------------+

Zone1 = DefineMouseZone(10, 10, 80, 80, TRUE) '    (x1, y1, width, height, Active)
Zone2 = DefineMouseZone(100, 10, 80, 80, TRUE)
Zone3 = DefineMouseZone(10, 100, 170, 80, TRUE)
Zone4 = DefineMouseZone(190, 10, 170, 170, TRUE)
Zone5 = DefineMouseZone(10, 190, 350, 350, TRUE)

SCREEN _NEWIMAGE(800, 600, 32)
_TITLE "MouseZone"
_MOUSEHIDE
'HideZone Zone3 ' hide zone 3 from the mouse

DO
    _LIMIT 30
    CLS

    '+---------------------------------------+
    '| Supply the user with some information |
    '+---------------------------------------+

    LOCATE 2, 50: PRINT "Move mouse to select zone area."
    LOCATE 4, 50: PRINT "Left mouse button to trap mouse pointer."
    LOCATE 6, 50: PRINT "Right mouse button to release mouse pointer."
    LOCATE 8, 50: PRINT "ESC to exit."
    LOCATE 10, 50:
    IF MouseHovering(0) THEN '                                          check all zones for a hovering mouse
        PRINT "Currently hovering zone area"; MouseHovering(0) '        print returned zone handle value
    ELSE
        PRINT "Mouse not currently hovering over a zone."
    END IF
    LOCATE 12, 50
    IF MouseTrapped(0) THEN '                                           check all zones for a trapped mouse
        PRINT "Currently trapped in zone"; MouseTrapped(0) '            print returned zone handle value
    ELSE
        PRINT "Mouse not currently trapped."
    END IF
    LOCATE 14, 50: PRINT "This zone is defined as ";
    IF MouseZone(Zone1) THEN PRINT CHR$(34); "Zone1"; CHR$(34) '        check each individual zone for mouse interaction
    IF MouseZone(Zone2) THEN PRINT CHR$(34); "Zone2"; CHR$(34)
    IF MouseZone(Zone3) THEN PRINT CHR$(34); "Zone3"; CHR$(34)
    IF MouseZone(Zone4) THEN PRINT CHR$(34); "Zone4"; CHR$(34)
    IF MouseZone(Zone5) THEN PRINT CHR$(34); "Zone5"; CHR$(34)

    '+-----------------------------------------+
    '| Draw border(s) around chosen zone areas |
    '+-----------------------------------------+

    DrawBorder 0 '        draw borders around all zones (optional)

    '+--------------------------------+
    '| Update all defined mouse zones |
    '+--------------------------------+

    UpdateMouseZone '                                                   manage any mouse trapping that is occurring
    _DISPLAY '            update screen with changes
LOOP UNTIL _KEYDOWN(27) ' leave when ESC pressed
SYSTEM '                  return to OS

'---------------------------------------------------------------------------------------------------------------------------------
SUB HideZone (z AS INTEGER)

    '+-----------------------------+
    '| Hides a zone from the mouse |
    '|                             |
    '| z - the zone handle to hide |
    '+-----------------------------+

    SHARED Zone() AS TYPE_ZONE ' need access to mouse zones

    Zone(z).Active = 0 ' hide zone from mouse

END SUB

'---------------------------------------------------------------------------------------------------------------------------------
SUB ShowZone (z AS INTEGER)

    '+------------------------------------+
    '| Reveals a hidden zone to the mouse |
    '|                                    |
    '| z - the zone handle to reveal      |
    '+------------------------------------+

    SHARED Zone() AS TYPE_ZONE ' need access to mouse zones

    Zone(z).Active = -1 ' allow mouse to see zone

END SUB

'---------------------------------------------------------------------------------------------------------------------------------
SUB DrawBorder (z AS INTEGER)

    '+-------------------------------------------------------------------+
    '| Draws a border around a zone area depecting the current state:    |
    '|    Bright white - mouse is trapped in this zone                   |
    '|    White        - mouse is hovering over this zone                |
    '|    Gray         - mouse has no interation with this zone          |
    '|                                                                   |
    '| z - The zone to draw a border around                              |
    '|     Supply the value of 0 to have borders drawn around all zones  |
    '+-------------------------------------------------------------------+

    SHARED Zone() AS TYPE_ZONE '         need access to mouse zones
    SHARED Mouse AS TYPE_MOUSE '         need access to mouse properties
    STATIC Colour(2) AS _UNSIGNED LONG ' border colors
    DIM c AS INTEGER '                   zone counter (start of count)
    DIM Finish AS INTEGER '              end of zone counter
    DIM Border AS INTEGER '              border color

    IF UBOUND(Zone) = 0 OR z > UBOUND(Zone) THEN EXIT SUB ' leave if no defined zone areas
    IF NOT Colour(0) THEN '                                 set border colors if not set yet
        Colour(0) = _RGB32(127, 127, 127) '                 not hovering (gray)
        Colour(1) = _RGB32(192, 192, 192) '                 hovering (white)
        Colour(2) = _RGB32(255, 255, 255) '                 trapped (bright white)
    END IF
    IF z = 0 THEN '                                         draw borders around all zones?
        c = 0 '                                             yes, start at the beginning of zone array
        Finish = UBOUND(Zone) '                             finish at the end of the zone array
    ELSE '                                                  no, just a single zone
        c = z - 1 '                                         start at the individual zone in array
        Finish = z '                                        finish at the individual zone in array
    END IF
    DO '                                                    cycle through chosen zone(s)
        c = c + 1 '                                         increment zone counter
        IF Zone(c).Active THEN '                            is tis zone active?
            Border = 0 '                                    yes, assume no interaction with zone
            IF MouseHovering(c) THEN Border = 1 '           white border if mouse is hovering this zone
            IF MouseTrapped(c) THEN Border = 2 '            bright white border if mouse is trapped in this zone
            LINE (Zone(c).Area.min.x, Zone(c).Area.min.y)-(Zone(c).Area.max.x, Zone(c).Area.max.y), Colour(Border), B ' draw border
        END IF
    LOOP UNTIL c = Finish '                                 leave when zone(s) processed

END SUB

'---------------------------------------------------------------------------------------------------------------------------------
FUNCTION MouseHovering (z AS INTEGER)

    '+--------------------------------------------------------------------------------------------------+
    '| Report mouse hovering status over a zone(s)                                                      |
    '|                                                                                                  |
    '| z - the zone's handle to check for a hovering mouse                                        (>0)  |
    '|     supplying a value of 0 will simply return the zone handle where the mouse is hovering  (0)   |
    '| Returns -1 (TRUE) if the mouse is hovering on the requested zone                           (-1)  |
    '| Returns a zone handle value if the zone requested is 0 and the mouse is hovering somewhere (>=0) |
    '| Returns 0 (FALSE) if the mouse is not hovering in either scenario                          (0)   |
    '+--------------------------------------------------------------------------------------------------+

    SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
    SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties

    MouseHovering = 0 '                      assume mouse is not hovering                           (0 FALSE return)
    IF Mouse.Hovering THEN '                 is the mouse hovering over a zone?
        IF z > 0 THEN '                      yes, was a zone requested?                             (>0)
            IF z = Mouse.Hovering THEN '     yes, is mouse hovering over the zone requested?
                MouseHovering = z '          yes, report that mouse is hovering over requested zone (-1 TRUE return)
            END IF
        ELSE '                               no, a zone was not requested
            MouseHovering = Mouse.Hovering ' report any zone handle the mouse may be hovering over  (>=0 TRUE or FALSE return)
        END IF
    END IF

END FUNCTION

'---------------------------------------------------------------------------------------------------------------------------------
FUNCTION MouseZone (z AS INTEGER)

    '+-------------------------------------------------------+
    '| Report interaction status of mouse and zone area      |
    '|                                                       |
    '| z - the zone's handle                                 |
    '| Returns -1 (TRUE) if interaction, 0 (FALSE) otherwise |
    '+-------------------------------------------------------+

    SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
    SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
    DIM Trapped AS INTEGER '     mouse trapped status

    IF NOT Zone(z).Active THEN EXIT FUNCTION ' leave is zone is inactive
    MouseZone = 0 '                            assume mouse not interacting with zone           (0 FALSE return)
    Trapped = MouseTrapped(0) '                record zone mouse may be trapped in
    IF Trapped THEN '                          is mouse trapped in a zone?
        IF z = Trapped THEN '                  yes, is it this zone?
            MouseZone = -1 '                   yes, report the only interaction that can happen (-1 TRUE return)
        END IF
    ELSE '                                     no, mouse if currently free
        IF MouseHover(Zone(z).Area) THEN '     is mouse interacting with this zone?
            MouseZone = -1 '                   yes, report that mouse is in this zone           (-1 TRUE return)
        END IF
    END IF

END FUNCTION

'---------------------------------------------------------------------------------------------------------------------------------
SUB TrapMouse (z AS INTEGER)

    '+---------------------------------------------+
    '| Trap mouse within a zone's area             |
    '|                                             |
    '| z - the handle of the zone to trap mouse in |
    '+---------------------------------------------+

    SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
    SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties

    IF NOT Zone(z).Active THEN EXIT SUB ' can't trap mouse in inactive zone
    Mouse.Area = Zone(z).Area '           define trapped area
    Mouse.ZoneTrap = z '                  mouse trapped in this zone  (>0)

END SUB

'---------------------------------------------------------------------------------------------------------------------------------
FUNCTION MouseTrapped (z AS INTEGER)

    '+-------------------------------------------------------------------------------------------------+
    '| Report mouse trapped status                                                                     |
    '|                                                                                                 |
    '| z - the zone's handle to check for a trapped mouse                                        (>0)  |
    '|     supplying a value of 0 will simply return the zone handle where the mouse is trapped  (0)   |
    '| Returns -1 (TRUE) if the mouse is trapped in the requested zone                           (-1)  |
    '| Returns a zone handle value if the zone requested is 0 and the mouse is trapped somewhere (>=0) |
    '| Returns 0 (FALSE) if the mouse is not trapped in either scenario                          (0)   |
    '+-------------------------------------------------------------------------------------------------+

    SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
    SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties

    MouseTrapped = 0 '                              assume mouse is not trapped                         (0 FALSE return)
    IF Mouse.ZoneTrap THEN '                        is the mouse trapped in a zone?
        IF z > 0 THEN '                             yes, was a zone requested?                          (>0)
            IF z = Mouse.ZoneTrap THEN '            yes, is mouse trapped in zone requested?
                MouseTrapped = -1 '                 yes, report that mouse is trapped in requested zone (-1 TRUE return)
            END IF
        ELSE '                                      no, a zone was not requested                        (0)
            MouseTrapped = Mouse.ZoneTrap '         report any zone handle the mouse may be trapped in  (>=0 TRUE or FALSE return)
        END IF
    END IF

END FUNCTION

'---------------------------------------------------------------------------------------------------------------------------------
SUB UpdateMouseZone ()

    SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
    SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
    SHARED MouseIMG AS LONG '    image of mouse pointer
    DIM z AS INTEGER '           zone counter

    IF UBOUND(Zone) = 0 THEN EXIT SUB '                                 leave if no zones defined
    WHILE _MOUSEINPUT: WEND '                                           get latest mouse update
    Mouse.x = _MOUSEX '                                                 record mouse pointer position
    Mouse.y = _MOUSEY
    IF Mouse.ZoneTrap THEN '                                            is mouse trapped in a zone?     (>0)
        IF Mouse.x < Mouse.Area.min.x THEN Mouse.x = Mouse.Area.min.x ' yes, confine mouse to zone area
        IF Mouse.x > Mouse.Area.max.x THEN Mouse.x = Mouse.Area.max.x
        IF Mouse.y < Mouse.Area.min.y THEN Mouse.y = Mouse.Area.min.y
        IF Mouse.y > Mouse.Area.max.y THEN Mouse.y = Mouse.Area.max.y
        _MOUSEMOVE Mouse.x, Mouse.y '                                   force mouse to any updated coordinates
        IF _MOUSEBUTTON(2) THEN Mouse.ZoneTrap = 0 '                    free mouse from trap if right mouse button pressed
    ELSE '                                                              no, mouse is free
        Mouse.Hovering = 0 '                                            assume mouse is not hovering a zone
        z = 0 '                                                         reset zone counter
        DO '                                                            cycle through zones
            z = z + 1 '                                                 increment zone counter
            IF MouseZone(z) THEN Mouse.Hovering = z '                   if mouse interacting with zone then record it hovering
        LOOP UNTIL z = UBOUND(Zone) '                                   leave when all zones checked
        IF _MOUSEBUTTON(1) AND Mouse.Hovering THEN '                    was left button clicked while hovering?
            TrapMouse Mouse.Hovering '                                  yes, trap the mouse within this zone
        END IF
    END IF
    _PUTIMAGE (Mouse.x, Mouse.y), MouseIMG '                            draw mouse pointer

END SUB

'---------------------------------------------------------------------------------------------------------------------------------
FUNCTION DefineMouseZone (x1 AS INTEGER, y1 AS INTEGER, w AS INTEGER, h AS INTEGER, Active AS INTEGER)

    '+--------------------------------------------+
    '| Defines mouse zones within the main screen |
    '+--------------------------------------------+

    SHARED Zone() AS TYPE_ZONE ' need access to zone areas

    REDIM _PRESERVE Zone(UBOUND(Zone) + 1) AS TYPE_ZONE ' increase array size
    Zone(UBOUND(Zone)).Area.min.x = x1 '                  set new zone area coordinates
    Zone(UBOUND(Zone)).Area.max.x = x1 + w - 1
    Zone(UBOUND(Zone)).Area.min.y = y1
    Zone(UBOUND(Zone)).Area.max.y = y1 + h - 1
    Zone(UBOUND(Zone)).Active = Active '                  set active status
    DefineMouseZone = UBOUND(Zone) '                      return handle of zone area

END FUNCTION

'---------------------------------------------------------------------------------------------------------------------------------
FUNCTION MouseHover (Area AS TYPE_AREA)

    '+--------------------------------------------------------------------------------+
    '| Returns a value of 1 if the mouse is hovering over the given area, 0 otherwise |
    '+--------------------------------------------------------------------------------+

    MouseHover = 0 '                            assume mouse not hovering over area
    WHILE _MOUSEINPUT: WEND '                   get latest mouse updates
    IF _MOUSEX >= Area.min.x THEN '             is mouse pointer currently within area limits?
        IF _MOUSEX <= Area.max.x THEN
            IF _MOUSEY >= Area.min.y THEN
                IF _MOUSEY <= Area.max.y THEN
                    MouseHover = 1 '            yes, report that mouse is hovering this area
                END IF
            END IF
        END IF
    END IF

END FUNCTION
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Reply


Messages In This Thread
Mapping screen for mouse - by PhilOfPerth - 08-07-2023, 01:52 AM
RE: Mapping screen for mouse - by commandvom - 08-07-2023, 02:32 AM
RE: Mapping screen for mouse - by mnrvovrfc - 08-07-2023, 03:36 AM
RE: Mapping screen for mouse - by mnrvovrfc - 08-07-2023, 03:51 AM
RE: Mapping screen for mouse - by PhilOfPerth - 08-07-2023, 04:14 AM
RE: Mapping screen for mouse - by SMcNeill - 08-07-2023, 07:25 AM
RE: Mapping screen for mouse - by PhilOfPerth - 08-08-2023, 06:53 AM
RE: Mapping screen for mouse - by TerryRitchie - 08-07-2023, 08:36 AM
RE: Mapping screen for mouse - by grymmjack - 08-07-2023, 02:32 PM
RE: Mapping screen for mouse - by TerryRitchie - 08-07-2023, 03:29 PM
RE: Mapping screen for mouse - by grymmjack - 08-08-2023, 12:12 AM
RE: Mapping screen for mouse - by TerryRitchie - 08-08-2023, 05:10 PM
RE: Mapping screen for mouse - by bplus - 08-07-2023, 02:36 PM
RE: Mapping screen for mouse - by TerryRitchie - 08-07-2023, 03:34 PM
RE: Mapping screen for mouse - by CharlieJV - 08-07-2023, 09:37 PM
RE: Mapping screen for mouse - by grymmjack - 08-08-2023, 12:17 AM
RE: Mapping screen for mouse - by CharlieJV - 08-08-2023, 01:53 AM
RE: Mapping screen for mouse - by grymmjack - 08-08-2023, 12:11 AM
RE: Mapping screen for mouse - by mnrvovrfc - 08-08-2023, 12:37 PM
RE: Mapping screen for mouse - by bplus - 08-07-2023, 05:44 PM
RE: Mapping screen for mouse - by justsomeguy - 08-07-2023, 07:55 PM
RE: Mapping screen for mouse - by CharlieJV - 08-07-2023, 09:35 PM
RE: Mapping screen for mouse - by grymmjack - 08-08-2023, 12:07 AM
RE: Mapping screen for mouse - by mdijkens - 08-08-2023, 10:24 AM
RE: Mapping screen for mouse - by bplus - 08-07-2023, 08:47 PM
RE: Mapping screen for mouse - by justsomeguy - 08-07-2023, 09:16 PM
RE: Mapping screen for mouse - by justsomeguy - 08-07-2023, 09:22 PM
RE: Mapping screen for mouse - by CharlieJV - 08-07-2023, 09:46 PM
RE: Mapping screen for mouse - by justsomeguy - 08-07-2023, 10:03 PM
RE: Mapping screen for mouse - by CharlieJV - 08-07-2023, 10:57 PM
RE: Mapping screen for mouse - by bplus - 08-07-2023, 11:37 PM
RE: Mapping screen for mouse - by TerryRitchie - 08-08-2023, 02:45 AM
RE: Mapping screen for mouse - by PhilOfPerth - 08-08-2023, 06:59 AM
RE: Mapping screen for mouse - by bplus - 08-08-2023, 12:25 PM
RE: Mapping screen for mouse - by mdijkens - 08-08-2023, 01:16 PM
RE: Mapping screen for mouse - by justsomeguy - 08-08-2023, 06:59 PM



Users browsing this thread: 9 Guest(s)