block.vbs
Sub MakeCoord(s,coords,x,y,w,t,h,a)
Dim c(2,8)
'bottom
c(1,1) = x
c(2,1) = y
c(1,2) = CInt(x+t*cos(a))
c(2,2) = CInt(y-t*sin(a))
c(1,3) = CInt(x+w+t*cos(a))
c(2,3) = CInt(y-t*sin(a))
c(1,4) = x+w
c(2,4) = y
c(1,5) = x
c(2,5) = y-h
c(1,6) = CInt(x+t*cos(a))
c(2,6) = CInt(y-h-t*sin(a))
c(1,7) = CInt(x+w+t*cos(a))
c(2,7) = CInt(y-h-t*sin(a))
c(1,8) = x+w
c(2,8) = y-h
Select case s
case 1 'bottom
coords(0) = c(1,1)
coords(1) = c(2,1)
coords(2) = c(1,2)
coords(3) = c(2,2)
coords(4) = c(1,3)
coords(5) = c(2,3)
coords(6) = c(1,4)
coords(7) = c(2,4)
case 2 'top
coords(0) = c(1,5)
coords(1) = c(2,5)
coords(2) = c(1,6)
coords(3) = c(2,6)
coords(4) = c(1,7)
coords(5) = c(2,7)
coords(6) = c(1,8)
coords(7) = c(2,8)
case 3 'back
coords(0) = c(1,2)
coords(1) = c(2,2)
coords(2) = c(1,6)
coords(3) = c(2,6)
coords(4) = c(1,7)
coords(5) = c(2,7)
coords(6) = c(1,3)
coords(7) = c(2,3)
case 4 'left
coords(0) = c(1,1)
coords(1) = c(2,1)
coords(2) = c(1,5)
coords(3) = c(2,5)
coords(4) = c(1,6)
coords(5) = c(2,6)
coords(6) = c(1,2)
coords(7) = c(2,2)
case 5 'right
coords(0) = c(1,3)
coords(1) = c(2,3)
coords(2) = c(1,4)
coords(3) = c(2,4)
coords(4) = c(1,8)
coords(5) = c(2,8)
coords(6) = c(1,7)
coords(7) = c(2,7)
case 6 'front
coords(0) = c(1,1)
coords(1) = c(2,1)
coords(2) = c(1,5)
coords(3) = c(2,5)
coords(4) = c(1,8)
coords(5) = c(2,8)
coords(6) = c(1,4)
coords(7) = c(2,4)
end select
end Sub
'====================================
'background
'====================================
Function background(x,y,w,t,h,a)
Dim coords(100)
'bottom
MakeCoord 1,coords,x,y,w,t,h,a
im.SetAlphaColor 215,215,215,alpha
im.DrawFilledPolygon coords, 8
'back
im.SetAlphaColor 215,215,215,alpha
MakeCoord 3,coords,x,y,w,t,h,a
im.DrawFilledPolygon coords, 8
im.SetAlphaColor 0,0,0,0
im.DrawLine coords(6),coords(7),coords(0),coords(1)
'left
im.SetAlphaColor 215,215,215,alpha
MakeCoord 4,coords,x,y,w,t,h,a
im.DrawFilledPolygon coords, 8
im.SetAlphaColor 0,0,0,0
im.DrawLine coords(4),coords(5),coords(6),coords(7)
im.DrawLine coords(0),coords(1),coords(6),coords(7)
end function
'================================================
'========================================
'Draw chart
'========================================
Function cub(x,y,w,h,t,a)
Dim coords(100)
for s=1 to 6
MakeCoord s,coords,x,y,w,t,h,a
im.SetAlphaColor d(2,j),d(3,j),d(4,j),alpha
im.DrawFilledPolygon coords, 8
next
end function
'================================================
' main
'================================================
Dim im
Set im = CreateObject("ActiveImage.Images.1")
alpha = 32
angle = 3.14/6
w = 10
h = 15
t = 7
st = 22
im.CreateImage 300,170
im.SetAlphaBlending 0
im.SetAlphaColor 127,255,255,alpha
im.Fill 0,0
im.SetAlphaBlending 1
background 25,148,200,55,90,angle
Dim d(4,8)
For i = 1 to 8
d(1,i) = CInt(RND*100)
d(2,i) = CInt(RND*255)
d(3,i) = CInt(RND*255)
d(4,i) = CInt(RND*255)
next
for j = 1 to 8
im.SetAlphaColor d(2,j),d(3,j),d(4,j),alpha
cub 50+j*st,132,w,d(1,j),t,angle
next
For i = 1 to 8
RANDOMIZE
d(1,i) = CInt(RND()*100)
d(2,i) = CInt(RND(2)*255)
d(3,i) = CInt(RND(3)*255)
d(4,i) = CInt(RND(4)*255)
next
for j = 1 to 8
im.SetAlphaColor d(2,j),d(3,j),d(4,j),alpha
cub 35+j*st,142,w,d(1,j),t,angle
next
'Draw Labels
im.SetAlphaColor 0,0,0,alpha
im.DrawText 35,150,"Diagram 1. Active Image v4.25"
im.SetAlphaBlending 1
'im.SetFontPathTTF "C:\WINNT\FONTS"
im.SetFontPathTTFAuto
im.SetFontTTF "ariblk"
im.SetFontSizeTTF 24
im.SetAlphaColor 0, 31, 191,0
im.DrawTextAngleTTF 30, 25 ,0, "Active Image"
im.SetSaveAlpha 0
im.WriteToFile "C:\block.png"
im.ConvertToPalette
im.WriteToFile "C:\blockt.png"
im.DestroyImage
Set im = Nothing
|
 |
 |
Picture 1. block.png (size - 4 Kb) |
Picture 2. blockt.png (size - 2 Kb) |
|