Mouse trouble

Game development specific discussions.
ITomi
Posts: 121
Joined: Jul 31, 2015 11:23
Location: Hungary

Mouse trouble

Postby ITomi » Jul 12, 2019 13:14

Hello members!

I have a big problem: I would like to scroll 3 images between two arrow icons. These 3 images are part of more images, but I would like show these 3 ones once, therefore I need the two arrow icons to scroll. Everything is OK until this point. But I would like to scroll only if the player releases the left mouse button above the arrow icon. This is my problem, because this is not works. I can do my code at pressing the mouse button, but not in case of release. The arrow icons and the other images are consists of two subimages (pressed and released).
Here is my code:

Code: Select all

for i as ubyte=0 to 1
        if scrollarrows(i).exists=1 then
            dim as integer mousex,mousey,mousebutton,mouse
            dim as any ptr sasprite=scrollarrows(i).itssprite
            mouse=getmouse(mousex,mousey,,mousebutton)
            if mouse=0 then
                if (mousebutton and 1) then
                    if mousex>=scrollarrows(i).xplace and mousex<=scrollarrows(i).xplace+64 and mousey>=scrollarrows(i).yplace and mousey<=scrollarrows(i).yplace+64 then
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(0)
                            sasprite=leftarrowspr(1)
                        case rightarrowspr(0)
                            sasprite=rightarrowspr(1)
                        end select
                    else
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(1)
                            sasprite=leftarrowspr(0)
                        case rightarrowspr(1)
                            sasprite=rightarrowspr(0)
                        end select
                    end if
                else'if mousex>=scrollarrows(i).xplace and mousex<=scrollarrows(i).xplace+64 and mousey>=scrollarrows(i).yplace and mousey<=scrollarrows(i).yplace+64 then
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(1)
                            if arraystart>0 and canscrollmenu=0 then
                                arraystart-=1
                                for j as ubyte=0 to showiconnumber-1
                                    if showicons(j).exists=1 then showicons(j).itssprite=iconarray(arraystart+j)
                                next j
                                canscrollmenu=10
                            end if
                            sasprite=leftarrowspr(0)
                        case rightarrowspr(1)
                            if arraystart+(showiconnumber-1)<numoficons-1 and canscrollmenu=0 then
                                arraystart+=1
                                for j as ubyte=0 to showiconnumber-1
                                    if showicons(j).exists=1 then showicons(j).itssprite=iconarray(arraystart+j)
                                next j
                                canscrollmenu=10
                            end if
                            sasprite=rightarrowspr(0)
                        end select
                end if
            end if
            put (scrollarrows(i).xplace, scrollarrows(i).yplace),sasprite,pset
        end if
next i
badidea
Posts: 1461
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Mouse trouble

Postby badidea » Jul 12, 2019 14:35

I cannot run your code, but in this small game (viewtopic.php?f=15&t=27720) I detect mouse button release by storing the previous state of the mouse buttons. And I compare this against current state. Mouse button was active and now it is not, then button was released.

I only used the mouse position at the moment of release. If both position at 'pressed' and position at 'release' are important, some additional code is needed. Worded differently, my buttons on screen don't change image when being pressed (state between 'pressed' and 'released').
dodicat
Posts: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Mouse trouble

Postby dodicat » Jul 12, 2019 16:52

See screenevent in the help file.
Quick example

Code: Select all

#include "fbgfx.bi"
using fb

dim as event e
dim as long mx,my,mb,mouse,lastmb

screen 19
do
 
     getmouse (mx,my,,mb)
    If (ScreenEvent(@e))   Then
        cls
        locate 5
        if e.type=EVENT_MOUSE_BUTTON_PRESS and mb=1 then print   "left  pressed"
        if e.type=EVENT_MOUSE_BUTTON_RELEASE and lastmb=1 then print "left released"
        end if
    sleep 1
    lastmb=mb
    loop until multikey(1)
ITomi
Posts: 121
Joined: Jul 31, 2015 11:23
Location: Hungary

Re: Mouse trouble

Postby ITomi » Jul 12, 2019 18:15

Thank you for your answers, Badidea and Dodicat! I will try these.
(Badidea, you can't run my code directly, because these are only few lines from my program.)
ITomi
Posts: 121
Joined: Jul 31, 2015 11:23
Location: Hungary

Re: Mouse trouble

Postby ITomi » Aug 14, 2019 13:15

I almost solved my problem, but something still wrong.
Here is the FOR loop in a nutshell, that manage the two arrows, which show icons to the player:

for i as ubyte=0 to 1
if scrollarrow(i).exists=1 then
(...)
(manage the mouse)
if (mousebutton and 1) then
(if mouse over scrollarrow(i) then change the sprite of arrow)
elseif leftmousebutton was pressed and mouse over the scrollarrow(i):
if i=0 then manage left scrollarrow
else manage right scrollarrow
(...)
next i


But the i=0 is never executed, at least as if the second option (i=1) always overwrite it. How can I solve this?
dodicat
Posts: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Mouse trouble

Postby dodicat » Aug 14, 2019 17:16

Have a flag to ensure that one click only is executed.
Reset this flag outside of any loop.
I don't use unsigned datatypes for loop variables, but that is my choice.
I avoid AND when = does the job.
I can then use AND as a conditional operator.
I hardly ever use elseif.

Example.

Code: Select all

#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius

screen 19,32

type circle
    as long x,y,rad
    as ulong col
end type

dim as circle c(0 to 1)={(200,200,20,rgb(200,0,0)),(500,200,20,rgb(0,200,0))}
dim as long mx,my,btn,flag
dim as string message
do
     getmouse mx,my,,btn
     screenlock
     cls
     draw string(300,200),message
    for i as long=0 to 1
        circle(c(i).x,c(i).y),c(i).rad,c(i).col,,,,f
        if incircle(c(i).x,c(i).y,c(i).rad,mx,my) then
            circle(c(i).x,c(i).y),c(i).rad 'highlight
            if btn=1 and flag=0 then
            swap c(0).col,c(1).col ' do something
           
            if i=0 then message="Left circle" else message="Right circle"
           
        end if
    end if
   
        next
        screenunlock
        sleep 1
        flag=btn
        loop until inkey=chr(27)
       

     
ITomi
Posts: 121
Joined: Jul 31, 2015 11:23
Location: Hungary

Re: Mouse trouble

Postby ITomi » Aug 15, 2019 7:37

Hello Dodicat!

My problem is now with the FOR loop, because I don't understand why is it not execute the SELECT CASE in case of i=0? (See the code in my first post.)
What happening with the SELECT CASE within the loop?
BasicCoder2
Posts: 3398
Joined: Jan 01, 2009 7:03

Re: Mouse trouble

Postby BasicCoder2 » Aug 15, 2019 9:51

ITomi wrote:My problem is now with the FOR loop, because I don't understand why is it not execute the SELECT CASE in case of i=0? (See the code in my first post.)
What happening with the SELECT CASE within the loop?

Maybe it has something to do with other unseen parts of the code. Your code is too complicated for me to unravel.
My assumption from your description in the first post is you have an array of images and want to scroll through them showing three at a time?

Code: Select all

screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255):cls
dim shared as integer mx,my,mb

type BUTTON
    as integer x,y   'position
    as integer w,h   'size
    as integer sel   'selected or not
    as any ptr image1
    as any ptr image2
end type

'create images for buttons
dim shared as any ptr leftButtonOff
dim shared as any ptr leftButtonOn
leftButtonOff = imagecreate(20,20,rgb(255,0,0))
leftButtonOn  = imagecreate(20,20,rgb(0,255,0))
draw string leftbuttonOff,(8,8),"<"
draw string leftbuttonOn,(8,8),"<"

dim shared as any ptr rightButtonOff
dim shared as any ptr rightButtonOn
rightButtonOff = imagecreate(20,20,rgb(255,0,0))
rightButtonOn  = imagecreate(20,20,rgb(0,255,0))
draw string rightbuttonOff,(8,8),">"
draw string rightbuttonOn,(8,8),">"

'create the buttons
dim shared as BUTTON btn1, btn2
btn1.x = 50
btn1.y = 50
btn1.w = 20
btn1.h = 20
btn1.image1 = leftButtonOff
btn1.image2 = leftButtonOn
btn1.sel = 0  'not selected

btn2.x = 530
btn2.y = 50
btn2.w = 20
btn2.h = 20
btn2.image1 = rightButtonOff
btn2.image2 = rightButtonOn
btn2.sel = 0  'not selected

dim shared as any ptr images(0 to 19)
dim as integer x,y,r

dim shared as integer imageNumber

for i as integer = 0 to 19
    images(i)=imagecreate(100,100)
    line images(i),(0,0)-(99,99),rgb(int(rnd(1)*256), int(rnd(1)*256), int(rnd(1)*256)),bf
    for j as integer = 0 to 20
        x = int(rnd(1)*100)
        y = int(rnd(1)*100)
        r = int(rnd(1)*10)+5
        circle images(i),(x,y) ,r,rgb(int(rnd(1)*256), int(rnd(1)*256), int(rnd(1)*256)),,,,f
    next j
    draw string images(i),(5,5),"image " & str(i)
next i

sub showImages()
    screenlock
    cls
    for j as integer = 0 to 2
        put ((imageNumber+j)+100+j*150,50),images(imageNumber+j),trans
    next j
   
    if btn1.sel = 0 then
        put (btn1.x,btn1.y),btn1.image1,trans
    else
        put (btn1.x,btn1.y),btn1.image2,trans
    end if
   
    if btn2.sel = 0 then
        put (btn2.x,btn2.y),btn2.image1,trans
    else
        put (btn2.x,btn2.y),btn2.image2,trans
    end if
   
    screenunlock
end sub

do
    showImages()
    getmouse mx,my,,mb
   
    'is mouse over left button?
    if mx>btn1.x and mx<btn1.x+btn1.w and my>btn1.y and my<btn1.y + btn1.h then
        btn1.sel = 1
    else
        btn1.sel = 0
    end if
   
    'is mouse over right button?
    if mx>btn2.x and mx<btn2.x+btn2.w and my>btn2.y and my<btn2.y + btn2.h then
        btn2.sel = 1
    else
        btn2.sel = 0
    end if
   
    'is mouse down on left button
    if mb = 1 then
        if mx>btn1.x and mx<btn1.x+btn1.w and my>btn1.y and my<btn1.y + btn1.h then
            if imageNumber >0 then
                imageNumber = imageNumber - 1
            end if
        end if
   
        'is mouse down on right button?
        if mx>btn2.x and mx<btn2.x+btn2.w and my>btn2.y and my<btn2.y + btn2.h then
           if imageNumber < 19-2 then
               imageNumber = imageNumber + 1
           end if
        end if
        showImages()
        while mb=1
            getmouse mx,my,,mb
        wend
    end if
   
   
    sleep 2
loop until multikey(&H01)
dodicat
Posts: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Mouse trouble

Postby dodicat » Aug 15, 2019 10:08

I see you have if mouse=0 then
...

end if

This adds an extra loop to complicate things.
Why don't you simplify things, if you are concerned about mouse not being available (outside the box say), then simply exit the loop if the mouse <>0
Simplified code.


Code: Select all

 screen 12

type udt
    as long exists,xplace,yplace
    dim as any ptr itssprite
end type
dim as udt scrollarrows(1)
 scrollarrows(0).exists=1
 scrollarrows(1).exists=1
dim as long  leftarrowspr(1),rightarrowspr(1)

do
    screenlock
    cls
    line(0,0)-(64,64),,b
    locate 6
for i as ubyte=0 to 1
        if scrollarrows(i).exists=1 then
            dim as integer mousex,mousey,mousebutton,mouse
            dim as any ptr sasprite=scrollarrows(i).itssprite
            mouse=getmouse(mousex,mousey,,mousebutton)
            if mouse<>0 then exit for
                if (mousebutton = 1) then'***   = more clear than and
                    if mousex>=scrollarrows(i).xplace and mousex<=scrollarrows(i).xplace+64 and mousey>=scrollarrows(i).yplace and mousey<=scrollarrows(i).yplace+64 then
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(0)
                            print i,"leftarrowspr(0)"
                           ' sasprite=leftarrowspr(1)
                        case rightarrowspr(0)
                            print i,"rightarrowspr(0)"
                            'sasprite=rightarrowspr(1)
                        end select
                    else
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(1)
                            print i,"leftarrowspr(1)"
                           ' sasprite=leftarrowspr(0)
                        case rightarrowspr(1)
                            print i,"rightarrowspr(1)"
                            'sasprite=rightarrowspr(0)
                        end select
                    end if ''
                else  'if mousebutton=0           'if mousex>=scrollarrows(i).xplace and mousex<=scrollarrows(i).xplace+64 and mousey>=scrollarrows(i).yplace and mousey<=scrollarrows(i).yplace+64 then
                   
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(1)
                            print i,"leftarrowspr(1)","else"
                       
                           ' if arraystart>0 and canscrollmenu=0 then
                               ' arraystart-=1
                               ' for j as ubyte=0 to showiconnumber-1
                                  '  if showicons(j).exists=1 then showicons(j).itssprite=iconarray(arraystart+j)
                               ' next j
                               ' canscrollmenu=10
                           ' end if
                            'sasprite=leftarrowspr(0)
                        case rightarrowspr(1)
                            print i,"rightarrowspr(1)","else"
                           ' if arraystart+(showiconnumber-1)<numoficons-1 and canscrollmenu=0 then
                               ' arraystart+=1
                               ' for j as ubyte=0 to showiconnumber-1
                                   ' if showicons(j).exists=1 then showicons(j).itssprite=iconarray(arraystart+j)
                                'next j
                                'canscrollmenu=10
                            'end if
                           ' sasprite=rightarrowspr(0)
                        end select
                end if
            end if
           ' put (scrollarrows(i).xplace, scrollarrows(i).yplace),sasprite,pset
       ' end if
next i
screenunlock
sleep 10
loop until inkey=chr(27) 
badidea
Posts: 1461
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Mouse trouble

Postby badidea » Aug 15, 2019 22:37

A mouse button example. 'Draggable' buttons not implemented yet.
"Good trigger" = Mouse button release above same button as when pressed.
"Bad trigger" = Mouse button release not above same button pressed.

Code: Select all

const SCREEN_W = 640, SCREEN_H = 480

'--------------------------- TYPES & ROUTINES ----------------------------------

const as ulong L_GREEN = rgb(0, 200, 0)
const as ulong D_GREEN = rgb(0, 100, 0)
const as ulong L_YELLOW = rgb(200, 200, 0)
const as ulong D_YELLOW = rgb(100, 100, 0)
const as ulong L_GREY = rgb(191, 191, 191)
const as ulong BLACK = rgb(0, 0, 0)

type mouse_type
   dim as integer res
   dim as integer x, y
   dim as integer wheel, clip
   union
      dim as integer buttons
      type
         lb : 1 as integer
         rb : 1 as integer
         mb : 1 as integer
      end type
   end union
end type

sub clearScreen(c as ulong)
   line(0, 0)-(SCREEN_W - 1, SCREEN_H - 1), c, bf
end sub

function intRndBetween(min as integer, max as integer) as integer
   return int(rnd * (max + 1 - min)) + min
end function

const MIN_BUTTON_W = 30, MAX_BUTTON_W = 150
const MIN_BUTTON_H = 20, MAX_BUTTON_H = 60

type button_type
   dim as integer x, y 'position
   dim as integer w, h 'size
   dim as integer allowDrag 'only used for color now
   dim as integer active
   dim as ulong c1, c2 'colors: normal, pressed
   declare constructor()
   declare sub draw()
   declare function check(x as integer, y as integer) as integer
end type

'create random button
constructor button_type()
   dim as integer r, g, b
   w = intRndBetween(MIN_BUTTON_W, MAX_BUTTON_W)
   h = intRndBetween(MIN_BUTTON_H, MAX_BUTTON_H)
   x = intRndBetween(10, SCREEN_W - w - 10)
   y = intRndBetween(10, SCREEN_H - h - 10)
   allowDrag = intRndBetween(0, 1)
   if allowDrag = 1 then
      c1 = L_GREEN
      c2 = D_GREEN
   else
      c1 = L_YELLOW
      c2 = D_YELLOW
   end if
end constructor

sub button_type.draw()
   if active = 0 then
      line(x + 1, y + 1)-step(w - 2, h - 2), c1, bf
      line(x, y)-step(w, h), c2, b
   else
      line(x + 1, y + 1)-step(w - 2, h - 2), c2, bf
      line(x, y)-step(w, h), c1, b
   end if
end sub

'button here?
Function button_type.check(xCheck as integer, yCheck as integer) as integer
   if xCheck > x and xCheck < x + w then
      if yCheck > y and yCheck < y + h then
         return 1
      end if
   end if
   return 0
end function

'return first button index found at x, y
function checkButtons(button() as button_type, xCheck as integer, yCheck as integer) as integer
   for i as integer = ubound(button) to 0 step -1 'draw last, select first
      if button(i).check(xCheck, yCheck) = 1 then return i
   next
   return -1 'none found
end function

sub drawButtons(button() as button_type)
   for i as integer = 0 to ubound(button)
      button(i).draw()
   next
end sub

'------------------------------ MAIN -------------------------------------------

screenres SCREEN_W, SCREEN_H, 32
width SCREEN_W \ 8, SCREEN_H \ 16

randomize timer

const NUM_BUTTONS = 10
dim as button_type button(NUM_BUTTONS - 1) 'create and intialize random buttons

dim as string key
dim as mouse_type mNow, mPrev
dim as integer quit = 0
dim as integer activeButtonId = -1
dim as string lastEventStr = ""
dim as double lastEventTime = timer

while quit = 0
   mPrev = mNow
   mNow.res = getmouse (mNow.x, mNow.y , mNow.wheel, mNow.buttons, mNow.clip)
   if mNow.res <> 0 then
      mNow = mPrev
   else
      if (mPrev.lb = 0 and mNow.lb = 1) then
         'print "MOUSE_LB_PRESSED"
         activeButtonId = checkButtons(button(), mNow.x, mNow.y)
         if activeButtonId <> -1 then
            button(activeButtonId).active = 1
         end if
      end if
      if (mPrev.lb = 1 and mNow.lb = 0) then
         'print "MOUSE_LB_RELEASED"
         if activeButtonId <> -1 then
            button(activeButtonId).active = 0
            'check if mouse is still above the button
            if activeButtonId = checkButtons(button(), mNow.x, mNow.y) then
               lastEventStr = "Good trigger: " + str(activeButtonId)
               lastEventTime = timer
            else
               lastEventStr = "Bad trigger: " + str(activeButtonId)
               lastEventTime = timer
            end if
            activeButtonId = -1
         end if
      end if
      if (mPrev.rb = 0 and mNow.rb = 1) then
         'print "MOUSE_RB_PRESSED"
      end if
      if (mPrev.rb = 1 and mNow.rb = 0) then
         'print "MOUSE_RB_RELEASED"
      end if
   end if
   'clear event text after 0.5 second
   if timer > lastEventTime + 0.5 then
      lastEventStr = ""
   end if
   'draw
   screenlock
   clearScreen(L_GREY)
   drawButtons(button())
   draw string(10, 10), lastEventStr, BLACK
   screenunlock
   'sleep
   key = inkey
   if key = chr(27) then quit = 1
   sleep 1
wend
ITomi
Posts: 121
Joined: Jul 31, 2015 11:23
Location: Hungary

Re: Mouse trouble

Postby ITomi » Aug 16, 2019 13:48

I wrote a piece of code focusing onto my problem. In this you can click the left and right circles to scroll the circles within. But only works with the right scroll circle, backwards not.

Code: Select all

#include "fbgfx.bi"
Using FB

dim shared as ubyte numofshowicon,leftmousebuttonpressed=0,arraystart,canscrollmenu
dim shared as any ptr whitecircle,leftarrowspr(2),rightarrowspr(2)

type icons
    as ushort xplace,yplace
    as ubyte exists,pressed
    as any ptr itssprite
end type

dim shared numoficons as ubyte=0
redim shared showicons(numoficons) as icons
redim shared scrollarrows(2) as icons
dim shared iconarray(9) as any ptr

screenres 640,480,32

function wcr(n as ubyte) as any ptr
    whitecircle=imagecreate(64,64)
    circle whitecircle,(32,32),28,Color RGB(0, 0, 0)
    draw string whitecircle,(1,1),str(n)
    return whitecircle
end function

leftarrowspr(0)=imagecreate(64,64)
circle leftarrowspr(0),(32,32),32,Color RGB(255, 0, 0)
draw string leftarrowspr(0),(1,1),"<-"
leftarrowspr(1)=imagecreate(64,64)
circle leftarrowspr(1),(32,32),32,Color RGB(0, 0, 255)
draw string leftarrowspr(1),(1,1),"<-"
rightarrowspr(0)=imagecreate(64,64)
circle rightarrowspr(0),(32,32),32,Color RGB(255, 0, 0)
draw string rightarrowspr(0),(1,1),"->"
rightarrowspr(1)=imagecreate(64,64)
circle rightarrowspr(1),(32,32),32,Color RGB(0, 0, 255)
draw string rightarrowspr(1),(1,1),"->"

function min(num1 as double, num2 as double) as double
    if num1<num2 then
        return num1
    else
        return num2
    end if
end function

sub showtheicons()
    for i as ubyte=0 to 1
        if scrollarrows(i).exists=1 then
            dim as integer mousex,mousey,mousebutton,mouse
            dim as any ptr scrarrsprite=scrollarrows(i).itssprite
            mouse=getmouse(mousex,mousey,,mousebutton)
            if mouse=0 then
                if (mousebutton and 1) then
                    if mousex>=scrollarrows(i).xplace and mousex<=scrollarrows(i).xplace+64 and mousey>=scrollarrows(i).yplace and mousey<=scrollarrows(i).yplace+64 then
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(0)
                            scrarrsprite=leftarrowspr(1)
                        case rightarrowspr(0)
                            scrarrsprite=rightarrowspr(1)
                        end select
                        leftmousebuttonpressed=1
                    else
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(1)
                            scrarrsprite=leftarrowspr(0)
                        case rightarrowspr(1)
                            scrarrsprite=rightarrowspr(0)
                        end select
                        leftmousebuttonpressed=0
                    end if
                elseif leftmousebuttonpressed=1 and mousex>=scrollarrows(i).xplace and mousex<=scrollarrows(i).xplace+64 and mousey>=scrollarrows(i).yplace and mousey<=scrollarrows(i).yplace+64 then
                        if i=0 then
                            if arraystart>0 and canscrollmenu=0 then
                                arraystart-=1
                                for j as ubyte=0 to numofshowicon-1
                                    if showicons(j).exists=1 then showicons(j).itssprite=iconarray(arraystart+j)
                                next j
                                canscrollmenu=10
                            end if
                            scrarrsprite=leftarrowspr(0)
                        else
                            if arraystart+(numofshowicon-1)<numoficons-1 and canscrollmenu=0 then
                                arraystart+=1
                                for j as ubyte=0 to numofshowicon-1
                                    if showicons(j).exists=1 then showicons(j).itssprite=iconarray(arraystart+j)
                                next j
                                canscrollmenu=10
                            end if
                            scrarrsprite=rightarrowspr(0)
                        end if
                        leftmousebuttonpressed=0
                    end if
            end if
            put (scrollarrows(i).xplace, scrollarrows(i).yplace),scrarrsprite,pset
        end if
    next i
    for i as ubyte=0 to min(2,numoficons-1)
        if showicons(i).exists=1 then
            put (showicons(i).xplace, showicons(i).yplace),showicons(i).itssprite,pset
        end if
    next i
end sub

iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
dim as ushort xh=4
redim preserve scrollarrows(0)
scrollarrows(0).exists=1
scrollarrows(0).xplace=xh : xh+=64 : scrollarrows(0).yplace=40
scrollarrows(0).itssprite=leftarrowspr(0)
numofshowicon=0 : arraystart=0
for i as ubyte=0 to min(2,numoficons-1)
        redim preserve showicons(i)
        showicons(i).exists=1 : numofshowicon+=1
        showicons(i).xplace=xh : xh+=64 : showicons(i).yplace=40
        showicons(i).itssprite=iconarray(i) : showicons(i).pressed=0
next i
redim preserve scrollarrows(1)
scrollarrows(1).exists=1
scrollarrows(1).xplace=xh : scrollarrows(1).yplace=40
scrollarrows(1).itssprite=rightarrowspr(0)

do
            screenlock
            cls
            showtheicons()
            if canscrollmenu>0 then canscrollmenu-=1
            screenunlock
            sleep 10
loop until multikey(sc_q)
imagedestroy whitecircle
for i as ubyte=0 to 1
    imagedestroy leftarrowspr(i)
    imagedestroy rightarrowspr(i)
next i
dodicat
Posts: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Mouse trouble

Postby dodicat » Aug 16, 2019 18:38

It is quite hard for me to follow.
But if you omit leftmousebuttonpressed=0 from the first bit it seems to be OK.

Code: Select all

 #include "fbgfx.bi"
Using FB

dim shared as ubyte numofshowicon,leftmousebuttonpressed=0,arraystart,canscrollmenu
dim shared as any ptr whitecircle,leftarrowspr(2),rightarrowspr(2)

type icons
    as ushort xplace,yplace
    as ubyte exists,pressed
    as any ptr itssprite
end type

dim shared numoficons as ubyte=0
redim shared showicons(numoficons) as icons
redim shared scrollarrows(2) as icons
dim shared iconarray(9) as any ptr

screenres 640,480,32

function wcr(n as ubyte) as any ptr
    whitecircle=imagecreate(64,64)
    circle whitecircle,(32,32),28,Color RGB(0, 0, 0)
    draw string whitecircle,(1,1),str(n)
    return whitecircle
end function

leftarrowspr(0)=imagecreate(64,64)
circle leftarrowspr(0),(32,32),32,Color RGB(255, 0, 0)
draw string leftarrowspr(0),(1,1),"<-"
leftarrowspr(1)=imagecreate(64,64)
circle leftarrowspr(1),(32,32),32,Color RGB(0, 0, 255)
draw string leftarrowspr(1),(1,1),"<-"
rightarrowspr(0)=imagecreate(64,64)
circle rightarrowspr(0),(32,32),32,Color RGB(255, 0, 0)
draw string rightarrowspr(0),(1,1),"->"
rightarrowspr(1)=imagecreate(64,64)
circle rightarrowspr(1),(32,32),32,Color RGB(0, 0, 255)
draw string rightarrowspr(1),(1,1),"->"

function min(num1 as double, num2 as double) as double
    if num1<num2 then
        return num1
    else
        return num2
    end if
end function

sub showtheicons()
    for i as ubyte=0 to 1
        if scrollarrows(i).exists=1 then
            dim as integer mousex,mousey,mousebutton,mouse
            dim as any ptr scrarrsprite=scrollarrows(i).itssprite
            mouse=getmouse(mousex,mousey,,mousebutton)
            if mouse=0 then
               
                if (mousebutton = 1) then
                    if mousex>=scrollarrows(i).xplace and mousex<=scrollarrows(i).xplace+64 and mousey>=scrollarrows(i).yplace and mousey<=scrollarrows(i).yplace+64 then
               
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(0)
                            scrarrsprite=leftarrowspr(1)
                        case rightarrowspr(0)
                            scrarrsprite=rightarrowspr(1)
                        end select
                        leftmousebuttonpressed=1
                    else
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(1)
                            scrarrsprite=leftarrowspr(0)
                        case rightarrowspr(1)
                            scrarrsprite=rightarrowspr(0)
                        end select
                       ' leftmousebuttonpressed=0  ''THIS BIT OUT
                    end if
               
                elseif leftmousebuttonpressed=1  and mousex>=scrollarrows(i).xplace and mousex<=scrollarrows(i).xplace+64 and mousey>=scrollarrows(i).yplace and mousey<=scrollarrows(i).yplace+64 then
                   
                        if i=0 then
                            if arraystart>0 and canscrollmenu=0 then
                                arraystart-=1
                                for j as ubyte=0 to numofshowicon-1
                                    if showicons(j).exists=1 then showicons(j).itssprite=iconarray(arraystart+j)
                                next j
                                canscrollmenu=10
                            end if
                            scrarrsprite=leftarrowspr(0)
                        else
                            if arraystart+(numofshowicon-1)<numoficons-1 and canscrollmenu=0 then
                                arraystart+=1
                                for j as ubyte=0 to numofshowicon-1
                                    if showicons(j).exists=1 then showicons(j).itssprite=iconarray(arraystart+j)
                                next j
                                canscrollmenu=10
                            end if
                            scrarrsprite=rightarrowspr(0)
                            leftmousebuttonpressed=0
                        end if
                        leftmousebuttonpressed=0
                    end if
                 
            end if
            put (scrollarrows(i).xplace, scrollarrows(i).yplace),scrarrsprite,pset
        end if
       
    next i
   
    for i as ubyte=0 to min(2,numoficons-1)
        if showicons(i).exists=1 then
            put (showicons(i).xplace, showicons(i).yplace),showicons(i).itssprite,pset
        end if
    next i
end sub

iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
dim as ushort xh=4
redim preserve scrollarrows(0)
scrollarrows(0).exists=1
scrollarrows(0).xplace=xh : xh+=64 : scrollarrows(0).yplace=40
scrollarrows(0).itssprite=leftarrowspr(0)
numofshowicon=0 : arraystart=0
for i as ubyte=0 to min(2,numoficons-1)
        redim preserve showicons(i)
        showicons(i).exists=1 : numofshowicon+=1
        showicons(i).xplace=xh : xh+=64 : showicons(i).yplace=40
        showicons(i).itssprite=iconarray(i) : showicons(i).pressed=0
next i
redim preserve scrollarrows(1)
scrollarrows(1).exists=1
scrollarrows(1).xplace=xh : scrollarrows(1).yplace=40
scrollarrows(1).itssprite=rightarrowspr(0)

do
            screenlock
            cls
            showtheicons()
            if canscrollmenu>0 then canscrollmenu-=1
            screenunlock
            sleep 10
loop until multikey(sc_q)
imagedestroy whitecircle
for i as ubyte=0 to 1
    imagedestroy leftarrowspr(i)
    imagedestroy rightarrowspr(i)
next i
BasicCoder2
Posts: 3398
Joined: Jan 01, 2009 7:03

Re: Mouse trouble

Postby BasicCoder2 » Aug 16, 2019 19:38

dodicat wrote:It is quite hard for me to follow.
But if you omit leftmousebuttonpressed=0 from the first bit it seems to be OK.

It also seems to work if you make it two if/then blocks instead of using the elseif
I also couldn't see the reason for using ubyte and ushort and changed them to integer but that had no effect.

Code: Select all

#include "fbgfx.bi"
Using FB

dim shared as integer numofshowicon,leftmousebuttonpressed=0,arraystart,canscrollmenu
dim shared as any ptr whitecircle,leftarrowspr(2),rightarrowspr(2)

type icons
    as integer xplace,yplace
    as integer exists,pressed
    as any ptr itssprite
end type

dim shared numoficons as integer=0
redim shared showicons(numoficons) as icons
redim shared scrollarrows(2) as icons
dim shared iconarray(9) as any ptr

screenres 640,480,32

function wcr(n as integer) as any ptr
    whitecircle=imagecreate(64,64)
    circle whitecircle,(32,32),28,Color RGB(0, 0, 0)
    draw string whitecircle,(1,1),str(n)
    return whitecircle
end function

leftarrowspr(0)=imagecreate(64,64)
circle leftarrowspr(0),(32,32),32,Color RGB(255, 0, 0)
draw string leftarrowspr(0),(1,1),"<-"
leftarrowspr(1)=imagecreate(64,64)
circle leftarrowspr(1),(32,32),32,Color RGB(0, 0, 255)
draw string leftarrowspr(1),(1,1),"<-"
rightarrowspr(0)=imagecreate(64,64)
circle rightarrowspr(0),(32,32),32,Color RGB(255, 0, 0)
draw string rightarrowspr(0),(1,1),"->"
rightarrowspr(1)=imagecreate(64,64)
circle rightarrowspr(1),(32,32),32,Color RGB(0, 0, 255)
draw string rightarrowspr(1),(1,1),"->"

function min(num1 as double, num2 as double) as double
    if num1<num2 then
        return num1
    else
        return num2
    end if
end function

sub showtheicons()
    for i as integer=0 to 1
        if scrollarrows(i).exists=1 then
           
            dim as integer mousex,mousey,mousebutton,mouse
            dim as any ptr scrarrsprite = scrollarrows(i).itssprite
           
            mouse = getmouse(mousex,mousey,,mousebutton)
           
            if mouse=0 then
               
                if (mousebutton and 1) then
                    if mousex>=scrollarrows(i).xplace and mousex<=scrollarrows(i).xplace+64 and mousey>=scrollarrows(i).yplace and mousey<=scrollarrows(i).yplace+64 then
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(0)
                            scrarrsprite=leftarrowspr(1)
                        case rightarrowspr(0)
                            scrarrsprite=rightarrowspr(1)
                        end select
                        leftmousebuttonpressed=1
                    else
                        select case scrollarrows(i).itssprite
                        case leftarrowspr(1)
                            scrarrsprite=leftarrowspr(0)
                        case rightarrowspr(1)
                            scrarrsprite=rightarrowspr(0)
                        end select
                        leftmousebuttonpressed=0
                    end if
                end if
               
                if leftmousebuttonpressed=1 and mousex>=scrollarrows(i).xplace and mousex<=scrollarrows(i).xplace+64 and mousey>=scrollarrows(i).yplace and mousey<=scrollarrows(i).yplace+64 then
                    if i=0 then
                        if arraystart>0 and canscrollmenu=0 then
                            arraystart-=1
                            for j as integer=0 to numofshowicon-1
                                if showicons(j).exists=1 then showicons(j).itssprite=iconarray(arraystart+j)
                            next j
                            canscrollmenu=10
                        end if
                        scrarrsprite=leftarrowspr(0)
                    else
                        if arraystart+(numofshowicon-1)<numoficons-1 and canscrollmenu=0 then
                            arraystart+=1
                            for j as integer=0 to numofshowicon-1
                                if showicons(j).exists=1 then showicons(j).itssprite=iconarray(arraystart+j)
                            next j
                            canscrollmenu=10
                        end if
                        scrarrsprite=rightarrowspr(0)
                    end if
                    leftmousebuttonpressed=0
                end if
            end if
           
            put (scrollarrows(i).xplace, scrollarrows(i).yplace),scrarrsprite,pset
           
        end if
       
    next i
   
    for i as integer=0 to min(2,numoficons-1)
        if showicons(i).exists=1 then
            put (showicons(i).xplace, showicons(i).yplace),showicons(i).itssprite,pset
        end if
    next i
   
end sub

iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
iconarray(numoficons)=wcr(numoficons) : numoficons+=1
dim as integer xh=4
redim preserve scrollarrows(0)
scrollarrows(0).exists=1
scrollarrows(0).xplace=xh : xh+=64 : scrollarrows(0).yplace=40
scrollarrows(0).itssprite=leftarrowspr(0)
numofshowicon=0 : arraystart=0

for i as integer=0 to min(2,numoficons-1)
    redim preserve showicons(i)
    showicons(i).exists=1 : numofshowicon+=1
    showicons(i).xplace=xh : xh+=64 : showicons(i).yplace=40
    showicons(i).itssprite=iconarray(i) : showicons(i).pressed=0
next i

redim preserve scrollarrows(1)
scrollarrows(1).exists=1
scrollarrows(1).xplace=xh : scrollarrows(1).yplace=40
scrollarrows(1).itssprite=rightarrowspr(0)

do
    screenlock
    cls
    showtheicons()
    if canscrollmenu>0 then canscrollmenu = canscrollmenu - 1
    screenunlock
    sleep 10
loop until multikey(sc_q)

imagedestroy whitecircle
for i as integer=0 to 1
    imagedestroy leftarrowspr(i)
    imagedestroy rightarrowspr(i)
next i
dodicat
Posts: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Mouse trouble

Postby dodicat » Aug 16, 2019 20:27

I tried that basiccoder2 (I hate elseif)
It worked up and down the cycles, but the little arrows didn't show on clicking.
BasicCoder2
Posts: 3398
Joined: Jan 01, 2009 7:03

Re: Mouse trouble

Postby BasicCoder2 » Aug 17, 2019 7:47

@dodicat,
Missed that I was just too pleased to see it "working" to notice :)

ITomi wants it to scroll only if the player releases the button above an arrow icon which is not how I see buttons usually behaving which is to act if the mouse button is pressed while over a GUI button.
So I wonder if this is what ITomi was trying to do?
The scroll buttons only work if the mouse is released while over them.

Code: Select all

screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255):cls
dim shared as integer mx,my,mb,mb2
dim shared as integer mouseReleased

type BUTTON
    as integer x,y   'position
    as integer w,h   'size
    as integer sel   'selected or not
    as any ptr image1
    as any ptr image2
end type

'create images for buttons
dim shared as any ptr leftButtonOff
dim shared as any ptr leftButtonOn
leftButtonOff = imagecreate(20,20,rgb(255,0,0))
leftButtonOn  = imagecreate(20,20,rgb(0,255,0))
draw string leftbuttonOff,(8,8),"<"
draw string leftbuttonOn,(8,8),"<"

dim shared as any ptr rightButtonOff
dim shared as any ptr rightButtonOn
rightButtonOff = imagecreate(20,20,rgb(255,0,0))
rightButtonOn  = imagecreate(20,20,rgb(0,255,0))
draw string rightbuttonOff,(8,8),">"
draw string rightbuttonOn,(8,8),">"

'create the buttons
dim shared as BUTTON btn1, btn2
btn1.x = 50
btn1.y = 50
btn1.w = 20
btn1.h = 20
btn1.image1 = leftButtonOff
btn1.image2 = leftButtonOn
btn1.sel = 0  'not selected

btn2.x = 530
btn2.y = 50
btn2.w = 20
btn2.h = 20
btn2.image1 = rightButtonOff
btn2.image2 = rightButtonOn
btn2.sel = 0  'not selected

dim shared as any ptr images(0 to 19)
dim as integer x,y,r

dim shared as integer imageNumber

for i as integer = 0 to 19
    images(i)=imagecreate(100,100)
    line images(i),(0,0)-(99,99),rgb(int(rnd(1)*256), int(rnd(1)*256), int(rnd(1)*256)),bf
    for j as integer = 0 to 20
        x = int(rnd(1)*100)
        y = int(rnd(1)*100)
        r = int(rnd(1)*10)+5
        circle images(i),(x,y) ,r,rgb(int(rnd(1)*256), int(rnd(1)*256), int(rnd(1)*256)),,,,f
    next j
    draw string images(i),(5,5),"image " & str(i)
next i

sub showImages()
    screenlock
    cls
    for j as integer = 0 to 2
        put ((imageNumber+j)+100+j*150,50),images(imageNumber+j),trans
    next j
   
    if btn1.sel = 0 then
        put (btn1.x,btn1.y),btn1.image1,trans
    else
        put (btn1.x,btn1.y),btn1.image2,trans
    end if
   
    if btn2.sel = 0 then
        put (btn2.x,btn2.y),btn2.image1,trans
    else
        put (btn2.x,btn2.y),btn2.image2,trans
    end if
   
    screenunlock
end sub

do
   
    showImages()
    getmouse mx,my,,mb
   
    'is mouse over a scroll button?
    if mx>btn1.x and mx<btn1.x+btn1.w and my>btn1.y and my<btn1.y + btn1.h then
        btn1.sel = 1
    else
        btn1.sel = 0
    end if
    if mx>btn2.x and mx<btn2.x+btn2.w and my>btn2.y and my<btn2.y + btn2.h then
        btn2.sel = 1
    else
        btn2.sel = 0
    end if
   
    if mb = 1 and mb2 = 0 then  'mouse has been pressed down since last loop
        mb2 = 1
    elseif mb = 0 and mb2 = 1 then 'mouse button released since last loop
        mb2 = 0
        mouseReleased = 1
    end if

    if mouseReleased = 1 then
   
        'is mouse released over left button
        if mx>btn1.x and mx<btn1.x+btn1.w and my>btn1.y and my<btn1.y + btn1.h then
            if imageNumber >0 then
                imageNumber = imageNumber - 1
            end if
        end if
   
        'is mouse released over right button?
        if mx>btn2.x and mx<btn2.x+btn2.w and my>btn2.y and my<btn2.y + btn2.h then
            if imageNumber < 19-2 then
                imageNumber = imageNumber + 1
            end if
        end if
       
        mouseReleased = 0

    end if
   
   
    sleep 2
loop until multikey(&H01)

Last edited by BasicCoder2 on Aug 17, 2019 9:52, edited 1 time in total.

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 3 guests