ASP Painter
Home
Home
Samples
Samples
Purchase
Purchase
Download
Download
Documentation
Documentation


ASPPainter Samples

Sample 2 - Create exploded pie chart. 

Filled rectangles, copying images
 


Dim pic
Dim colorplane(3)
Dim coloredge(3)
Dim colorboard(3)
Dim colorpie(3,10)
Dim data(2,10)
Dim color(10,3)

delta = -85

Set pic = CreateObject("ASPPainter.Pictures.1")
pic.SetBKColor 255,255,255,255
pic.Create 300,300

xc = 150
yc = 120
w = 250
h = 120
d = 50
abegin = delta
exploded = 20


colorplane(1) = 255
colorplane(2) = 255
colorplane(3) = 0

coloredge(1) = 0
coloredge(2) = 0
coloredge(3) = 0

colorboard(1) = 0
colorboard(2) = 0
colorboard(3) = 127

Dim rc,bc,gc

rc = split("106,255,255,156,127,127,127,127,127,127",",")
gc = split("156,255,0,0,127,127,127,127,127,127",",")
bc = split("255,0,0,255,255,255,255,255,255,255",",")


for i = 0 to 9
colorpie(1,i) = rc(i)
colorpie(2,i) = gc(i)
colorpie(3,i) = bc(i)
next

'pic.SetColor colorpie(1),colorpie(2),colorpie(3),255

n = 4
data(1,0) = 1
data(2,0) = 75
data(1,1) = 0
data(2,1) = 10
data(1,2) = 1
data(2,2) = 20
data(1,3) = 1
data(2,3) = 75
'data(1,4) = 1
'data(2,4) = 10
'data(1,5) = 1
'data(2,5) = 10
'data(1,6) = 1
'data(2,6) = 90

DrawNow im,data,color,n,dist 

pic.SetColor 0,0,0,255
pic.SetFontName "Verdana"
pic.SetFontSize 30
pic.SetFontBold 1
pic.TextOut 25,10, "Pie Chart"

pic.SetFontSize 16
pic.SetFontBold 1
pic.TextOut 25,250, "www.asppainter.com"


pic.MakeThumbnail 100,100
pic.SetColor 255,255,255,255
pic.setColorAsTransparent

pic.SaveToFile "C:\pieex.png"
pic.SetFormat 3
pic.SaveToFile "C:\pieex.gif"

pic.DestroyALL
Set pic = Nothing


SUB DrawNow(im,data,color,n,dist)
	sum = 0 
	a = 0
	For i = 0 to n-1
		sum = sum + data(2,i)
	next
	
	sum = CInt(sum)
	
	For ja = 0 to 5
		a = 0
			
		For ia = 0 to n-1			
			e = CInt((360*a)/sum)
			a = a + data(2,ia)
			s = CInt((360*a)/sum)	
			s = s + abegin
			e = e + abegin
			Select  case ja
				case 0:
					DrawUp im,e,s,data(1,ia),ia
				case 1:
					DrawEdge im,e,s,data(1,ia)
				case 2:
					DrawIn im,e,s,data(1,ia)
				case 3:
					DrawOut im,e,s,data(1,ia)	
					DrawOutEdge im,e,s,data(1,ia)	
				case 4:
					DrawDown im,e,s,data(1,ia),ia
				case 5:
					DrawUpEdge im,e,s,data(1,ia)
				case default:
					
			end select
		next
	next	

END SUB

Sub ShowPlane (e,s,isVisible1,isVisible2)

etest = e
stest = s
if e > 360 then etest = e - 360
if s > 360 then stest = s - 360
	if etest >= 0 and etest <= 90 then
		isVisible1 = false
	else
		if etest > 90 and etest <270 then
			isVisible1 = true
		else
			if etest >= 270 and etest <=360 then
				isVisible1 = false
			else
				isVisible1 = true
			end if		
		end if
	end if

	if stest >= 0 and stest < 90 then
		isVisible2 = true
	else
		if stest > 90 and stest <=270 then
			isVisible2 = false
		else
			if stest > 270 and stest <=360 then
				isVisible2 = true
			else			
				isVisible2 = false
			end if		
		end if
	end if


End Sub


Function DrawUp(im,e,s,sh,ia)
	NewCoords xc,yc,e,s,xnew,ynew
	pic.SetColor colorpie(1,ia),colorpie(2,ia),colorpie(3,ia),255
	if (sh=1) then pic.DrawFilledPie xnew,ynew+d,w,h,e,s
	pic.SetColor colorpie(1,ia),colorpie(2,ia),colorpie(3,ia),255
	if (sh=1) then pic.DrawFilledPie xnew,ynew+d,w,h,e,s
end Function

Function DrawOut(im,e,s,sh)
	etest = e
	stest = s
	ends = 179
	begine = 360
	draw_out = true
	istwo = false

	if  e < 180 and s < 180 then 
	
	end if
	
	if e<180 and s>180 and s <360 then
		etest = e
		stest = ends
	end if
	
	if e<180 and  s >360 then
		etest = e
		stest = ends
		e2 = begine
		s2 = s
		istwo = true
	end if
	
	if e>=180 and s>180 and s <=360 then
		etest = begine
		stest = ends
		draw_out = false
	end if
	
	if e>=180 and s >360 then
		etest = e
		stest = s
	end if
	
	pic.SetColor colorboard(1),colorboard(2),colorboard(3),255
	For i = yc to yc+d-1			
		if (sh=1) and draw_out=true then
			NewCoords xc,i,etest,stest,xnew,ynew
			pic.DrawPie xnew,ynew,w,h,etest,stest
			if istwo = true then 
				NewCoords xc,i,e2,s2,xnew,ynew
				pic.DrawPie xnew,ynew,w,h,e2,s2
			end if
		end if
	next
	
	pic.SetColor coloredge(1),coloredge(2),coloredge(3),255				
	if (sh=1)  and draw_out=true  then
		 NewCoords xc,i,etest,stest,xnew,ynew
		 pic.DrawPie xnew,ynew,w,h,etest,stest ''	
			if istwo = true then 
				NewCoords xc,i,e2,s2,xnew,ynew
				pic.DrawPie xnew,ynew,w,h,e2,s2 ''
			end if
	end if
	

end Function

Function DrawIn(im,e,s,sh)
	Dim point(8)

	isVisible1 = false
	isVisible2 = false

	ShowPlane  e,s,isVisible1,isVisible2

	if (isVisible2 = true) then
		GetPoints point, s
		pic.SetColor colorplane(1),colorplane(2),colorplane(3),255
		if (sh=1) then pic.DrawFilledPolygon point,8	
	end if

	if (isVisible1 = true) then
		GetPoints point, e
		pic.SetColor colorplane(1),colorplane(2),colorplane(3),255
		if (sh=1) then pic.DrawFilledPolygon point,8
	end if	

end Function

Function DrawEdge(im,e,s,sh)
	Dim point(8)

	isVisible1 = false
	isVisible2 = false

	ShowPlane  e,s,isVisible1,isVisible2	
	
	if (isVisible2 = true) then
		GetPoints point, s
		pic.SetColor coloredge(1),coloredge(2),coloredge(3),255		
		if (sh=1) then pic.DrawPolygon point,8		
	end if

	if (isVisible1 = true) then
		GetPoints point, e
		pic.SetColor coloredge(1),coloredge(2),coloredge(3),255
		if (sh=1) then 
			pic.DrawLine point(0) , point(1), point(6) ,point(7)
			pic.DrawLine point(0) , point(1), point(2) ,point(3)
			pic.DrawLine point(2) , point(3), point(4) ,point(5)
			pic.DrawLine point(4) , point(5), point(6) ,point(7)
		end if
	end if	


end Function

Function DrawDown(im,e,s,sh,ia)
	pic.SetColor colorpie(1,ia),colorpie(2,ia),colorpie(3,ia),255
	if (sh=1) then pic.DrawFilledPie xc,yc,w,h,e,s
	pic.SetColor coloredge(1),coloredge(2),coloredge(3),255
	if (sh=1) then pic.DrawPie xc,yc,w,h,e,s
end Function

Function DrawUPEdge(im,e,s,sh)
	Dim point(8)

	isVisible1 = false
	isVisible2 = false

	GetPoints point, s
	pic.SetColor coloredge(1),coloredge(2),coloredge(3),255
	if (sh=1) then pic.DrawLine point(0) , point(1), point(6) ,point(7)

	GetPoints point, e

	pic.SetColor coloredge(1),coloredge(2),coloredge(3),255
	if (sh=1) then 
		pic.DrawLine point(0) , point(1), point(6) ,point(7)
	end if

end Function

Function DrawOutEdge(im,e,s,sh)
	Dim point(8)

	isVisible1 = false
	isVisible2 = false


	if e < 180 or e > 360 then isVisible1 = true
	if s < 180 or s > 360 then isVisible2 = true
	
	if (isVisible2 = true) then
		GetPoints point, s
		pic.SetColor coloredge(1),coloredge(2),coloredge(3),255
		if (sh=1) then pic.DrawLine point(4) , point(5), point(6) ,point(7)		
	end if

	if (isVisible1 = true) then
		GetPoints point, e
		pic.SetColor coloredge(1),coloredge(2),coloredge(3),255
		if (sh=1) then 
			pic.DrawLine point(4) , point(5), point(6) ,point(7)
		end if		
	end if	

end Function

Sub GetPoints(point, angle)
		xn = ((w/2)*cos((3.14*angle)/180))
		yn = ((h/2)*sin((3.14*angle)/180))		
		
		point(0) = CInt(xc)
		point(1) = CInt(yc)
		point(2) = CInt(xc)
		point(3) = CInt(yc+d)
		point(4) = CInt(xc+xn)
		point(5) = CInt(yc+yn+d)
		point(6) = CInt(xc+xn)
		point(7) = CInt(yc+yn)
End Sub

Sub NewCoords(xto,yto,eto,sto,xnew,ynew)
	amid = CInt((eto+sto)/2)
	xnew = ((exploded)*cos((3.14*amid)/180))+xto
	ynew = ((exploded)*sin((3.14*amid)/180))+yto
	xnew = xto
	ynew = yto
end sub

Figure 1. pieex.gif (size - 1.9 Kb)



home samples purchase documentation download