[DBP] A box you can drag the corners.

Author

Message

HowDo

21

Years of Service

User Offline

Joined: 28th Nov 2002

Location: United Kingdom

Posted: 4th Nov 2008 13:46 Edited at: 4th Nov 2008 16:32

Link

Hi All,

Just something that lets you draw a box the you can move the corners to change the shape.

Rem Project: dragboxes1

Rem ***** Main Source File *****
sync on
sync rate 60
global tcx tcy  
tcx=screen width()/2
tcy=screen height()/2
dim boxes(8) 
dim dragbox(8) 
dim r(4)
dim g(4)
dim b(4)
for i = 1 to 4
	r(i)=255
	g(i)=255
	b(i)=255
next i
rem click box size
boxes(1)=2
boxes(2)=2
rem start positions
rem top left x,y
dragbox(1)=tcx-15
dragbox(2)=tcy-15

rem top right x,y
dragbox(3)=tcx+15
dragbox(4)=tcy-15

rem bottom right x,y
dragbox(5)=tcx+15
dragbox(6)=tcy+15

rem bottom left x,y
dragbox(7)=tcx-15
dragbox(8)=tcy+15

do
	cls
	isindragbox()
	makebox()
	sync
loop

function makebox()

box dragbox(1)-boxes(1),dragbox(2)-boxes(2),dragbox(1)+boxes(1),dragbox(2)+boxes(2),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1))
box dragbox(3)-boxes(1),dragbox(4)-boxes(2),dragbox(3)+boxes(1),dragbox(4)+boxes(2),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2))
box dragbox(5)-boxes(1),dragbox(6)-boxes(2),dragbox(5)+boxes(1),dragbox(6)+boxes(2),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3))
box dragbox(7)-boxes(1),dragbox(8)-boxes(2),dragbox(7)+boxes(1),dragbox(8)+boxes(2),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4))

line dragbox(1),dragbox(2),dragbox(3),dragbox(4)
line dragbox(3),dragbox(4),dragbox(5),dragbox(6)
line dragbox(5),dragbox(6),dragbox(7),dragbox(8)
line dragbox(7),dragbox(8),dragbox(1),dragbox(2)

endfunction

function isindragbox()
mx=mousex()
my=mousey()

text 0,60,str$(mx)+"  "+str$(my)
for i = 1 to 8 step 2
text 0,0+(i*6),str$(dragbox(i) )+"   "+str$(dragbox(i+1) )
next i
if mx>dragbox(1)-boxes(1) and mx<dragbox(1)+boxes(1) and my>dragbox(2)-boxes(2) and my<dragbox(2)+boxes(2) 
	r(1)=255:g(1)=0:b(1)=0
	while mouseclick()<>0
		drag(1,2)
	endwhile
else
	r(1)=255:g(1)=255:b(1)=255
endif
if mx>dragbox(3)-boxes(1) and mx<dragbox(3)+boxes(1) and my>dragbox(4)-boxes(2) and my<dragbox(4)+boxes(2) 
	r(2)=255:g(2)=0:b(2)=0
	while mouseclick()<>0
		drag(3,4)
	endwhile
	else
	r(2)=255:g(2)=255:b(2)=255
endif
if mx>dragbox(5)-boxes(1) and mx<dragbox(5)+boxes(1) and my>dragbox(6)-boxes(2) and my<dragbox(6)+boxes(2) 
	r(3)=255:g(3)=0:b(3)=0
	while mouseclick()<>0
		drag(5,6)
	endwhile
	else
	r(3)=255:g(3)=255:b(3)=255
endif
if mx>dragbox(7)-boxes(1) and mx<dragbox(7)+boxes(1) and my>dragbox(8)-boxes(2) and my<dragbox(8)+boxes(2) 
	r(4)=255:g(4)=0:b(4)=0
	while mouseclick()<>0
		drag(7,8)
	endwhile
	else
	r(4)=255:g(4)=255:b(4)=255
endif
endfunction

function drag(a,b)
cls
	text 0,0,"draging on"
		mx=mousex()
		my=mousey()
		dragbox(a)=mx
		dragbox(b)=my
		makebox()
sync
endfunction

+ Code Snippet

Rem Project: dragboxes1

Rem ***** Main Source File *****
sync on
sync rate 60
global tcx tcy  
tcx=screen width()/2
tcy=screen height()/2
dim boxes(8) 
dim dragbox(8) 
dim r(4)
dim g(4)
dim b(4)
for i = 1 to 4
	r(i)=255
	g(i)=255
	b(i)=255
next i
rem click box size
boxes(1)=2
boxes(2)=2
rem start positions
rem top left x,y
dragbox(1)=tcx-15
dragbox(2)=tcy-15

rem top right x,y
dragbox(3)=tcx+15
dragbox(4)=tcy-15

rem bottom right x,y
dragbox(5)=tcx+15
dragbox(6)=tcy+15

rem bottom left x,y
dragbox(7)=tcx-15
dragbox(8)=tcy+15

do
	cls
	isindragbox()
	makebox()
	sync
loop


function makebox()

box dragbox(1)-boxes(1),dragbox(2)-boxes(2),dragbox(1)+boxes(1),dragbox(2)+boxes(2),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1))
box dragbox(3)-boxes(1),dragbox(4)-boxes(2),dragbox(3)+boxes(1),dragbox(4)+boxes(2),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2))
box dragbox(5)-boxes(1),dragbox(6)-boxes(2),dragbox(5)+boxes(1),dragbox(6)+boxes(2),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3))
box dragbox(7)-boxes(1),dragbox(8)-boxes(2),dragbox(7)+boxes(1),dragbox(8)+boxes(2),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4))

line dragbox(1),dragbox(2),dragbox(3),dragbox(4)
line dragbox(3),dragbox(4),dragbox(5),dragbox(6)
line dragbox(5),dragbox(6),dragbox(7),dragbox(8)
line dragbox(7),dragbox(8),dragbox(1),dragbox(2)

endfunction

function isindragbox()
mx=mousex()
my=mousey()

text 0,60,str$(mx)+"  "+str$(my)
for i = 1 to 8 step 2
text 0,0+(i*6),str$(dragbox(i) )+"   "+str$(dragbox(i+1) )
next i
if mx>dragbox(1)-boxes(1) and mx<dragbox(1)+boxes(1) and my>dragbox(2)-boxes(2) and my<dragbox(2)+boxes(2) 
	r(1)=255:g(1)=0:b(1)=0
	while mouseclick()<>0
		drag(1,2)
	endwhile
else
	r(1)=255:g(1)=255:b(1)=255
endif
if mx>dragbox(3)-boxes(1) and mx<dragbox(3)+boxes(1) and my>dragbox(4)-boxes(2) and my<dragbox(4)+boxes(2) 
	r(2)=255:g(2)=0:b(2)=0
	while mouseclick()<>0
		drag(3,4)
	endwhile
	else
	r(2)=255:g(2)=255:b(2)=255
endif
if mx>dragbox(5)-boxes(1) and mx<dragbox(5)+boxes(1) and my>dragbox(6)-boxes(2) and my<dragbox(6)+boxes(2) 
	r(3)=255:g(3)=0:b(3)=0
	while mouseclick()<>0
		drag(5,6)
	endwhile
	else
	r(3)=255:g(3)=255:b(3)=255
endif
if mx>dragbox(7)-boxes(1) and mx<dragbox(7)+boxes(1) and my>dragbox(8)-boxes(2) and my<dragbox(8)+boxes(2) 
	r(4)=255:g(4)=0:b(4)=0
	while mouseclick()<>0
		drag(7,8)
	endwhile
	else
	r(4)=255:g(4)=255:b(4)=255
endif
endfunction

function drag(a,b)
cls
	text 0,0,"draging on"
		mx=mousex()
		my=mousey()
		dragbox(a)=mx
		dragbox(b)=my
		makebox()
sync
endfunction

update added midpoints

Rem Project: dragboxes1

Rem ***** Main Source File *****
sync on
sync rate 60
global tcx tcy  
tcx=screen width()/2
tcy=screen height()/2
dim boxes(8) 
dim dragbox(8) 
dim r(4)
dim g(4)
dim b(4)
for i = 1 to 4
	r(i)=255
	g(i)=255
	b(i)=255
next i
rem click box size
boxes(1)=2
boxes(2)=2
rem start positions
rem top left x,y
dragbox(1)=tcx-15
dragbox(2)=tcy-15

rem top right x,y
dragbox(3)=tcx+15
dragbox(4)=tcy-15

rem bottom right x,y
dragbox(5)=tcx+15
dragbox(6)=tcy+15

rem bottom left x,y
dragbox(7)=tcx-15
dragbox(8)=tcy+15

do
	cls
	isindragbox()
	makebox()
	sync
loop

function makebox()
rem corners points
box dragbox(1)-boxes(1),dragbox(2)-boxes(2),dragbox(1)+boxes(1),dragbox(2)+boxes(2),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1))
box dragbox(3)-boxes(1),dragbox(4)-boxes(2),dragbox(3)+boxes(1),dragbox(4)+boxes(2),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2))
box dragbox(5)-boxes(1),dragbox(6)-boxes(2),dragbox(5)+boxes(1),dragbox(6)+boxes(2),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3))
box dragbox(7)-boxes(1),dragbox(8)-boxes(2),dragbox(7)+boxes(1),dragbox(8)+boxes(2),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4))

rem midpoint boxes
box (dragbox(1)+dragbox(3))/2-boxes(1),(dragbox(2)+dragbox(4))/2-boxes(2),(dragbox(1)+dragbox(3))/2+boxes(1),(dragbox(2)+dragbox(4))/2+boxes(2)
box (dragbox(3)+dragbox(5))/2-boxes(1),(dragbox(4)+dragbox(6))/2-boxes(2),(dragbox(3)+dragbox(5))/2+boxes(1),(dragbox(4)+dragbox(6))/2+boxes(2)
box (dragbox(5)+dragbox(7))/2-boxes(1),(dragbox(6)+dragbox(8))/2-boxes(2),(dragbox(5)+dragbox(7))/2+boxes(1),(dragbox(6)+dragbox(8))/2+boxes(2)
box (dragbox(1)+dragbox(7))/2-boxes(1),(dragbox(8)+dragbox(2))/2-boxes(2),(dragbox(1)+dragbox(7))/2+boxes(1),(dragbox(8)+dragbox(2))/2+boxes(2)

rem connecting lines
line dragbox(1),dragbox(2),dragbox(3),dragbox(4)
line dragbox(3),dragbox(4),dragbox(5),dragbox(6)
line dragbox(5),dragbox(6),dragbox(7),dragbox(8)
line dragbox(7),dragbox(8),dragbox(1),dragbox(2)

endfunction

function isindragbox()
mx=mousex()
my=mousey()

text 0,60,str$(mx)+"  "+str$(my)
for i = 1 to 8 step 2
text 0,0+(i*6),str$(dragbox(i) )+"   "+str$(dragbox(i+1) )
next i
if mx>dragbox(1)-boxes(1) and mx<dragbox(1)+boxes(1) and my>dragbox(2)-boxes(2) and my<dragbox(2)+boxes(2) 
	r(1)=255:g(1)=0:b(1)=0
	while mouseclick()<>0
		drag(1,2)
	endwhile
else
	r(1)=255:g(1)=255:b(1)=255
endif
if mx>dragbox(3)-boxes(1) and mx<dragbox(3)+boxes(1) and my>dragbox(4)-boxes(2) and my<dragbox(4)+boxes(2) 
	r(2)=255:g(2)=0:b(2)=0
	while mouseclick()<>0
		drag(3,4)
	endwhile
	else
	r(2)=255:g(2)=255:b(2)=255
endif
if mx>dragbox(5)-boxes(1) and mx<dragbox(5)+boxes(1) and my>dragbox(6)-boxes(2) and my<dragbox(6)+boxes(2) 
	r(3)=255:g(3)=0:b(3)=0
	while mouseclick()<>0
		drag(5,6)
	endwhile
	else
	r(3)=255:g(3)=255:b(3)=255
endif
if mx>dragbox(7)-boxes(1) and mx<dragbox(7)+boxes(1) and my>dragbox(8)-boxes(2) and my<dragbox(8)+boxes(2) 
	r(4)=255:g(4)=0:b(4)=0
	while mouseclick()<>0
		drag(7,8)
	endwhile
	else
	r(4)=255:g(4)=255:b(4)=255
endif
endfunction

function drag(a,b)
cls
	text 0,0,"draging on"
		mx=mousex()
		my=mousey()
		dragbox(a)=mx
		dragbox(b)=my
		makebox()
sync
endfunction

+ Code Snippet

Rem Project: dragboxes1

Rem ***** Main Source File *****
sync on
sync rate 60
global tcx tcy  
tcx=screen width()/2
tcy=screen height()/2
dim boxes(8) 
dim dragbox(8) 
dim r(4)
dim g(4)
dim b(4)
for i = 1 to 4
	r(i)=255
	g(i)=255
	b(i)=255
next i
rem click box size
boxes(1)=2
boxes(2)=2
rem start positions
rem top left x,y
dragbox(1)=tcx-15
dragbox(2)=tcy-15

rem top right x,y
dragbox(3)=tcx+15
dragbox(4)=tcy-15

rem bottom right x,y
dragbox(5)=tcx+15
dragbox(6)=tcy+15

rem bottom left x,y
dragbox(7)=tcx-15
dragbox(8)=tcy+15

do
	cls
	isindragbox()
	makebox()
	sync
loop


function makebox()
rem corners points
box dragbox(1)-boxes(1),dragbox(2)-boxes(2),dragbox(1)+boxes(1),dragbox(2)+boxes(2),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1))
box dragbox(3)-boxes(1),dragbox(4)-boxes(2),dragbox(3)+boxes(1),dragbox(4)+boxes(2),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2))
box dragbox(5)-boxes(1),dragbox(6)-boxes(2),dragbox(5)+boxes(1),dragbox(6)+boxes(2),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3))
box dragbox(7)-boxes(1),dragbox(8)-boxes(2),dragbox(7)+boxes(1),dragbox(8)+boxes(2),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4))

rem midpoint boxes
box (dragbox(1)+dragbox(3))/2-boxes(1),(dragbox(2)+dragbox(4))/2-boxes(2),(dragbox(1)+dragbox(3))/2+boxes(1),(dragbox(2)+dragbox(4))/2+boxes(2)
box (dragbox(3)+dragbox(5))/2-boxes(1),(dragbox(4)+dragbox(6))/2-boxes(2),(dragbox(3)+dragbox(5))/2+boxes(1),(dragbox(4)+dragbox(6))/2+boxes(2)
box (dragbox(5)+dragbox(7))/2-boxes(1),(dragbox(6)+dragbox(8))/2-boxes(2),(dragbox(5)+dragbox(7))/2+boxes(1),(dragbox(6)+dragbox(8))/2+boxes(2)
box (dragbox(1)+dragbox(7))/2-boxes(1),(dragbox(8)+dragbox(2))/2-boxes(2),(dragbox(1)+dragbox(7))/2+boxes(1),(dragbox(8)+dragbox(2))/2+boxes(2)

rem connecting lines
line dragbox(1),dragbox(2),dragbox(3),dragbox(4)
line dragbox(3),dragbox(4),dragbox(5),dragbox(6)
line dragbox(5),dragbox(6),dragbox(7),dragbox(8)
line dragbox(7),dragbox(8),dragbox(1),dragbox(2)

endfunction

function isindragbox()
mx=mousex()
my=mousey()

text 0,60,str$(mx)+"  "+str$(my)
for i = 1 to 8 step 2
text 0,0+(i*6),str$(dragbox(i) )+"   "+str$(dragbox(i+1) )
next i
if mx>dragbox(1)-boxes(1) and mx<dragbox(1)+boxes(1) and my>dragbox(2)-boxes(2) and my<dragbox(2)+boxes(2) 
	r(1)=255:g(1)=0:b(1)=0
	while mouseclick()<>0
		drag(1,2)
	endwhile
else
	r(1)=255:g(1)=255:b(1)=255
endif
if mx>dragbox(3)-boxes(1) and mx<dragbox(3)+boxes(1) and my>dragbox(4)-boxes(2) and my<dragbox(4)+boxes(2) 
	r(2)=255:g(2)=0:b(2)=0
	while mouseclick()<>0
		drag(3,4)
	endwhile
	else
	r(2)=255:g(2)=255:b(2)=255
endif
if mx>dragbox(5)-boxes(1) and mx<dragbox(5)+boxes(1) and my>dragbox(6)-boxes(2) and my<dragbox(6)+boxes(2) 
	r(3)=255:g(3)=0:b(3)=0
	while mouseclick()<>0
		drag(5,6)
	endwhile
	else
	r(3)=255:g(3)=255:b(3)=255
endif
if mx>dragbox(7)-boxes(1) and mx<dragbox(7)+boxes(1) and my>dragbox(8)-boxes(2) and my<dragbox(8)+boxes(2) 
	r(4)=255:g(4)=0:b(4)=0
	while mouseclick()<>0
		drag(7,8)
	endwhile
	else
	r(4)=255:g(4)=255:b(4)=255
endif
endfunction

function drag(a,b)
cls
	text 0,0,"draging on"
		mx=mousex()
		my=mousey()
		dragbox(a)=mx
		dragbox(b)=my
		makebox()
sync
endfunction

edit 2
now all points do as they should.

Rem Project: dragboxes1

Rem ***** Main Source File *****
sync on
sync rate 60
global tcx tcy  
tcx=screen width()/2
tcy=screen height()/2
dim boxes(8) 
dim dragbox(8) 
dim r(8)
dim g(8)
dim b(8)
for i = 1 to 8
	r(i)=255
	g(i)=255
	b(i)=255
next i
rem click box size
boxes(1)=2
boxes(2)=2
rem start positions
rem top left x,y
dragbox(1)=tcx-15
dragbox(2)=tcy-15

rem top right x,y
dragbox(3)=tcx+15
dragbox(4)=tcy-15

rem bottom right x,y
dragbox(5)=tcx+15
dragbox(6)=tcy+15

rem bottom left x,y
dragbox(7)=tcx-15
dragbox(8)=tcy+15

do
	cls
	isindragbox()
	makebox()
	sync
loop

function makebox()
rem corners points
box dragbox(1)-boxes(1),dragbox(2)-boxes(2),dragbox(1)+boxes(1),dragbox(2)+boxes(2),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1))
box dragbox(3)-boxes(1),dragbox(4)-boxes(2),dragbox(3)+boxes(1),dragbox(4)+boxes(2),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2))
box dragbox(5)-boxes(1),dragbox(6)-boxes(2),dragbox(5)+boxes(1),dragbox(6)+boxes(2),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3))
box dragbox(7)-boxes(1),dragbox(8)-boxes(2),dragbox(7)+boxes(1),dragbox(8)+boxes(2),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4))

rem midpoint boxes
box (dragbox(1)+dragbox(3))/2-boxes(1),(dragbox(2)+dragbox(4))/2-boxes(2),(dragbox(1)+dragbox(3))/2+boxes(1),(dragbox(2)+dragbox(4))/2+boxes(2),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5))
box (dragbox(3)+dragbox(5))/2-boxes(1),(dragbox(4)+dragbox(6))/2-boxes(2),(dragbox(3)+dragbox(5))/2+boxes(1),(dragbox(4)+dragbox(6))/2+boxes(2),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6))
box (dragbox(5)+dragbox(7))/2-boxes(1),(dragbox(6)+dragbox(8))/2-boxes(2),(dragbox(5)+dragbox(7))/2+boxes(1),(dragbox(6)+dragbox(8))/2+boxes(2),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7))
box (dragbox(1)+dragbox(7))/2-boxes(1),(dragbox(8)+dragbox(2))/2-boxes(2),(dragbox(1)+dragbox(7))/2+boxes(1),(dragbox(8)+dragbox(2))/2+boxes(2),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8))

rem connecting lines
line dragbox(1),dragbox(2),dragbox(3),dragbox(4)
line dragbox(3),dragbox(4),dragbox(5),dragbox(6)
line dragbox(5),dragbox(6),dragbox(7),dragbox(8)
line dragbox(7),dragbox(8),dragbox(1),dragbox(2)

endfunction

function isindragbox()
mx=mousex()
my=mousey()

text 0,60,str$(mx)+"  "+str$(my)
for i = 1 to 8 step 2
text 0,0+(i*6),str$(dragbox(i) )+"   "+str$(dragbox(i+1) )
next i
if mx>dragbox(1)-boxes(1) and mx<dragbox(1)+boxes(1) and my>dragbox(2)-boxes(2) and my<dragbox(2)+boxes(2) 
	r(1)=255:g(1)=0:b(1)=0
	while mouseclick()<>0
		drag(1,2)
	endwhile
else
	r(1)=255:g(1)=255:b(1)=255
endif
if mx>dragbox(3)-boxes(1) and mx<dragbox(3)+boxes(1) and my>dragbox(4)-boxes(2) and my<dragbox(4)+boxes(2) 
	r(2)=255:g(2)=0:b(2)=0
	while mouseclick()<>0
		drag(3,4)
	endwhile
	else
	r(2)=255:g(2)=255:b(2)=255
endif
if mx>dragbox(5)-boxes(1) and mx<dragbox(5)+boxes(1) and my>dragbox(6)-boxes(2) and my<dragbox(6)+boxes(2) 
	r(3)=255:g(3)=0:b(3)=0
	while mouseclick()<>0
		drag(5,6)
	endwhile
	else
	r(3)=255:g(3)=255:b(3)=255
endif
if mx>dragbox(7)-boxes(1) and mx<dragbox(7)+boxes(1) and my>dragbox(8)-boxes(2) and my<dragbox(8)+boxes(2) 
	r(4)=255:g(4)=0:b(4)=0
	while mouseclick()<>0
		drag(7,8)
	endwhile
	else
	r(4)=255:g(4)=255:b(4)=255
endif
rem mid point boxes
if mx>(dragbox(1)+dragbox(3))/2-boxes(1) and  mx<(dragbox(1)+dragbox(3))/2+boxes(1) and my>(dragbox(2)+dragbox(4))/2-boxes(2) and my<(dragbox(2)+dragbox(4))/2+boxes(2)
	r(5)=255:g(5)=0:b(5)=0
	oldmy=my
	oldy1=dragbox(2)
	oldy2=dragbox(4)
	while mouseclick()<>0
		cls
	text 0,0,"draging on"
		my=mousey()
   	    dragbox(2)=oldy1+( my-oldmy)
			dragbox(4)= oldy2+(my -oldmy)
		makebox()
	sync
endwhile
else
	r(5)=255:g(5)=255:b(5)=255
endif

if mx>(dragbox(3)+dragbox(5))/2-boxes(1) and  mx<(dragbox(3)+dragbox(5))/2+boxes(1) and my>(dragbox(4)+dragbox(6))/2-boxes(2) and my<(dragbox(4)+dragbox(6))/2+boxes(2)
	r(6)=255:g(6)=0:b(6)=0
oldmx=mx
	oldx1=dragbox(3)
	oldx2=dragbox(5)
	while mouseclick()<>0
		cls
	text 0,0,"draging on"
		mx=mousex()
   	     dragbox(3)=oldx1+(mx-oldmx)
		dragbox(5)= oldx2+(mx-oldmx)
		makebox()
	sync
endwhile
else
	r(6)=255:g(6)=255:b(6)=255
endif
if mx>(dragbox(5)+dragbox(7))/2-boxes(1) and  mx<(dragbox(5)+dragbox(7))/2+boxes(1) and my>(dragbox(6)+dragbox(8))/2-boxes(2) and my<(dragbox(6)+dragbox(8))/2+boxes(2)
	r(7)=255:g(7)=0:b(7)=0
	oldmy=my
	oldy1=dragbox(6)
	oldy2=dragbox(8)
while mouseclick()<>0
		cls
	text 0,0,"draging on"
		my=mousey()
		   	 dragbox(6)=oldy1+( my-oldmy)
			dragbox(8)= oldy2+(my -oldmy)
		makebox()
	sync
endwhile
else
	r(7)=255:g(7)=255:b(7)=255
endif
if mx>(dragbox(7)+dragbox(1))/2-boxes(1) and  mx<(dragbox(7)+dragbox(1))/2+boxes(1) and my>(dragbox(8)+dragbox(2))/2-boxes(2) and my<(dragbox(8)+dragbox(2))/2+boxes(2)
	r(8)=255:g(8)=0:b(8)=0
oldmx=mx
	oldx1=dragbox(7)
	oldx2=dragbox(1)
while mouseclick()<>0
		cls
	text 0,0,"draging on"
		mx=mousex()
   	   dragbox(7)=oldx1+( mx-oldmx)
      dragbox(1)= oldx2+(mx -oldmx)
		makebox()
	sync
endwhile
else
	r(8)=255:g(8)=255:b(8)=255
endif

endfunction

function drag(a,b)
cls
	text 0,0,"draging on"
		mx=mousex()
		my=mousey()
		dragbox(a)=mx
		dragbox(b)=my
		makebox()
sync
endfunction

+ Code Snippet

Rem Project: dragboxes1

Rem ***** Main Source File *****
sync on
sync rate 60
global tcx tcy  
tcx=screen width()/2
tcy=screen height()/2
dim boxes(8) 
dim dragbox(8) 
dim r(8)
dim g(8)
dim b(8)
for i = 1 to 8
	r(i)=255
	g(i)=255
	b(i)=255
next i
rem click box size
boxes(1)=2
boxes(2)=2
rem start positions
rem top left x,y
dragbox(1)=tcx-15
dragbox(2)=tcy-15

rem top right x,y
dragbox(3)=tcx+15
dragbox(4)=tcy-15

rem bottom right x,y
dragbox(5)=tcx+15
dragbox(6)=tcy+15

rem bottom left x,y
dragbox(7)=tcx-15
dragbox(8)=tcy+15



do
	cls
	isindragbox()
	makebox()
	sync
loop


function makebox()
rem corners points
box dragbox(1)-boxes(1),dragbox(2)-boxes(2),dragbox(1)+boxes(1),dragbox(2)+boxes(2),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1))
box dragbox(3)-boxes(1),dragbox(4)-boxes(2),dragbox(3)+boxes(1),dragbox(4)+boxes(2),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2))
box dragbox(5)-boxes(1),dragbox(6)-boxes(2),dragbox(5)+boxes(1),dragbox(6)+boxes(2),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3))
box dragbox(7)-boxes(1),dragbox(8)-boxes(2),dragbox(7)+boxes(1),dragbox(8)+boxes(2),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4))

rem midpoint boxes
box (dragbox(1)+dragbox(3))/2-boxes(1),(dragbox(2)+dragbox(4))/2-boxes(2),(dragbox(1)+dragbox(3))/2+boxes(1),(dragbox(2)+dragbox(4))/2+boxes(2),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5))
box (dragbox(3)+dragbox(5))/2-boxes(1),(dragbox(4)+dragbox(6))/2-boxes(2),(dragbox(3)+dragbox(5))/2+boxes(1),(dragbox(4)+dragbox(6))/2+boxes(2),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6))
box (dragbox(5)+dragbox(7))/2-boxes(1),(dragbox(6)+dragbox(8))/2-boxes(2),(dragbox(5)+dragbox(7))/2+boxes(1),(dragbox(6)+dragbox(8))/2+boxes(2),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7))
box (dragbox(1)+dragbox(7))/2-boxes(1),(dragbox(8)+dragbox(2))/2-boxes(2),(dragbox(1)+dragbox(7))/2+boxes(1),(dragbox(8)+dragbox(2))/2+boxes(2),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8))

rem connecting lines
line dragbox(1),dragbox(2),dragbox(3),dragbox(4)
line dragbox(3),dragbox(4),dragbox(5),dragbox(6)
line dragbox(5),dragbox(6),dragbox(7),dragbox(8)
line dragbox(7),dragbox(8),dragbox(1),dragbox(2)

endfunction

function isindragbox()
mx=mousex()
my=mousey()

text 0,60,str$(mx)+"  "+str$(my)
for i = 1 to 8 step 2
text 0,0+(i*6),str$(dragbox(i) )+"   "+str$(dragbox(i+1) )
next i
if mx>dragbox(1)-boxes(1) and mx<dragbox(1)+boxes(1) and my>dragbox(2)-boxes(2) and my<dragbox(2)+boxes(2) 
	r(1)=255:g(1)=0:b(1)=0
	while mouseclick()<>0
		drag(1,2)
	endwhile
else
	r(1)=255:g(1)=255:b(1)=255
endif
if mx>dragbox(3)-boxes(1) and mx<dragbox(3)+boxes(1) and my>dragbox(4)-boxes(2) and my<dragbox(4)+boxes(2) 
	r(2)=255:g(2)=0:b(2)=0
	while mouseclick()<>0
		drag(3,4)
	endwhile
	else
	r(2)=255:g(2)=255:b(2)=255
endif
if mx>dragbox(5)-boxes(1) and mx<dragbox(5)+boxes(1) and my>dragbox(6)-boxes(2) and my<dragbox(6)+boxes(2) 
	r(3)=255:g(3)=0:b(3)=0
	while mouseclick()<>0
		drag(5,6)
	endwhile
	else
	r(3)=255:g(3)=255:b(3)=255
endif
if mx>dragbox(7)-boxes(1) and mx<dragbox(7)+boxes(1) and my>dragbox(8)-boxes(2) and my<dragbox(8)+boxes(2) 
	r(4)=255:g(4)=0:b(4)=0
	while mouseclick()<>0
		drag(7,8)
	endwhile
	else
	r(4)=255:g(4)=255:b(4)=255
endif
rem mid point boxes
if mx>(dragbox(1)+dragbox(3))/2-boxes(1) and  mx<(dragbox(1)+dragbox(3))/2+boxes(1) and my>(dragbox(2)+dragbox(4))/2-boxes(2) and my<(dragbox(2)+dragbox(4))/2+boxes(2)
	r(5)=255:g(5)=0:b(5)=0
	oldmy=my
	oldy1=dragbox(2)
	oldy2=dragbox(4)
	while mouseclick()<>0
		cls
	text 0,0,"draging on"
		my=mousey()
   	    dragbox(2)=oldy1+( my-oldmy)
			dragbox(4)= oldy2+(my -oldmy)
		makebox()
	sync
endwhile
else
	r(5)=255:g(5)=255:b(5)=255
endif

if mx>(dragbox(3)+dragbox(5))/2-boxes(1) and  mx<(dragbox(3)+dragbox(5))/2+boxes(1) and my>(dragbox(4)+dragbox(6))/2-boxes(2) and my<(dragbox(4)+dragbox(6))/2+boxes(2)
	r(6)=255:g(6)=0:b(6)=0
oldmx=mx
	oldx1=dragbox(3)
	oldx2=dragbox(5)
	while mouseclick()<>0
		cls
	text 0,0,"draging on"
		mx=mousex()
   	     dragbox(3)=oldx1+(mx-oldmx)
		dragbox(5)= oldx2+(mx-oldmx)
		makebox()
	sync
endwhile
else
	r(6)=255:g(6)=255:b(6)=255
endif
if mx>(dragbox(5)+dragbox(7))/2-boxes(1) and  mx<(dragbox(5)+dragbox(7))/2+boxes(1) and my>(dragbox(6)+dragbox(8))/2-boxes(2) and my<(dragbox(6)+dragbox(8))/2+boxes(2)
	r(7)=255:g(7)=0:b(7)=0
	oldmy=my
	oldy1=dragbox(6)
	oldy2=dragbox(8)
while mouseclick()<>0
		cls
	text 0,0,"draging on"
		my=mousey()
		   	 dragbox(6)=oldy1+( my-oldmy)
			dragbox(8)= oldy2+(my -oldmy)
		makebox()
	sync
endwhile
else
	r(7)=255:g(7)=255:b(7)=255
endif
if mx>(dragbox(7)+dragbox(1))/2-boxes(1) and  mx<(dragbox(7)+dragbox(1))/2+boxes(1) and my>(dragbox(8)+dragbox(2))/2-boxes(2) and my<(dragbox(8)+dragbox(2))/2+boxes(2)
	r(8)=255:g(8)=0:b(8)=0
oldmx=mx
	oldx1=dragbox(7)
	oldx2=dragbox(1)
while mouseclick()<>0
		cls
	text 0,0,"draging on"
		mx=mousex()
   	   dragbox(7)=oldx1+( mx-oldmx)
      dragbox(1)= oldx2+(mx -oldmx)
		makebox()
	sync
endwhile
else
	r(8)=255:g(8)=255:b(8)=255
endif





endfunction

function drag(a,b)
cls
	text 0,0,"draging on"
		mx=mousex()
		my=mousey()
		dragbox(a)=mx
		dragbox(b)=my
		makebox()
sync
endfunction

Dark Physics makes any hot drink go cold.

Back to top

Profile PM

SunDawg

19

Years of Service

User Offline

Joined: 21st Dec 2004

Location: Massachusetts

Posted: 15th Nov 2008 03:39

Link

That's really cool!

My site, for various stuff that I make.

Back to top

Profile PM Email Website

Phaelax

DBPro Master

21

Years of Service

User Offline

Joined: 16th Apr 2003

Location: Metropia

Posted: 16th Nov 2008 00:54

Link

Since you're already using an array, why not take advantage of that with a FOR loop? It should be easy enough to build a function to display a shape of any number of points with only a few lines. Consider this a little challenge for ya

Back to top

Profile PM Email Website

AndrewT

17

Years of Service

User Offline

Joined: 11th Feb 2007

Location: MI, USA

Posted: 23rd Nov 2008 03:23

Link

Regarding Phaelax's post, I was working on something similar to what he described. Here's the code:

//***********************************************************************************************************************
//User-Defined Types
//***********************************************************************************************************************
Type TVertex //Defines a type used for the vertices of a polygon.
	X as Float //X position of vertex.
	Y as Float //Y position of the vertex.
EndType
Type TPolygon //Defines a type used for polygons.
	Dragging as Integer //Contains the vertex--if any--currently being dragged.
	NumVertices as Integer //Number of vertices in the polygon.
EndType
//***********************************************************************************************************************
//Arrays and Variables
//***********************************************************************************************************************
Dim Polygons( 100 ) as TPolygon
Dim PolygonVertices( 100, 100 ) as TVertex
//***********************************************************************************************************************
//Program Setup
//***********************************************************************************************************************
Set Display Mode 1024, 768, 32
Sync On
Sync Rate 0
Randomize Timer( )
Set Text Font "Arial"
Set Text Size 16

CreatePolygon( 1, 8, 400, 400, 400 )
//***********************************************************************************************************************
//Main Loop
//***********************************************************************************************************************
Do
	CLS
	DrawPolygon( 1 )
	DrawPolygonVertices( 1 )
	DragPolygonVertices( 1 )
	Center Text Screen Width( ) / 2, 10, "Click on a vertex and move your mouse to drag the vertex."
	Sync
Loop
//***********************************************************************************************************************
//Function
//***********************************************************************************************************************
//Polygon Functions-------------------------------------------------------
Function CreatePolygon( PolygonID as Integer, NumVertices as Integer, Size as Float, X as Float, Y as Float )
	Local Angle as Float
	Angle = 360 / NumVertices
	Polygons( PolygonID ).NumVertices = NumVertices
	For V = 1 to NumVertices
		PolygonVertices( PolygonID, V ).X = ( Sin( ( V - 1 ) * Angle ) * ( Size / 2 ) ) + X
		PolygonVertices( PolygonID, V ).Y = ( Cos( ( V - 1 ) * Angle ) * ( Size / 2 ) ) + Y
	Next V
EndFunction
Function DrawPolygon( PolygonID as Integer )
	Local X1 as Float
	Local Y1 as Float
	Local X2 as Float
	Local Y2 as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		X1 = PolygonVertices( PolygonID, V ).X
		Y1 = PolygonVertices( PolygonID, V ).Y
		If V < Polygons( PolygonID ).NumVertices
			X2 = PolygonVertices( PolygonID, V + 1 ).X
			Y2 = PolygonVertices( PolygonID, V + 1 ).Y
		Else
			X2 = PolygonVertices( PolygonID, 1 ).X
			Y2 = PolygonVertices( PolygonID, 1 ).Y
		EndIf
		Line X1, Y1, X2, Y2
	Next V
EndFunction
Function DrawPolygonVertices( PolygonID )
	Local X1 as Float
	Local Y1 as Float
	Local X2 as Float
	Local Y2 as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		X1 = PolygonVertices( PolygonID, V ).X - 5
		Y1 = PolygonVertices( PolygonID, V ).Y - 5
		X2 = PolygonVertices( PolygonID, V ).X + 5
		Y2 = PolygonVertices( PolygonID, V ).Y + 5
		Box X1, Y1, X2, Y2
	Next V
EndFunction
Function DragPolygonVertices( PolygonID as Integer )
	If MouseClick( ) = 1
		If Polygons( PolygonID ).Dragging = 0
			For V = 1 to Polygons( PolygonID ).NumVertices
				If MouseX( ) > PolygonVertices( PolygonID, V ).X - 5
					If MouseY( ) > PolygonVertices( PolygonID, V ).Y - 5
						If MouseX( ) < PolygonVertices( PolygonID, V ).X + 5
							If MouseY( ) < PolygonVertices( PolygonID, V ).Y + 5
								Polygons( PolygonID ).Dragging = V
							Endif
						EndIf
					EndIf
				EndIf
			Next V
		EndIf
	Else
		Polygons( PolygonID ).Dragging = 0
	Endif
	If Polygons( PolygonID ).Dragging > 0
		PolygonVertices( PolygonID, Polygons( PolygonID ).Dragging ).X = MouseX( )
		PolygonVertices( PolygonID, Polygons( PolygonID ).Dragging ).Y = MouseY( )
	EndIf
EndFunction
Function DrawPolygonMidpoints( PolygonID as Integer )
	Local MidX1 as Float
	Local MidY1 as Float
	Local MidX2 as Float
	Local MidY2 as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		If V < Polygons( PolygonID ).NumVertices
			MidX1 = ( ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, V + 1 ).X ) / 2 ) - 5
			MidY1 = ( ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, V + 1 ).Y ) / 2 ) - 5
			MidX2 = ( ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, V + 1 ).X ) / 2 ) + 5
			MidY2 = ( ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, V + 1 ).Y ) / 2 ) + 5
		Else
			MidX1 = ( ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, 1 ).X ) / 2 ) - 5
			MidY1 = ( ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, 1 ).Y ) / 2 ) - 5
			MidX2 = ( ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, 1 ).X ) / 2 ) + 5
			MidY2 = ( ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, 1 ).Y ) / 2 ) + 5	
		EndIf
		Box MidX1, MidY1, MidX2, MidY2
	Next V
EndFunction
Function DrawPolygonCentroid( PolygonID as Integer )
	Local CentroidX as Float
	Local CentroidY as Float
	Local TotalX as Float
	Local TotalY as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		Inc TotalX, PolygonVertices( PolygonID, V ).X
		Inc TotalY, PolygonVertices( PolygonID, V ).Y
	Next V
	CentroidX = TotalX / Polygons( PolygonID ).NumVertices
	CentroidY = TotalY / Polygons( PolygonID ).NumVertices
	Box CentroidX - 5, CentroidY - 5, CentroidX + 5, CentroidY + 5
EndFunction
Function DrawPolygonMedians( PolygonID as Integer )
	Local MidX as Float
	Local MidY as Float
	Local VertX as Float
	Local VertY as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		If V < Polygons( PolygonID ).NumVertices
			MidX = ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, V + 1 ).X ) / 2
			MidY = ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, V + 1 ).Y ) / 2
		Else
			MidX = ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, 1 ).X ) / 2
			MidY = ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, 1 ).Y ) / 2
		EndIf
		Select V
			Case 1
				VertX = PolygonVertices( PolygonID, 3 ).X
				VertY = PolygonVertices( PolygonID, 3 ).Y
			EndCase
			Case 2
				VertX = PolygonVertices( PolygonID, 1 ).X
				VertY = PolygonVertices( PolygonID, 1 ).Y
			EndCase
			Case 3
				VertX = PolygonVertices( PolygonID, 2 ).X
				VertY = PolygonVertices( PolygonID, 2 ).Y
			EndCase
		EndSelect
		Line MidX, MidY, VertX, VertY
	Next V
EndFunction
Function DrawPolygonMidSegments( PolygonID as Integer )
	Local MidX1 as Float
	Local MidY1 as Float
	Local MidX2 as Float
	Local MidY2 as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		If V + 1 < Polygons( PolygonID ).NumVertices
			MidX1 = ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, V + 1 ).X ) / 2
			MidY1 = ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, V + 1 ).Y ) / 2
			MidX2 = ( PolygonVertices( PolygonID, V + 1 ).X + PolygonVertices( PolygonID, V + 2 ).X ) / 2
			MidY2 = ( PolygonVertices( PolygonID, V + 1 ).Y + PolygonVertices( PolygonID, V + 2 ).Y ) / 2
		Else
			If V + 1 = Polygons( PolygonID ).NumVertices
				MidX1 = ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, V + 1 ).X ) / 2
				MidY1 = ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, V + 1 ).Y ) / 2
				MidX2 = ( PolygonVertices( PolygonID, V + 1 ).X + PolygonVertices( PolygonID, 1 ).X ) / 2
				MidY2 = ( PolygonVertices( PolygonID, V + 1 ).Y + PolygonVertices( PolygonID, 1 ).Y ) / 2
			EndIf
			If V = Polygons( PolygonID ).NumVertices
				MidX1 = ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, 1 ).X ) / 2
				MidY1 = ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, 1 ).Y ) / 2
				MidX2 = ( PolygonVertices( PolygonID, 1 ).X + PolygonVertices( PolygonID, 2 ).X ) / 2
				MidY2 = ( PolygonVertices( PolygonID, 1 ).Y + PolygonVertices( PolygonID, 2 ).Y ) / 2
			EndIf
		EndIf
		Line MidX1, MidY1, MidX2, MidY2
	Next V
EndFunction
//------------------------------------------------------------------------

+ Code Snippet

//***********************************************************************************************************************
//User-Defined Types
//***********************************************************************************************************************
Type TVertex //Defines a type used for the vertices of a polygon.
	X as Float //X position of vertex.
	Y as Float //Y position of the vertex.
EndType
Type TPolygon //Defines a type used for polygons.
	Dragging as Integer //Contains the vertex--if any--currently being dragged.
	NumVertices as Integer //Number of vertices in the polygon.
EndType
//***********************************************************************************************************************
//Arrays and Variables
//***********************************************************************************************************************
Dim Polygons( 100 ) as TPolygon
Dim PolygonVertices( 100, 100 ) as TVertex
//***********************************************************************************************************************
//Program Setup
//***********************************************************************************************************************
Set Display Mode 1024, 768, 32
Sync On
Sync Rate 0
Randomize Timer( )
Set Text Font "Arial"
Set Text Size 16

CreatePolygon( 1, 8, 400, 400, 400 )
//***********************************************************************************************************************
//Main Loop
//***********************************************************************************************************************
Do
	CLS
	DrawPolygon( 1 )
	DrawPolygonVertices( 1 )
	DragPolygonVertices( 1 )
	Center Text Screen Width( ) / 2, 10, "Click on a vertex and move your mouse to drag the vertex."
	Sync
Loop
//***********************************************************************************************************************
//Function
//***********************************************************************************************************************
//Polygon Functions-------------------------------------------------------
Function CreatePolygon( PolygonID as Integer, NumVertices as Integer, Size as Float, X as Float, Y as Float )
	Local Angle as Float
	Angle = 360 / NumVertices
	Polygons( PolygonID ).NumVertices = NumVertices
	For V = 1 to NumVertices
		PolygonVertices( PolygonID, V ).X = ( Sin( ( V - 1 ) * Angle ) * ( Size / 2 ) ) + X
		PolygonVertices( PolygonID, V ).Y = ( Cos( ( V - 1 ) * Angle ) * ( Size / 2 ) ) + Y
	Next V
EndFunction
Function DrawPolygon( PolygonID as Integer )
	Local X1 as Float
	Local Y1 as Float
	Local X2 as Float
	Local Y2 as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		X1 = PolygonVertices( PolygonID, V ).X
		Y1 = PolygonVertices( PolygonID, V ).Y
		If V < Polygons( PolygonID ).NumVertices
			X2 = PolygonVertices( PolygonID, V + 1 ).X
			Y2 = PolygonVertices( PolygonID, V + 1 ).Y
		Else
			X2 = PolygonVertices( PolygonID, 1 ).X
			Y2 = PolygonVertices( PolygonID, 1 ).Y
		EndIf
		Line X1, Y1, X2, Y2
	Next V
EndFunction
Function DrawPolygonVertices( PolygonID )
	Local X1 as Float
	Local Y1 as Float
	Local X2 as Float
	Local Y2 as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		X1 = PolygonVertices( PolygonID, V ).X - 5
		Y1 = PolygonVertices( PolygonID, V ).Y - 5
		X2 = PolygonVertices( PolygonID, V ).X + 5
		Y2 = PolygonVertices( PolygonID, V ).Y + 5
		Box X1, Y1, X2, Y2
	Next V
EndFunction
Function DragPolygonVertices( PolygonID as Integer )
	If MouseClick( ) = 1
		If Polygons( PolygonID ).Dragging = 0
			For V = 1 to Polygons( PolygonID ).NumVertices
				If MouseX( ) > PolygonVertices( PolygonID, V ).X - 5
					If MouseY( ) > PolygonVertices( PolygonID, V ).Y - 5
						If MouseX( ) < PolygonVertices( PolygonID, V ).X + 5
							If MouseY( ) < PolygonVertices( PolygonID, V ).Y + 5
								Polygons( PolygonID ).Dragging = V
							Endif
						EndIf
					EndIf
				EndIf
			Next V
		EndIf
	Else
		Polygons( PolygonID ).Dragging = 0
	Endif
	If Polygons( PolygonID ).Dragging > 0
		PolygonVertices( PolygonID, Polygons( PolygonID ).Dragging ).X = MouseX( )
		PolygonVertices( PolygonID, Polygons( PolygonID ).Dragging ).Y = MouseY( )
	EndIf
EndFunction
Function DrawPolygonMidpoints( PolygonID as Integer )
	Local MidX1 as Float
	Local MidY1 as Float
	Local MidX2 as Float
	Local MidY2 as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		If V < Polygons( PolygonID ).NumVertices
			MidX1 = ( ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, V + 1 ).X ) / 2 ) - 5
			MidY1 = ( ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, V + 1 ).Y ) / 2 ) - 5
			MidX2 = ( ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, V + 1 ).X ) / 2 ) + 5
			MidY2 = ( ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, V + 1 ).Y ) / 2 ) + 5
		Else
			MidX1 = ( ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, 1 ).X ) / 2 ) - 5
			MidY1 = ( ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, 1 ).Y ) / 2 ) - 5
			MidX2 = ( ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, 1 ).X ) / 2 ) + 5
			MidY2 = ( ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, 1 ).Y ) / 2 ) + 5	
		EndIf
		Box MidX1, MidY1, MidX2, MidY2
	Next V
EndFunction
Function DrawPolygonCentroid( PolygonID as Integer )
	Local CentroidX as Float
	Local CentroidY as Float
	Local TotalX as Float
	Local TotalY as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		Inc TotalX, PolygonVertices( PolygonID, V ).X
		Inc TotalY, PolygonVertices( PolygonID, V ).Y
	Next V
	CentroidX = TotalX / Polygons( PolygonID ).NumVertices
	CentroidY = TotalY / Polygons( PolygonID ).NumVertices
	Box CentroidX - 5, CentroidY - 5, CentroidX + 5, CentroidY + 5
EndFunction
Function DrawPolygonMedians( PolygonID as Integer )
	Local MidX as Float
	Local MidY as Float
	Local VertX as Float
	Local VertY as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		If V < Polygons( PolygonID ).NumVertices
			MidX = ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, V + 1 ).X ) / 2
			MidY = ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, V + 1 ).Y ) / 2
		Else
			MidX = ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, 1 ).X ) / 2
			MidY = ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, 1 ).Y ) / 2
		EndIf
		Select V
			Case 1
				VertX = PolygonVertices( PolygonID, 3 ).X
				VertY = PolygonVertices( PolygonID, 3 ).Y
			EndCase
			Case 2
				VertX = PolygonVertices( PolygonID, 1 ).X
				VertY = PolygonVertices( PolygonID, 1 ).Y
			EndCase
			Case 3
				VertX = PolygonVertices( PolygonID, 2 ).X
				VertY = PolygonVertices( PolygonID, 2 ).Y
			EndCase
		EndSelect
		Line MidX, MidY, VertX, VertY
	Next V
EndFunction
Function DrawPolygonMidSegments( PolygonID as Integer )
	Local MidX1 as Float
	Local MidY1 as Float
	Local MidX2 as Float
	Local MidY2 as Float
	For V = 1 to Polygons( PolygonID ).NumVertices
		If V + 1 < Polygons( PolygonID ).NumVertices
			MidX1 = ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, V + 1 ).X ) / 2
			MidY1 = ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, V + 1 ).Y ) / 2
			MidX2 = ( PolygonVertices( PolygonID, V + 1 ).X + PolygonVertices( PolygonID, V + 2 ).X ) / 2
			MidY2 = ( PolygonVertices( PolygonID, V + 1 ).Y + PolygonVertices( PolygonID, V + 2 ).Y ) / 2
		Else
			If V + 1 = Polygons( PolygonID ).NumVertices
				MidX1 = ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, V + 1 ).X ) / 2
				MidY1 = ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, V + 1 ).Y ) / 2
				MidX2 = ( PolygonVertices( PolygonID, V + 1 ).X + PolygonVertices( PolygonID, 1 ).X ) / 2
				MidY2 = ( PolygonVertices( PolygonID, V + 1 ).Y + PolygonVertices( PolygonID, 1 ).Y ) / 2
			EndIf
			If V = Polygons( PolygonID ).NumVertices
				MidX1 = ( PolygonVertices( PolygonID, V ).X + PolygonVertices( PolygonID, 1 ).X ) / 2
				MidY1 = ( PolygonVertices( PolygonID, V ).Y + PolygonVertices( PolygonID, 1 ).Y ) / 2
				MidX2 = ( PolygonVertices( PolygonID, 1 ).X + PolygonVertices( PolygonID, 2 ).X ) / 2
				MidY2 = ( PolygonVertices( PolygonID, 1 ).Y + PolygonVertices( PolygonID, 2 ).Y ) / 2
			EndIf
		EndIf
		Line MidX1, MidY1, MidX2, MidY2
	Next V
EndFunction
//------------------------------------------------------------------------

It's not well commented because I wasn't expecting to give it to anybody, sorry.

Back to top

Profile PM

HowDo

21

Years of Service

User Offline

Joined: 28th Nov 2002

Location: United Kingdom

Posted: 23rd Nov 2008 12:58

Link

Thank for sharing the code AndrewT, looks very easy to do now you've done all the hard work finding out how to don it.

Now as Phaelax said above to find away of make either code start with three corners then make it so that more sides can be added.

Dark Physics makes any hot drink go cold.

Back to top

Profile PM

AndrewT

17

Years of Service

User Offline

Joined: 11th Feb 2007

Location: MI, USA

Posted: 23rd Nov 2008 15:43

Link

Quote: "Now as Phaelax said above to find away of make either code start with three corners then make it so that more sides can be added."

I already did. You can use CreatePolygon( ) to create polygons with up to 100 sides, you can optionally draw the midpoints of every side, you can optionally draw the center of any figure, you can drag around any vertex of any figure, and if you have a triangle you can draw medians as well.

Try changing this:

+ Code Snippet

CreatePolygon( 1, 8, 400, 400, 400 )

to this:

+ Code Snippet

CreatePolygon( 1, 18, 300, 200, 500 )

The first parameter is the ID of the shape, the second is the number of sides, the third is the polygon's size, and the last two are the polygon's starting position.

Back to top

Profile PM

Sorry your browser is not supported!

Code Snippets / [DBP] A box you can drag the corners.