PureBasic Forums - English

Posted: **Sun Nov 26, 2006 9:42 pm**

I am a flat gadget style adept, so i made this progressbar. It doesn't require external images, etc. Maybe somebody will find a good use for it

.

Code: Select all

Structure ProgressBarEx
  GadgetID.l
  x.l
  y.l
  w.l
  h.l
  min.l
  max.l
  state.l
EndStructure
 
Global NewList ProgressBarsEx.ProgressBarEx()

Procedure ProgressBarGadgetEx(GadgetID,x,y,w,h,min,max)
 
 AddElement(ProgressBarsEx())
 ProgressBarsEx()\GadgetID.l = GadgetID
 ProgressBarsEx()\x.l = x
 ProgressBarsEx()\y.l = y
 ProgressBarsEx()\w.l = w
 ProgressBarsEx()\h.l = h
 ProgressBarsEx()\min.l = min
 ProgressBarsEx()\max.l = max
 ProgressBarsEx()\state.l = 0
 
 ;Startup Image
 PImage = CreateImage(#PB_Any,w,h)
 StartDrawing(ImageOutput(PImage))
 
  Box(0,0,w,h,RGB(255,255,255))
  Line(0,0,w-1,0,RGB(160,160,160))
  Line(0,0,0,h,RGB(160,160,160))
  Line(1,h-1,w-1,0,RGB(134,134,134))
  Line(w-1,0,0,h,RGB(134,134,134))
  Line(1,1,w-2,0,RGB(225,225,225))
  Line(1,h-2,w-2,0,RGB(169,169,169))
  Line(1,2,0,h-4,RGB(178,178,178))
  Line(w-2,2,0,h-4,RGB(178,178,178))
  Box(2,2,w-4,h-4,RGB(192,192,192))
 
 StopDrawing()
 
 Handle = ImageGadget(GadgetID,x,y,w,h,ImageID(PImage))
 
 If IsImage(PImage)
  FreeImage(PImage)
 EndIf
 
 ProcedureReturn Handle
 
EndProcedure

Procedure SetProgressExBarState(GadgetID.l,State.l)

 If state = 0
  ProcedureReturn
 EndIf

 ForEach ProgressBarsEx()
 
  If ProgressBarsEx()\GadgetID = GadgetID
   ProgressBarsEx()\State = State
   SPImage = CreateImage(#PB_Any,ProgressBarsEx()\w,ProgressBarsEx()\h)
   StartDrawing(ImageOutput(SPImage))
    Box(0,0,ProgressBarsEx()\w,ProgressBarsEx()\h,RGB(255,255,255))
    Line(0,0,ProgressBarsEx()\w-1,0,RGB(160,160,160))
    Line(0,0,0,ProgressBarsEx()\h,RGB(160,160,160))
    Line(1,ProgressBarsEx()\h-1,ProgressBarsEx()\w-1,0,RGB(134,134,134))
    Line(ProgressBarsEx()\w-1,0,0,ProgressBarsEx()\h,RGB(134,134,134))
    Line(1,1,ProgressBarsEx()\w-2,0,RGB(225,225,225))
    Line(1,ProgressBarsEx()\h-2,ProgressBarsEx()\w-2,0,RGB(169,169,169))
    Line(1,2,0,ProgressBarsEx()\h-4,RGB(178,178,178))
    Line(ProgressBarsEx()\w-2,2,0,ProgressBarsEx()\h-4,RGB(178,178,178))
    Box(2,2,ProgressBarsEx()\w-4,ProgressBarsEx()\h-4,RGB(192,192,192))
    
    w = ProgressBarsEx()\w / 100 * ProgressBarsEx()\State
    h = ProgressBarsEx()\h
    
    Line(0,0,w-1,0,RGB(230,136,136))
    Line(0,0,0,h,RGB(230,136,136))
    Line(1,h-1,w-1,0,RGB(143,0,0))
    Line(w-1,0,0,h,RGB(143,0,0))
    Line(1,1,w-2,0,RGB(216,64,64))
    Line(1,h-2,w-2,0,RGB(177,0,0))
    Line(1,2,0,h-4,RGB(211,34,34))
    Line(w-2,2,0,h-4,RGB(211,34,34))
    Box(2,2,w-4,h-4,RGB(204,0,0))
   StopDrawing()

   SetGadgetState(ProgressBarsEx()\GadgetID,ImageID(SPImage))
   If IsImage(SPImage)
    FreeImage(SPImage)
   EndIf
    
  EndIf
  
 Next
 
 ProcedureReturn 0

EndProcedure

Procedure Demo(Dummy.l)

 Repeat
  If Statev = 100
   Statev =0
  EndIf
  SetProgressExBarState(5,Statev)
  Statev + 1
  Delay(10)
 ForEver
 
EndProcedure

If OpenWindow(0, 0, 0, 300, 50, "BitDefender-style progressbar",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
  ProgressBarGadgetEx(5,50,15,200,20,0,100)
  CreateThread(@Demo(),0)
  Repeat
   event = WaitWindowEvent()
  Until event = #PB_Event_CloseWindow
  End
EndIf

Posted: **Sun Nov 26, 2006 9:49 pm**

Where is the difference between yours and the PB ones set to #PB_ProgressBar_Smooth and red color!?

Anyway, thanks for shareing.

Posted: **Sun Nov 26, 2006 10:01 pm**

His has a bit more 3D look to it, worth doing imho. Good job.

Posted: **Sun Nov 26, 2006 10:33 pm**

Thanks!

I'll try to make some real subclassed gadgets after i finish my actual project.

Posted: **Sun Nov 26, 2006 10:44 pm**

looks cool

Posted: **Mon Nov 27, 2006 12:46 am**

Nice one info.

Posted: **Mon Nov 27, 2006 4:30 pm**

Tranquil wrote:Where is the difference between yours and the PB ones set to #PB_ProgressBar_Smooth and red color!?

#PB_ProgressBar_Smooth do not work with XP themes. (always annoys the heck out of me that one can't have smooth api bar

PS! I'm wondering which is fastest, the way the above source do it,
or drawing a full box instead of lines?
Anyone up for the challenge of doing a benchmark test?

Posted: **Mon Nov 27, 2006 4:49 pm**

I really like this one... Gonna put it in my coding procedures folder

Posted: **Mon Nov 27, 2006 6:36 pm**

Inf0Byt3, your avatar is 8686 bytes (8.48 KB). NOT 3 KB

hehehe

Posted: **Mon Nov 27, 2006 9:47 pm**

I could not resist fiddling with the code.

Faster more cpu and resource friendly routine.
The gadget image is reused rather than creating a new one each time.
Simplified the borders a bit, fixed/tweaked the drawing coordinates/size.
You can now choose a bar color, borders will automatically be changed to a matching shade of the color.
Added several validation checks to make the two procedures more solid codewise.
Progressbar can now be reset to a state of 0 as well.
Rounding error prevention, no more graphic glitches possible.
I really should have done some work instead of using time on this stuff
Note! The example may crash when closing the window, this is the fault of the demo procedure/thread and not the progressbar code.

Code: Select all

EnableExplicit

Structure ProgressBarEx
 GadgetID.l
 ImageID.l
 Image.l
 w.l
 h.l
 min.l
 ;max.l ;not used anywhere else in this code
 state.l
 color.l
 colorlight.l
 colordark.l
 resolution.f
EndStructure
 
Global NewList ProgressBarEx.ProgressBarEx()

Procedure ProgressBarExGadget(GadgetID,x,y,w,h,min,max,color)
 Protected r.l,g.l,b.l,Handle.l=#False,PImage.l
 
 If AddElement(ProgressBarEx())
  ProgressBarEx()\GadgetID = GadgetID
  ProgressBarEx()\w = w-4
  ProgressBarEx()\h = h-4
  ProgressBarEx()\min = min
  ;ProgressBarEx()\max = max ;not used anywhere else in this code
  ProgressBarEx()\state = 0
  ProgressBarEx()\resolution = ProgressBarEx()\w / (1.0*(max-min))
  ProgressBarEx()\color = color
  r=Red(color) : g=Green(color) : b=Blue(color)
  ProgressBarEx()\colordark = RGB(r-(r>>2),g-(g>>2),b-(b>>2))
  r=Red(color) : g=Green(color) : b=Blue(color)
  ProgressBarEx()\colorlight = RGB(255-((255-r)>>1),255-((255-g)>>1),255-((255-b)>>1))
  
  ;Startup Image
  PImage = CreateImage(#PB_Any,w,h)
  If IsImage(PImage)
   ProgressBarEx()\ImageID = PImage
   ProgressBarEx()\Image = ImageID(PImage)
   If StartDrawing(ImageOutput(PImage))
   
    ;Gadget background and borders
    Box(0,0,w,h,RGB(255,255,255))
    Line(0,0,w-1,0,RGB(160,160,160))
    Line(0,0,0,h,RGB(160,160,160))
    Line(1,h-1,w-1,0,RGB(134,134,134))
    Line(w-1,0,0,h,RGB(134,134,134))
   
    ;Progressbar background and borders.
    Box(2,2,ProgressBarEx()\w,ProgressBarEx()\h,$CCCCCC) ;RGB(192,192,192)
    Line(1,1,ProgressBarEx()\w+2,0,$DDDDDD)
    Line(1,2,0,ProgressBarEx()\h+1,$DDDDDD)
    Line(1,ProgressBarEx()\h+2,ProgressBarEx()\w+2,0,$BBBBBB)
    Line(ProgressBarEx()\w+2,2,0,ProgressBarEx()\h,$BBBBBB)
    
    StopDrawing()
    Handle = ImageGadget(GadgetID,x,y,w,h,ProgressBarEx()\Image)
   EndIf
  EndIf

  If Handle=#False
   If IsImage(PImage) : FreeImage(PImage) : EndIf
   DeleteElement(ProgressBarEx())
  EndIf
 EndIf

 ProcedureReturn Handle
EndProcedure

;Valid states are 0 to 2^31
Procedure.l SetProgressBarExState(GadgetID.l,State.l)
 Protected w.l,result=#False
 ForEach ProgressBarEx()
  If ProgressBarEx()\GadgetID = GadgetID
   If ProgressBarEx()\State<>State ;Is the state different from last time?
    If StartDrawing(ImageOutput(ProgressBarEx()\ImageID))
     ProgressBarEx()\State = State ;store new state
     ;redraw background
     Box(2,2,ProgressBarEx()\w,ProgressBarEx()\h,$CCCCCC)
     Line(1,1,ProgressBarEx()\w+2,0,$DDDDDD)
     Line(1,2,0,ProgressBarEx()\h+1,$DDDDDD)
     Line(1,ProgressBarEx()\h+2,ProgressBarEx()\w+2,0,$BBBBBB)
     Line(ProgressBarEx()\w+2,2,0,ProgressBarEx()\h,$BBBBBB)
     If State<>0 ;Should we draw the progress bar or not?
      w = ProgressBarEx()\resolution * (State-ProgressBarEx()\min)
      If w>0 ;This and next line is to avoid potential rounding errors/gfx glitches.
       If w>ProgressBarEx()\w : w=ProgressBarEx()\w : EndIf
       Line(1,1,w+1,0,ProgressBarEx()\colorlight)
       Line(1,2,0,ProgressBarEx()\h+1,ProgressBarEx()\colorlight)
       Line(1,ProgressBarEx()\h+2,w+2,0,ProgressBarEx()\colordark)
       Line(w+2,1,0,ProgressBarEx()\h+1,ProgressBarEx()\colordark)
       Box(2,2,w,ProgressBarEx()\h,ProgressBarEx()\color)
      EndIf
     EndIf
     StopDrawing()
     SetGadgetState(ProgressBarEx()\GadgetID,ProgressBarEx()\Image)
     result=#True
    EndIf
   EndIf
  EndIf
 Next
 ProcedureReturn result
EndProcedure

Procedure Demo(Dummy.l)
 Protected Statev.l=10
 Repeat
  If Statev = 91
   Statev = 10
  EndIf
  SetProgressBarExState(5,Statev)
  Statev + 1

  Delay(10)
 ForEver
 
EndProcedure

Define event.l,thread.l
If OpenWindow(0, 0, 0, 300, 50, "progressmeter",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
  ProgressBarExGadget(5,50,15,200,20,10,90,RGB(224,32,16))
  thread=CreateThread(@Demo(),0)
  Repeat
   event = WaitWindowEvent()
  Until event = #PB_Event_CloseWindow
  End
EndIf

KillThread(thread)
Delay(1000)

Posted: **Mon Nov 27, 2006 11:19 pm**

Rescator,
I think there's a slight error in the code...

Line 30:

Code: Select all

ProgressBarEx()\resolution = ProgressBarEx()\w / 100.0

should be:

Code: Select all

ProgressBarEx()\resolution = ProgressBarEx()\w / (max * 1.0)

... no?

Thanks to both of you for sharing, BTW.

Posted: **Tue Nov 28, 2006 1:13 am**

Thanks guys! This is awesome!

@GeoTrail
Oops, forgot to change that

.

Posted: **Tue Nov 28, 2006 1:18 am**

Hehehe couldn't help myself

Posted: **Tue Nov 28, 2006 7:50 am**

Clutch wrote:Rescator,
I think there's a slight error in the code...

Line 30:
Code: Select all
ProgressBarEx()\resolution = ProgressBarEx()\w / 100.0
should be:
Code: Select all
ProgressBarEx()\resolution = ProgressBarEx()\w / (max * 1.0)
... no?

Thanks to both of you for sharing, BTW.

Oops! Your right! Thanks.
However doing it just like that is not good enough either, turned out to be a bit more work to properly handle a different Min value. *phew*

And in the process I added some boundary check just in case a float rounding error caused a 0 or negative or too big result causing odd "wrapping" of the bar.

Also uncommented the max entry from the structure as it is not used in this example. (it may be useful in the future or with helper functions to this code *shrug*)

Now if no sneaky bugs pop up I consider myself done with this.
*hands the stick to someone else to play with*

PS! There are still a few helper functions missing here, like a freeing one to free the image and remove the list entry. (usefull if the progressbar is used in a window other than the parent window or in popup windows)
Or a resize function, etc. etc.

Posted: **Wed Nov 29, 2006 9:04 pm**

Rescator wrote:• Note! The example may crash when closing the window, this is the fault of the demo procedure/thread and not the progressbar code.

To avoid killing Thread I've changed the code by adding global var 'Finish' and Thread to repeat Until Finish = #True (see at the end).

Code: Select all

Global Finish = #False

EnableExplicit 

Structure ProgressBarEx 
 GadgetID.l 
 ImageID.l 
 Image.l 
 w.l 
 h.l 
 min.l 
 ;max.l ;not used anywhere else in this code 
 state.l 
 color.l 
 colorlight.l 
 colordark.l 
 resolution.f 
EndStructure 
  
Global NewList ProgressBarEx.ProgressBarEx() 

Procedure ProgressBarExGadget(GadgetID,x,y,w,h,min,max,color) 
 Protected r.l,g.l,b.l,Handle.l=#False,PImage.l 
  
 If AddElement(ProgressBarEx()) 
  ProgressBarEx()\GadgetID = GadgetID 
  ProgressBarEx()\w = w-4 
  ProgressBarEx()\h = h-4 
  ProgressBarEx()\min = min 
  ;ProgressBarEx()\max = max ;not used anywhere else in this code 
  ProgressBarEx()\state = 0 
  ProgressBarEx()\resolution = ProgressBarEx()\w / (1.0*(max-min)) 
  ProgressBarEx()\color = color 
  r=Red(color) : g=Green(color) : b=Blue(color) 
  ProgressBarEx()\colordark = RGB(r-(r>>2),g-(g>>2),b-(b>>2)) 
  r=Red(color) : g=Green(color) : b=Blue(color) 
  ProgressBarEx()\colorlight = RGB(255-((255-r)>>1),255-((255-g)>>1),255-((255-b)>>1)) 
  
  ;Startup Image 
  PImage = CreateImage(#PB_Any,w,h) 
  If IsImage(PImage) 
   ProgressBarEx()\ImageID = PImage 
   ProgressBarEx()\Image = ImageID(PImage) 
   If StartDrawing(ImageOutput(PImage)) 
    
    ;Gadget background and borders 
    Box(0,0,w,h,RGB(255,255,255)) 
    Line(0,0,w-1,0,RGB(160,160,160)) 
    Line(0,0,0,h,RGB(160,160,160)) 
    Line(1,h-1,w-1,0,RGB(134,134,134)) 
    Line(w-1,0,0,h,RGB(134,134,134)) 
    
    ;Progressbar background and borders. 
    Box(2,2,ProgressBarEx()\w,ProgressBarEx()\h,$CCCCCC) ;RGB(192,192,192) 
    Line(1,1,ProgressBarEx()\w+2,0,$DDDDDD) 
    Line(1,2,0,ProgressBarEx()\h+1,$DDDDDD) 
    Line(1,ProgressBarEx()\h+2,ProgressBarEx()\w+2,0,$BBBBBB) 
    Line(ProgressBarEx()\w+2,2,0,ProgressBarEx()\h,$BBBBBB) 
    
    StopDrawing() 
    Handle = ImageGadget(GadgetID,x,y,w,h,ProgressBarEx()\Image) 
   EndIf 
  EndIf 

  If Handle=#False 
   If IsImage(PImage) : FreeImage(PImage) : EndIf 
   DeleteElement(ProgressBarEx()) 
  EndIf 
 EndIf 

 ProcedureReturn Handle 
EndProcedure 

;Valid states are 0 to 2^31 
Procedure.l SetProgressBarExState(GadgetID.l,State.l) 
 Protected w.l,result=#False 
 ForEach ProgressBarEx() 
  If ProgressBarEx()\GadgetID = GadgetID 
   If ProgressBarEx()\State<>State ;Is the state different from last time? 
    If StartDrawing(ImageOutput(ProgressBarEx()\ImageID)) 
     ProgressBarEx()\State = State ;store new state 
     ;redraw background 
     Box(2,2,ProgressBarEx()\w,ProgressBarEx()\h,$CCCCCC) 
     Line(1,1,ProgressBarEx()\w+2,0,$DDDDDD) 
     Line(1,2,0,ProgressBarEx()\h+1,$DDDDDD) 
     Line(1,ProgressBarEx()\h+2,ProgressBarEx()\w+2,0,$BBBBBB) 
     Line(ProgressBarEx()\w+2,2,0,ProgressBarEx()\h,$BBBBBB) 
     If State<>0 ;Should we draw the progress bar or not? 
      w = ProgressBarEx()\resolution * (State-ProgressBarEx()\min) 
      If w>0 ;This and next line is to avoid potential rounding errors/gfx glitches. 
       If w>ProgressBarEx()\w : w=ProgressBarEx()\w : EndIf 
       Line(1,1,w+1,0,ProgressBarEx()\colorlight) 
       Line(1,2,0,ProgressBarEx()\h+1,ProgressBarEx()\colorlight) 
       Line(1,ProgressBarEx()\h+2,w+2,0,ProgressBarEx()\colordark) 
       Line(w+2,1,0,ProgressBarEx()\h+1,ProgressBarEx()\colordark) 
       Box(2,2,w,ProgressBarEx()\h,ProgressBarEx()\color) 
      EndIf 
     EndIf 
     StopDrawing() 
     SetGadgetState(ProgressBarEx()\GadgetID,ProgressBarEx()\Image) 
     result=#True 
    EndIf 
   EndIf 
  EndIf 
 Next 
 ProcedureReturn result 
EndProcedure 

Procedure Demo(Dummy.l) 
 Protected Statev.l=10 
 Repeat 
  If Statev = 91 
   Statev = 10 
  EndIf 
  SetProgressBarExState(5,Statev) 
  Statev + 1 

  Delay(10) 
 Until Finish = #True 
  
EndProcedure 

Define event.l,thread.l 
If OpenWindow(0, 0, 0, 300, 50, "progressmeter",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0)) 
  ProgressBarExGadget(5,50,15,200,20,10,90,RGB(224,32,16)) 
  thread=CreateThread(@Demo(),0) 
  Repeat 
   event = WaitWindowEvent() 
  Until event = #PB_Event_CloseWindow
  Finish = #True
  HideWindow(0, 1)
  WaitThread(thread) 
  End 
EndIf

PureBasic Forums - English

BitDefender Style Progressbar :)

BitDefender Style Progressbar :)