ProgressCircle (for Linux/Windows & Mac.. I guess))

walker · Post by **walker** » Wed Mar 12, 2008 2:38 pm

something I needed for myself... I hope, this is usefull for someone (though this ProgressCircle isn't optimized nor perfect)
just a little math and some 2D drawing... that's all .. and the best... it's crossplattform

an image:

and here's the source:

Code: Select all

; ProgressCircle
; 2008 by walker
; free for everyone and any purposes
; enhancements made by others must be published and posted in the same PB-Forum ;-)
;--------------------------------------------


Procedure ProgressCircle(number.l,x.l,y.l,size.l,segments.l,fg.l,bg.l)
    img=CreateImage(0,size,size)
    StartDrawing(ImageOutput(0))
    FillArea(0,0,1,bg)
    Circle(size/2,size/2,size/2,fg)
    Circle(size/2,size/2,size/2-10,bg)    
    t2=(segments/4);steps 
    t3=size/t2; width per step
    For n = 0 To t2
        LineXY(n*t3,0,size-(n*t3),size,bg)     
        LineXY(size,n*t3,0,size-(n*t3),bg)             
    Next
    StopDrawing()
    ImageGadget(number,x,y,size,size,ImageID(0))
EndProcedure

Procedure SetProgressCircleState(progressbar.l,segments.l, state.l, text.s , color.l, bg.l)
LoadFont(0,"sans",8)
StartDrawing(ImageOutput(0))

If text.s<>""
    BackColor(bg)
    DrawingFont(FontID(0))
    DrawText(ImageWidth(0)/2-(TextWidth(text)/2)-4,(ImageWidth(0)/2-5),"       ")
    DrawText(ImageWidth(0)/2-(TextWidth(text)/2),(ImageWidth(0)/2-5),text)
EndIf   
t2=(segments/4)
t3=ImageWidth(0)/t2
size=ImageWidth(0)

beta.d=(360/segments)*(state)
beta_h.d=(360/segments)/2
beta=beta-beat_h-90
x=ImageWidth(0)/2
y=ImageWidth(0)
cx=ImageWidth(0)/2
cy=ImageWidth(0)/2
r=ImageWidth(0)/2
r-3

beta_in_rad.d=(beta/180)*#PI
x1 = cx+r * Cos(beta_in_rad);
y1 = cy+r * Sin(beta_in_rad);

FillArea(x1,y1,bg,color)
StopDrawing()
SetGadgetState(progressbar,ImageID(0))

While WindowEvent():Wend
ProcedureReturn 1
EndProcedure

;---- DEMO -----<

bg=$D2D8C3; backgroundcolor
fg=$AAB68F; initial color of the circle
stp=12; values  4 , (8,9,10 = 10); 12; 18; 22; 28 for other values the drawing procedure must be changed (and I have no time at present)
size=50;20 is minimum;  maximum... your screen ;-)

OpenWindow(0,0,0,210,210,"ProgressCircle DEMO")
CreateGadgetList(WindowID(0))
ProgressCircle(0,70,70,size,stp,fg,bg)

r=10
g=150
b=10
count=0
Repeat
    For m= 1 To stp
        SetProgressCircleState(0,stp,m,"",RGB(r, g, b),bg)
        Delay(100)
    Next
    count+1
    r+20
    g+20
    b+10
    If r >240 Or g>240 Or  b>240
        r=Random(255)
        g=Random(255)
        b=Random(255)
    EndIf
Until WaitWindowEvent(1)=#PB_Event_CloseWindow Or count=10
End

there is plenty room for optimisations.... (i.e the drawing procedure could be fine-tuned to allow other values than listed in the source)

Enjoy!

rsts · Post by **rsts** » Wed Mar 12, 2008 6:55 pm

Very nice

These things always come in handy.
Thanks for sharing.

cheers

ebs · Post by **ebs** » Thu Mar 13, 2008 3:13 pm

walker,

What a coincidence!

This is exactly like the progress indicator on the Microsoft SQL Server Management Studio program (even their program names are long!),
and I've been wanting to make one like it. Thanks for doing the work for me!

There was one error I noticed in this line:

Code: Select all

beta=beta-beat_h-90

"beat_h" should be "beta_h".

I hope you don't mind, but I made modifications to simplify some of your math and adjust a few cosmetic things.
I left your original code in the comments. Here's my update:

Code: Select all

; ProgressCircle
; 2008 by walker
; modifications by ebs
; free for everyone and any purposes
; enhancements made by others must be published and posted in the same PB-Forum ;-)
;--------------------------------------------


Procedure ProgressCircle(number.l,x.l,y.l,Size.l,segments.l,fg.l,bg.l)
  img=CreateImage(0,Size,Size)
  StartDrawing(ImageOutput(0))
  Box(0,0,Size,Size,bg)
  ;FillArea(0,0,1,bg)
  radius.l = Size/2
  Circle(radius,radius,radius,fg)
  Circle(radius,radius,radius-8,bg)   
  ;Circle(Size/2,Size/2,Size/2,fg)
  ;Circle(Size/2,Size/2,Size/2-8,bg)   
  t2=(segments/4);steps
  ;t3=Size/t2; width per step
  For n = 0 To t2
    Pos.l = n*(Size/t2)
    LineXY(Pos,0,Size-Pos,Size,bg)     
    LineXY(Size,Pos,0,Size-Pos,bg)             
    ;LineXY(n*t3,0,Size-(n*t3),Size,bg)     
    ;LineXY(Size,n*t3,0,Size-(n*t3),bg)             
  Next
  StopDrawing()
  ImageGadget(number,x,y,Size,Size,ImageID(0))
EndProcedure

Procedure SetProgressCircleState(progressbar.l,segments.l, state.l, Text.s , color.l, bg.l)
  LoadFont(0,"sans",8)
  StartDrawing(ImageOutput(0))
  
  IW2.l = ImageWidth(0)/2

  If Text
  ;If Text.s<>""
    ;BackColor(bg)
    DrawingFont(FontID(0))
    TW2.l = TextWidth(Text)/2
    TH2.l = TextHeight(Text)/2
    DrawText(IW2-TW2-4,IW2-TH2,"       ",color,bg)
    ; use circle color for text
    DrawText(IW2-TW2,IW2-TH2,Text,color,bg)
    ;DrawText(ImageWidth(0)/2-(TextWidth(Text)/2)-4,(ImageWidth(0)/2-5),"       ")
    ;DrawText(ImageWidth(0)/2-(TextWidth(Text)/2),(ImageWidth(0)/2-5),Text)
  EndIf   
  ;t2=(segments/4)
  ;t3=ImageWidth(0)/t2
  ;Size=ImageWidth(0)
  
  ;beta.d=(360/segments)*(state)
  ;beta_h.d=(360/segments)/2
  ;beta=beta-beat_h-90
  
  ;x=ImageWidth(0)/2
  ;y=ImageWidth(0)
  ;cx=ImageWidth(0)/2
  ;cy=ImageWidth(0)/2
  ;r=ImageWidth(0)/2
  ;r-3
  
  ; adjust angle so first segment is at top of circle
  beta_in_rad.d = (2*#PI*state)/segments - #PI/2
  ;beta_in_rad.d=(beta/180)*#PI
  ;beta_in_rad.d=(beta/180)*#PI
  x1 = IW2 + (IW2-3)*Cos(beta_in_rad)
  y1 = IW2 + (IW2-3)*Sin(beta_in_rad)
  ;x1 = cx+r * Cos(beta_in_rad);
  ;y1 = cy+r * Sin(beta_in_rad);
  
  FillArea(x1,y1,bg,color)
  StopDrawing()
  SetGadgetState(progressbar,ImageID(0))
  
  While WindowEvent():Wend
  ProcedureReturn 1
EndProcedure

;---- DEMO -----<

bg=$D2D8C3; backgroundcolor
fg=$AAB68F; initial color of the circle
stp=12; values  4 , (8,9,10 = 8); 12; 18; 22; 28 for other values the drawing procedure must be changed (and I have no time at present)
Size=50;20 is minimum;  maximum... your screen ;-)

OpenWindow(0,0,0,210,210,"ProgressCircle DEMO")
CreateGadgetList(WindowID(0))
ProgressCircle(0,70,70,Size,stp,fg,bg)

r=10
g=150
b=10
count=0
Repeat
  For m= 1 To stp
    SetProgressCircleState(0,stp,m,Str(m),RGB(r, g, b),bg)
    ;SetProgressCircleState(0,stp,m,"",RGB(r, g, b),bg)
    Delay(100)
  Next
  count+1
  r+20
  g+20
  b+10
  If r >240 Or g>240 Or  b>240
    r=Random(255)
    g=Random(255)
    b=Random(255)
  EndIf
Until WaitWindowEvent(1)=#PB_Event_CloseWindow Or count=10
End

Regards,
Eric

walker · Post by **walker** » Thu Mar 13, 2008 7:17 pm

Hi ebs,

..well done..

that's the way I want it to be developed.. each modifications should be posted here... (is it realy like the one from the MS blahblah....? I don't know the programm.. I almost work on Linux)

In the next version (done by someone - everyone is invited) the commented lines could be removed and new (changed) lines could be commented... so we get a gadget becoming better and better

(I know that some of my math could be optimized... I'd calculated some things too often instead of one time :roll: .. but I wrote this little procedures strait down as they come in my mind

)
and there were some unnecessary lines ....

AND I should use Enable Explicit

Demivec · Post by **Demivec** » Thu Mar 13, 2008 7:32 pm

walker wrote:AND I should use Enable Explicit

Added EnableExplicit.

Added generalization so that it can be used with any gadget#. Image# for the ImageGadget is also generalized, using #pb_any and stored as data with the gadget. The font number is also generalized and the font is only loaded once, not with each call. These modifications allow more than one gadget to display a progressBar (each with the same font).

Improved event monitoring in demo so that the window can be closed before the program finishes normally.

Looking for ways to improve the segmentation and progress update, so that more size and segment variation is possible (i.e. 8 segments doesn't currently work).

Code: Select all

; ProgressCircle
; 2008 by walker
; modifications by ebs
; modifications by Demivec
; free for everyone and any purposes
; enhancements made by others must be published and posted in the same PB-Forum ;-)
;--------------------------------------------
EnableExplicit

Procedure ProgressCircle(gadgetNumber.l,x.l,y.l,Size.l,segments.l,fg.l,bg.l)
  Protected radius.l,T2.l,Pos.l,n.l,img.l
  
  img = CreateImage(#PB_Any,Size,Size)
  StartDrawing(ImageOutput(img))
  Box(0,0,Size,Size,bg)
  radius = Size/2
  Circle(radius,radius,radius,fg)
  Circle(radius,radius,radius-8,bg)   
  T2=(segments/4);steps
  For n = 1 To T2
    ;For n = 0 To T2
    Pos = n*(Size/T2)
    LineXY(Pos,0,Size-Pos,Size,bg)     
    LineXY(Size,Pos,0,Size-Pos,bg)             
  Next
  StopDrawing()
  ImageGadget(gadgetNumber,x,y,Size,Size,ImageID(img))
  SetGadgetData(gadgetNumber, img) ;store #image with gadget
EndProcedure

Procedure SetProgressCircleState(progressbar.l,segments.l, state.l, Text.s , COLOR.l, bg.l)
  Static progCirc_font.l
  Protected IW2.l,TW2.l,TH2.l,x.l,y.l
  Protected img.l = GetGadgetData(progressbar) ;retrieve stored #image
  Protected beta_in_rad.d
  
  If progCirc_font = 0 ;avoid loading font if it is already loaded
    progCirc_font = LoadFont(#PB_Any,"sans",8)
  EndIf 
  
  StartDrawing(ImageOutput(img))
  
  IW2.l = ImageWidth(img)/2
  
  If Text
    DrawingFont(FontID(progCirc_font))
    TW2 = TextWidth(Text)/2
    TH2 = TextHeight(Text)/2
    DrawText(IW2-TW2-4,IW2-TH2,"       ",COLOR,bg)
    ; use circle color for text
    DrawText(IW2-TW2,IW2-TH2,Text,COLOR,bg)
  EndIf   
  
  ; adjust angle so first segment is at top of circle
  beta_in_rad = (2*#PI*state)/segments - #PI/2
  x = IW2 + (IW2-3)*Cos(beta_in_rad)
  y = IW2 + (IW2-3)*Sin(beta_in_rad)
  
  FillArea(x,y,bg,COLOR)
  StopDrawing()
  SetGadgetState(progressbar,ImageID(img))
  
  While WindowEvent():Wend
  ProcedureReturn 1
EndProcedure

;---- DEMO -----<
Define.l bg,fg,stp,Size,r,g,b,count,m
Define.l Event

bg=$D2D8C3; backgroundcolor
fg=$AAB68F; initial color of the circle
stp=12; values  4 , (8,9,10 = 8); 12; 18; 22; 28 for other values the drawing procedure must be changed (and I have no time at present)
Size=50;20 is minimum;  maximum... your screen ;-)

OpenWindow(0,0,0,210,210,"ProgressCircle DEMO",#PB_Window_SystemMenu | #PB_Window_SizeGadget)
CreateGadgetList(WindowID(0))
ProgressCircle(0,70,70,Size,stp,fg,bg)

r=10
g=150
b=10
count=0
Repeat
  For m= 1 To stp
    SetProgressCircleState(0,stp,m,Str(m),RGB(r, g, b),bg)
    Delay(100)
    Event = WindowEvent() 
    While Event ;improved event catcher for demo
      If Event = #PB_Event_CloseWindow
        Break 2
      EndIf
      Event=WindowEvent()
    Wend 
  Next
  count+1
  r+20
  g+20
  b+10
  If r >240 Or g>240 Or  b>240
    r=Random(255)
    g=Random(255)
    b=Random(255)
  EndIf
Until Event =#PB_Event_CloseWindow Or count=10
End

Amnesty · Post by **Amnesty** » Thu Mar 13, 2008 8:54 pm

Great job!

It's almost the progress circle from SQL Server, indeed.

Has anyone a solution how to make the background transparent in MS Windows ?

ebs · Post by **ebs** » Thu Mar 13, 2008 9:31 pm

OK, here's the next installment!

I rewrote the drawing code for the radial lines and filling the segment. My changes are marked with (ebs).

Now any number of segments evenly divisible by 4 can be used. Anything from 4 to 32 looks OK.

Code: Select all

; ProgressCircle
; 2008 by walker
; modifications by ebs
; modifications by Demivec
; more modifications by ebs
; free for everyone and any purposes
; enhancements made by others must be published and posted in the same PB-Forum ;-)
;--------------------------------------------
EnableExplicit

Procedure ProgressCircle(gadgetNumber.l,x.l,y.l,Size.l,segments.l,fg.l,bg.l)
  Protected radius.l,n.l,x2.l,y2.l,img.l, beta_in_rad.d ; (ebs)
  
  img = CreateImage(#PB_Any,Size,Size)
  StartDrawing(ImageOutput(img))
  Box(0,0,Size,Size,bg)
  radius = Size/2
  Circle(radius,radius,radius,fg)
  Circle(radius,radius,radius-8,bg)   

  ; draw radial lines (ebs)
  For n = 0 To segments-1
    beta_in_rad = (2*#PI*n)/segments
    x2.l = radius *(1 + Cos(beta_in_rad))
    y2.l = radius *(1 + Sin(beta_in_rad))
    LineXY(radius,radius,x2,y2,bg)
  Next
  ; (ebs)

  StopDrawing()
  ImageGadget(gadgetNumber,x,y,Size,Size,ImageID(img))
  SetGadgetData(gadgetNumber, img) ;store #image with gadget
EndProcedure

Procedure SetProgressCircleState(progressbar.l,segments.l, state.l, Text.s , color.l, bg.l)
  Static progCirc_font.l
  Protected IW2.l,TW2.l,TH2.l,x.l,y.l
  Protected img.l = GetGadgetData(progressbar) ;retrieve stored #image
  Protected beta_in_rad.d
  
  If progCirc_font = 0 ;avoid loading font if it is already loaded
    progCirc_font = LoadFont(#PB_Any,"sans",8)
  EndIf
  
  StartDrawing(ImageOutput(img))
  
  IW2.l = ImageWidth(img)/2
  
  If Text
    DrawingFont(FontID(progCirc_font))
    TW2 = TextWidth(Text)/2
    TH2 = TextHeight(Text)/2
    DrawText(IW2-TW2-4,IW2-TH2,"       ",color,bg)
    ; use circle color for text
    DrawText(IW2-TW2,IW2-TH2,Text,color,bg)
  EndIf   
  
  ; adjust angle so first segment is at top of circle (ebs)
  state - 1
  beta_in_rad.d = (2*#PI*state)/segments - #PI/2
  ; calculate point on radius
  x = IW2 + (IW2 - 4)*Cos(beta_in_rad)
  y = IW2 + (IW2 - 4)*Sin(beta_in_rad)
  
  ; nudge fill point into adjacent segment
  If state < segments/4
    x + 2
    y + 2
  ElseIf state < segments/2
    x - 2
    y + 2
  ElseIf state < 3*segments/4
    x - 2
    y - 2
  Else
    x + 2
    y - 2 
  EndIf 
  ; (ebs)
  
  FillArea(x,y,bg,color)
  
  StopDrawing()
  SetGadgetState(progressbar,ImageID(img))
  
  While WindowEvent():Wend
  ProcedureReturn 1
EndProcedure

;---- DEMO -----<
Define.l bg,fg,stp,Size,r,g,b,count,m
Define.l event

bg=$D2D8C3; backgroundcolor
fg=$AAB68F; initial color of the circle
stp=16; values must be multiples of 4, anything from 4 to 32 works OK (ebs)
Size=50;20 is minimum;  maximum... your screen ;-)

OpenWindow(0,0,0,210,210,"ProgressCircle DEMO",#PB_Window_SystemMenu | #PB_Window_SizeGadget)
CreateGadgetList(WindowID(0))
ProgressCircle(0,70,70,Size,stp,fg,bg)

r=10
g=150
b=10
count=0
Repeat
  For m= 1 To stp
    SetProgressCircleState(0,stp,m,Str(m),RGB(r, g, b),bg)
    Delay(100)
    event = WindowEvent()
    While event ;improved event catcher for demo
      If event = #PB_Event_CloseWindow
        Break 2
      EndIf
      event=WindowEvent()
    Wend
  Next
  count+1
  r+20
  g+20
  b+10
  If r >240 Or g>240 Or  b>240
    r=Random(255)
    g=Random(255)
    b=Random(255)
  EndIf
Until event =#PB_Event_CloseWindow Or count=10
End

Regards,
Eric

ebs · Post by **ebs** » Fri Mar 14, 2008 2:41 am

Two small changes:

1. In ProgressCircle(), change

Code: Select all

Circle(radius,radius,radius-8,bg)

to

Code: Select all

   Circle(radius,radius,2*radius/3,bg)

2. In SetProgressCircleState(), chgange

Code: Select all

x = IW2 + (IW2 - 4)*Cos(beta_in_rad)
y = IW2 + (IW2 - 4)*Sin(beta_in_rad)

to

Code: Select all

x = IW2 + (IW2 - IW2/6)*Cos(beta_in_rad) 
y = IW2 + (IW2 - IW2/6)*Sin(beta_in_rad)

This will make the thickness of the circle adjust based on the size.

walker · Post by **walker** » Fri Mar 14, 2008 11:17 am

I'm very happy with this "evolution"...

One note: It should be always cross plattform... so if someone adds some API it must be done for all 3 OS... (excluded with a Compilerif if not possible for all OS'es)
with a very small mod (as sometimes the clearing of the text wipes out a bit of the circle):

Code: Select all

; ProgressCircle
; 2008 by walker
; modifications by ebs
; modifications by Demivec
; more modifications by ebs
; modification by walker 14.03.2008
; -------------------------------------------
; free for everyone and any purposes
; enhancements made by others must be published and posted in the same PB-Forum ;-)
;--------------------------------------------
EnableExplicit

Procedure ProgressCircle(gadgetNumber.l,x.l,y.l,Size.l,segments.l,fg.l,bg.l)
  Protected radius.l,n.l,x2.l,y2.l,img.l, beta_in_rad.d ; (ebs)
 
  img = CreateImage(#PB_Any,Size,Size)
  StartDrawing(ImageOutput(img))
  Box(0,0,Size,Size,bg)
  radius = Size/2
  Circle(radius,radius,radius,fg)
  Circle(radius,radius,radius-8,bg)   

  ; draw radial lines (ebs)
  For n = 0 To segments-1
    beta_in_rad = (2*#PI*n)/segments
    x2.l = radius *(1 + Cos(beta_in_rad))
    y2.l = radius *(1 + Sin(beta_in_rad))
    LineXY(radius,radius,x2,y2,bg)
  Next
  ; (ebs)

  StopDrawing()
  ImageGadget(gadgetNumber,x,y,Size,Size,ImageID(img))
  SetGadgetData(gadgetNumber, img) ;store #image with gadget
EndProcedure

Procedure SetProgressCircleState(progressbar.l,segments.l, state.l, Text.s , color.l, bg.l)
  Static progCirc_font.l
  Protected IW2.l,TW2.l,TH2.l,x.l,y.l,sp_to_clear.l
  Protected img.l = GetGadgetData(progressbar) ;retrieve stored #image
  Protected beta_in_rad.d
 
  If progCirc_font = 0 ;avoid loading font if it is already loaded
    progCirc_font = LoadFont(#PB_Any,"sans",8)
  EndIf
 
  StartDrawing(ImageOutput(img))
 
  IW2.l = ImageWidth(img)/2
 
  If Text
    DrawingFont(FontID(progCirc_font))
    TW2 = TextWidth(Text)/2
    TH2 = TextHeight(Text)/2
    sp_to_clear = Len(text)+3 ; to avoid spaces drawn on the circle if using fixed spaces (walker)    
    DrawText(IW2-TW2-4,IW2-TH2,Space(sp_to_clear),color,bg)
    ; use circle color for text
    DrawText(IW2-TW2,IW2-TH2,Text,color,bg)
  EndIf   
 
  ; adjust angle so first segment is at top of circle (ebs)
  state - 1
  beta_in_rad.d = (2*#PI*state)/segments - #PI/2
  ; calculate point on radius
  x = IW2 + (IW2 - 4)*Cos(beta_in_rad)
  y = IW2 + (IW2 - 4)*Sin(beta_in_rad)
 
  ; nudge fill point into adjacent segment
  If state < segments/4
    x + 2
    y + 2
  ElseIf state < segments/2
    x - 2
    y + 2
  ElseIf state < 3*segments/4
    x - 2
    y - 2
  Else
    x + 2
    y - 2
  EndIf
  ; (ebs)
 
  FillArea(x,y,bg,color)
 
  StopDrawing()
  SetGadgetState(progressbar,ImageID(img))
 
  While WindowEvent():Wend
  ProcedureReturn 1
EndProcedure

;---- DEMO -----<
Define.l bg,fg,stp,Size,r,g,b,count,m
Define.l event

bg=$D2D8C3; backgroundcolor
fg=$AAB68F; initial color of the circle
stp=16; values must be multiples of 4, anything from 4 to 32 works OK (ebs)
Size=50;20 is minimum;  maximum... your screen ;-)

OpenWindow(0,0,0,210,210,"ProgressCircle DEMO",#PB_Window_SystemMenu | #PB_Window_SizeGadget)
CreateGadgetList(WindowID(0))
ProgressCircle(0,70,70,Size,stp,fg,bg)

r=10
g=150
b=10
count=0
Repeat
  For m= 1 To stp
    SetProgressCircleState(0,stp,m,Str(m),RGB(r, g, b),bg)
    Delay(100)
    event = WindowEvent()
    While event ;improved event catcher for demo
      If event = #PB_Event_CloseWindow
        Break 2
      EndIf
      event=WindowEvent()
    Wend
  Next
  count+1
  r+20
  g+20
  b+10
  If r >240 Or g>240 Or  b>240
    r=Random(255)
    g=Random(255)
    b=Random(255)
  EndIf
Until event =#PB_Event_CloseWindow Or count=10
End

ebs · Post by **ebs** » Fri Mar 14, 2008 1:43 pm

walker,

I changed the code that clears the text to use a circle and not bother with spaces.
I also made the text font bold and adjusted its size, so it's easier to see.

Code: Select all

; ProgressCircle
; 2008 by walker
; modifications by ebs
; modifications by Demivec
; more modifications by ebs
; free for everyone and any purposes
; enhancements made by others must be published and posted in the same PB-Forum ;-)
;--------------------------------------------
EnableExplicit

Procedure ProgressCircle(gadgetNumber.l,x.l,y.l,Size.l,segments.l,fg.l,bg.l)
  Protected radius.l,n.l,x2.l,y2.l,img.l, beta_in_rad.d ; (ebs)
  
  img = CreateImage(#PB_Any,Size,Size)
  StartDrawing(ImageOutput(img))
  Box(0,0,Size,Size,bg)
  radius = Size/2
  Circle(radius,radius,radius,fg)
  Circle(radius,radius,2*radius/3,bg) ; [ebs]
  
  ; draw radial lines (ebs)
  For n = 0 To segments-1
    beta_in_rad = (2*#PI*n)/segments
    x2.l = radius *(1 + Cos(beta_in_rad))
    y2.l = radius *(1 + Sin(beta_in_rad))
    LineXY(radius,radius,x2,y2,bg)
  Next
  ; (ebs)

  StopDrawing()
  ImageGadget(gadgetNumber,x,y,Size,Size,ImageID(img))
  SetGadgetData(gadgetNumber, img) ;store #image with gadget
EndProcedure

Procedure SetProgressCircleState(progressbar.l,segments.l, state.l, Text.s , color.l, bg.l)
  Static progCirc_font.l
  Protected IW2.l,TW2.l,TH2.l,x.l,y.l
  Protected img.l = GetGadgetData(progressbar) ;retrieve stored #image
  Protected beta_in_rad.d
  
  IW2.l = ImageWidth(img)/2

  If progCirc_font = 0 ;avoid loading font if it is already loaded
    progCirc_font = LoadFont(#PB_Any,"sans",IW2/2,#PB_Font_Bold) ; [ebs] adjust font size and make BOLD
  EndIf
  
  StartDrawing(ImageOutput(img))
   
  If Text
    TH2 = TextHeight(Text)/2
    TW2 = TextWidth(Text)/2
    Circle(IW2,IW2,2*IW2/3,bg) ; [ebs] just clear inner circle, don't bother with spaces 
    ; use circle color for text
    DrawingFont(FontID(progCirc_font))
    DrawText(IW2-TW2,IW2-TH2,Text,color,bg)
  EndIf   
  
  ; adjust angle so first segment is at top of circle (ebs)
  state - 1
  beta_in_rad.d = (2*#PI*state)/segments - #PI/2
  ; calculate point on radius
  x = IW2 + (IW2 - IW2/6)*Cos(beta_in_rad)  ; [ebs]
  y = IW2 + (IW2 - IW2/6)*Sin(beta_in_rad)  ; [ebs]
  
  ; nudge fill point into adjacent segment
  If state < segments/4
    x + 2
    y + 2
  ElseIf state < segments/2
    x - 2
    y + 2
  ElseIf state < 3*segments/4
    x - 2
    y - 2
  Else
    x + 2
    y - 2 
  EndIf 
  ; (ebs)
  
  FillArea(x,y,bg,color)
  
  StopDrawing()
  SetGadgetState(progressbar,ImageID(img))
  
  While WindowEvent():Wend
  ProcedureReturn 1
EndProcedure

;---- DEMO -----<
Define.l bg,fg,stp,Size,r,g,b,count,m
Define.l event

bg=$D2D8C3; backgroundcolor
fg=$AAB68F; initial color of the circle
stp=16; values must be multiples of 4, anything from 4 to 32 works OK (ebs)
Size=50;40 is minimum;  maximum... your screen ;-)

OpenWindow(0,0,0,310,310,"ProgressCircle DEMO",#PB_Window_SystemMenu | #PB_Window_SizeGadget)
CreateGadgetList(WindowID(0))
ProgressCircle(0,70,70,Size,stp,fg,bg)

r=10
g=150
b=10
count=0
Repeat
  For m= 1 To stp
    SetProgressCircleState(0,stp,m,Str(m),RGB(r, g, b),bg)
    Delay(100)
    event = WindowEvent()
    While event ;improved event catcher for demo
      If event = #PB_Event_CloseWindow
        Break 2
      EndIf
      event=WindowEvent()
    Wend
  Next
  count+1
  r+20
  g+20
  b+10
  If r >240 Or g>240 Or  b>240
    r=Random(255)
    g=Random(255)
    b=Random(255)
  EndIf
Until event =#PB_Event_CloseWindow Or count=10
End

Regards,
Eric

walker · Post by **walker** » Fri Mar 14, 2008 3:14 pm

Added a Parameter for the Font-Color
Moved one line (DrawingFont) in front of the lines with the calculation of TextWidth and height...(otherweise the width and heigth of the default-font were used

)

Code: Select all

; ProgressCircle
; 2008 by walker
; modifications by ebs
; modifications by Demivec
; more modifications by ebs
; some enhancements - walker
; free for everyone and any purposes
; enhancements made by others must be published and posted in the same PB-Forum ;-)
;--------------------------------------------
EnableExplicit

Procedure ProgressCircle(gadgetNumber.l,x.l,y.l,Size.l,segments.l,fg.l,bg.l)
  Protected radius.l,n.l,x2.l,y2.l,img.l, beta_in_rad.d ; (ebs)
 
  img = CreateImage(#PB_Any,Size,Size)
  StartDrawing(ImageOutput(img))
  Box(0,0,Size,Size,bg)
  radius = Size/2
  Circle(radius,radius,radius,fg)
  Circle(radius,radius,2*radius/3,bg) ; [ebs]
 
  ; draw radial lines (ebs)
  For n = 0 To segments-1
    beta_in_rad = (2*#PI*n)/segments
    x2.l = radius *(1 + Cos(beta_in_rad))
    y2.l = radius *(1 + Sin(beta_in_rad))
    LineXY(radius,radius,x2,y2,bg)
  Next
  ; (ebs)

  StopDrawing()
  ImageGadget(gadgetNumber,x,y,Size,Size,ImageID(img))
  SetGadgetData(gadgetNumber, img) ;store #image with gadget
EndProcedure

Procedure SetProgressCircleState(progressbar.l,segments.l, state.l, Text.s , color.l, bg.l, textcolor.l)
  Static progCirc_font.l
  Protected IW2.l,TW2.l,TH2.l,x.l,y.l
  Protected img.l = GetGadgetData(progressbar) ;retrieve stored #image
  Protected beta_in_rad.d
 
  IW2.l = ImageWidth(img)/2

  If progCirc_font = 0 ;avoid loading font if it is already loaded    
    progCirc_font = LoadFont(#PB_Any,"sans",IW2/2,#PB_Font_Bold) ; [ebs] adjust font size and make BOLD

  EndIf
 
  StartDrawing(ImageOutput(img))
   
  If Text
    ; use circle color for text
    DrawingFont(FontID(progCirc_font)); moved before the calculation of the sizes... otherwise it's used the defaulr font [walker]
    TH2 = TextHeight(Text)/2
    TW2 = TextWidth(Text)/2
    
    Circle(IW2,IW2,2*IW2/3,bg) ; [ebs] just clear inner circle, don't bother with spaces
    
    DrawText(IW2-TW2,IW2-TH2,Text,textcolor,bg)
  EndIf   
 
  ; adjust angle so first segment is at top of circle (ebs)
  state - 1
  beta_in_rad.d = (2*#PI*state)/segments - #PI/2
  ; calculate point on radius
  x = IW2 + (IW2 - IW2/6)*Cos(beta_in_rad)  ; [ebs]
  y = IW2 + (IW2 - IW2/6)*Sin(beta_in_rad)  ; [ebs]
 
  ; nudge fill point into adjacent segment
  If state < segments/4
    x + 2
    y + 2
  ElseIf state < segments/2
    x - 2
    y + 2
  ElseIf state < 3*segments/4
    x - 2
    y - 2
  Else
    x + 2
    y - 2
  EndIf
  ; (ebs)
 
  FillArea(x,y,bg,color)
 
  StopDrawing()
  SetGadgetState(progressbar,ImageID(img))
 
  While WindowEvent():Wend
  ProcedureReturn 1
EndProcedure

;---- DEMO -----<
Define.l bg,fg,stp,Size,r,g,b,count,m
Define.l event

bg=$D2D8C3; backgroundcolor
fg=$AAB68F; initial color of the circle
stp=32; values must be multiples of 4, anything from 4 to 32 works OK (ebs)
Size=50;40 is minimum;  maximum... your screen ;-)

OpenWindow(0,0,0,310,310,"ProgressCircle DEMO",#PB_Window_SystemMenu | #PB_Window_SizeGadget)
CreateGadgetList(WindowID(0))
ProgressCircle(0,70,70,Size,stp,fg,bg)

r=10
g=150
b=10
count=0
Repeat
  For m= 1 To stp
    SetProgressCircleState(0,stp,m,Str(m),RGB(r, g, b),bg, RGB(236, 200-(m*4), 19)) ; new Parameter added [walker]
    Delay(100)
    event = WindowEvent()
    While event ;improved event catcher for demo
      If event = #PB_Event_CloseWindow
        Break 2
      EndIf
      event=WindowEvent()
    Wend
  Next
  count+1
  r+20
  g+20
  b+10
  If r >240 Or g>240 Or  b>240
    r=Random(255)
    g=Random(255)
    b=Random(255)
  EndIf
Until event =#PB_Event_CloseWindow Or count=10
End

Demivec · Post by **Demivec** » Fri Mar 14, 2008 4:21 pm

One small change.

In SetProgressCircleState(), change

Code: Select all

  ; adjust angle so first segment is at top of circle (ebs)
  state - 1
  beta_in_rad.d = (2*#PI*state)/segments - #PI/2

to

Code: Select all

  ; adjust angle so first segment is at top of circle (ebs)
  state - 1
  state % segments ;[Demivec] allow state to wrap in positive range, allows rotation of the positions of the states clockwise by adding an offset
  beta_in_rad.d = (2*#PI*state)/segments - #PI/2

This limits bad results from bad positve state values (ones larger than the # of segments). It also allows the the positions of all states to be rotated clockwise around the circle by adding an offset (i.e. using "state+4" as the parameter value of state instead of "state", all positions would rotate clockwise by 4 positions). Negative values of state still cause bad effects and should not be used.

Two comments, the font size would have to be adjusted down to "IW2/3" from "IW2/2" to allow room for showing percentages (i.e. "100%") instead of state #''s. This would be necessary to show 4 characters, though there is enough room for 3 digits at the larger size (just no room for "%"). The font might benefit from more than one size. Just a thought question.

@ebs: The # of segments does not have to be a multiple of 4. In testing, it seems other values work well too. I'm not sure what the deciding factor is though. It worked with 2/3 of the values from 1 to 33 at size 50. All values I tested seem to be only limited by the size used.

walker · Post by **walker** » Fri Mar 14, 2008 6:11 pm

Changed the font-size as mentioned by Demivec and make it work on all sizes from 44 (which is the smalles possible size without glitches) on...
Changed the Demo ...

@Demivec: didn't understand what you want to achieve with the line state%segments ,,,,

Code: Select all

; ProgressCircle
; 2008 by walker
; modifications by ebs
; modifications by Demivec
; more modifications by ebs
; some enhancements - walker
; enhancement by Demivec
; free for everyone and any purposes
; enhancements made by others must be published and posted in the same PB-Forum ;-)
;--------------------------------------------
EnableExplicit

Procedure ProgressCircle(gadgetNumber.l,x.l,y.l,Size.l,segments.l,fg.l,bg.l)
  Protected radius.l,n.l,x2.l,y2.l,img.l, beta_in_rad.d ; (ebs)
 
  img = CreateImage(#PB_Any,Size,Size)
  StartDrawing(ImageOutput(img))
  Box(0,0,Size,Size,bg)
  radius = Size/2
  Circle(radius,radius,radius,fg)
  Circle(radius,radius,2*radius/3,bg) ; [ebs]
 
  ; draw radial lines (ebs)
  For n = 0 To segments-1
    beta_in_rad = (2*#PI*n)/segments
    x2.l = radius *(1 + Cos(beta_in_rad))
    y2.l = radius *(1 + Sin(beta_in_rad))
    LineXY(radius,radius,x2,y2,bg)
  Next
  ; (ebs)

  StopDrawing()
  ImageGadget(gadgetNumber,x,y,Size,Size,ImageID(img))
  SetGadgetData(gadgetNumber, img) ;store #image with gadget
EndProcedure

Procedure SetProgressCircleState(progressbar.l,segments.l, state.l, Text.s , color.l, bg.l, textcolor.l)
  Static progCirc_font.l
  Protected IW2.l,TW2.l,TH2.l,x.l,y.l
  Protected img.l = GetGadgetData(progressbar) ;retrieve stored #image
  Protected beta_in_rad.d
 
  IW2.l = ImageWidth(img)/2

  If progCirc_font = 0 ;avoid loading font if it is already loaded    
    progCirc_font = LoadFont(#PB_Any,"sans",IW2/3-1,#PB_Font_Bold) ;[Demivec] reduced the size to make an additional sign (%) fit into the circle
                                                                                                                 ; added -1 to make sure it's working on small circles too
  EndIf
 
  StartDrawing(ImageOutput(img))
   
  If Text
    ; use circle color for text
    DrawingFont(FontID(progCirc_font)); moved before the calculation of the sizes... otherwise it's used the default font [walker]
    TH2 = TextHeight(Text)/2
    TW2 = TextWidth(Text)/2
    
    Circle(IW2,IW2,2*IW2/3,bg) ; [ebs] just clear inner circle, don't bother with spaces
    
    DrawText(IW2-TW2,IW2-TH2,Text,textcolor,bg)
  EndIf   
 
  ; adjust angle so first segment is at top of circle (ebs)
  state -1
  beta_in_rad.d = (2*#PI*state)/segments - #PI/2
  ; calculate point on radius
  x = IW2 + (IW2 - IW2/6)*Cos(beta_in_rad)  ; [ebs]
  y = IW2 + (IW2 - IW2/6)*Sin(beta_in_rad)  ; [ebs]
 
  ; nudge fill point into adjacent segment
  If state < segments/4
    x + 2
    y + 2
  ElseIf state < segments/2 
    x - 2
    y + 2
  ElseIf state < 3*segments/4 
    x - 2
    y - 2
  Else
    x + 2
    y - 2
  EndIf
  ; (ebs)
 
  FillArea(x,y,bg,color)
 
  StopDrawing()
  SetGadgetState(progressbar,ImageID(img))
 
  While WindowEvent():Wend
  ProcedureReturn 1
EndProcedure

;---- DEMO -----<
Define.l bg,fg,stp,Size,r,g,b,count,m
Define.l event

bg=$D2D8C3; backgroundcolor
fg=$AAB68F; initial color of the circle
stp=16 ;values must be multiples of 4, anything from 4 to 32 works OK (ebs)
Size=60 ;44 is minimum;  maximum... your screen ;-)

OpenWindow(0,0,0,310,310,"ProgressCircle DEMO",#PB_Window_SystemMenu | #PB_Window_SizeGadget)
CreateGadgetList(WindowID(0))
ProgressCircle(0,70,70,Size,stp,fg,bg)

r=10
g=150
b=10
count=0
Repeat
  For m= 1 To stp
    SetProgressCircleState(0,stp,m,Str(4+100/stp*m)+ "%",RGB(r, g, b),bg, RGB(236, 200-(m*5), 19))
    Delay(200)
    event = WindowEvent()
    While event ;improved event catcher for demo
      If event = #PB_Event_CloseWindow
        Break 2
      EndIf
      event=WindowEvent()
    Wend
  Next
  count+1
  r+20
  g+20
  b+10
  If r >240 Or g>240 Or  b>240
    r=Random(255)
    g=Random(255)
    b=Random(255)
  EndIf
Until event =#PB_Event_CloseWindow Or count=10
End

ebs · Post by **ebs** » Fri Mar 14, 2008 6:15 pm

@ebs: The # of segments does not have to be a multiple of 4. In testing, it seems other values work well too. I'm not sure what the deciding factor is though. It worked with 2/3 of the values from 1 to 33 at size 50. All values I tested seem to be only limited by the size used.

demivec,

That's interesting...

I think it's just due to the imprecise nature of the circle drawing routines, and my "voodoo" code to get the fill point inside the correct segment.
I think I've reached the end of my limited math ability to improve it further.

Regards,
Eric

walker · Post by **walker** » Fri Mar 14, 2008 9:59 pm

Added the ability to set a particular state i.e. 16 (from32) and the
ability to clear the circle (simply set the color to the initial color)
Made the last Parameter (TextColor) optional
Cleaned up the code a little (removed most comments which are not necessary and reformated it) and enhanced the demo included:

Code: Select all

;- ProgressCircle
;  2008 by walker
; modifications by ebs
; modifications by Demivec
; modifications by walker
;--------------------------------------------
;-free for everyone and any purposes
;-enhancements made by others 
;-must be published and posted in the same PB-Forum ;-)
;-cross plattform ability must be achieved
;--------------------------------------------
EnableExplicit

Procedure ProgressCircle(gadgetNumber.l,x.l,y.l,Size.l,segments.l,fg.l,bg.l)
Protected radius.l,n.l,x2.l,y2.l,img.l, beta_in_rad.d 

img = CreateImage(#PB_Any,Size,Size)
StartDrawing(ImageOutput(img))
Box(0,0,Size,Size,bg)
radius = Size/2
Circle(radius,radius,radius,fg)
Circle(radius,radius,2*radius/3,bg) 

; draw radial lines
For n = 0 To segments-1
    beta_in_rad = (2*#PI*n)/segments
    x2.l = radius *(1 + Cos(beta_in_rad))
    y2.l = radius *(1 + Sin(beta_in_rad))
    LineXY(radius,radius,x2,y2,bg)
Next
StopDrawing()
ImageGadget(gadgetNumber,x,y,Size,Size,ImageID(img))
SetGadgetData(gadgetNumber, img) ;store #image with gadget
EndProcedure

Procedure SetProgressCircleState(progressbar.l,segments.l, state.l, Text.s , color.l, backgroundcolor.l, textcolor.l=0)
Static progCirc_font.l
Protected IW2.l,TW2.l,TH2.l,x.l,y.l
Protected img.l = GetGadgetData(progressbar) ;retrieve stored #image
Protected beta_in_rad.d
Define.l m
  
IW2.l = ImageWidth(img)/2
If progCirc_font = 0 ;avoid loading font if it is already loaded    
    progCirc_font = LoadFont(#PB_Any,"sans",IW2/3-1,#PB_Font_Bold) 
EndIf                                                                                                     
  
StartDrawing(ImageOutput(img))   
If Text
; use circle color for text
    DrawingFont(FontID(progCirc_font));
    TH2 = TextHeight(Text)/2
    TW2 = TextWidth(Text)/2    
    Circle(IW2,IW2,2*IW2/3,backgroundcolor) ; 
    DrawText(IW2-TW2,IW2-TH2,Text,textcolor,backgroundcolor)
EndIf   
 
 ; adjust angle so first segment is at top of circle
state -1
For m= 0 To state; necessary to set a particular state.... AND to clear the circle (set color to initial color and text to 1 space
    beta_in_rad.d = (2*#PI*m)/segments - #PI/2
    ; calculate point on radius
    x = IW2 + (IW2 - IW2/6)*Cos(beta_in_rad) 
    y = IW2 + (IW2 - IW2/6)*Sin(beta_in_rad)  
    
    ; nudge fill point into adjacent segment
    If m < segments/4
        x + 2
        y + 2
    ElseIf m < segments/2 
        x - 2
        y + 2
    ElseIf m < 3*segments/4 
        x - 2
        y - 2
    Else
        x + 2
        y - 2
    EndIf
    FillArea(x,y,backgroundcolor,color)
Next 

StopDrawing()
SetGadgetState(progressbar,ImageID(img))
While WindowEvent():Wend; update the gadget
ProcedureReturn 1
EndProcedure

;---- DEMO -----<
Define.l bg,fg,stp,Size,r,g,b,count,m
Define.l event

bg=$D2D8C3; backgroundcolor
fg=$AAB68F; initial color of the circle
stp=32 ;values must be multiples of 4, anything from 4 to 32 works OK (ebs)
Size=44 ;44 is minimum;  maximum... your screen ;-)

OpenWindow(0,0,0,310,310,"ProgressCircle DEMO",#PB_Window_SystemMenu | #PB_Window_SizeGadget)
CreateGadgetList(WindowID(0))
ProgressCircle(0,70,70,Size,stp,fg,bg)

r=10
g=150
b=10
count=0
Repeat
    For m= 1 To stp
        SetProgressCircleState(0,stp,m,Str(4+100/stp*m)+ "%",RGB(r, g, b),bg, RGB(236, 200-(m*5), 19))
        Delay(200)
        event = WindowEvent()
        While event ;improved event catcher for demo
            If event = #PB_Event_CloseWindow
                Break 2
            EndIf
            event=WindowEvent()
        Wend
    Next
    count+1
    r+20
    g+20
    b+10
    If r >240 Or g>240 Or  b>240
        r=Random(255)
        g=Random(255)
        b=Random(255)
    EndIf
Until event =#PB_Event_CloseWindow Or count=3
SetProgressCircleState(0,stp,stp," ",fg,bg); clear the ProgressCircle....
Delay(3000)
End