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) |