A crappy FreeBASIC gui code maker

Turd · Post by **Turd** » Dec 27, 2008 3:52

Heres a program that I'm working on that will output a .bas file that has all the code to make (Draw) a gui program.

Video

Output:

First name the file that it will make then choose the size of the form.
Left click to add a button, right click to add a text box and scroll/middle click to undo a button or text box.
On Esc or X it will make the file.

Code: Select all

type btype

    as integer x, y, w

    as string s

end type

 

dim as string s, ifelse

dim shared box as string

dim shared bstring(300) as btype

dim shared bdraw(300) as btype

dim bif(300) as btype

dim brelease(300) as btype

dim shared inbox(300) as btype

dim inboxif(300) as btype

dim as integer x, y, x1, y1, w, buttons, wheel, boxes, bttns, resx, resy

dim shared as integer i



declare sub drawform



const q = chr(34)



screeninfo x, y

screenres x - x / 5, y - y / 5



input "Form name"; s

open s & ".bas" for binary as #1

cls

do while buttons < 1

	getmouse (resx, resy, , buttons)

	s = inkey$

	if s = chr(255) & "k" or s = chr(27) then end

	color 15, 0: locate resy/2/9,resx/2/8 - 5

	print using "#### : ####"; resx; resy

	line (0, 0)-(resx, 0), 15

	line (0, 0)-(0, resy), 15

	line (0, resy)-(resx, resy), 15

	line (resx, 0)-(resx, resy), 15

	sleep 10

	cls

loop

getmouse (resx, resy, , buttons)

do while resx > 1 and buttons > 0: getmouse (resx, resy, , buttons): sleep 10: loop



print #1, "dim as integer x, y, buttons"

print #1, "dim as string s"

print #1,

print #1, "screenres " & resx & "," & resy

print #1, "color 0, 15"

print #1, "cls"

print #1,



screenres resx + 10, resy + 25, 8

color 0, 15

cls



boxes = 1

bttns = 1



box = "BM5,20 D" & resy & "R" & resx & "U" & resy & "L" & resx



do while inkey$ = ""

	do while buttons < 1

		getmouse (x, y, , buttons)		

		s = inkey$

		if s = chr(255) & "k" or s = chr(27) then

			for i = 1 to 300

				if bstring(i).s = "" then exit for

				print #1, "draw string (" & bstring(i).x - 5 & "," & bstring(i).y - 20 & ")," & q & bstring(i).s & q

			next i

			for i = 1 to 300

				if bdraw(i).x = 0 then exit for

				print #1, "draw " & q & "C0 BM" & bdraw(i).x - 5 & "," & bdraw(i).y - 20 & " D26 R D R D R" & bdraw(i).w & " U R U R U26 L U L U L" & bdraw(i).w & " D L D L C8 BM" & bdraw(i).x - 2 & "," & bdraw(i).y + 9 & " R" & bdraw(i).w & " U R U R U26" & q

			next i

			for i = 1 to 300

				if inbox(i).x = 0 then exit for

				print #1, "draw " & q & "C0 BM" & inbox(i).x - 5 & "," & inbox(i).y - 20 & " D26 R D R D R" & inbox(i).w & " U R U R U26 L U L U L" & inbox(i).w & " D L D L C7 BM" & inbox(i).x - 4 & "," & inbox(i).y - 19 & " D24 R D R D R" & inbox(i).w - 2 & " U R U R U24 L U L U L" & inbox(i).w - 2 & "D L D" & q

			next i

			print #1, "do"

			print #1, "	do while buttons < 1"

			print #1, "		getmouse (x, y, , buttons)"

			print #1, "		s = inkey$"

			print #1, "		if s = chr(255) & " & q & "k" & q & " or s = chr(27) then end"

			print #1, "		sleep 10"

			print #1, "	loop"

			print #1,

			print #1, "'buttons"

			ifelse = "	if x > "

			for i = 1 to 300

				if bif(i).x = 0 then exit for

				print #1, ifelse & bif(i).x - 5 & " and x < " & bif(i).x + bif(i).w - 1 & " and y > " & bif(i).y - 20 & " and y < " & bif(i).y + 10 & " then" & chr(13) & "		draw " & q & "C15 BM" & bif(i).x - 2 & "," & bif(i).y + 9 & " R" & bif(i).w & " U R U R U26 C8 BM" & bif(i).x - 4 & "," & bif(i).y + 5 & "U24 R U R U R" & bif(i).w & q

				print #1, "		"

				ifelse = "	elseif x > "

			next i

			print #1, "'input boxs"

			if bttns > 1 then

				ifelse = "	elseif x > "

			else

				ifelse = "	if x > "

			end if

			for i = 1 to 300

				if inboxif(i).x = 0 then exit for

				print #1, ifelse & inboxif(i).x - 5 & " and x < " & inboxif(i).x + inboxif(i).w - 1 & " and y > " & inboxif(i).y - 20 & " and y < " & inboxif(i).y + 10 & " then" & chr(13) & "		draw " & q & "BM" & inboxif(i).x - 2 & "," & inboxif(i).Y - 17 & " P15,7 C0" & q

				print #1, "		"

				ifelse = "	elseif x > "

			next i

			print #1, "	end if"

			print #1,

			print #1, "	sleep 10"

			print #1, "	getmouse (x, y, , buttons)"

			print #1, "	do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop"

			for i = 1 to 300

				if brelease(i).x = 0 then exit for

				print #1, "	draw " & q & "C15 BM" & brelease(i).x & "," & brelease(i).y & " U24 R U R U R" & brelease(i).w - 2 & " C8 BM" & brelease(i).x + 2 & "," & brelease(i).y + 4 & " R" & brelease(i).w & "U R U R U26" & q

			next i

			print #1, "loop"

			close #1

			end

		end if

		drawform

		sleep 20

		cls

	loop

	

	if buttons = 1 then

		locate 2, 1

		print "                        "

		color 0, 15: locate 2, 1

		input "Button text"; s

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			color 0, 15: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			w = len(s) * 8 + 10

			draw string (x1 + 8, y1 + 10), s

			draw "C0 BM" & x1 & "," & y1 & " D26 R D R D R" & w & " U R U R U26 L U L U L" & w & " D L D L C8 BM" & x1 + 1 & "," & y1 + 1 & " BD26 BR BD BR BD R" & w & " U R U R U26 C0"

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), 0

			line (x1, 20)-(x1, resy + 20), 0

			sleep 20

			cls

		loop

		

		bstring(bttns).x = x1 + 8: bstring(bttns).y = y1 + 10: bstring(bttns).s = s

		bdraw(bttns).x = x1: bdraw(bttns).y = y1: bdraw(bttns).w = w

		bif(bttns).x = x1: bif(bttns).y = y1: bif(bttns).w = w

		brelease(bttns).x = x1 - 4: brelease(bttns).y = y1 + 5: brelease(bttns).w = w

		

		bttns += 1

		

		locate 2, 1

		print "                        "

	end if

	

	if buttons = 2 then

		locate 2, 1

		print "                        "

		color 0, 15: locate 2, 1

		input "Box size"; i

		s = space(i + 1)

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			color 0, 15: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			w = len(s) * 8 + 10

			draw "C0 BM" & x1 & "," & y1 & " D26 R D R D R" & w & " U R U R U26 L U L U L" & w & " D L D L C7 BM" & x1 + 1 & "," & y1 + 1 & " D24 R D R D R" & w - 2 & " U R U R U24 L U L U L" & w - 2 & "D L D"

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), 0

			line (x1, 20)-(x1, resy + 20), 0

			sleep 20

			cls

		loop

		

		inbox(boxes).x = x1: inbox(boxes).y = y1: inbox(boxes).w = w

		inboxif(boxes).x = x1: inboxif(boxes).y = y1: inboxif(boxes).w = w

		

		boxes += 1

		

		locate 2, 1

		print "                        "

	end if

	

	if buttons = 4 then

		locate 1, 1: print "                        "

		locate 1, 2: print "                        "

		color 0, 15: locate 1, 1

		print "Undo button: A"

		print "Undo box: B"

		print "or nothing: C"

		input "", s

		if s = "A" or s = "a" then

			bstring(bttns - 1).x = 0: bstring(bttns - 1).y = 0: bstring(bttns - 1).s = ""

			bdraw(bttns - 1).x = 0: bdraw(bttns - 1).y = 0: bdraw(bttns - 1).w = 0

			bif(bttns - 1).x = 0: bif(bttns - 1).y = 0: bif(bttns - 1).w = 0

			brelease(bttns - 1).x = 0: brelease(bttns - 1).y = 0: brelease(bttns - 1).w = 0

			if bttns = 1 then

			else

				bttns -= 1

			end if

		elseif s = "B" or s = "b" then

			inbox(boxes - 1).x = 0: inbox(boxes - 1).y = 0: inbox(boxes - 1).w = 0

			inboxif(boxes - 1).x = 0: inboxif(boxes - 1).y = 0: inboxif(boxes - 1).w = 0

			if boxes = 1 then

			else

				boxes -= 1

			end if

		elseif s = "C" or s = "c" then

		end if

	end if	

	

    getmouse (x, y, , buttons)

    do while x > 1 and buttons > 0: getmouse (x, y, , buttons): color 0, 15: locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

loop



sub drawform


	for i = 1 to 300

		if bstring(i).s = "" then exit for

		draw string (bstring(i).x, bstring(i).y), bstring(i).s, 0

	next i

	for i = 1 to 300

		if bdraw(i).x = 0 then exit for

		draw "C0 BM" & bdraw(i).x & "," & bdraw(i).y & " D26 R D R D R" & bdraw(i).w & " U R U R U26 L U L U L" & bdraw(i).w & " D L D L C8 BM" & bdraw(i).x + 1 & "," & bdraw(i).y + 1 & " BD26 BR BD BR BD R" & bdraw(i).w & " U R U R U26 C0" & q

	next i

	for i = 1 to 300

		if inbox(i).x = 0 then exit for

		draw "C0 BM" & inbox(i).x & "," & inbox(i).y & " D26 R D R D R" & inbox(i).w & " U R U R U26 L U L U L" & inbox(i).w & " D L D L C7 BM" & inbox(i).x + 1 & "," & inbox(i).y + 1 & " D24 R D R D R" & inbox(i).w - 2 & " U R U R U24 L U L U L" & inbox(i).w - 2 & "D L D"

	next i

	draw box

end sub

rolliebollocks · Post by **rolliebollocks** » Dec 27, 2008 11:54

Nice work so far. Have you considered having instead of a full code generator, a text file data generator which will save relevant data? A button for instance is composed of an x position, y position, an x distance, a y distance, a label/pic and a target routine which redirects on a click. That's five pieces of data since the drawing routine is always more or less the same.

Hexadecimal Dude! · Post by **Hexadecimal Dude!** » Dec 27, 2008 14:14

This is pretty nice, it's great to see movement in this direction after such a long time without it. Also, while I usually really hate fbgfx guis, your style is nice.
However, it flickers a lot for me, and also, when I click a button in a test program, if I do it fast it doesn't seem to go down (I haven't checked yet whether it calls its sub).

Keep up the good work! :)

Turd · Post by **Turd** » Dec 27, 2008 16:43

Thanks :)

rolliebollocks wrote:Nice work so far. Have you considered having instead of a full code generator, a text file data generator which will save relevant data? A button for instance is composed of an x position, y position, an x distance, a y distance, a label/pic and a target routine which redirects on a click. That's five pieces of data since the drawing routine is always more or less the same.

Kinda, I was think it should output Subs for "bttn" which draws the button and the bottom and right shadow, "buttonup" which draws the bottom and right shadow, and whites-out the top and left shadow, "buttondown" which draws the top and left shadow, and whites-out the bottom and right shadow and "inbox" which draws the in/out text boxs. All it needs to know to draw a button is the X, Y and the button text it will figure out the width.

Code: Select all

dim as integer x, y, buttons
dim as string s

declare sub bttn(x as integer, y as integer, s as string)
declare sub buttonup(x as integer, y as integer, s as integer)
declare sub buttondown(x as integer, y as integer, s as integer)
declare sub inbox(x as integer, y as integer, l as integer)

screenres 329,276
color 0, 15
cls

'draw string (27,32),"OK"
'draw string (123,32),"Start"
'draw string (259,32),"Stop"
'draw string (259,240),"Exit"
bttn (19, 22, "OK")
bttn (115,22, "Start")
bttn (251, 22, "Stop")
bttn (251, 230, "Exit")
'draw "C0 BM19,22 D26 R D R D R26 U R U R U26 L U L U L26 D L D L C8 BM22,51 R26 U R U R U26"
'draw "C0 BM115,22 D26 R D R D R50 U R U R U26 L U L U L50 D L D L C8 BM118,51 R50 U R U R U26"
'draw "C0 BM251,22 D26 R D R D R42 U R U R U26 L U L U L42 D L D L C8 BM254,51 R42 U R U R U26"
'draw "C0 BM251,230 D26 R D R D R42 U R U R U26 L U L U L42 D L D L C8 BM254,259 R42 U R U R U26"
inbox (67, 86, 10)
inbox (67, 158, 10)
'draw "C0 BM67,86 D26 R D R D R178 U R U R U26 L U L U L178 D L D L C7 BM68,87 D24 R D R D R176 U R U R U24 L U L U L176D L D"
'draw "C0 BM67,158 D26 R D R D R178 U R U R U26 L U L U L178 D L D L C7 BM68,159 D24 R D R D R176 U R U R U24 L U L U L176D L D"
do
	do while buttons < 1
		getmouse (x, y, , buttons)
		s = inkey$
		if s = chr(255) & "k" or s = chr(27) then end
		sleep 10
	loop

'buttons
	if x > 19 and x < 49 and y > 22 and y < 52 then
		'draw "C15 BM22,51 R26 U R U R U26 C8 BM20,47 U24 R U R U R26"
		buttondown (22, 51, 26)
		
	elseif x > 115 and x < 169 and y > 22 and y < 52 then
		'draw "C15 BM118,51 R50 U R U R U26 C8 BM116,47U24 R U R U R50"
		buttondown (118, 51, 50)
		
	elseif x > 251 and x < 297 and y > 22 and y < 52 then
		'draw "C15 BM254,51 R42 U R U R U26 C8 BM252,47U24 R U R U R42"
		buttondown (254, 51, 42)
		
	elseif x > 251 and x < 297 and y > 230 and y < 260 then
		'draw "C15 BM254,259 R42 U R U R U26 C8 BM252,255U24 R U R U R42"
		buttondown (254, 259, 42)
		end
'input boxs
	elseif x > 67 and x < 249 and y > 86 and y < 116 then
		draw "BM70,89 P15,7 C0"	'clear box
		
	elseif x > 67 and x < 249 and y > 158 and y < 188 then
		draw "BM70,161 P15,7 C0"	'clear box
		
	end if

	sleep 10
	getmouse (x, y, , buttons)
	do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop
	'draw "C15 BM20,47 U24 R U R U R24 C8 BM22,51 R26U R U R U26"
	'draw "C15 BM116,47 U24 R U R U R48 C8 BM118,51 R50U R U R U26"
	'draw "C15 BM252,47 U24 R U R U R40 C8 BM254,51 R42U R U R U26"
	'draw "C15 BM252,255 U24 R U R U R40 C8 BM254,259 R42U R U R U26"
	buttonup (20, 47, 24)
	buttonup (116, 47, 48)
	buttonup (252, 47, 40)
	buttonup (252, 255, 40)
loop

sub bttn(x as integer, y as integer, s as string)
	dim as integer w
	w = len(s) * 8 + 10
	draw string (x + 8, y + 10), s
	draw "C0 BM" & x & "," & y & " D26 R D R D R" & w & " U R U R U26 L U L U L" & w & " D L D L C8 BM" & x + 1 & "," & y + 1 & " BD26 BR BD BR BD R" & w & " U R U R U26 C0"
end sub

sub buttonup(x as integer, y as integer, w as integer)
	draw "C15 BM" & x & "," & y & " U24 R U R U R" & w & " C8 BM" & x + 2 & "," & y + 4 & " R" & w + 2 & " U R U R U26"
end sub

sub buttondown(x as integer, y as integer, w as integer)
	draw "C15 BM" & x & "," & y & " R" & w & " U R U R U26 C8 BM" & x - 2 & "," & y - 4 & " U24 R U R U R" & w
	'draw "C15 BM" & x & "," & y & " R" & w & " U R U R U26 C8 BM" & x & "," & y & " U24 R U R U R" & w 
end sub

sub inbox(x as integer, y as integer, l as integer)
	dim as integer w
	w = l * 8 + 3
	draw "C0 BM" & x & "," & y & " D26 R D R D R" & w & " U R U R U26 L U L U L" & w & " D L D L C7 BM" & x + 1 & "," & y + 1 & " D24 R D R D R" & w - 2 & " U R U R U24 L U L U L" & w - 2 & "D L D"
	locate 2 + y / 8, 2 + x / 8: color 0, 15: print "8888888888"
end sub

Hexadecimal Dude! wrote:This is pretty nice, it's great to see movement in this direction after such a long time without it. Also, while I usually really hate fbgfx guis, your style is nice.
However, it flickers a lot for me, and also, when I click a button in a test program, if I do it fast it doesn't seem to go down (I haven't checked yet whether it calls its sub).

Keep up the good work! :)

I've noticed that sometimes too (in using the program and the output programs. Maybe it'll help to change the "sleep 10"s to "sleep 1" or something.

Hexadecimal Dude! · Post by **Hexadecimal Dude!** » Dec 27, 2008 17:26

Try locking the screen too ( http://www.freebasic.net/wiki/wikka.php ... Screenlock )

Turd · Post by **Turd** » Dec 27, 2008 18:02

That did the trick, thanks :)

Code: Select all

type btype

    as integer x, y, w

    as string s

end type

 

dim as string s, ifelse

dim shared box as string

dim shared bstring(300) as btype

dim shared bdraw(300) as btype

dim bif(300) as btype

dim brelease(300) as btype

dim shared inbox(300) as btype

dim inboxif(300) as btype

dim as integer x, y, x1, y1, w, buttons, wheel, boxes, bttns, resx, resy

dim shared as integer i



declare sub drawform



const q = chr(34)



screeninfo x, y

screenres x - x / 5, y - y / 5



input "Form name"; s

open s & ".bas" for binary as #1

cls

do while buttons < 1

	getmouse (resx, resy, , buttons)

	s = inkey$

	if s = chr(255) & "k" or s = chr(27) then end

	color 15, 0: locate resy/2/9,resx/2/8 - 5

	print using "#### : ####"; resx; resy

	line (0, 0)-(resx, 0), 15

	line (0, 0)-(0, resy), 15

	line (0, resy)-(resx, resy), 15

	line (resx, 0)-(resx, resy), 15

	sleep 10

	cls

loop

getmouse (resx, resy, , buttons)

do while resx > 1 and buttons > 0: getmouse (resx, resy, , buttons): sleep 10: loop



print #1, "dim as integer x, y, buttons"

print #1, "dim as string s"

print #1,

print #1, "screenres " & resx & "," & resy

print #1, "color 0, 15"

print #1, "cls"

print #1,



screenres resx + 10, resy + 25, 8

color 0, 15

cls



boxes = 1

bttns = 1



box = "BM5,20 D" & resy & "R" & resx & "U" & resy & "L" & resx



do while inkey$ = ""

	do while buttons < 1

		getmouse (x, y, , buttons)		

		s = inkey$

		if s = chr(255) & "k" or s = chr(27) then

			for i = 1 to 300

				if bstring(i).s = "" then exit for

				print #1, "draw string (" & bstring(i).x - 5 & "," & bstring(i).y - 20 & ")," & q & bstring(i).s & q

			next i

			for i = 1 to 300

				if bdraw(i).x = 0 then exit for

				print #1, "draw " & q & "C0 BM" & bdraw(i).x - 5 & "," & bdraw(i).y - 20 & " D26 R D R D R" & bdraw(i).w & " U R U R U26 L U L U L" & bdraw(i).w & " D L D L C8 BM" & bdraw(i).x - 2 & "," & bdraw(i).y + 9 & " R" & bdraw(i).w & " U R U R U26" & q

			next i

			for i = 1 to 300

				if inbox(i).x = 0 then exit for

				print #1, "draw " & q & "C0 BM" & inbox(i).x - 5 & "," & inbox(i).y - 20 & " D26 R D R D R" & inbox(i).w & " U R U R U26 L U L U L" & inbox(i).w & " D L D L C7 BM" & inbox(i).x - 4 & "," & inbox(i).y - 19 & " D24 R D R D R" & inbox(i).w - 2 & " U R U R U24 L U L U L" & inbox(i).w - 2 & "D L D" & q

			next i

			print #1, "do"

			print #1, "	do while buttons < 1"

			print #1, "		getmouse (x, y, , buttons)"

			print #1, "		s = inkey$"

			print #1, "		if s = chr(255) & " & q & "k" & q & " or s = chr(27) then end"

			print #1, "		sleep 10"

			print #1, "	loop"

			print #1,

			print #1, "'buttons"

			ifelse = "	if x > "

			for i = 1 to 300

				if bif(i).x = 0 then exit for

				print #1, ifelse & bif(i).x - 5 & " and x < " & bif(i).x + bif(i).w - 1 & " and y > " & bif(i).y - 20 & " and y < " & bif(i).y + 10 & " then" & chr(13) & "		draw " & q & "C15 BM" & bif(i).x - 2 & "," & bif(i).y + 9 & " R" & bif(i).w & " U R U R U26 C8 BM" & bif(i).x - 4 & "," & bif(i).y + 5 & "U24 R U R U R" & bif(i).w & q

				print #1, "		"

				ifelse = "	elseif x > "

			next i

			print #1, "'input boxs"

			if bttns > 1 then

				ifelse = "	elseif x > "

			else

				ifelse = "	if x > "

			end if

			for i = 1 to 300

				if inboxif(i).x = 0 then exit for

				print #1, ifelse & inboxif(i).x - 5 & " and x < " & inboxif(i).x + inboxif(i).w - 1 & " and y > " & inboxif(i).y - 20 & " and y < " & inboxif(i).y + 10 & " then" & chr(13) & "		draw " & q & "BM" & inboxif(i).x - 2 & "," & inboxif(i).Y - 17 & " P15,7 C0" & q

				print #1, "		"

				ifelse = "	elseif x > "

			next i

			print #1, "	end if"

			print #1,

			print #1, "	sleep 10"

			print #1, "	getmouse (x, y, , buttons)"

			print #1, "	do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop"

			for i = 1 to 300

				if brelease(i).x = 0 then exit for

				print #1, "	draw " & q & "C15 BM" & brelease(i).x & "," & brelease(i).y & " U24 R U R U R" & brelease(i).w - 2 & " C8 BM" & brelease(i).x + 2 & "," & brelease(i).y + 4 & " R" & brelease(i).w & "U R U R U26" & q

			next i

			print #1, "loop"

			close #1

			end

		end if

		ScreenLock()

		Cls()

		drawform

		ScreenUnlock()

		sleep 20

		'cls

	loop

	

	if buttons = 1 then

		locate 2, 1

		print "                        "

		color 0, 15: locate 2, 1

		input "Button text"; s

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			w = len(s) * 8 + 10

			ScreenLock()

			Cls()

			color 0, 15: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			draw string (x1 + 8, y1 + 10), s

			draw "C0 BM" & x1 & "," & y1 & " D26 R D R D R" & w & " U R U R U26 L U L U L" & w & " D L D L C8 BM" & x1 + 1 & "," & y1 + 1 & " BD26 BR BD BR BD R" & w & " U R U R U26 C0"

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), 0

			line (x1, 20)-(x1, resy + 20), 0

			ScreenUnlock()

			sleep 20

		loop

		

		bstring(bttns).x = x1 + 8: bstring(bttns).y = y1 + 10: bstring(bttns).s = s

		bdraw(bttns).x = x1: bdraw(bttns).y = y1: bdraw(bttns).w = w

		bif(bttns).x = x1: bif(bttns).y = y1: bif(bttns).w = w

		brelease(bttns).x = x1 - 4: brelease(bttns).y = y1 + 5: brelease(bttns).w = w

		

		bttns += 1

		

		locate 2, 1

		print "                        "

	end if

	

	if buttons = 2 then

		locate 2, 1

		print "                        "

		color 0, 15: locate 2, 1

		input "Box size"; i

		s = space(i + 1)

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			w = len(s) * 8 + 10

			ScreenLock()

			Cls()

			color 0, 15: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			draw "C0 BM" & x1 & "," & y1 & " D26 R D R D R" & w & " U R U R U26 L U L U L" & w & " D L D L C7 BM" & x1 + 1 & "," & y1 + 1 & " D24 R D R D R" & w - 2 & " U R U R U24 L U L U L" & w - 2 & "D L D"

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), 0

			line (x1, 20)-(x1, resy + 20), 0

			ScreenUnlock()

			sleep 20

		loop

		

		inbox(boxes).x = x1: inbox(boxes).y = y1: inbox(boxes).w = w

		inboxif(boxes).x = x1: inboxif(boxes).y = y1: inboxif(boxes).w = w

		

		boxes += 1

		

		locate 2, 1

		print "                        "

	end if

	

	if buttons = 4 then

		locate 1, 1: print "                        "

		locate 1, 2: print "                        "

		color 0, 15: locate 1, 1

		print "Undo button: A"

		print "Undo box: B"

		print "or nothing: C"

		input "", s

		if s = "A" or s = "a" then

			bstring(bttns - 1).x = 0: bstring(bttns - 1).y = 0: bstring(bttns - 1).s = ""

			bdraw(bttns - 1).x = 0: bdraw(bttns - 1).y = 0: bdraw(bttns - 1).w = 0

			bif(bttns - 1).x = 0: bif(bttns - 1).y = 0: bif(bttns - 1).w = 0

			brelease(bttns - 1).x = 0: brelease(bttns - 1).y = 0: brelease(bttns - 1).w = 0

			if bttns = 1 then

			else

				bttns -= 1

			end if

		elseif s = "B" or s = "b" then

			inbox(boxes - 1).x = 0: inbox(boxes - 1).y = 0: inbox(boxes - 1).w = 0

			inboxif(boxes - 1).x = 0: inboxif(boxes - 1).y = 0: inboxif(boxes - 1).w = 0

			if boxes = 1 then

			else

				boxes -= 1

			end if

		elseif s = "C" or s = "c" then

		end if

	end if	

	

    getmouse (x, y, , buttons)

    do while x > 1 and buttons > 0: getmouse (x, y, , buttons): color 0, 15: locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

loop



sub drawform

	for i = 1 to 300

		if bstring(i).s = "" then exit for

		draw string (bstring(i).x, bstring(i).y), bstring(i).s, 0

	next i

	for i = 1 to 300

		if bdraw(i).x = 0 then exit for

		draw "C0 BM" & bdraw(i).x & "," & bdraw(i).y & " D26 R D R D R" & bdraw(i).w & " U R U R U26 L U L U L" & bdraw(i).w & " D L D L C8 BM" & bdraw(i).x + 1 & "," & bdraw(i).y + 1 & " BD26 BR BD BR BD R" & bdraw(i).w & " U R U R U26 C0" & q

	next i

	for i = 1 to 300

		if inbox(i).x = 0 then exit for

		draw "C0 BM" & inbox(i).x & "," & inbox(i).y & " D26 R D R D R" & inbox(i).w & " U R U R U26 L U L U L" & inbox(i).w & " D L D L C7 BM" & inbox(i).x + 1 & "," & inbox(i).y + 1 & " D24 R D R D R" & inbox(i).w - 2 & " U R U R U24 L U L U L" & inbox(i).w - 2 & "D L D"

	next i

	draw box

end sub

Turd · Post by **Turd** » Dec 27, 2008 20:41

It now make Subs. Hopefully it'll be more efficient for program with a lot of buttons and boxes.

Code: Select all

type btype

    as integer x, y, w

    as string s

end type

 

dim as string s, ifelse

dim shared box as string

dim shared bstring(300) as btype

dim shared bdraw(300) as btype

dim bif(300) as btype

dim brelease(300) as btype

dim shared inbox(300) as btype

dim inboxif(300) as btype

dim as integer x, y, x1, y1, w, buttons, wheel, boxes, bttns, resx, resy

dim shared as integer i



declare sub drawform



const q = chr(34)



screeninfo x, y

screenres x - x / 5, y - y / 5



input "Form name"; s

open s & ".bas" for binary as #1

cls

do while buttons < 1

	getmouse (resx, resy, , buttons)

	s = inkey$

	if s = chr(255) & "k" or s = chr(27) then end

	color 15, 0: locate resy/2/9,resx/2/8 - 5

	print using "#### : ####"; resx; resy

	line (0, 0)-(resx, 0), 15

	line (0, 0)-(0, resy), 15

	line (0, resy)-(resx, resy), 15

	line (resx, 0)-(resx, resy), 15

	sleep 10

	cls

loop

getmouse (resx, resy, , buttons)

do while resx > 1 and buttons > 0: getmouse (resx, resy, , buttons): sleep 10: loop



print #1, "dim as integer x, y, buttons"

print #1, "dim as string s"

print #1,

print #1, "declare sub bttn(x as integer, y as integer, s as string)"

print #1, "declare sub buttonup(x as integer, y as integer, s as integer)"

print #1, "declare sub buttondown(x as integer, y as integer, s as integer)"

print #1, "declare sub inbox(x as integer, y as integer, w as integer)"

print #1, "declare sub clearbox(x as integer, y as integer)"

print #1,

print #1, "screenres " & resx & "," & resy

print #1, "color 0, 15"

print #1, "cls"

print #1,



screenres resx + 10, resy + 25, 8

color 0, 15

cls



boxes = 1

bttns = 1



box = "BM5,20 D" & resy & "R" & resx & "U" & resy & "L" & resx



do while inkey$ = ""

	do while buttons < 1

		getmouse (x, y, , buttons)		

		s = inkey$

		if s = chr(255) & "k" or s = chr(27) then

			for i = 1 to 300

				if bdraw(i).x = 0 then exit for

				print #1, "bttn (" & bdraw(i).x - 5 & ", " & bdraw(i).y - 20 & ", " & q & bstring(i).s & q & ")"

			next i

			for i = 1 to 300

				if inbox(i).x = 0 then exit for

				print #1, "inbox (" & inbox(i).x - 5 & ", " & inbox(i).y - 20 & ", " & inbox(i).w & ")"

			next i

			print #1,

			print #1, "do"

			print #1, "	do while buttons < 1"

			print #1, "		getmouse (x, y, , buttons)"

			print #1, "		s = inkey$"

			print #1, "		if s = chr(255) & " & q & "k" & q & " or s = chr(27) then end"

			print #1, "		sleep 10"

			print #1, "	loop"

			print #1,

			print #1, "'buttons"

			ifelse = "	if x > "

			for i = 1 to 300

				if bif(i).x = 0 then exit for

				print #1, ifelse & bif(i).x - 5 & " and x < " & bif(i).x + bif(i).w - 1 & " and y > " & bif(i).y - 20 & " and y < " & bif(i).y + 10 & " then" & chr(13) & "		buttondown (" & bif(i).x - 2 & ", " & bif(i).y + 9 & ", " & bif(i).w & ")"

				print #1, "		"

				ifelse = "	elseif x > "

			next i

			print #1, "'input boxs"

			if bttns > 1 then

				ifelse = "	elseif x > "

			else

				ifelse = "	if x > "

			end if

			for i = 1 to 300

				if inboxif(i).x = 0 then exit for

				print #1, ifelse & inboxif(i).x - 5 & " and x < " & inboxif(i).x + inboxif(i).w - 1 & " and y > " & inboxif(i).y - 20 & " and y < " & inboxif(i).y + 10 & " then" & chr(13) & "		clearbox (" & inboxif(i).x - 2 & ", " & inboxif(i).Y - 17 & ")"

				print #1, "		"

				ifelse = "	elseif x > "

			next i

			print #1, "	end if"

			print #1,

			print #1, "	sleep 10"

			print #1, "	getmouse (x, y, , buttons)"

			print #1, "	do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop"

			for i = 1 to 300

				if brelease(i).x = 0 then exit for

				print #1, "	buttonup (" & brelease(i).x & "," & brelease(i).y & "," & brelease(i).w & ")"

			next i

			print #1, "loop"

			print #1,

			print #1, "sub bttn(x as integer, y as integer, s as string)" & chr(13) & "	dim as integer w" & chr(13) & "	w = len(s) * 8 + 10" & chr(13) & "	draw string (x + 8, y + 10), s" & chr(13) & "	draw" & q & "C0 BM" & q & " & x & " & q & "," & q & " & y & " & q & "D26 R D R D R" & q & " & w & " & q & "U R U R U26 L U L U L" & q & " & w & " & q & "D L D L C8 BM" & q & " & x + 1 & " & q & "," & q & " & y + 1 & " & q & "BD26 BR BD BR BD R" & q & " & w & " & q & "U R U R U26 C0" & q & chr(13) & "end sub"

			print #1,

			print #1, "sub buttonup(x as integer, y as integer, w as integer)" & chr(13) & "	draw " & q & "C15 BM" & q & " & x & " & q & "," & q & " & y & " & q & "U24 R U R U R" & q & " & w - 2 & " & q & "C8 BM" & q & " & x + 2 & " & q & "," & q & " & y + 4 & " & q & "R" & q & " & w & " & q & "U R U R U26" & q & chr(13) & "end sub"

			print #1,

			print #1, "sub buttondown(x as integer, y as integer, w as integer)" & chr(13) & "	draw " & q & "C15 BM" & q & " & x & " & q & "," & q & " & y & " & q & " R " & q & " & w & " & q & " U R U R U26 C8 BM" & q & " & x - 2 & " & q & "," & q & " & y - 4 & " & q & " U24 R U R U R" & q & " & w" & chr(13) & "end sub"

			print #1,

			print #1, "sub inbox(x as integer, y as integer, w as integer)" & chr(13) & "	draw " & q & "C0 BM" & q & " & x & " & q & "," & q & " & y & " & q & " D26 R D R D R" & q & " & w & " & q & " U R U R U26 L U L U L" & q & " & w & " & q & " D L D L C7 BM" & q & " & x + 1 & " & q & "," & q & " & y + 1 & " & q & " D24 R D R D R" & q & " & w - 2 & " & q & " U R U R U24 L U L U L" & q & " & w - 2 & " & q & "D L D" & q & chr(13) & "end sub"

			print #1,

			print #1, "sub clearbox(x as integer, y as integer)" & chr(13) & "	draw " & q & "BM" & q & " & x & " & q & "," & q & " & y & " & q & "P15,7 C0" & q & chr(13) & "end sub"

			print #1,

			close #1

			end

		end if

		screenlock

		cls

		drawform

		screenunlock

		sleep 20

	loop

	

	if buttons = 1 then

		locate 2, 1

		print "                        "

		color 0, 15: locate 2, 1

		input "Button text"; s

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			w = len(s) * 8 + 10

			screenlock

			cls

			color 0, 15: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			draw string (x1 + 8, y1 + 10), s

			draw "C0 BM" & x1 & "," & y1 & " D26 R D R D R" & w & " U R U R U26 L U L U L" & w & " D L D L C8 BM" & x1 + 1 & "," & y1 + 1 & " BD26 BR BD BR BD R" & w & " U R U R U26 C0"

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), 0

			line (x1, 20)-(x1, resy + 20), 0

			screenunlock

			sleep 20

		loop

		

		bstring(bttns).x = x1 + 8: bstring(bttns).y = y1 + 10: bstring(bttns).s = s

		bdraw(bttns).x = x1: bdraw(bttns).y = y1: bdraw(bttns).w = w

		bif(bttns).x = x1: bif(bttns).y = y1: bif(bttns).w = w

		brelease(bttns).x = x1 - 4: brelease(bttns).y = y1 + 5: brelease(bttns).w = w

		

		bttns += 1

		

		locate 2, 1

		print "                        "

	end if

	

	if buttons = 2 then

		locate 2, 1

		print "                        "

		color 0, 15: locate 2, 1

		input "Box size"; i

		s = space(i + 1)

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			w = len(s) * 8 + 10

			screenlock

			cls

			color 0, 15: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			draw "C0 BM" & x1 & "," & y1 & " D26 R D R D R" & w & " U R U R U26 L U L U L" & w & " D L D L C7 BM" & x1 + 1 & "," & y1 + 1 & " D24 R D R D R" & w - 2 & " U R U R U24 L U L U L" & w - 2 & "D L D"

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), 0

			line (x1, 20)-(x1, resy + 20), 0

			screenunlock

			sleep 20

		loop

		

		inbox(boxes).x = x1: inbox(boxes).y = y1: inbox(boxes).w = w

		inboxif(boxes).x = x1: inboxif(boxes).y = y1: inboxif(boxes).w = w

		

		boxes += 1

		

		locate 2, 1

		print "                        "


	end if

	

	if buttons = 4 then

		locate 1, 1: print "                        "

		locate 1, 2: print "                        "

		color 0, 15: locate 1, 1

		print "Undo button: A"

		print "Undo box: B"

		print "or nothing: C"

		input "", s

		if s = "A" or s = "a" then

			bstring(bttns - 1).x = 0: bstring(bttns - 1).y = 0: bstring(bttns - 1).s = ""

			bdraw(bttns - 1).x = 0: bdraw(bttns - 1).y = 0: bdraw(bttns - 1).w = 0

			bif(bttns - 1).x = 0: bif(bttns - 1).y = 0: bif(bttns - 1).w = 0

			brelease(bttns - 1).x = 0: brelease(bttns - 1).y = 0: brelease(bttns - 1).w = 0

			if bttns = 1 then

			else

				bttns -= 1

			end if

		elseif s = "B" or s = "b" then

			inbox(boxes - 1).x = 0: inbox(boxes - 1).y = 0: inbox(boxes - 1).w = 0

			inboxif(boxes - 1).x = 0: inboxif(boxes - 1).y = 0: inboxif(boxes - 1).w = 0

			if boxes = 1 then

			else

				boxes -= 1

			end if

		elseif s = "C" or s = "c" then

		end if

	end if	

	

    getmouse (x, y, , buttons)

    do while x > 1 and buttons > 0: getmouse (x, y, , buttons): color 0, 15: locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

loop



sub drawform

	for i = 1 to 300

		if bstring(i).s = "" then exit for

		draw string (bstring(i).x, bstring(i).y), bstring(i).s, 0

	next i

	for i = 1 to 300

		if bdraw(i).x = 0 then exit for

		draw "C0 BM" & bdraw(i).x & "," & bdraw(i).y & " D26 R D R D R" & bdraw(i).w & " U R U R U26 L U L U L" & bdraw(i).w & " D L D L C8 BM" & bdraw(i).x + 1 & "," & bdraw(i).y + 1 & " BD26 BR BD BR BD R" & bdraw(i).w & " U R U R U26 C0" & q

	next i

	for i = 1 to 300

		if inbox(i).x = 0 then exit for

		draw "C0 BM" & inbox(i).x & "," & inbox(i).y & " D26 R D R D R" & inbox(i).w & " U R U R U26 L U L U L" & inbox(i).w & " D L D L C7 BM" & inbox(i).x + 1 & "," & inbox(i).y + 1 & " D24 R D R D R" & inbox(i).w - 2 & " U R U R U24 L U L U L" & inbox(i).w - 2 & "D L D"

	next i

	draw box

end sub

Turd · Post by **Turd** » Dec 28, 2008 19:14

I added a color picker so you can make really nice looking programs lol.

Heres a new video of how to make a program with the output file.

Turd · Post by **Turd** » Dec 29, 2008 16:08

oops, I forgot to post the code.

Code: Select all

type btype

    as integer x, y, w

    as string s

end type

 

dim as string s, ifelse

dim shared box as string

dim shared bstring(300) as btype

dim shared bdraw(300) as btype

dim bif(300) as btype

dim brelease(300) as btype

dim shared inbox(300) as btype

dim inboxif(300) as btype

dim as integer x, y, x1, y1, w, buttons, wheel, boxes, bttns, resx, resy

dim shared as integer i

dim shared as integer bg, fg, sd



declare sub drawform

declare sub drawcolors()

declare sub bttn(x as integer, y as integer, s as string)



const q = chr(34)



screeninfo x, y

screenres x - x / 5, y - y / 5



input "Form name"; s

open s & ".bas" for binary as #1

cls



for x = 1 to 738

	for y = 60 to 90

		pset (x, y), x / 3

	next y

next x



fg = 0: bg = 15: sd = 8

drawcolors



do

	do while buttons < 1

		getmouse (x, y, , buttons)

		s = inkey$

		if s = chr(255) & "k" or s = chr(27) then end

		sleep 10

	loop



'buttons

	if x > 219 and x < 313 and y > 14 and y < 44 then

		'buttondown (222, 43, 90)

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			s = inkey$

			if s = chr(255) & "k" or s = chr(27) then end

			fg = x / 3

			if fg > 256 then fg = 0

			drawcolors

			sleep 10

		loop

		

	elseif x > 323 and x < 417 and y > 14 and y < 44 then

		'buttondown (326, 43, 90)

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			s = inkey$

			if s = chr(255) & "k" or s = chr(27) then end

			bg = x / 3

			if bg > 256 then bg = 0

			drawcolors

			sleep 10

		loop

		

	elseif x > 427 and x < 489 and y > 14 and y < 44 then

		'buttondown (430, 43, 58)

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			s = inkey$

			if s = chr(255) & "k" or s = chr(27) then end

			sd = x / 3

			if sd > 256 then sd = 0

			drawcolors

			sleep 10

		loop

		

	elseif x > 547 and x < 593 and y > 14 and y < 44 then

		'buttondown (550, 43, 42)

		exit do

'input boxs

	end if



	sleep 10

	getmouse (x, y, , buttons)

	do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop

loop

getmouse (x, y, , buttons)

do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop



cls



do while buttons < 1

	getmouse (resx, resy, , buttons)

	s = inkey$

	if s = chr(255) & "k" or s = chr(27) then end

	color 15, 0: locate resy/2/9,resx/2/8 - 5

	print using "#### : ####"; resx; resy

	line (0, 0)-(resx, 0), 15

	line (0, 0)-(0, resy), 15

	line (0, resy)-(resx, resy), 15

	line (resx, 0)-(resx, resy), 15

	sleep 10

	cls

loop

getmouse (resx, resy, , buttons)

do while resx > 1 and buttons > 0: getmouse (resx, resy, , buttons): sleep 10: loop



print #1, "dim as integer x, y, buttons"

print #1, "dim as string s"

print #1,

print #1, "declare sub bttn(x as integer, y as integer, s as string)"

print #1, "declare sub buttonup(x as integer, y as integer, s as integer)"

print #1, "declare sub buttondown(x as integer, y as integer, s as integer)"

print #1, "declare sub inbox(x as integer, y as integer, w as integer)"

print #1, "declare sub clearbox(x as integer, y as integer)"

print #1,

print #1, "screenres " & resx & "," & resy

print #1, "color " & fg & ", " & bg

print #1, "cls"

print #1,



screenres resx + 10, resy + 25, 8

color fg, bg

cls



boxes = 1

bttns = 1



box = "C" & fg & "BM5,20 D" & resy & "R" & resx & "U" & resy & "L" & resx



do while inkey$ = ""

	do while buttons < 1

		getmouse (x, y, , buttons)		

		s = inkey$

		if s = chr(255) & "k" or s = chr(27) then

			for i = 1 to 300

				if bdraw(i).x = 0 then exit for

				print #1, "bttn (" & bdraw(i).x - 5 & ", " & bdraw(i).y - 20 & ", " & q & bstring(i).s & q & ")"

			next i

			for i = 1 to 300

				if inbox(i).x = 0 then exit for

				print #1, "inbox (" & inbox(i).x - 5 & ", " & inbox(i).y - 20 & ", " & inbox(i).w & ")"

			next i

			print #1,

			print #1, "do"

			print #1, "	do while buttons < 1"

			print #1, "		getmouse (x, y, , buttons)"

			print #1, "		s = inkey$"

			print #1, "		if s = chr(255) & " & q & "k" & q & " or s = chr(27) then end"

			print #1, "		sleep 10"

			print #1, "	loop"

			print #1,

			print #1, "'buttons"

			ifelse = "	if x > "

			for i = 1 to 300

				if bif(i).x = 0 then exit for

				print #1, ifelse & bif(i).x - 5 & " and x < " & bif(i).x + bif(i).w - 1 & " and y > " & bif(i).y - 20 & " and y < " & bif(i).y + 10 & " then" & chr(13) & "		buttondown (" & bif(i).x - 2 & ", " & bif(i).y + 9 & ", " & bif(i).w & ")"

				print #1, "		"

				ifelse = "	elseif x > "

			next i

			print #1, "'input boxs"

			if bttns > 1 then

				ifelse = "	elseif x > "

			else

				ifelse = "	if x > "

			end if

			for i = 1 to 300

				if inboxif(i).x = 0 then exit for

				print #1, ifelse & inboxif(i).x - 5 & " and x < " & inboxif(i).x + inboxif(i).w - 1 & " and y > " & inboxif(i).y - 20 & " and y < " & inboxif(i).y + 10 & " then" & chr(13) & "		clearbox (" & inboxif(i).x - 2 & ", " & inboxif(i).Y - 17 & ")"

				print #1, "		"

				ifelse = "	elseif x > "

			next i

			print #1, "	end if"

			print #1,

			print #1, "	sleep 10"

			print #1, "	getmouse (x, y, , buttons)"

			print #1, "	do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop"

			for i = 1 to 300

				if brelease(i).x = 0 then exit for

				print #1, "	buttonup (" & brelease(i).x & "," & brelease(i).y & "," & brelease(i).w & ")"

			next i

			print #1, "loop"

			print #1,

			print #1, "sub bttn(x as integer, y as integer, s as string)" & chr(13) & "	dim as integer w" & chr(13) & "	w = len(s) * 8 + 10" & chr(13) & "	draw string (x + 8, y + 10), s" & chr(13) & "	draw" & q & "C" & fg & " BM" & q & " & x & " & q & "," & q & " & y & " & q & "D26 R D R D R" & q & " & w & " & q & "U R U R U26 L U L U L" & q & " & w & " & q & "D L D L C" & sd & " BM" & q & " & x + 1 & " & q & "," & q & " & y + 1 & " & q & "BD26 BR BD BR BD R" & q & " & w & " & q & "U R U R U26 C" & fg & q & chr(13) & "end sub"

			print #1,

			print #1, "sub buttonup(x as integer, y as integer, w as integer)" & chr(13) & "	draw " & q & "C" & bg & " BM" & q & " & x & " & q & "," & q & " & y & " & q & "U24 R U R U R" & q & " & w - 2 & " & q & "C" & sd & " BM" & q & " & x + 2 & " & q & "," & q & " & y + 4 & " & q & "R" & q & " & w & " & q & "U R U R U26" & q & chr(13) & "end sub"

			print #1,

			print #1, "sub buttondown(x as integer, y as integer, w as integer)" & chr(13) & "	draw " & q & "C" & bg & " BM" & q & " & x & " & q & "," & q & " & y & " & q & " R " & q & " & w & " & q & " U R U R U26 C" & sd & " BM" & q & " & x - 2 & " & q & "," & q & " & y - 4 & " & q & " U24 R U R U R" & q & " & w - 2" & chr(13) & "end sub"

			print #1,

			print #1, "sub inbox(x as integer, y as integer, w as integer)" & chr(13) & "	draw " & q & "C" & fg & " BM" & q & " & x & " & q & "," & q & " & y & " & q & " D26 R D R D R" & q & " & w & " & q & " U R U R U26 L U L U L" & q & " & w & " & q & " D L D L C" & sd & " BM" & q & " & x + 1 & " & q & "," & q & " & y + 1 & " & q & " D24 R D R D R" & q & " & w - 2 & " & q & " U R U R U24 L U L U L" & q & " & w - 2 & " & q & "D L D" & q & chr(13) & "end sub"

			print #1,

			print #1, "sub clearbox(x as integer, y as integer)" & chr(13) & "	draw " & q & "BM" & q & " & x & " & q & "," & q & " & y & " & q & "P" & bg & "," & sd & " C" & fg & q & chr(13) & "end sub"

			print #1,

			close #1

			end

		end if

		screenlock

		cls

		drawform

		screenunlock

		sleep 20

	loop

	

	if buttons = 1 then

		locate 2, 1

		print "                        "

		color fg, bg: locate 2, 1

		input "Button text"; s

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			w = len(s) * 8 + 10

			screenlock

			cls

			color fg, bg: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			draw string (x1 + 8, y1 + 10), s, fg

			draw "C" & fg & "BM" & x1 & "," & y1 & " D26 R D R D R" & w & " U R U R U26 L U L U L" & w & " D L D L C" & sd & " C" & sd & "BM" & x1 + 1 & "," & y1 + 1 & " BD26 BR BD BR BD R" & w & " U R U R U26 C0"

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), fg

			line (x1, 20)-(x1, resy + 20), fg

			screenunlock

			sleep 20

		loop

		

		bstring(bttns).x = x1 + 8: bstring(bttns).y = y1 + 10: bstring(bttns).s = s

		bdraw(bttns).x = x1: bdraw(bttns).y = y1: bdraw(bttns).w = w

		bif(bttns).x = x1: bif(bttns).y = y1: bif(bttns).w = w

		brelease(bttns).x = x1 - 4: brelease(bttns).y = y1 + 5: brelease(bttns).w = w

		

		bttns += 1

		

		locate 2, 1

		print "                        "

	end if

	

	if buttons = 2 then

		locate 2, 1

		print "                        "

		color fg, bg: locate 2, 1

		input "Box size"; i

		s = space(i - 1)

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			w = len(s) * 8 + 11

			screenlock

			cls

			color fg, bg: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			draw "C" & fg & " BM" & x1 & "," & y1 & " D26 R D R D R" & w & " U R U R U26 L U L U L" & w & " D L D L C" & sd & " BM" & x1 + 1 & "," & y1 + 1 & " D24 R D R D R" & w - 2 & " U R U R U24 L U L U L" & w - 2 & "D L D"

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), fg

			line (x1, 20)-(x1, resy + 20), fg

			screenunlock

			sleep 20

		loop

		

		inbox(boxes).x = x1: inbox(boxes).y = y1: inbox(boxes).w = w

		inboxif(boxes).x = x1: inboxif(boxes).y = y1: inboxif(boxes).w = w

		

		boxes += 1

		

		locate 2, 1

		print "                        "

	end if

	

	if buttons = 4 then

		cls

		locate 1, 1: print "                        "

		locate 1, 2: print "                        "

		color fg, bg: locate 1, 1

		print "Undo button: A"

		print "Undo box: B"

		print "or nothing: C"

		input "", s

		if s = "A" or s = "a" then

			bstring(bttns - 1).x = 0: bstring(bttns - 1).y = 0: bstring(bttns - 1).s = ""

			bdraw(bttns - 1).x = 0: bdraw(bttns - 1).y = 0: bdraw(bttns - 1).w = 0

			bif(bttns - 1).x = 0: bif(bttns - 1).y = 0: bif(bttns - 1).w = 0

			brelease(bttns - 1).x = 0: brelease(bttns - 1).y = 0: brelease(bttns - 1).w = 0

			if bttns = 1 then

			else

				bttns -= 1

			end if

		elseif s = "B" or s = "b" then

			inbox(boxes - 1).x = 0: inbox(boxes - 1).y = 0: inbox(boxes - 1).w = 0

			inboxif(boxes - 1).x = 0: inboxif(boxes - 1).y = 0: inboxif(boxes - 1).w = 0

			if boxes = 1 then

			else

				boxes -= 1

			end if

		elseif s = "C" or s = "c" then

		end if

	end if	

	

    getmouse (x, y, , buttons)

    do while x > 1 and buttons > 0: getmouse (x, y, , buttons): color fg, bg: locate 1,1: print using "##### : ##### : #        "; x; y; buttons: sleep 10: loop

loop



sub drawform

	for i = 1 to 300

		if bstring(i).s = "" then exit for

		draw string (bstring(i).x, bstring(i).y), bstring(i).s, fg

	next i

	for i = 1 to 300

		if bdraw(i).x = 0 then exit for

		draw "C" & fg & " BM" & bdraw(i).x & "," & bdraw(i).y & " D26 R D R D R" & bdraw(i).w & " U R U R U26 L U L U L" & bdraw(i).w & " D L D L C" & sd & " BM" & bdraw(i).x + 1 & "," & bdraw(i).y + 1 & " BD26 BR BD BR BD R" & bdraw(i).w & " U R U R U26 C0" & q

	next i

	for i = 1 to 300

		if inbox(i).x = 0 then exit for

		draw "C" & fg & " BM" & inbox(i).x & "," & inbox(i).y & " D26 R D R D R" & inbox(i).w & " U R U R U26 L U L U L" & inbox(i).w & " D L D L C" & sd & " BM" & inbox(i).x + 1 & "," & inbox(i).y + 1 & " D24 R D R D R" & inbox(i).w - 2 & " U R U R U24 L U L U L" & inbox(i).w - 2 & "D L D"

	next i

	draw box

end sub



sub drawcolors()

	dim as integer x, y

	screenlock

	cls

	

	line (211, 6)-(602, 6), 15

	line (211, 50)-(602, 50), 15

	line (211, 6)-(211, 50), 15

	line (602, 6)-(602, 50), 15

	line (212, 7)-(601, 7), 31

	line (212, 49)-(601, 49), 31

	line (212, 7)-(212, 49), 31

	line (601, 7)-(601, 49), 31

	if bg <> 15 then

		draw "BM214,9 P" & bg & ",15"

	elseif bg <> 31 then

		draw "BM214,9 P" & bg & ",31"

	end if

	bttn (219, 14, "Foreground")

	bttn (323, 14, "Background")

	bttn (427, 14, "Shadow")

	bttn (547, 14, "Done")

	

	for x = 1 to 738

		for y = 60 to 90

			pset (x, y), x / 3

		next y

	next x

	screenunlock

end sub



sub bttn(x as integer, y as integer, s as string)

	dim as integer w

	w = len(s) * 8 + 10

	draw string (x + 8, y + 10), s, fg

	draw "C" & fg & " BM" & x & "," & y & "D26 R D R D R" & w & "U R U R U26 L U L U L" & w & "D L D L C" & sd & "BM" & x + 1 & "," & y + 1 & "BD26 BR BD BR BD R" & w & "U R U R U26"

end sub

Turd · Post by **Turd** » Jan 01, 2009 8:21

It now uses buttons 0, 1, 2, 3 and 4 in stead of the mouse buttons to place the objects.
0) Undo
1) Buttons
2) Boxes
3) Progress bars
4) check boxes

I added progress bars and check boxes.

Code: Select all

type btype

    as integer x, y, w, h

    as string s

end type

 

dim as string s, ifelse

dim shared box as string

dim shared bstring(300) as btype

dim shared bdraw(300) as btype

dim bif(300) as btype

dim brelease(300) as btype

dim shared inbox(300) as btype

dim inboxif(300) as btype

dim shared pbar(300) as btype

dim shared cbox(300) as btype

dim as integer x, y, x1, y1, w, h, hh, buttons, wheel, boxes, bttns, pbars, cboxs, resx, resy

dim shared as integer i

dim shared as integer bg, fg, sd



declare sub drawform

declare sub drawcolors()

declare sub bttn(x as integer, y as integer, s as string)



const q = chr(34)



screeninfo x, y

screenres x - x / 5, y - y / 5



input "Form name"; s

open s & ".bas" for binary as #1

cls



for x = 1 to 738

	for y = 60 to 90

		pset (x, y), x / 3

	next y

next x



fg = 0: bg = 15: sd = 7

drawcolors



do

	do while buttons < 1

		getmouse (x, y, , buttons)

		s = inkey$

		if s = chr(255) & "k" or s = chr(27) then end

		sleep 10

	loop



'buttons

	if x > 219 and x < 313 and y > 14 and y < 44 then

		'buttondown (222, 43, 90)

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			s = inkey$

			if s = chr(255) & "k" or s = chr(27) then end

			fg = x / 3

			if fg > 256 then fg = 0

			drawcolors

			sleep 10

		loop

		

	elseif x > 323 and x < 417 and y > 14 and y < 44 then

		'buttondown (326, 43, 90)

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			s = inkey$

			if s = chr(255) & "k" or s = chr(27) then end

			bg = x / 3

			if bg > 256 then bg = 0

			drawcolors

			sleep 10

		loop

		

	elseif x > 427 and x < 489 and y > 14 and y < 44 then

		'buttondown (430, 43, 58)

		getmouse (x, y, , buttons)

		do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop

		do while buttons < 1

			getmouse (x, y, , buttons)

			s = inkey$

			if s = chr(255) & "k" or s = chr(27) then end

			sd = x / 3

			if sd > 256 then sd = 0

			drawcolors

			sleep 10

		loop

		

	elseif x > 547 and x < 593 and y > 14 and y < 44 then

		'buttondown (550, 43, 42)

		exit do

'input boxs

	end if



	sleep 10

	getmouse (x, y, , buttons)

	do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop

loop

getmouse (x, y, , buttons)

do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop



cls



do while buttons < 1

	getmouse (resx, resy, , buttons)

	s = inkey$

	if s = chr(255) & "k" or s = chr(27) then end

	color 15, 0: locate resy/2/9,resx/2/8 - 5

	print using "#### : ####"; resx; resy

	line (0, 0)-(resx, 0), 15

	line (0, 0)-(0, resy), 15

	line (0, resy)-(resx, resy), 15

	line (resx, 0)-(resx, resy), 15

	sleep 10

	cls

loop

getmouse (resx, resy, , buttons)

do while resx > 1 and buttons > 0: getmouse (resx, resy, , buttons): sleep 10: loop



screenres resx + 10, resy + 25, 8

color fg, bg

cls



boxes = 1

bttns = 1

pbars = 1

cboxs = 1



box = "C" & fg & "BM5,20 D" & resy & "R" & resx & "U" & resy & "L" & resx



do while inkey$ = ""

	do	

		s = inkey$

		if s = chr(255) & "k" or s = chr(27) then

			print #1, "dim as integer x, y, buttons";

			if pbar(1).x > 0 then

				print #1, ", pbarstate"

			else

				print #1,

			end if

			print #1, "dim as string s"

			print #1,

			if cbox(1).x > 0 then print #1, "dim checkbox(" & cboxs - 1 & ") as integer": print #1,

			print #1, "declare sub bttn(x as integer, y as integer, s as string)"

			print #1, "declare sub buttonup(x as integer, y as integer, s as integer)"

			print #1, "declare sub buttondown(x as integer, y as integer, s as integer)"

			print #1, "declare sub inbox(x as integer, y as integer, w as integer, h as integer)"

			print #1, "declare sub clearbox(x as integer, y as integer)"

			print #1, "declare sub pbar(x as integer, y as integer, w as integer, state as double)"

			print #1, "declare sub cbox(x as integer, y as integer, check as integer)"

			print #1, 

			print #1, "screenres " & resx & "," & resy

			print #1, "color " & fg & ", " & bg

			print #1, "cls"

			print #1,

			for i = 1 to 300

				if bdraw(i).x = 0 then exit for

				print #1, "bttn (" & bdraw(i).x - 5 & ", " & bdraw(i).y - 20 & ", " & q & bstring(i).s & q & ")"

			next i

			for i = 1 to 300

				if inbox(i).x = 0 then exit for

				print #1, "inbox (" & inbox(i).x - 5 & ", " & inbox(i).y - 20 & ", " & inbox(i).w & ", " & inbox(i).h & ")"

			next i

			for i = 1 to 300

				if pbar(i).x = 0 then exit for

				print #1, "pbar (" & pbar(i).x - 5 & ", " & pbar(i).y - 20 & ", " & pbar(i).w & ", pbarstate)"

			next i

			for i = 1 to 300

				if cbox(i).x = 0 then exit for

				print #1, "cbox (" & cbox(i).x - 5 & ", " & cbox(i).y - 20 & ", 0)"

			next i

			print #1,

			print #1, "do"

			print #1, "	do while buttons < 1"

			print #1, "		getmouse (x, y, , buttons)"

			print #1, "		s = inkey$"

			print #1, "		if s = chr(255) & " & q & "k" & q & " or s = chr(27) then end"

			print #1, "		sleep 10"

			print #1, "	loop"

			print #1,

			print #1, "'buttons"

			ifelse = "	if x > "

			for i = 1 to 300

				if bif(i).x = 0 then exit for

				print #1, "'" & bstring(i).s

				print #1, ifelse & bif(i).x - 5 & " and x < " & bif(i).x + bif(i).w - 1 & " and y > " & bif(i).y - 20 & " and y < " & bif(i).y + 10 & " then" & chr(13) & "		buttondown (" & bif(i).x - 2 & ", " & bif(i).y + 9 & ", " & bif(i).w & ")"

				print #1, "		"

				ifelse = "	elseif x > "

			next i

			print #1, "'input boxs"

			if bttns > 1 then

				ifelse = "	elseif x > "

			else

				ifelse = "	if x > "

			end if

			for i = 1 to 300

				if inboxif(i).x = 0 then exit for

				print #1, "'Box #" & i

				print #1, ifelse & inboxif(i).x - 5 & " and x < " & inboxif(i).x + inboxif(i).w - 1 & " and y > " & inboxif(i).y - 20 & " and y < " & inbox(i).h + inboxif(i).y - 17 & " then" & chr(13) & "		clearbox (" & inboxif(i).x - 2 & ", " & inboxif(i).y - 17 & ")"

				print #1, "		'locate " & cint(inboxif(i).y / 8) & ", " & 1 + cint(inboxif(i).x / 8) & ": color " & fg & "," & bg & ": print " & q & "???" & q

				print #1, "		"

				ifelse = "	elseif x > "

			next i

			print #1, "'check boxes"

			if bttns > 1 or boxes > 1then

				ifelse = "	elseif x > "

			else

				ifelse = "	if x > "

			end if

			for i = 1 to 300

				if cbox(i).x = 0 then exit for

				print #1, "'Chech box #" & i

				print #1, ifelse & cbox(i).x - 5 & " and x < " & cbox(i).x + 10 & " and y > " & cbox(i).y - 13 & " and y < " & cbox(i).y + 2 & " then" & chr(13) & "		if checkbox(" & i & ") = 1 then" & chr(13) & "		cbox ("& cbox(i).x - 5 & ","& cbox(i).y - 20 & ", 0)" & chr(13) & "		checkbox(" & i & ") = 0" & chr(13)

				print #1, "		elseif checkbox(" & i & ") = 0 then" & chr(13) & "		cbox ("& cbox(i).x - 5 & ", "& cbox(i).y - 20 & ", 1)" & chr(13) & "		checkbox(" & i & ") = 1" & chr(13) & "		end if"

				print #1, "		"

				ifelse = "	elseif x > "

			next i

			print #1, "	end if"

			print #1,

			print #1, "	sleep 10"

			print #1, "	getmouse (x, y, , buttons)"

			print #1, "	do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop"

			for i = 1 to 300

				if brelease(i).x = 0 then exit for

				print #1, "	buttonup (" & brelease(i).x & "," & brelease(i).y & "," & brelease(i).w & ")"

			next i

			print #1, "loop"

			print #1,

			print #1, "sub bttn(x as integer, y as integer, s as string)" & chr(13) & "	dim as integer w" & chr(13) & "	w = len(s) * 8 + 10" & chr(13) & "	draw string (x + 8, y + 10), s" & chr(13) & "	draw " & q & "C" & fg & " BM" & q & " & x & " & q & "," & q & " & y & " & q & "D26 R D R D R" & q & " & w & " & q & "U R U R U26 L U L U L" & q & " & w & " & q & "D L D L C" & sd & " BM" & q & " & x + 1 & " & q & "," & q & " & y + 1 & " & q & "BD26 BR BD BR BD R" & q & " & w & " & q & "U R U R U26 C" & fg & q & chr(13) & "end sub"

			print #1,

			print #1, "sub buttonup(x as integer, y as integer, w as integer)" & chr(13) & "	draw " & q & "C" & bg & " BM" & q & " & x & " & q & "," & q & " & y & " & q & "U24 R U R U R" & q & " & w - 2 & " & q & "C" & sd & " BM" & q & " & x + 2 & " & q & "," & q & " & y + 4 & " & q & "R" & q & " & w & " & q & "U R U R U26" & q & chr(13) & "end sub"

			print #1,

			print #1, "sub buttondown(x as integer, y as integer, w as integer)" & chr(13) & "	draw " & q & "C" & bg & " BM" & q & " & x & " & q & "," & q & " & y & " & q & " R " & q & " & w & " & q & " U R U R U26 C" & sd & " BM" & q & " & x - 2 & " & q & "," & q & " & y - 4 & " & q & " U24 R U R U R" & q & " & w - 2" & chr(13) & "end sub"

			print #1,

			print #1, "sub inbox(x as integer, y as integer, w as integer, h as integer)" & chr(13) & "	draw " & q & "C" & fg & " BM" & q & " & x & " & q & "," & q & " & y & " & q & " D" & q & " & h & " & q & " R D R D R" & q & " & w & " & q & " U R U R U" & q &  " & h & " & q & " L U L U L" & q & " & w & " & q & " D L D L C" & sd & " BM" & q & " & x + 1 & " & q & "," & q & " & y + 1 & " & q & " D" & q & " & h - 2 & " & q & " R D R D R" & q & " & w - 2 & " & q & " U R U R U" & q & " & h - 2 & " & q & " L U L U L" & q & " & w - 2 & " & q & "D L D" & q & chr(13) & "end sub"

			print #1,

			print #1, "sub clearbox(x as integer, y as integer)" & chr(13) & "	draw " & q & "BM" & q & " & x & " & q & "," & q & " & y & " & q & "P" & bg & "," & sd & " C" & fg & q & chr(13) & "end sub"

			print #1,

			print #1, "sub pbar(x as integer, y as integer, w as integer, state as double)" & chr(13) & "	dim as integer i" & chr(13) & "	state = state / 100" & chr(13) & "	screenlock"& chr(13) & "	draw " & q & " C" & fg & " BM" & q & " & x & " & q & "," & q & " & y & " & q & " D26 R" & q & " & w + 4 & " & q & " U26 L" & q & " & w + 4 & " & q & " C" & sd & " BM" & q & " & x + 1 & " & q & "," & q & " & y + 1 & " & q & " D24 R" & q & " & w + 2 & " & q & " U24  L" & q & " & w + 2 & "& q & "BM" & q & " & x + 4 & " & q & "," & q & " & y + 4 & " & q & "P" & bg & ","& sd & q

			print #1, "	for i = 0 to w * state" & chr(13) & "		line (x + 2 + i, y + 2)-(x + i + 2, y + 24)," & fg & chr(13) & "	next i" & chr(13) & "	if state > .5 then" & chr(13) & "		draw string (x - 8 + w / 2, y + 10), str(cint(state * 100)) & " & q & "%" & q & "," & bg & chr(13) & "	else" & chr(13) & "		draw string (x - 8 + w / 2, y + 10), str(cint(state * 100)) & " & q & "%" & q & "," & fg & chr(13) & "	end if" & chr(13) & "	screenunlock" & chr(13) & "end sub"

			print #1,

			print #1, "sub cbox(x as integer, y as integer, check as integer)" & chr(13) & "	draw " & q & "C" & fg & " BM" & q & " & x & " & q & "," & q & " & y + 5 & " & q & " D15 R15 U15 L14 D C" & sd & " D13 R13 U13 L13" & q & chr(13) & "	if check = 1 then" & chr(13) & "		line (x + 3, y + 8)-(x + 12, y + 17), " & fg & chr(13) & "		line (x + 12, y + 8)-(x + 3, y + 17), " & fg & chr(13) & "	elseif check = 0 then"

			print #1, "		line (x + 3, y + 8)-(x + 12, y + 17), " & bg & chr(13) & "		line (x + 12, y + 8)-(x + 3, y + 17), " & bg & chr(13) & "	end if" & chr(13) & "end sub"

			print #1,

			print #1,

			print #1,

			close #1

			end

		end if

		screenlock

		cls

		drawform

		screenunlock

		sleep 20

	loop while s = ""



'BUTTONS

	if s = "1" then

		locate 2, 1

		color fg, bg: locate 2, 1

		input "Button text"; s

		getmouse (x, y, , buttons)

		do while buttons < 1

			getmouse (x, y, , buttons)

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			w = len(s) * 8 + 10

			screenlock

			cls

			color fg, bg: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			draw string (x1 + 8, y1 + 10), s, fg

			draw "C" & fg & "BM" & x1 & "," & y1 & " D26 R D R D R" & w & " U R U R U26 L U L U L" & w & " D L D L C" & sd & " C" & sd & "BM" & x1 + 1 & "," & y1 + 1 & " BD26 BR BD BR BD R" & w & " U R U R U26 C0"

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), fg

			line (x1, 20)-(x1, resy + 20), fg

			screenunlock

			sleep 20

		loop

		

		bstring(bttns).x = x1 + 8: bstring(bttns).y = y1 + 10: bstring(bttns).s = s

		bdraw(bttns).x = x1: bdraw(bttns).y = y1: bdraw(bttns).w = w

		bif(bttns).x = x1: bif(bttns).y = y1: bif(bttns).w = w

		brelease(bttns).x = x1 - 4: brelease(bttns).y = y1 + 5: brelease(bttns).w = w

		

		bttns += 1

		

	end if



'BOXES	

	if s = "2" then

		color fg, bg: locate 1, 1

		input "Box width"; i

		input "Box hight"; hh

		cls

		s = space(i - 1)

		getmouse (x, y, , buttons)

		do while buttons < 1

			getmouse (x, y, , buttons)

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			w = len(s) * 8 + 11

			if hh = 0 then hh = 1

			h = 18 + 8 * hh

			screenlock

			cls

			color fg, bg: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			draw "C" & fg & " BM" & x1 & "," & y1 & " D" & h & " R D R D R" & w & " U R U R U" & h & " L U L U L" & w & " D L D L C" & sd & " BM" & x1 + 1 & "," & y1 + 1 & " D" & h - 2 & " R D R D R" & w - 2 & " U R U R U" & h - 2 & " L U L U L" & w - 2 & "D L D"

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), fg

			line (x1, 20)-(x1, resy + 20), fg

			screenunlock

			sleep 20

		loop

		

		inbox(boxes).x = x1: inbox(boxes).y = y1: inbox(boxes).w = w: inbox(boxes).h = h

		inboxif(boxes).x = x1: inboxif(boxes).y = y1: inboxif(boxes).w = w: inboxif(boxes).h = h

		

		boxes += 1

		

		locate 2, 1

		print "                        "

	end if



'PROGRESS BARS

	if s = "3" then

		cls

		color fg, bg: locate 2, 1

		input "Bar width"; i

		cls

		s = space(i - 1)

		getmouse (x, y, , buttons)

		do while buttons < 1

			getmouse (x, y, , buttons)

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			w = len(s) * 8 + 11

			screenlock

			cls

			color fg, bg: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			draw "C" & fg & " BM" & x1 & "," & y1 & " D26 R" & w + 4 & " U26 L" & w + 4 & " C" & sd & " BM" & x1 + 1 & "," & y1 + 1 & " D24 R" & w + 2 & " U24  L" & w + 2

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), fg

			line (x1, 20)-(x1, resy + 20), fg

			screenunlock

			sleep 20

		loop

		

		pbar(pbars).x = x1: pbar(pbars).y = y1: pbar(pbars).w = w

		

		pbars += 1

		

		locate 2, 1

		print "                        "

	end if



'CHECK BOXES

	if s = "4" then

		getmouse (x, y, , buttons)

		do while buttons < 1

			getmouse (x, y, , buttons)

			x1 = cint(x / 8) * 8

			y1 = cint(y / 8) * 8 + 2

			screenlock

			cls

			color fg, bg: locate 1,1

			print using "##### : ##### : #        "; x1 - 5; y1 - 20; buttons

			draw "C" & fg & " BM" & x1 & "," & y1 + 5 & " D15 R15 U15 L14 D C" & sd & " D13 R13 U13 L13"

			line (x1 + 3, y1 + 8)-(x1 + 12, y1 + 17), fg

			line (x1 + 12, y1 + 8)-(x1 + 3, y1 + 17), fg

			drawform

			line (5, y1 - 2)-(resx + 5, y1 - 2), fg

			line (x1, 20)-(x1, resy + 20), fg

			screenunlock

			sleep 20

		loop

		

		cbox(cboxs).x = x1: cbox(cboxs).y = y1

		

		cboxs += 1

		

	end if

	

'RADIAL BUTTONS

	

	



	if s = "0" then

		cls

		color fg, bg: locate 1, 1

		print "Undo button: 1"

		print "Undo box: 2"

		print "Undo pbar: 3"

		input "", s

		if s = "1" then

			bstring(bttns - 1).x = 0: bstring(bttns - 1).y = 0: bstring(bttns - 1).s = ""

			bdraw(bttns - 1).x = 0: bdraw(bttns - 1).y = 0: bdraw(bttns - 1).w = 0

			bif(bttns - 1).x = 0: bif(bttns - 1).y = 0: bif(bttns - 1).w = 0

			brelease(bttns - 1).x = 0: brelease(bttns - 1).y = 0: brelease(bttns - 1).w = 0

			if bttns = 1 then

			else

				bttns -= 1

			end if

		elseif s = "2" then

			inbox(boxes - 1).x = 0: inbox(boxes - 1).y = 0: inbox(boxes - 1).w = 0

			inboxif(boxes - 1).x = 0: inboxif(boxes - 1).y = 0: inboxif(boxes - 1).w = 0

			if boxes = 1 then

			else

				boxes -= 1

			end if

		elseif s = "3" then

			pbar(pbars - 1).x = 0: pbar(pbars - 1).y = 0: pbar(pbars - 1).w = 0

			if pbars = 1 then

			else

				pbars -= 1

			end if

		elseif s = "4" then

			pbar(pbars - 1).x = 0: pbar(pbars - 1).y = 0: pbar(pbars - 1).w = 0

			if pbars = 1 then

			else

				pbars -= 1

			end if

		elseif s = "5" then

			cbox(cboxs - 1).x = 0: cbox(cboxs - 1).y = 0: cbox(cboxs - 1).w = 0

			if cboxs = 1 then

			else

				cboxs -= 1

			end if

		end if

	end if	

	

loop



sub drawform

	for i = 1 to 300

		if bstring(i).s = "" then exit for

		draw string (bstring(i).x, bstring(i).y), bstring(i).s, fg

	next i

	for i = 1 to 300

		if bdraw(i).x = 0 then exit for

		draw "C" & fg & " BM" & bdraw(i).x & "," & bdraw(i).y & " D26 R D R D R" & bdraw(i).w & " U R U R U26 L U L U L" & bdraw(i).w & " D L D L C" & sd & " BM" & bdraw(i).x + 1 & "," & bdraw(i).y + 1 & " BD26 BR BD BR BD R" & bdraw(i).w & " U R U R U26 C0" & q

	next i

	for i = 1 to 300

		if inbox(i).x = 0 then exit for

		draw "C" & fg & " BM" & inbox(i).x & "," & inbox(i).y & " D" & inbox(i).h & " R D R D R" & inbox(i).w & " U R U R U" & inbox(i).h & " L U L U L" & inbox(i).w & " D L D L C" & sd & " BM" & inbox(i).x + 1 & "," & inbox(i).y + 1 & " D" & inbox(i).h - 2 & " R D R D R" & inbox(i).w - 2 & " U R U R U" & inbox(i).h - 2 & " L U L U L" & inbox(i).w - 2 & "D L D"

	next i

	for i = 1 to 300

		if pbar(i).x = 0 then exit for

		draw "C" & fg & " BM" & pbar(i).x & "," & pbar(i).y & " D26 R" & pbar(i).w + 4 & " U26 L" & pbar(i).w + 4 & " C" & sd & " BM" & pbar(i).x + 1 & "," & pbar(i).y + 1 & " D24 R" & pbar(i).w + 2 & " U24  L" & pbar(i).w + 2

	next i

	for i = 1 to 300

		if cbox(i).x = 0 then exit for

		draw "C" & fg & " BM" & cbox(i).x & "," & cbox(i).y + 5 & " D15 R15 U15 L14 D C" & sd & " D13 R13 U13 L13"

		line (cbox(i).x + 3, cbox(i).y + 8)-(cbox(i).x + 12, cbox(i).y + 17), fg

		line (cbox(i).x + 12, cbox(i).y + 8)-(cbox(i).x + 3, cbox(i).y + 17), fg

	next i

	draw box

end sub



sub drawcolors()

	dim as integer x, y

	screenlock

	cls

	

	line (211, 6)-(602, 6), 15

	line (211, 50)-(602, 50), 15

	line (211, 6)-(211, 50), 15

	line (602, 6)-(602, 50), 15

	line (212, 7)-(601, 7), 31

	line (212, 49)-(601, 49), 31

	line (212, 7)-(212, 49), 31

	line (601, 7)-(601, 49), 31

	if bg <> 15 then

		draw "BM214,9 P" & bg & ",15"

	elseif bg <> 31 then

		draw "BM214,9 P" & bg & ",31"

	end if

	bttn (219, 14, "Foreground")

	bttn (323, 14, "Background")

	bttn (427, 14, "Shadow")

	bttn (547, 14, "Done")

	

	for x = 1 to 738

		for y = 60 to 90

			pset (x, y), x / 3

		next y

	next x

	screenunlock

end sub



sub bttn(x as integer, y as integer, s as string)

	dim as integer w

	w = len(s) * 8 + 10

	draw string (x + 8, y + 10), s, fg

	draw "C" & fg & " BM" & x & "," & y & "D26 R D R D R" & w & "U R U R U26 L U L U L" & w & "D L D L C" & sd & "BM" & x + 1 & "," & y + 1 & "BD26 BR BD BR BD R" & w & "U R U R U26"

end sub

Heres a test program using the output file:

Code: Select all

dim as integer x, y, buttons, pbarstate, speed
dim as string s

dim checkbox(1) as integer

declare sub bttn(x as integer, y as integer, s as string)
declare sub buttonup(x as integer, y as integer, s as integer)
declare sub buttondown(x as integer, y as integer, s as integer)
declare sub inbox(x as integer, y as integer, w as integer, h as integer)
declare sub clearbox(x as integer, y as integer)
declare sub pbar(x as integer, y as integer, w as integer, state as double)
declare sub cbox(x as integer, y as integer, check as integer)

screenres 452,207
color 0, 15
cls

bttn (387, 158, "Exit")
bttn (43, 62, "Start")
inbox (179, 22, 131, 26)
pbar (131, 62, 243, pbarstate)
cbox (43, 22, 0)
locate 5, 9: color 0,15: print "Fast"

speed = 50

do
	do while buttons < 1
		getmouse (x, y, , buttons)
		s = inkey$
		if s = chr(255) & "k" or s = chr(27) then end
		sleep 10
	loop

'buttons
'Exit
	if x > 387 and x < 433 and y > 158 and y < 188 then
		buttondown (390, 187, 42)
		end
'Start
	elseif x > 43 and x < 97 and y > 62 and y < 92 then
		buttondown (46, 91, 50)
		locate 5, 24: color 0,15: print " Downloading..."
		for pbarstate = 1 to 100
			pbar (131, 62, 243, pbarstate)
			sleep speed, 1
		next pbarstate
	locate 5, 24: color 0,15: print "     Done      "
		
'input boxs
'Box #1
	elseif x > 179 and x < 314 and y > 22 and y < 51 then
		'clearbox (182, 25)
		
		
'check boxes
'Chech box #1
	elseif x > 43 and x < 58 and y > 29 and y < 44 then
		if checkbox(1) = 1 then
		cbox (43,22, 0)
		checkbox(1) = 0
		speed = 50
		elseif checkbox(1) = 0 then
		cbox (43, 22, 1)
		checkbox(1) = 1
		speed = 10
		end if
		
	end if

	sleep 10
	getmouse (x, y, , buttons)
	do while x > 1 and buttons > 0: getmouse (x, y, , buttons): sleep 10: loop
	buttonup (388,183,42)
	buttonup (44,87,50)
loop

sub bttn(x as integer, y as integer, s as string)
	dim as integer w
	w = len(s) * 8 + 10
	draw string (x + 8, y + 10), s
	draw "C0 BM" & x & "," & y & "D26 R D R D R" & w & "U R U R U26 L U L U L" & w & "D L D L C7 BM" & x + 1 & "," & y + 1 & "BD26 BR BD BR BD R" & w & "U R U R U26 C0"
end sub

sub buttonup(x as integer, y as integer, w as integer)
	draw "C15 BM" & x & "," & y & "U24 R U R U R" & w - 2 & "C7 BM" & x + 2 & "," & y + 4 & "R" & w & "U R U R U26"
end sub

sub buttondown(x as integer, y as integer, w as integer)
	draw "C15 BM" & x & "," & y & " R " & w & " U R U R U26 C7 BM" & x - 2 & "," & y - 4 & " U24 R U R U R" & w - 2
end sub

sub inbox(x as integer, y as integer, w as integer, h as integer)
	draw "C0 BM" & x & "," & y & " D" & h & " R D R D R" & w & " U R U R U" & h & " L U L U L" & w & " D L D L C7 BM" & x + 1 & "," & y + 1 & " D" & h - 2 & " R D R D R" & w - 2 & " U R U R U" & h - 2 & " L U L U L" & w - 2 & "D L D"
end sub

sub clearbox(x as integer, y as integer)
	draw "BM" & x & "," & y & "P15,7 C0"
end sub

sub pbar(x as integer, y as integer, w as integer, state as double)
	dim as integer i
	state = state / 100
	screenlock
	draw " C0 BM" & x & "," & y & " D26 R" & w + 4 & " U26 L" & w + 4 & " C7 BM" & x + 1 & "," & y + 1 & " D24 R" & w + 2 & " U24  L" & w + 2 & "BM" & x + 4 & "," & y + 4 & "P15,7"
	for i = 0 to w * state
		line (x + 2 + i, y + 2)-(x + i + 2, y + 24),0
	next i
	if state > .5 then
		draw string (x - 8 + w / 2, y + 10), str(cint(state * 100)) & "%",15
	else
		draw string (x - 8 + w / 2, y + 10), str(cint(state * 100)) & "%",0
	end if
	screenunlock
end sub

sub cbox(x as integer, y as integer, check as integer)
	draw "C0 BM" & x & "," & y + 5 & " D15 R15 U15 L14 D C7 D13 R13 U13 L13"
	if check = 1 then
		line (x + 3, y + 8)-(x + 12, y + 17), 0
		line (x + 12, y + 8)-(x + 3, y + 17), 0
	elseif check = 0 then
		line (x + 3, y + 8)-(x + 12, y + 17), 15
		line (x + 12, y + 8)-(x + 3, y + 17), 15
	end if
end sub

rolliebollocks · Post by **rolliebollocks** » Jan 01, 2009 12:07

Wow. This project is coming along nicely. The checkbox operates ok, and the progress bar looks good too. Everything is in working order.

Are you going to allow for graphical buttons? As in pictures to be used as buttons?

Turd · Post by **Turd** » Jan 01, 2009 15:30

rolliebollocks wrote:Wow. This project is coming along nicely. The checkbox operates ok, and the progress bar looks good too. Everything is in working order.

Thanks :)

rolliebollocks wrote:Are you going to allow for graphical buttons? As in pictures to be used as buttons?

Sounds cool, but I don't know how I'd do that.

ps. keep in mind I'm just a noob. This project is a result of a lot of buckling down. lol

Turd · Post by **Turd** » Jan 01, 2009 19:52

Ok, people use that pink color to make parts of a picture invisible, but how?

Code: Select all

Screenres 200, 100, 16
Dim myImage As Any Ptr = ImageCreate( 48, 32 )
BLoad "button.bmp", myImage
Put (10,10), myImage
ImageDestroy( myImage )
Sleep

vdecampo · Post by **vdecampo** » Jan 01, 2009 19:57

@Turd

The color for transparency is &hFF00FF. (magenta)

Then when use Put the image specify TRANS

Put (x,y),img,TRANS

Thats it!
-Vince

Turd · Post by **Turd** » Jan 01, 2009 20:07

Awesome, thanks. I'll start playing around right away :)