Mouse trouble

[ITomi]

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]

I cannot run your code, but in this small game (https://freebasic.net/forum/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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

I tried that basiccoder2 (I hate elseif)
It worked up and down the cycles, but the little arrows didn't show on clicking.

[BasicCoder2]

@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)