Buttons (kinda) (DBP) - Is this "Art Programming"?

Author

Message

slik72 and 2thirds

19

Years of Service

User Offline

Joined: 30th Aug 2005

Location:

Posted: 3rd Sep 2005 04:13

Link

With this, you can have as many buttons as you like, with whatever text you like, in whatever screen resoltion you like. Now, this is my first piece of serious(ish) programming. So suggestions of how to make this faster/better/anything to improve it really.

`SET UP
sdmx=1024   `The first part of the display mode resolution
sdmy=768    `The second part of the display mode resolution
Set Display Mode sdmx,sdmy,32
txtsize=20
Set Text Size txtsize
`Colours
red AS Dword
green AS Dword
blue AS Dword
black AS Dword
red=RGB(175,0,0)
green=RGB(0,175,0)
blue=RGB(0,0,175)
black=RGB(0,0,0)

`Border around the text (in pixels)- difines how big the box is
bor=10
`        ###########
`This is #IMPORTANT# Set how many buttons there are here
`        ###########
nobx=7

`Text in button - This is the text that appears on the button
DIM t$(nobx)
t$(1)="What ever you do, do not click this button"
t$(2)="Seriously"
t$(3)="Please don't"
t$(4)="Hello"
t$(5)="LALALALALALA"
t$(6)="Anything else to demonstrate?"
t$(7)="This is a lot of buttons"

`Text width/height
DIM tw(nobx)
For a=1 to nobx
tw(a)=Text Width (t$(a))         `This figures out what the width of the text is, for later use
Next a
DIM th(nobx)
For a=1 to nobx
th(a)=Text Height (t$(a))        `This figures out what the height of the text is, for later use
Next a

`Top left of box
DIM x(nobx)
For a=1 to nobx
x(a)=((sdmx/2)-((tw(a))/2)-bor)      `x=(center of x-axis)-(textwidth/2)-border
Next a                           `This will place the left side of the box "border" to the left of the text
DIM y(nobx)
For a=1 to nobx
y(a)=(a*(sdmy/(nobx+1))-((th(a))/2)-bor)   `y=button number*((center of y-axis)/number of boxes)-(textheight/2)-border
Next a                                    `This evenly spaces the button vertically, and provides for the border

`Bottom right of box
DIM lx(nobx)
For a=1 to nobx
lx(a)=x(a)+(2*bor)+tw(a)         `lx=x[see above]+(2*border)+(textwidth)
Next a                           `(2*border) because there is (-border) in x, this has to be compensated for to make the border
DIM ly(nobx)
For a=1 to nobx
ly(a)=y(a)+(2*bor)+th(a)         `ly=y[see above]+(2*border)+(textheight)
Next a                           `(2*border) because there is (-border) in y, this has to be compensated for to make the border

`Main Loop
Do
   Gosub bkgrd
   Gosub mousepos
   Gosub alltxt
Loop

`Check position of mouse, if in box, then change colour, and check for click and give "id"
mousepos:
For a=1 to nobx
If mousex()>x(a) and mousex()<lx(a) and mousey()>y(a) and mousey()<ly(a)
   col=green:col2=red         `sets the color to green/red for the box
   Gosub drawbx
   id=a
   Gosub click
Else
   id=0
EndIF
Next a
Return

`Puts all the text on the screen
alltxt:
For a=1 to nobx
TEXT x(a)+bor,y(a)+bor,t$(a)     `The text in the boxes
Next a
Set Text Size 10                                            `This can be deleted
Set Cursor 0,0                                              `This can be deleted
Print "Mouse X: ",MOUSEX()       `Shows where mouse is      `This can be deleted
Print "Mouse Y: ",MOUSEY()                                  `This can be deleted
For a=1 to nobx                                             `This can be deleted
Print "Box: ",a                  `Details about each box     This can be deleted
Print "  x: ",x(a),", y: ",y(a)                             `This can be deleted
Print "  lx: ",lx(a),", ly: ",ly(a)                         `This can be deleted
Print "Box Border: ",bor                                    `This can be deleted
Print "Text Pos(x,y): ",x(a)+bor,",",y(a)+bor               `This can be deleted
Print "Text Width,Height: ",tw(a),",",th(a)                 `This can be deleted
Next a                                                      `This can be deleted
Set Text Size txtsize                                       `This can be deleted
Return

`Draws the button box
drawbx:
Box x(a)+4,y(a)+4,lx(a)+4,ly(a)+4,col,col,col2,col          `This draw the back box
Box x(a)+1,y(a)+1,lx(a)+1,ly(a)+1,black,black,black,black   `This is the black line
Box x(a),y(a),lx(a),ly(a),col,col,col,col2                  `The main box
Return

bkgrd:
   CLS
   Box 0,0,1024,768,blue,green,red,blue
   col=red:col2=green         `resets the color to red/green for the box
   For a=1 to nobx
      Gosub drawbx            `redraws all the boxs
   Next a
Return

`Checks for click, and prints the id of the button if it is pressed
click:
If mouseclick()=1
   Goto holdown
EndIf
Return

`This keeps the pressed button coloured blue until the mouse is released
holdown:
Do
If mouseclick()=1
   Gosub bkgrd
   col=green:col2=blue:a=id
   Gosub drawbx
   Gosub alltxt
Else
   Sleep 500
   Exit
EndIf
Loop

CLS
Print "You presses the button that said: -"
Print t$(id)
Print "This was button: -"
Print id    `This is how you know which button was pressed
Wait Key
CLS
Print "Try changing the number of buttons by changing the 'nobx' value near the start of the program"
Print "Also how big the buttons are with the 'bor' value, also near the start of the program"
Print "The text, and screen resolution, and I guess the colours, can all be altered"
Wait Key

+ Code Snippet

`SET UP
sdmx=1024   `The first part of the display mode resolution
sdmy=768    `The second part of the display mode resolution
Set Display Mode sdmx,sdmy,32
txtsize=20
Set Text Size txtsize
`Colours
red AS Dword
green AS Dword
blue AS Dword
black AS Dword
red=RGB(175,0,0)
green=RGB(0,175,0)
blue=RGB(0,0,175)
black=RGB(0,0,0)

`Border around the text (in pixels)- difines how big the box is
bor=10
`        ###########
`This is #IMPORTANT# Set how many buttons there are here
`        ###########
nobx=7

`Text in button - This is the text that appears on the button
DIM t$(nobx)
t$(1)="What ever you do, do not click this button"
t$(2)="Seriously"
t$(3)="Please don't"
t$(4)="Hello"
t$(5)="LALALALALALA"
t$(6)="Anything else to demonstrate?"
t$(7)="This is a lot of buttons"

`Text width/height
DIM tw(nobx)
For a=1 to nobx
tw(a)=Text Width (t$(a))         `This figures out what the width of the text is, for later use
Next a
DIM th(nobx)
For a=1 to nobx
th(a)=Text Height (t$(a))        `This figures out what the height of the text is, for later use
Next a

`Top left of box
DIM x(nobx)
For a=1 to nobx
x(a)=((sdmx/2)-((tw(a))/2)-bor)      `x=(center of x-axis)-(textwidth/2)-border
Next a                           `This will place the left side of the box "border" to the left of the text
DIM y(nobx)
For a=1 to nobx
y(a)=(a*(sdmy/(nobx+1))-((th(a))/2)-bor)   `y=button number*((center of y-axis)/number of boxes)-(textheight/2)-border
Next a                                    `This evenly spaces the button vertically, and provides for the border

`Bottom right of box
DIM lx(nobx)
For a=1 to nobx
lx(a)=x(a)+(2*bor)+tw(a)         `lx=x[see above]+(2*border)+(textwidth)
Next a                           `(2*border) because there is (-border) in x, this has to be compensated for to make the border
DIM ly(nobx)
For a=1 to nobx
ly(a)=y(a)+(2*bor)+th(a)         `ly=y[see above]+(2*border)+(textheight)
Next a                           `(2*border) because there is (-border) in y, this has to be compensated for to make the border


`Main Loop
Do
   Gosub bkgrd
   Gosub mousepos
   Gosub alltxt
Loop

`Check position of mouse, if in box, then change colour, and check for click and give "id"
mousepos:
For a=1 to nobx
If mousex()>x(a) and mousex()<lx(a) and mousey()>y(a) and mousey()<ly(a)
   col=green:col2=red         `sets the color to green/red for the box
   Gosub drawbx
   id=a
   Gosub click
Else
   id=0
EndIF
Next a
Return

`Puts all the text on the screen
alltxt:
For a=1 to nobx
TEXT x(a)+bor,y(a)+bor,t$(a)     `The text in the boxes
Next a
Set Text Size 10                                            `This can be deleted
Set Cursor 0,0                                              `This can be deleted
Print "Mouse X: ",MOUSEX()       `Shows where mouse is      `This can be deleted
Print "Mouse Y: ",MOUSEY()                                  `This can be deleted
For a=1 to nobx                                             `This can be deleted
Print "Box: ",a                  `Details about each box     This can be deleted
Print "  x: ",x(a),", y: ",y(a)                             `This can be deleted
Print "  lx: ",lx(a),", ly: ",ly(a)                         `This can be deleted
Print "Box Border: ",bor                                    `This can be deleted
Print "Text Pos(x,y): ",x(a)+bor,",",y(a)+bor               `This can be deleted
Print "Text Width,Height: ",tw(a),",",th(a)                 `This can be deleted
Next a                                                      `This can be deleted
Set Text Size txtsize                                       `This can be deleted
Return

`Draws the button box
drawbx:
Box x(a)+4,y(a)+4,lx(a)+4,ly(a)+4,col,col,col2,col          `This draw the back box
Box x(a)+1,y(a)+1,lx(a)+1,ly(a)+1,black,black,black,black   `This is the black line
Box x(a),y(a),lx(a),ly(a),col,col,col,col2                  `The main box
Return

bkgrd:
   CLS
   Box 0,0,1024,768,blue,green,red,blue
   col=red:col2=green         `resets the color to red/green for the box
   For a=1 to nobx
      Gosub drawbx            `redraws all the boxs
   Next a
Return

`Checks for click, and prints the id of the button if it is pressed
click:
If mouseclick()=1
   Goto holdown
EndIf
Return

`This keeps the pressed button coloured blue until the mouse is released
holdown:
Do
If mouseclick()=1
   Gosub bkgrd
   col=green:col2=blue:a=id
   Gosub drawbx
   Gosub alltxt
Else
   Sleep 500
   Exit
EndIf
Loop

CLS
Print "You presses the button that said: -"
Print t$(id)
Print "This was button: -"
Print id    `This is how you know which button was pressed
Wait Key
CLS
Print "Try changing the number of buttons by changing the 'nobx' value near the start of the program"
Print "Also how big the buttons are with the 'bor' value, also near the start of the program"
Print "The text, and screen resolution, and I guess the colours, can all be altered"
Wait Key

The only problem you might come up against is if you have too many buttons, because all the details about each button is printed to the side, so that screws things up.

Back to top

Profile PM

Sven B

20

Years of Service

User Offline

Joined: 5th Jan 2005

Location: Belgium

Posted: 4th Sep 2005 11:38

Link

When I create buttons, I usually make a function.

sync on

do

cls

`create a button
   if button(320,240,"Hello") > 0 then ink rgb(255,255,255),0 : text 10,10,"Hello button pressed"
   if button(320,280,"There") > 0 then ink rgb(255,255,255),0 : text 10,10,"There button pressed"
   if button(320,320,"How are you today") > 0 then ink rgb(255,255,255),0 : text 10,10,"How are you today button pressed"

sync
loop

function button(cx,cy,text$)
   tx = text width(text$)/2
   ty = text height(text$)/2
   pressed = 0
   if mousex() > cx - tx - 10 and mousex() < cx + tx + 10
      if mousey() > cy - ty - 5 and mousey() < cy + ty + 5
         pressed = 1
      endif
   endif
   if pressed = 1
      box cx - tx - 8, cy - ty - 3, cx + tx + 12, cy + ty + 7,rgb(255,0,0),rgb(0,255,0),rgb(255,0,0),rgb(255,0,0)
      box cx - tx - 10, cy - ty - 5, cx + tx + 10, cy + ty + 5, rgb(255,0,0), rgb(255,0,0), rgb(0,255,0), rgb(255,0,0)
   else
      box cx - tx - 8, cy - ty - 3, cx + tx + 12, cy + ty + 7,rgb(255,0,0),rgb(255,0,0),rgb(0,255,0),rgb(255,0,0)
      box cx - tx - 10, cy - ty - 5, cx + tx + 10, cy + ty + 5, rgb(255,0,0), rgb(0,255,0), rgb(255,0,0), rgb(255,0,0)
   endif
   ink 0,0
   center text cx,cy - ty, text$
   if mouseclick() = 0 then pressed = 0
endfunction pressed

+ Code Snippet

sync on

do

   cls

   `create a button
   if button(320,240,"Hello") > 0 then ink rgb(255,255,255),0 : text 10,10,"Hello button pressed"
   if button(320,280,"There") > 0 then ink rgb(255,255,255),0 : text 10,10,"There button pressed"
   if button(320,320,"How are you today") > 0 then ink rgb(255,255,255),0 : text 10,10,"How are you today button pressed"

   sync
loop

function button(cx,cy,text$)
   tx = text width(text$)/2
   ty = text height(text$)/2
   pressed = 0
   if mousex() > cx - tx - 10 and mousex() < cx + tx + 10
      if mousey() > cy - ty - 5 and mousey() < cy + ty + 5
         pressed = 1
      endif
   endif
   if pressed = 1
      box cx - tx - 8, cy - ty - 3, cx + tx + 12, cy + ty + 7,rgb(255,0,0),rgb(0,255,0),rgb(255,0,0),rgb(255,0,0)
      box cx - tx - 10, cy - ty - 5, cx + tx + 10, cy + ty + 5, rgb(255,0,0), rgb(255,0,0), rgb(0,255,0), rgb(255,0,0)
   else
      box cx - tx - 8, cy - ty - 3, cx + tx + 12, cy + ty + 7,rgb(255,0,0),rgb(255,0,0),rgb(0,255,0),rgb(255,0,0)
      box cx - tx - 10, cy - ty - 5, cx + tx + 10, cy + ty + 5, rgb(255,0,0), rgb(0,255,0), rgb(255,0,0), rgb(255,0,0)
   endif
   ink 0,0
   center text cx,cy - ty, text$
   if mouseclick() = 0 then pressed = 0
endfunction pressed

Immunity and Annihalation makes Immunihalation...

Back to top

Profile PM Email

Kohaku

21

Years of Service

User Offline

Joined: 3rd May 2004

Location: The not very United Kingdom

Posted: 5th Sep 2005 22:32 Edited at: 6th Sep 2005 04:42

Link

That's interesting. I may use something like that for the framework I'm working on. Save my current "input" method.

Edit:

Well, I'm happy with these buttons, and will be using them in the framework.

rem Standard Setup Code
sync on : sync rate 0
color backdrop rgb(0,0,128)
set text font "arial" : set text size 12 : set text transparent

do

cls

`create a button
   if button(320,240,"Hello") > 0 then ink rgb(255,255,255),0 : text 10,10,"Hello button pressed"
   if button(320,280,"There") > 0 then ink rgb(255,255,255),0 : text 10,10,"There button pressed"
   if button(320,320,"How are you today") > 0 then ink rgb(255,255,255),0 : text 10,10,"How are you today button pressed"

sync
loop

function button(cx,cy,text$)
   tx = text width(text$)/2
   ty = text height(text$)/2
   pressed = 0
   if mousex() > cx - tx - 3 and mousex() < cx + tx + 3
      if mousey() > cy - ty - 1 and mousey() < cy + ty + 1
        pressed = 1
      endif
   endif
   if pressed = 1
      if mouseclick() = 0
   		box cx - tx - 3, cy - ty - 1, cx + tx + 4, cy + ty + 2,rgb(180,180,180),rgb(255,255,255),rgb(180,180,180),rgb(255,255,255)
   	else
   		box cx - tx - 3, cy - ty - 1, cx + tx + 4, cy + ty + 2,rgb(180,180,180),rgb(180,180,180),rgb(180,180,180),rgb(180,180,180)
   	endif
   else
      box cx - tx - 3, cy - ty - 1, cx + tx + 4, cy + ty + 2,rgb(255,255,255),rgb(180,180,180),rgb(180,180,180),rgb(255,255,255)
   endif
   if mouseclick() = 0
   	pressed = 0
   endif
   ink 0,0
   center text cx,cy - ty, text$
endfunction pressed

+ Code Snippet

rem Standard Setup Code
sync on : sync rate 0
color backdrop rgb(0,0,128)
set text font "arial" : set text size 12 : set text transparent

do

   cls

   `create a button
   if button(320,240,"Hello") > 0 then ink rgb(255,255,255),0 : text 10,10,"Hello button pressed"
   if button(320,280,"There") > 0 then ink rgb(255,255,255),0 : text 10,10,"There button pressed"
   if button(320,320,"How are you today") > 0 then ink rgb(255,255,255),0 : text 10,10,"How are you today button pressed"

   sync
loop

function button(cx,cy,text$)
   tx = text width(text$)/2
   ty = text height(text$)/2
   pressed = 0
   if mousex() > cx - tx - 3 and mousex() < cx + tx + 3
      if mousey() > cy - ty - 1 and mousey() < cy + ty + 1
        pressed = 1
      endif
   endif
   if pressed = 1
      if mouseclick() = 0
   		box cx - tx - 3, cy - ty - 1, cx + tx + 4, cy + ty + 2,rgb(180,180,180),rgb(255,255,255),rgb(180,180,180),rgb(255,255,255)
   	else
   		box cx - tx - 3, cy - ty - 1, cx + tx + 4, cy + ty + 2,rgb(180,180,180),rgb(180,180,180),rgb(180,180,180),rgb(180,180,180)
   	endif
   else
      box cx - tx - 3, cy - ty - 1, cx + tx + 4, cy + ty + 2,rgb(255,255,255),rgb(180,180,180),rgb(180,180,180),rgb(255,255,255)
   endif
   if mouseclick() = 0
   	pressed = 0
   endif
   ink 0,0
   center text cx,cy - ty, text$
endfunction pressed

Thanks peeps.

You are not alone.

Back to top

Profile PM Website

Sven B

20

Years of Service

User Offline

Joined: 5th Jan 2005

Location: Belgium

Posted: 6th Sep 2005 19:09

Link

I'm glad I was any help.

Cheers,

Sven

Immunity and Annihalation makes Immunihalation...

Back to top

Profile PM Email

Nul error

19

Years of Service

User Offline

Joined: 12th Aug 2005

Location:

Posted: 9th Sep 2005 07:23

Link

very nice function Sven B but if you wanted it to say it pressed the button after you release it like standard buttons how would you do this?

Back to top

Profile PM

Nul error

19

Years of Service

User Offline

Joined: 12th Aug 2005

Location:

Posted: 9th Sep 2005 11:59

Link

oh sorry my english is not that good sometimes but I made sven function mimic buttons like standard windows. it doesn't work 100% of the time due to the "wait 10" part and it tends to slow down your program.

function button(cx,cy,text$)
   tx = text width(text$)/2
   ty = text height(text$)/2
   mouseover =0
   pressed = 0
mclick# = 1
   if mousex() > cx - tx - 10 and mousex() < cx + tx + 10
      if mousey() > cy - ty - 5 and mousey() < cy + ty + 5
         mouseover = 1
      endif
   endif
   if mouseover = 1
   rem turns button red when mouse is over it
       box cx - tx - 11, cy - ty - 6, cx + tx + 11, cy + ty + 6,RGB(0,0,0),RGB(0,0,0),RGB(0,0,0),RGB(0,0,0) `border
       box cx - tx - 10, cy - ty - 5, cx + tx + 10, cy + ty + 5,RGB(196,96,96),RGB(128,128,128),RGB(196,96,96),RGB(128,128,128)
   else
   rem button is grey since mouse isn't over it
       box cx - tx - 11, cy - ty - 6, cx + tx + 11, cy + ty + 6,RGB(0,0,0),RGB(0,0,0),RGB(0,0,0),RGB(0,0,0) `border
       box cx - tx - 10, cy - ty - 5, cx + tx + 10, cy + ty + 5,RGB(96,96,96),RGB(128,128,128),RGB(96,96,96),RGB(128,128,128)
   endif

ink 0,0
   center text cx,cy - ty, text$
   if mouseover = 1 and mouseclick() = 1
      rem turns box blue when you press it down like standard button
       box cx - tx - 11, cy - ty - 6, cx + tx + 11, cy + ty + 6,RGB(0,0,0),RGB(0,0,0),RGB(0,0,0),RGB(0,0,0) `border
       box cx - tx - 10, cy - ty - 5, cx + tx + 10, cy + ty + 5,RGB(96,96,196),RGB(96,96,196),RGB(96,96,196),RGB(96,96,196)
   ink 0,0
   center text cx,cy - ty, text$
   mclick# = 0 : wait 10
   endif

if mouseover = 1 and mouseclick() = 0
   if mclick# = 0
      pressed = 1
   endif
endif

endfunction pressed

+ Code Snippet

function button(cx,cy,text$)
   tx = text width(text$)/2
   ty = text height(text$)/2
   mouseover =0
   pressed = 0
mclick# = 1
   if mousex() > cx - tx - 10 and mousex() < cx + tx + 10
      if mousey() > cy - ty - 5 and mousey() < cy + ty + 5
         mouseover = 1
      endif
   endif
   if mouseover = 1
   rem turns button red when mouse is over it
       box cx - tx - 11, cy - ty - 6, cx + tx + 11, cy + ty + 6,RGB(0,0,0),RGB(0,0,0),RGB(0,0,0),RGB(0,0,0) `border
       box cx - tx - 10, cy - ty - 5, cx + tx + 10, cy + ty + 5,RGB(196,96,96),RGB(128,128,128),RGB(196,96,96),RGB(128,128,128)
   else
   rem button is grey since mouse isn't over it
       box cx - tx - 11, cy - ty - 6, cx + tx + 11, cy + ty + 6,RGB(0,0,0),RGB(0,0,0),RGB(0,0,0),RGB(0,0,0) `border
       box cx - tx - 10, cy - ty - 5, cx + tx + 10, cy + ty + 5,RGB(96,96,96),RGB(128,128,128),RGB(96,96,96),RGB(128,128,128)
   endif

   ink 0,0
   center text cx,cy - ty, text$
   if mouseover = 1 and mouseclick() = 1
      rem turns box blue when you press it down like standard button
       box cx - tx - 11, cy - ty - 6, cx + tx + 11, cy + ty + 6,RGB(0,0,0),RGB(0,0,0),RGB(0,0,0),RGB(0,0,0) `border
       box cx - tx - 10, cy - ty - 5, cx + tx + 10, cy + ty + 5,RGB(96,96,196),RGB(96,96,196),RGB(96,96,196),RGB(96,96,196)
   ink 0,0
   center text cx,cy - ty, text$
   mclick# = 0 : wait 10
   endif

if mouseover = 1 and mouseclick() = 0
   if mclick# = 0
      pressed = 1
   endif
endif

endfunction pressed

Back to top

Profile PM

Sorry your browser is not supported!

Code Snippets / Buttons (kinda) (DBP) - Is this "Art Programming"?

Sorry your browser is not supported!

Code Snippets / Buttons (kinda) (DBP) - Is this &quot;Art Programming&quot;?

Code Snippets / Buttons (kinda) (DBP) - Is this "Art Programming"?