Health bar - GameCreators Forum

Author

Message

sneaky smith12

19

Years of Service

User Offline

Joined: 30th Apr 2006

Location: Like id tell you, oh wait i just did

Posted: 2nd May 2006 05:38

Link

Also in Codedatabase

Remstart
HEALTH BAR
REVISED BY: SNEAKYSMITH12

Hold control key to make health rnd
Otherwise toggle health using up and down keys
This is highly based on scource code found in the codebase.

remend
black=rgb(0,0,0)
red=rgb(255,0,0)
yellow=rgb(255,255,0)
white=rgb(255,255,255)
green=rgb(0,255,0)

hp1# = 50
Do
cls
randomize timer()

if controlkey()=0 then gosub control
if controlkey()=1 then gosub rndhealth

hp2#=100
hpper#=hp1#/hp2#
hpper=percent(hpper#)
hp1$=str$(hp1#)
hp2$=str$(hp2#)
hp12$=hp1$+"/"+hp2$

gosub stats

ink white,black
liney(30,30)
liney(50,50)
linex(30,50)
ink red,black
box (screen width()/2)-50,35,((screen width()/2)-50)+hpper,45
suspend for key
if inkey$()="q" then exit
Loop

End
function percent(a#)
a$=str$(a#)
b$=mid$(a$,1)
b=val(b$)
if b<1
   a=len(a$)
   a$=right$(a$,a-2)
   b$=mid$(a$,1)
   if b$="0"
      b$=mid$(a$,2)
      b=val(b$)
      if b>4 then goto notzero
      b$=mid$(a$,3)
      b=val(b$)
      if b>4 then goto notzero
      perval=0
      goto funcend
   endif
   notzero:
   b$=mid$(a$,3)
   a$=left$(a$,2)
   a=val(a$)
   b=val(b$)
   if b>4
      a=a+1
   endif
   b$=mid$(a$,4)
   b=val(b$)
   if b>4
      a=a+1
   endif
   a$=str$(a)
   perval=val(a$)
   goto funcend
endif
if b>1 or b=1
hund$=str$(b)
   a=len(a$)
   a$=right$(a$,a-2)
   b$=mid$(a$,3)
   a$=left$(a$,2)
   a=val(a$)
   b=val(b$)
   if b>4
      a=a+1
   endif
   b$=mid$(a$,4)
   b=val(b$)
   if b>4
      a=a+1
   endif
   a$=str$(a)
   a$=hund$+a$
   perval=val(a$)
endif
funcend:
endfunction perval
function liney(y1#,y2#)
     line (screen width()/2)+55,y1#,(screen width()/2)-55,y2#
endfunction
function linex(y1#,y2#)
     line (screen width()/2)+55,y1#,(screen width()/2)+55,y2#
     line (screen width()/2)-55,y1#,(screen width()/2)-55,y2#
endfunction

stats:
if hpper = 0 then ink white,black : Print "DEAD!"
if hpper >=90
     ink green,black
endif
if hpper<=30 and hpper>5
     ink yellow,black
endif
if hpper<90 and hpper>30
     ink white,black
endif
if hpper<=5
     ink red,black
endif
center text screen width()/2,2,hp12$
return

rndhealth:
hp1#=rnd(hp2#)
return

control:
if upkey() = 1
     hp1# = hp1# + 1
endif
if downkey() = 1
     hp1# = hp1# - 1
endif
return

+ Code Snippet

Remstart
HEALTH BAR
REVISED BY: SNEAKYSMITH12

Hold control key to make health rnd
Otherwise toggle health using up and down keys
This is highly based on scource code found in the codebase.

remend
black=rgb(0,0,0)
red=rgb(255,0,0)
yellow=rgb(255,255,0)
white=rgb(255,255,255)
green=rgb(0,255,0)

hp1# = 50
Do
cls
randomize timer()

if controlkey()=0 then gosub control
if controlkey()=1 then gosub rndhealth

hp2#=100
hpper#=hp1#/hp2#
hpper=percent(hpper#)
hp1$=str$(hp1#)
hp2$=str$(hp2#)
hp12$=hp1$+"/"+hp2$

gosub stats

ink white,black
liney(30,30)
liney(50,50)
linex(30,50)
ink red,black
box (screen width()/2)-50,35,((screen width()/2)-50)+hpper,45
suspend for key
if inkey$()="q" then exit
Loop

End
function percent(a#)
a$=str$(a#)
b$=mid$(a$,1)
b=val(b$)
if b<1
   a=len(a$)
   a$=right$(a$,a-2)
   b$=mid$(a$,1)
   if b$="0"
      b$=mid$(a$,2)
      b=val(b$)
      if b>4 then goto notzero
      b$=mid$(a$,3)
      b=val(b$)
      if b>4 then goto notzero
      perval=0
      goto funcend
   endif
   notzero:
   b$=mid$(a$,3)
   a$=left$(a$,2)
   a=val(a$)
   b=val(b$)
   if b>4
      a=a+1
   endif
   b$=mid$(a$,4)
   b=val(b$)
   if b>4
      a=a+1
   endif
   a$=str$(a)
   perval=val(a$)
   goto funcend
endif
if b>1 or b=1
hund$=str$(b)
   a=len(a$)
   a$=right$(a$,a-2)
   b$=mid$(a$,3)
   a$=left$(a$,2)
   a=val(a$)
   b=val(b$)
   if b>4
      a=a+1
   endif
   b$=mid$(a$,4)
   b=val(b$)
   if b>4
      a=a+1
   endif
   a$=str$(a)
   a$=hund$+a$
   perval=val(a$)
endif
funcend:
endfunction perval
function liney(y1#,y2#)
     line (screen width()/2)+55,y1#,(screen width()/2)-55,y2#
endfunction
function linex(y1#,y2#)
     line (screen width()/2)+55,y1#,(screen width()/2)+55,y2#
     line (screen width()/2)-55,y1#,(screen width()/2)-55,y2#
endfunction

stats:
if hpper = 0 then ink white,black : Print "DEAD!"
if hpper >=90
     ink green,black
endif
if hpper<=30 and hpper>5
     ink yellow,black
endif
if hpper<90 and hpper>30
     ink white,black
endif
if hpper<=5
     ink red,black
endif
center text screen width()/2,2,hp12$
return

rndhealth:
hp1#=rnd(hp2#)
return

control:
if upkey() = 1
     hp1# = hp1# + 1
endif
if downkey() = 1
     hp1# = hp1# - 1
endif
return

Thought it was too cool to be a secret.
It works great.

If at first you dont succeed, LOWER YOUR STANDARDS.

Back to top

Profile PM Email

indi

22

Years of Service

User Offline

Joined: 26th Aug 2002

Location: Earth, Brisbane, Australia

Posted: 2nd May 2006 13:49

Link

this will only run in DBP as it uses types.

sync on : sync rate 60
set text size 13 : set text font "arial"

rem setup memory bar type holder

type Membar
name$ as string
x1 as integer
y1 as integer
x2 as integer
y2 as integer
bdr as integer
width as integer
height as integer
memory as integer
endtype

dim Membar(3) as Membar

Membar(1).height = 8
Membar(1).width = 256
Membar(1).x1 = 10
Membar(1).y1 = 10
Membar(1).x2 = Membar(1).x1 + Membar(1).width
Membar(1).y2 = Membar(1).y1 + Membar(1).height
Membar(1).bdr = 2
Membar(1).name$ = "dmem"
Membar(1).memory = system dmem available()
Membar(1).memory = Membar(1).memory /1024
Membar(1).memory = Membar(1).memory /1024

Membar(2).height = 8
Membar(2).width = 256
Membar(2).x1 = 10
Membar(2).y1 = 40
Membar(2).x2 = Membar(2).x1 + Membar(2).width
Membar(2).y2 = Membar(2).y1 + Membar(2).height
Membar(2).bdr = 2
Membar(2).name$ = "smem"
Membar(2).memory = system smem available()
Membar(2).memory = Membar(2).memory /1024
Membar(2).memory = Membar(2).memory /1024

Membar(3).height = 8
Membar(3).width = 256
Membar(3).x1 = 10
Membar(3).y1 = 70
Membar(3).x2 = Membar(3).x1 + Membar(3).width
Membar(3).y2 = Membar(3).y1 + Membar(3).height
Membar(3).bdr = 2
Membar(3).name$ = "tmem"
Membar(3).memory = system tmem available()
Membar(3).memory = Membar(3).memory /1024
Membar(3).memory = Membar(3).memory /1024

disable escapekey
while escapekey()=0

for i = 1 to 3
Display_Membar(i)
next i

sync
endwhile
undim Membar(3)
end

function Display_Membar(Num)

ink rgb(192,192,192),1
box Membar(Num).x1,Membar(Num).y1,Membar(Num).x2,Membar(Num).y2

ink rgb(32,32,32),1
box Membar(Num).x1+Membar(Num).bdr,Membar(Num).y1+Membar(Num).bdr,Membar(Num).x2-Membar(Num).bdr,Membar(Num).y2-Membar(Num).bdr

if Membar(Num).memory > Membar(Num).width
   ink rgb(32,192,32),1
   box Membar(Num).x1+Membar(Num).bdr+1,Membar(Num).y1+Membar(Num).bdr+1,Membar(Num).x1+Membar(Num).width-Membar(Num).bdr-1,Membar(Num).y2-Membar(Num).bdr-1
else
   ink rgb(32,192,32),1
   box Membar(Num).x1+Membar(Num).bdr+1,Membar(Num).y1+Membar(Num).bdr+1,Membar(Num).x1+Membar(Num).memory-1,Membar(Num).y2-Membar(Num).bdr-1
endif

ink rgb(255,255,55),1
text Membar(Num).x1+Membar(Num).bdr+2,Membar(Num).y1 + Membar(Num).height+2,Membar(Num).name$+" "+STR$(Membar(Num).memory)+"megs"
endfunction

+ Code Snippet

sync on : sync rate 60
set text size 13 : set text font "arial"

rem setup memory bar type holder

type Membar
name$ as string
x1 as integer
y1 as integer
x2 as integer
y2 as integer
bdr as integer
width as integer
height as integer
memory as integer
endtype

dim Membar(3) as Membar

Membar(1).height = 8
Membar(1).width = 256
Membar(1).x1 = 10
Membar(1).y1 = 10
Membar(1).x2 = Membar(1).x1 + Membar(1).width
Membar(1).y2 = Membar(1).y1 + Membar(1).height
Membar(1).bdr = 2
Membar(1).name$ = "dmem"
Membar(1).memory = system dmem available()
Membar(1).memory = Membar(1).memory /1024
Membar(1).memory = Membar(1).memory /1024

Membar(2).height = 8
Membar(2).width = 256
Membar(2).x1 = 10
Membar(2).y1 = 40
Membar(2).x2 = Membar(2).x1 + Membar(2).width
Membar(2).y2 = Membar(2).y1 + Membar(2).height
Membar(2).bdr = 2
Membar(2).name$ = "smem"
Membar(2).memory = system smem available()
Membar(2).memory = Membar(2).memory /1024
Membar(2).memory = Membar(2).memory /1024

Membar(3).height = 8
Membar(3).width = 256
Membar(3).x1 = 10
Membar(3).y1 = 70
Membar(3).x2 = Membar(3).x1 + Membar(3).width
Membar(3).y2 = Membar(3).y1 + Membar(3).height
Membar(3).bdr = 2
Membar(3).name$ = "tmem"
Membar(3).memory = system tmem available()
Membar(3).memory = Membar(3).memory /1024
Membar(3).memory = Membar(3).memory /1024

disable escapekey
while escapekey()=0

for i = 1 to 3
Display_Membar(i)
next i

sync
endwhile
undim Membar(3)
end


function Display_Membar(Num)

ink rgb(192,192,192),1
box Membar(Num).x1,Membar(Num).y1,Membar(Num).x2,Membar(Num).y2

ink rgb(32,32,32),1
box Membar(Num).x1+Membar(Num).bdr,Membar(Num).y1+Membar(Num).bdr,Membar(Num).x2-Membar(Num).bdr,Membar(Num).y2-Membar(Num).bdr

if Membar(Num).memory > Membar(Num).width
   ink rgb(32,192,32),1
   box Membar(Num).x1+Membar(Num).bdr+1,Membar(Num).y1+Membar(Num).bdr+1,Membar(Num).x1+Membar(Num).width-Membar(Num).bdr-1,Membar(Num).y2-Membar(Num).bdr-1
else
   ink rgb(32,192,32),1
   box Membar(Num).x1+Membar(Num).bdr+1,Membar(Num).y1+Membar(Num).bdr+1,Membar(Num).x1+Membar(Num).memory-1,Membar(Num).y2-Membar(Num).bdr-1
endif

ink rgb(255,255,55),1
text Membar(Num).x1+Membar(Num).bdr+2,Membar(Num).y1 + Membar(Num).height+2,Membar(Num).name$+" "+STR$(Membar(Num).memory)+"megs"
endfunction

this is just another way to handle it.

here is the original link, perhaps you can combine the best parts of both?
http://forum.thegamecreators.com/?m=forum_view&t=37583&b=6

good work so far.

If no-one gives your an answer to a question you have asked, consider:- Is your question clear.- Did you ask nicely.- Are you showing any effort to solve the problem yourself 

Back to top

Profile PM Email

TobiasWK

19

Years of Service

User Offline

Joined: 4th Sep 2005

Location: Denmark

Posted: 16th May 2006 10:19

Link

Im gonna try add the health bar to my FPS project!

Thanks

Back to top

Profile PM Email

sneaky smith12

19

Years of Service

User Offline

Joined: 30th Apr 2006

Location: Like id tell you, oh wait i just did

Posted: 19th May 2006 06:15

Link

Here is a better working way to do this.
Hope this works for you.
Plz dont question my box meathod ( IT JUST WORKS.)
it may seem confusing i know, but once u get it its really easy to use.

It works great.
Any suggestions would be helpful.

sync on
black=rgb(0,0,0)
red=rgb(255,0,0)
yellow=rgb(255,255,0)
white=rgb(255,255,255)
green=rgb(0,255,0)
blue=rgb(0,0,255)

hp1# = 50
mp1# = 50

Do
cls
randomize timer()

gosub Control

hp2#=100
hpper#=hp1#/hp2#
hpper=percent(hpper#)
hp1$=str$(hp1#)
hp2$=str$(hp2#)
hp12$=hp1$+"/"+hp2$

mp2#=100
mpper#=mp1#/mp2#
mpper=percent(mpper#)
mp1$=str$(mp1#)
mp2$=str$(mp2#)
mp12$=mp1$+"/"+mp2$

gosub catching
gosub stats

ink white,black
liney(30,30)
liney(50,50)
linex(30,50)

ink red,black
box (screen width()/2)-50,35,((screen width()/2)-50)+hpper,45

ink white,black
liney(60,60)
liney(80,80)
linex(60,80)

ink blue,black
box (screen width()/2)-50,65,((screen width()/2)-50)+mpper,75

sync
Loop
end

catching:
if hp1# >= hp2# then hpper = hp2#
if (hp1#*2)= hp2# then hpper = 50
if hp1# <= 0 then hp1# = 0
if mp1# >= mp2# then mpper = mp2#
if (mp1#*2)= mp2# then mpper = 50
if mp1# <= 0 then mp1# = 0

return
stats:
if hpper = 0 then ink white,black : Print "DEAD!"
if hpper >=90
     ink green,black
endif
if hpper<=30 and hpper>5
     ink yellow,black
endif
if hpper<90 and hpper>30
   ink white,black
endif
if hpper<=5
 ink red,black
endif
if hpper = 100 then ink green,black
center text screen width() /2,2,hp12$
if mpper >=90
     ink green,black
endif
if mpper<=30 and mpper>5
     ink yellow,black
endif
if mpper<90 and mpper>30
   ink white,black
endif
if mpper<=5
 ink red,black
endif
center text screen width()/2,100,mp12$
if mpper = 100 then ink green,black
return
Control:
if upkey() > 0: hp1#=hp1#+1: endif: if downkey() > 0: hp1# = hp1# - 1: endif: if rightkey() = 1: mp1#=mp1# +1: endif: if leftkey() = 1: mp1#=mp1#-1: endif
return
function percent(a#)
a$=str$(a#): b$=mid$(a$,1): b=val(b$): if b<1: a=len(a$): a$=right$(a$,a-2): b$=mid$(a$,1): if b$="0": b$=mid$(a$,2)
b=val(b$): if b>4 then goto notzero: b$=mid$(a$,3): b=val(b$): if b>4 then goto notzero: perval=0: goto funcend
endif
notzero:
b$=mid$(a$,3): a$=left$(a$,2): a=val(a$): b=val(b$): if b>4: a=a+1: endif: b$=mid$(a$,4): b=val(b$): if b>4
a=a+1: endif: a$=str$(a): perval=val(a$): goto funcend: endif
if b>1 or b=1: hund$=str$(b): a=len(a$): a$=right$(a$,a-2): b$=mid$(a$,3): a$=left$(a$,2): a=val(a$): b=val(b$)
if b>4: a=a+1: endif: b$=mid$(a$,4): b=val(b$): if b>4: a=a+1: endif: a$=str$(a): a$=hund$+a$: perval=val(a$)
endif
funcend:
endfunction perval
function liney(y1#,y2#)
line (screen width()/2)+55,y1#,(screen width()/2)-55,y2#
endfunction
function linex(y1#,y2#)
line (screen width()/2)+55,y1#,(screen width()/2)+55,y2#: line (screen width()/2)-55,y1#,(screen width()/2)-55,y2#
endfunction

+ Code Snippet

sync on
black=rgb(0,0,0)
red=rgb(255,0,0)
yellow=rgb(255,255,0)
white=rgb(255,255,255)
green=rgb(0,255,0)
blue=rgb(0,0,255)

hp1# = 50
mp1# = 50

Do
cls
randomize timer()

gosub Control

hp2#=100
hpper#=hp1#/hp2#
hpper=percent(hpper#)
hp1$=str$(hp1#)
hp2$=str$(hp2#)
hp12$=hp1$+"/"+hp2$

mp2#=100
mpper#=mp1#/mp2#
mpper=percent(mpper#)
mp1$=str$(mp1#)
mp2$=str$(mp2#)
mp12$=mp1$+"/"+mp2$

gosub catching
gosub stats

ink white,black
liney(30,30)
liney(50,50)
linex(30,50)

ink red,black
box (screen width()/2)-50,35,((screen width()/2)-50)+hpper,45

ink white,black
liney(60,60)
liney(80,80)
linex(60,80)

ink blue,black
box (screen width()/2)-50,65,((screen width()/2)-50)+mpper,75

sync
Loop
end

catching:
if hp1# >= hp2# then hpper = hp2#
if (hp1#*2)= hp2# then hpper = 50
if hp1# <= 0 then hp1# = 0
if mp1# >= mp2# then mpper = mp2#
if (mp1#*2)= mp2# then mpper = 50
if mp1# <= 0 then mp1# = 0

return
stats:
if hpper = 0 then ink white,black : Print "DEAD!"
if hpper >=90
     ink green,black
endif
if hpper<=30 and hpper>5
     ink yellow,black
endif
if hpper<90 and hpper>30
   ink white,black
endif
if hpper<=5
 ink red,black
endif
if hpper = 100 then ink green,black
center text screen width() /2,2,hp12$
if mpper >=90
     ink green,black
endif
if mpper<=30 and mpper>5
     ink yellow,black
endif
if mpper<90 and mpper>30
   ink white,black
endif
if mpper<=5
 ink red,black
endif
center text screen width()/2,100,mp12$
if mpper = 100 then ink green,black
return
Control:
if upkey() > 0: hp1#=hp1#+1: endif: if downkey() > 0: hp1# = hp1# - 1: endif: if rightkey() = 1: mp1#=mp1# +1: endif: if leftkey() = 1: mp1#=mp1#-1: endif
return
function percent(a#)
a$=str$(a#): b$=mid$(a$,1): b=val(b$): if b<1: a=len(a$): a$=right$(a$,a-2): b$=mid$(a$,1): if b$="0": b$=mid$(a$,2)
b=val(b$): if b>4 then goto notzero: b$=mid$(a$,3): b=val(b$): if b>4 then goto notzero: perval=0: goto funcend
endif
notzero:
b$=mid$(a$,3): a$=left$(a$,2): a=val(a$): b=val(b$): if b>4: a=a+1: endif: b$=mid$(a$,4): b=val(b$): if b>4
a=a+1: endif: a$=str$(a): perval=val(a$): goto funcend: endif
if b>1 or b=1: hund$=str$(b): a=len(a$): a$=right$(a$,a-2): b$=mid$(a$,3): a$=left$(a$,2): a=val(a$): b=val(b$)
if b>4: a=a+1: endif: b$=mid$(a$,4): b=val(b$): if b>4: a=a+1: endif: a$=str$(a): a$=hund$+a$: perval=val(a$)
endif
funcend:
endfunction perval
function liney(y1#,y2#)
line (screen width()/2)+55,y1#,(screen width()/2)-55,y2#
endfunction
function linex(y1#,y2#)
line (screen width()/2)+55,y1#,(screen width()/2)+55,y2#: line (screen width()/2)-55,y1#,(screen width()/2)-55,y2#
endfunction

Yes i know this is quite long for a silly little program.

If at first you dont succeed, LOWER YOUR STANDARDS.

Back to top

Profile PM Email

Sorry your browser is not supported!

Code Snippets / Health bar