+ Code SnippetRem *** Include File: m_edit fonctions.dba ***
Rem Created: 29/11/2003 19:11:53
set display mode 800,600,16
sync on
sync rate 40
set text font "arial"
set text size 18
rem test of the button
repeat
click = button(300,300,"Click on me please ",rgb(0,0,0),rgb(192,192,210),rgb(50,40,40))
sync
until click=1
cls
rem test of the request
name as string
name = request(400, 350, 200, 120, "Hello, what's your name ? I'd really like to know it.", "Here you are","Default_Name", rgb(100,100,192), rgb(150,150,255), rgb(0,0,0))
cls
rem test of the textbox, but we need to put it into a loop, so I had a button
tb_text as string
tb_text = "This is the default text"
repeat
tb_text=text_box(10,300-text height("|")-25, tb_text, 250, rgb(50,255,50),rgb(0,100,0))
sync
until button(10,300,"When you've enough played with the text_box,"+name+" click on me ",rgb(0,0,0),rgb(192,192,210),rgb(50,40,40))
cls
rem test of the popup_yesno
if popup_yesno(100, 30, 250, 100, "This is a popup_yesno. If you want to see the last function, click on 'yes', else, click on 'no'.",rgb(192,192,192),rgb(0,0,0))=0
end
endif
cls
cd "c:\windows\"
file as string
file = select_file(100, 100, 180, 450, "Which file do you want to delete ? Please, I want to delete a lovely file, just a little one ", ".dll", rgb(255,200,200), rgb(50,0,0))
cls
rem test of the check_box
repeat
rem a small backgroud ^^
box 50,50,750,550,rgb(196,196,196),rgb(196,196,196),rgb(196,196,196),rgb(196,196,196)
cb = check_box(100,100,"I agree to leave the program", rgb(0,0,0),cb)
button_exit = button(100,125,"Exit",rgb(50,50,50),rgb(192,192,192),rgb(50,40,40))
sync
until cb=1 and button_exit = 1
Rem Included in Project: C:\Program Files\Dark Basic Software\Dark Basic Professional\Projects\Bomberman\Editeur de cartes Bomberman.dbpro
function button(x_button as integer,y_button as integer,txt_button as string,color_text_button as dword,color_up_button as dword,color_down_button as dword)
` Here I draw the button ; there are text width and text height commands because I want the button to work with every size of text :)
box x_button,y_button,x_button+text width(txt_button)+8,y_button+text height(txt_button)+8,color_down_button-rgb(50,50,50),color_down_button,color_down_button-rgb(50,50,50),color_down_button
box x_button+2,y_button+2,x_button+text width(txt_button)+5,y_button+text height(txt_button)+5,color_up_button+rgb(10,10,10),color_up_button,color_up_button+rgb(10,10,10),color_up_button
ink color_text_button,0
` text of the button
text x_button+4,y_button+4,txt_button
mob = 0
if mouseclick()=1 and mousex()>x_button and mousex()<x_button+text width(txt_button)+8 and mousey()>y_button and mousey()<y_button+text height(txt_button)+8
` if we're clickling on the button, we have to draw it down, and wait until we don't click anymore on it
repeat
` when the button is down, I reverse the color_up and the color_down
box x_button,y_button,x_button+text width(txt_button)+8,y_button+text height(txt_button)+8,color_up_button+rgb(10,10,10),color_up_button,color_up_button+rgb(10,10,10),color_up_button
box x_button+2,y_button+2,x_button+text width(txt_button)+5,y_button+text height(txt_button)+5,color_down_button-rgb(50,50,50),color_down_button,color_down_button-rgb(50,50,50),color_down_button
ink color_text_button,0
text x_button+4,y_button+4,txt_button
sync
until mouseclick()=0
` now, we must test if the mouse is still on the button, because if the user clicked on the button, but changed his mind just at this time, he can cancel this action by moving the mouse out of the button before he release the mouseclick :)
if mousex()>x_button and mousex()<x_button+text width(txt_button)+8 and mousey()>y_button and mousey()<y_button+text height(txt_button)+8
mob = 1 :` mob tells if the button has been pressed or not
else
mob = 0
endif
endif
ink rgb(0,0,0),0
endfunction mob
` request ask the user to give a string.. it can be everything you want : his girlfriend's name, or where he wants to save something
function request(x as integer, y as integer, sizex as integer, sizey as integer, question as string, txt_button as string,res as string, color_win as dword, color_barre as dword, color_text as dword)
` that's just a small animation when the window come...
animex as float = 6.0
animey as float = 6.0
repeat
` if the animation is too slow, replace the /6 by a number a bit smaller
if animex<sizex then inc animex,(sizex-animex)/6
if animey<sizey then inc animey,(sizey-animey)/6
box x,y,x+animex,y+animey,color_win-rgb(30,30,30),color_win-rgb(30,30,30),color_win-rgb(30,30,30),color_win-rgb(30,30,30)
box x+3,y+3,x+animex-5,y+animey-5,color_win,color_win,color_win,color_win
fastsync
until animex+1>=sizex and animey+1>=sizey
` here we draw the animation with the good size
box x,y,x+sizex,y+sizey,color_win-rgb(30,30,30),color_win-rgb(30,30,30),color_win-rgb(30,30,30),color_win-rgb(30,30,30)
box x+3,y+3,x+sizex-5,y+sizey-5,color_win,color_win,color_win,color_win
` there's a comment I made when I was very tired ^^
rem si le texte est plus long que le button, éh bien il faut lui couper la queue et la poser juste en-dessous... arf, le pauvre, se faire ainsi émasculer parce qu'il est trop long, quelle horreur pour un string ! mais bon, c'est la vie, et la dure loi de la programmation : du texte ne doit en aucun cas dépasser des buttons sous peine de défaut d'affichage, ce qui peut être comparé à un bug, bien que ce nom vienne du fait qu'il était une fois un papillon qui a grillé et fait planter un des premiers ordinateurs... bref, je m'égare
ink color_text,0
remstart
if the text is too long for the size of the window, what will append ? the text will
be cut in several pieces that will fit in the window...
but it won't cut the text in the middle of a word : it cut the text between words
why am I so great ?
remend
if text width(question)>sizex-10
repeat
` chr_to_show => it's the number of characters that can be showed before it go out of the window
chr_to_show = 0
repeat
inc chr_to_show
until text width(left$(right$(question,len(question)-already_showed),chr_to_show+1))>sizex-10 or already_showed + chr_to_show >= len(question)
` now, we have a piece of text, but it may be cut in a word, so we'll have to find where
` ends the last word
if already_showed + chr_to_show <> len(question)
` easy : just have to find the lase space ^^
while mid$(question,already_showed+chr_to_show)<>" " or chr_to_show=<0
dec chr_to_show
endwhile
endif
` posy tells how many lines we already have, so we won't print everything on the same line
inc posy
text x+4,y+4+text height("|")*(posy-1),left$(right$(question,len(question)-already_showed),chr_to_show)
` these two lines look if we showed all the text, or if there's still something to show
already_showed = already_showed + chr_to_show
if already_showed => len(question) then text_showed = 1
sync
until text_showed = 1
else
` when the text is short enough for the window... :)
text x+4,y+4,question
endif
ink rgb(0,0,0),0
` this line ? of, if you had a request before this one, you're maybe still
` holding the return key down, so we wait until it's up
repeat:until returnkey()=0
while returnkey()=0 and button(x+sizex/2-text width("valider")/2,y+sizey-15-text height("|"),"Valider",rgb(0,0,0),rgb(128,128,128),rgb(100,100,100))=0
` ?? what's that ?? why did I write this line ?? I don't remimber ^_^
text x+4,y+4+text height("|")*(posy-1),left$(right$(question,len(question)-already_showed),chr_to_show)
` and here's the text box where the user writes his girlfriend's name or a path :)
res = text_box(x+15,y+sizey-2*text height("|")-30,res, sizex-40,color_barre, color_text)
sync
endwhile
endfunction res
` the textbox from before... it works for only one line, but it's far enough for me..
` I don't want to make a text editor ;)
function text_box(x as integer, y as integer ,txt as string, width as integer, color as dword, text_color as dword)
` drawing the box
box x,y,x+width+7,y+text height("|")+7,color-rgb(30,30,30),color-rgb(30,30,30),color-rgb(30,30,30),color-rgb(30,30,30)
box x+2,y+2,x+width+5,y+text height("|")+5,color,color,color,color
` now, we'll write the text that is in it, but what if it's too wide ?
` hmm... I don't like when girls are too wide, I don't like either when
` the texts are too wide for my functions...
` I can't cut the girls, but I can cut the texts ^_^
if text width(txt)>width
chr_to_show = 0
repeat
` here, we looks how many letters we can write before it's too long...
` but we count them from the right
inc chr_to_show
until text width(right$(txt,chr_to_show+1))>width
else
` if the text fits in the box, then we can write all :)
chr_to_show = len(txt)
endif
text x+2,y+2,right$(txt,chr_to_show)
` and now, we click on the text_box, so we'll have to write.. I like writting, I often write letters to a girl. We choosed that if we still hadn't a girl/boyfriend when we'll be 30 years old, we'll get married :)
if mousex()>x and mousex()<x+width+7
if mousey()>y and mousey()<y+text height("|")+7
if mouseclick()=1
` we'll use the entry buffer, it's better that an input that leave lines under
` the text ;)
clear entry buffer
repeat:until mouseclick()=0
` here's the loop where everythig appends
repeat
` here we draw the box again, to erase the text that was under it
box x,y,x+width+7,y+text height("|")+7,color-rgb(30,30,30),color-rgb(30,30,30),color-rgb(30,30,30),color-rgb(30,30,30)
box x+2,y+2,x+width+5,y+text height("|")+5,color,color,color,color
` if we click out of the box, we leave this loop
if mouseclick()=1
if mousex()<x or mousex()>x+width+7 or mousey()<y or mousey()>y+text height("|")+7
cond=1 : ` if cond=1 then the loop will be left
else
cond=0
endif
endif
` if we press return, we leave the loop too
if returnkey()=1 then cond = 1
` here, we add the netry$() to the string... I like strings, especially
` when girls are wearing them :)
if returnkey()=0 then txt = txt + entry$()
` backspace isn't very kind with the strings, it cut them ^_^
if scancode()=14
txt = left$(txt,len(txt)-1)
pause=0
repeat
inc pause
wait 1
until pause=20 or keystate(14)=0
endif
` if the text is too long, we'll have to write only its end...
` like at the beggining :)
if text width(txt)>width-5
chr_to_show = 0
repeat
inc chr_to_show
until text width(right$(txt+"|",chr_to_show+1))>=width-5
else
chr_to_show = len(txt)
endif
` the | at the end of a string we're writting, but I want a small animation
` with it :)
inc barre_fin
if barre_fin < 20
text x+2,y+2,right$(txt,chr_to_show)+"|"
else
text x+2,y+2,right$(txt,chr_to_show)+""
if barre_fin>40 then barre_fin=0
endif
clear entry buffer
sync
` end of the loop, and soon, the one of the function
until cond=1
endif
endif
endif
ink rgb(0,0,0),0
endfunction txt
` do you remimber the box you had to check to leae the test ? here it is :)
function check_box(x as integer,y as integer, info as string, color_text as dword, valeur)
` I make it has the same size of the text that's written next to it
size = text height("|")
` drawing it first
box x+1,y+1,x+size,y+size,rgb(128,128,128),rgb(196,196,196),rgb(128,128,128),rgb(196,196,196)
ink rgb(0,0,0),0
line x,y,x+size,y
line x+size,y,x+size,y+size
line x+size,y+size,x,y+size
line x,y,x,y+size
` but if it's checked, so we'll have to draw the cross
if valeur > 0
for t=0 to size/4
line x+t,y,x+size-t,y+size
line x,y+t,x+size,y+size-t
line x+size,y+t,x,y+size-t
line x+size-t,y,x+t,y+size
next t
endif
` the text, but I'm sure you had already guessed :)
ink color_text,0
text x+size+5,y,info
` and now, when we click on it
if mousex()>x and mousex()<x+size
if mousey()>y and mousey()<y+size
if mouseclick()=1
repeat:until mouseclick()=0
` as for the button, we look if the mouse is still on it
if mousex()>x and mousex()<x+size
if mousey()>y and mousex()<y+size
` .. changing the value
if valeur >0 then valeur = 0 else valeur = 1
endif
endif
endif
endif
endif
endfunction valeur
` do I really need to explain ? okay, but very fast => all the informations are
` in other functions
function popup_yesno(x as integer, y as integer, sizex as integer, sizey as integer, question as string,color_win as dword,color_text as dword)
` the animation
animex as float = 6.0
animey as float = 6.0
repeat
if animex<sizex then inc animex,(sizex-animex)/6
if animey<sizey then inc animey,(sizey-animey)/6
box x,y,x+animex,y+animey,color_win-rgb(30,30,30),color_win-rgb(30,30,30),color_win-rgb(30,30,30),color_win-rgb(30,30,30)
box x+3,y+3,x+animex-5,y+animey-5,color_win,color_win,color_win,color_win
fastsync
until animex+1>=sizex and animey+1>=sizey
box x,y,x+sizex,y+sizey,color_win-rgb(30,30,30),color_win-rgb(30,30,30),color_win-rgb(30,30,30),color_win-rgb(30,30,30)
box x+3,y+3,x+sizex-5,y+sizey-5,color_win,color_win,color_win,color_win
` cutting the text
if text width(question)>sizex-10
repeat
chr_to_show = 0
repeat
inc chr_to_show
until text width(left$(right$(question,len(question)-already_showed),chr_to_show+1))>sizex-10 or already_showed + chr_to_show >= len(question)
if already_showed + chr_to_show <> len(question)
while mid$(question,already_showed+chr_to_show)<>" " or chr_to_show=<0
dec chr_to_show
endwhile
endif
inc posy
text x+4,y+4+text height("|")*(posy-1),left$(right$(question,len(question)-already_showed),chr_to_show)
already_showed = already_showed + chr_to_show
if already_showed => len(question) then text_showed = 1
sync
until text_showed = 1
else
text x+4,y+4,question
endif
` waiting the user click on a button
repeat
No = button(x+sizex/2 - text width("No") - 20,y+sizey-15-text height("|"),"No",color_text,color_win,color_win-rgb(30,30,30))
Yes = button(x+sizex/2 + 20,y+sizey-15-text height("|"),"Yes",color_text,color_win,color_win-rgb(30,30,30))
if Yes = 1 or No = 1 then oki = 1
sync
until oki=1
` giving the result
if Yes = 1 then res = 1 else res = 0
endfunction res
` what's white and climb trees ?
function select_file(x as integer, y as integer, sizex as integer, sizey as integer, question as string, format as string, color_win as dword, color_text as dword)
perform checklist for files
` aniamtion
animex as float = 6.0
animey as float = 6.0
repeat
if animex<sizex then inc animex,(sizex-animex)/6
if animey<sizey then inc animey,(sizey-animey)/6
box x,y,x+animex,y+animey,color_win-rgb(30,30,30),color_win-rgb(90,90,90),color_win-rgb(30,30,30),color_win-rgb(90,90,90)
box x+3,y+3,x+animex-5,y+animey-5,color_win,color_win,color_win,color_win
fastsync
until animex+1>=sizex and animey+1>=sizey
` cut the question and write it on several lines
if text width(question)>sizex-10
repeat
chr_to_show = 0
repeat
inc chr_to_show
until text width(left$(right$(question,len(question)-already_showed),chr_to_show+1))>sizex-10 or already_showed + chr_to_show >= len(question)
if already_showed + chr_to_show <> len(question)
while mid$(question,already_showed+chr_to_show)<>" " or chr_to_show=<0
dec chr_to_show
endwhile
endif
inc posy
text x+4,y+4+text height("|")*(posy-1),left$(right$(question,len(question)-already_showed),chr_to_show)
already_showed = already_showed + chr_to_show
if already_showed => len(question) then text_showed = 1
sync
until text_showed = 1
else
text x+4,y+4,question
endif
` here we select the kind of files we want to show.. *.* will show them all
dim file(1000) as string
for t=3 to checklist quantity()
if right$(checklist string$(t),4)=format or format="*.*"
inc f
file(f)=checklist string$(t)
endif
next t
` reactor online, sensors online, weapons online, all systems nominal
` here we look from where we begin to write the files
starty = y+4+text height("|")*posy
selected = 1
` and here we write them
repeat
` decalage => from how much steps it move the files in the list, when it's too long
if decalage < 0 then decalage = 0
if decalage+(y+sizey-starty-text height("|")*2-40)/text height("|") > 1000 then decalage = 1000-(y+sizey-starty-text height("|")*2-40)/text height("|")
` here we write them
for t=1 to (y+sizey-starty-text height("|")*2-40)/text height("|") : ` (y+... looks how many filenames we can write before the bottom of the window
` if the one we're writting is the one we already selected, we write >> before it
if selected = t+decalage
` if it's too long, we show only the beggining and then we add ... and the end
if text width(">>"+file(t+decalage))>sizex-30
tronc = len(">>"+file(t+decalage))
repeat
dec tronc
until text width(left$(">>"+file(t+decalage),tronc)+"...")=<sizex-30
text x+20,starty+t*text height("|"),left$(">>"+file(t+decalage),tronc)+"..."
else
text x+20,starty+t*text height("|"),">>"+file(t+decalage)
endif
else
` if it isn't the selected file... we cut it too ^_^
if text width(file(t+decalage))>sizex-30
tronc = len(file(t+decalage))
repeat
dec tronc
until text width(left$(file(t+decalage),tronc)+"...")=<sizex-30
text x+20,starty+t*text height("|"),left$(file(t+decalage),tronc)+"..."
else
text x+20,starty+t*text height("|"),file(t+decalage)
endif
endif
next t
` the question is written, the filename are showed, now, the buttons :)
` these two ones move the filename list.. useful if there are too many
if button(x+10+text width("Okay")+20,y+sizey-text height("|")-30," + ",rgb(0,0,0),rgb(196,196,196),rgb(96,96,96))=1 then inc decalage
if button(x+10+text width("Okay+")+40,y+sizey-text height("|")-30," - ",rgb(0,0,0),rgb(196,196,196),rgb(96,96,96))=1 then dec decalage
sync
box x+3,starty,x+animex-5,y+animey-5,color_win,color_win,color_win,color_win
` here we select the file if we click on it
if mousex()>x and mousex()<x+sizex
if mousey()>starty and mousey()<y+sizey-text height("|")-32
if mouseclick()=1
if (mousey()-starty)/text height("|")=<f then selected = (mousey()-starty)/text height("|")+decalage
endif
endif
endif
` now we leave the function
until button(x+10,y+sizey-text height("|")-30,"Okay",rgb(0,0,0),rgb(196,196,196),rgb(96,96,96))
res$ = file(selected)
endfunction res$
` a fridge... I lied when I said it climbed trees...