I like your routines, but I believe the functions are only producing perfect results when drawing an opaque layer at the top. Give me a hint if this is correct (I only made a quick test replacing all occurrences of $FF by $80...
I need transparent shapes, maybe the following example makes this a little bit clearer:
Code:
Procedure Min(a,b)
If a<b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure AddPathRoundBox(x.d,y.d,w.d,h.d,radius.d,flags=#PB_Path_Default)
If radius>h/2 : radius=h/2 : EndIf
If radius>w/2 : radius=w/2 : EndIf
If radius<0
radius=0
EndIf
MovePathCursor(x+radius,y,flags)
AddPathArc(w-radius,0,w-radius,radius,radius,#PB_Path_Relative)
AddPathArc(0,h-radius,-radius,h-radius,radius,#PB_Path_Relative)
AddPathArc(-w+radius,0,-w+radius,-radius,radius,#PB_Path_Relative)
AddPathArc(0,-h+radius,radius,-h+radius,radius,#PB_Path_Relative)
ClosePath()
MovePathCursor(-radius,0,#PB_Path_Relative)
EndProcedure
Procedure AddPathHighlight(x.d,y.d,w.d,h.d,r.d,angle.d,flags=#PB_Path_Default)
Protected t1.d,t2.d,t3.d,t4.d,t5.d
t1=Cos(angle*#PI/180); 1-89°
t2=Sin(angle*#PI/180)
t3=r*t1
t4=r*t2
t5=2*r-t4
MovePathCursor(x,y+r,flags)
AddPathCircle(r,0,r,180,270,#PB_Path_Relative)
AddPathLine(w-r*2,0,#PB_Path_Relative)
AddPathCircle(0,r,r,270,270+angle,#PB_Path_Relative|#PB_Path_Connected)
AddPathLine(-w+t5,0,#PB_Path_Relative)
AddPathCircle(0,t3,t3,270,180,#PB_Path_Relative|#PB_Path_Connected|#PB_Path_CounterClockwise)
AddPathLine(0,h-t5,#PB_Path_Relative)
AddPathCircle(t3,-t4,r,180-angle,180,#PB_Path_Relative|#PB_Path_Connected)
ClosePath()
EndProcedure
Procedure AddPathShadow(x.d,y.d,w.d,h.d,r.d,angle.d,flags=#PB_Path_Default)
Protected ro.d
Protected t1.d,t2.d,t3.d,t4.d,t5.d
ro=Min(Min(r,h/2),w/2)
t1=Cos(angle*#PI/180); 1-89°
t2=Sin(angle*#PI/180)
t3=r*t1
t4=r*t2
t5=2*r-t4
r=ro
Debug ro
MovePathCursor(x+w,y+h-r,flags)
AddPathCircle(-r,0,r,0,90,#PB_Path_Relative)
AddPathLine(-w+r*2,0,#PB_Path_Relative)
AddPathCircle(0,-r,r,90,90+angle,#PB_Path_Relative|#PB_Path_Connected)
AddPathLine(w-t5,0,#PB_Path_Relative)
AddPathCircle(0,-t3,t3,90,0,#PB_Path_Relative|#PB_Path_Connected|#PB_Path_CounterClockwise)
AddPathLine(0,-h+t5,#PB_Path_Relative)
AddPathCircle(-t3,t4,r,360-angle,360,#PB_Path_Relative|#PB_Path_Connected)
ClosePath()
EndProcedure
Procedure boxs(x,y,w,h,radius,col,extra=8)
AddPathRoundBox(x,y,w,h,radius)
VectorSourceColor($a0000000|col)
FillPath(#PB_Path_Preserve)
VectorSourceColor($60000000)
StrokePath(1)
VectorSourceColor($40ffffff)
AddPathHighlight(x,y,w,h,radius,extra*2)
FillPath()
AddPathHighlight(x,y,w,h,radius,extra*3)
FillPath()
VectorSourceColor($20000000)
AddPathShadow(x,y,w,h,radius,extra*2)
FillPath()
AddPathShadow(x,y,w,h,radius,extra*3)
FillPath()
; Debug "Data.i "+Str(boxnr)+", "+Str(x)+","+Str(y)+", "+Str(w)+","+Str(h)+"; "+Str(size)
EndProcedure
Procedure show()
Protected i
StartVectorDrawing(CanvasVectorOutput(0))
AddPathBox(0,0,VectorOutputWidth(),VectorOutputHeight())
VectorSourceColor($Ff000000|#White)
FillPath()
AddPathBox(100,150,450,250)
VectorSourceColor($400000f0)
FillPath()
boxs(50,50,300,200,90,$F3D1AD)
boxs(50,350,300,100,40,$F3D1AD,20); smaller radius
boxs(400,100,300,100,90,$9AF0B8)
boxs(500,250,100,300,90,$9AF0B8,20)
StopVectorDrawing()
EndProcedure
Procedure main()
#X=800
#Y=600
OpenWindow(0,0,0,#X,#Y,"")
CanvasGadget(0,0,0,#X,#Y)
show()
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
Case #WM_CHAR
End
EndSelect
ForEver
EndProcedure
main()
And that's what I am able to produce with your code:
Code:
Macro doevents
Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
EndMacro
Macro VFill(c,flag=#PB_Path_Default)
VectorSourceColor($20000000|(c&$FFFFFF))
FillPath(flag)
EndMacro
Macro vcolor(c)
VectorSourceColor(c)
EndMacro
Procedure SortIdx(Array t.l(1),Array idx.l(1),deb=0, fin=-1) ;<= met dans le tableau idx() la position des element trié du tableau t()
Protected min,i,j,v,idmin
If fin=-1: fin=ArraySize(t()):EndIf
Dim idx(fin)
For i=deb To fin:idx(i)=i:Next
For i=deb To fin
min=$7fffffff
For j=i To fin
v=t(idx(j))
If v<min:min=v:idmin=j:EndIf
Next
Swap idx(i),idx(idmin)
Next
EndProcedure
Procedure initIF(image,centerX.w=-1,centerY.w=-1)
;image : numero de l'image
;centerx/y : definit le centre de l'image
Structure IFsij
i.b
j.b
EndStructure
Protected i,j,n,di,dj
Protected idx=ImageWidth (image)
Protected idy=ImageHeight(image)
Protected Dim IFdis.l(idx * idy-1)
Global IFcenterx
If centerX=-1:IFcenterx=idx/2:Else:IFcenterx=centerx:EndIf
Global IFcenterY
If centery=-1:IFcentery=idy/2:Else:IFcentery=centery:EndIf
Global Dim IFidx.l(idx * idy-1)
Global Dim IFbmp.l(idx-1,idy-1)
Global Dim IFpos.IFsij(idx * idy-1)
StartDrawing(ImageOutput(image))
DrawingMode(#PB_2DDrawing_AllChannels)
For j=0 To idy-1
For i=0 To idx-1
IFbmp(i,j)=Point(i,j)
IFpos(n)\i=i:di=i-IFcenterx
IFpos(n)\j=j:dj=j-IFcentery
;IFdis(n)=di*di+dj*dj
IFdis(n)=Abs(di)+Abs(dj)
n+1
Next
Next
StopDrawing()
sortidx(IFdis(),IFidx())
EndProcedure
Procedure FillPathBrush(image,centerX.w=-1,centerY.w=-1)
initIF(image,centerX,centerY)
Protected s.s=PathSegments()
Protected n,nn=ArraySize(IFidx())
ResetPath()
For n=0 To nn
With IFpos(IFidx(nn-n))
If Alpha(IFbmp(\i,\j))
MovePathCursor(\i-ifcenterX+1,\j-ifcentery+1)
AddPathSegments(s,#PB_Path_Relative)
Vfill(IFbmp(\i,\j))
EndIf
EndWith
Next
EndProcedure
Procedure exemple()
EnableExplicit
Protected i,j,n, a.f,y, idx=800,idy=600
For n=0 To 7
CreateImage(10+n,16,16,32,#PB_Image_Transparent)
StartVectorDrawing(ImageVectorOutput(10+n))
Select n
Case 0
VectorSourceCircularGradient(8-3,8-3,10)
VectorSourceGradientColor($ffffffff, 0.0)
VectorSourceGradientColor($ffffaaaa, 0.4)
VectorSourceGradientColor($ff886666, 1.0)
VectorSourceGradientColor($00886666, 1.0)
AddPathCircle(8,8,7):FillPath()
EndSelect
StopVectorDrawing()
Next
CreateImage(0,idx,idy,32,#White)
StartVectorDrawing(ImageVectorOutput(0))
AddPathBox(480,100,100,260)
VectorSourceColor($6000ff00)
FillPath()
y=i*72+10
MovePathCursor(0,30+y)
;DrawVectorImage(ImageID(10+i))
AddPathBox(380,200,200,60)
FillPathBrush(10+i)
StopVectorDrawing()
OpenWindow(0, 0, 0, idx, idy, "VectorDrawing-Brush", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ImageGadget(0, 0, 0, idx, idy,ImageID(0))
doevents
EndProcedure
exemple()