Page 2 of 2

Posted: Wed Sep 03, 2008 8:17 am
by Rescator
Fiddled with this again the other night.

Now it has pretty much all features of the normal PB progressbar and supporting functions, and a few abilities of imagegadget as well, background and foreground color changing, negative progressbar.

Yep, the second progress bar in the demo runs backwards from 0 to -100 using actual negative values. And it is the background of the progressbar that is changing colors very rapidly in case you get confused.

The colors in the demo are the core values of the Vista Normal, Pause and Error and classic progressbars.

No fancy "Aero" look though, but in return this is snappy, hardly uses cpu, is platform independent, several safety/value checks so it should be very solid, and does not have the same update issue that Vista's own progressbar can have on very short progress runs.

I doubt I'll fiddle with this any further, but if anyone got some improvements by all means post, I'm sure there is still some optimization possible.

Code: Select all

EnableExplicit

Structure ProgressBarEx
 gadget.l
 image.l
 imageid.l
 w.l
 h.l
 floor.l
 ceiling.l
 state.l
 color.l
 colorlight.l
 colordark.l
 bgcolor.l
 bgcolorlight.l
 bgcolordark.l
 redraw.l
 resolution.f
EndStructure
 
Global NewList ProgressBarEx.ProgressBarEx()

Procedure ProgressBarExGadget(Gadget.l,x.l,y.l,Width.l,Height.l,Min.l,Max.l,Flags.l=#Null)
 Protected r.l,g.l,b.l,handle.l=#False,image.l
 If AddElement(ProgressBarEx())
  ProgressBarEx()\gadget=Gadget
  ProgressBarEx()\w=Width-4
  ProgressBarEx()\h=Height-4
  If Max>Min
   ProgressBarEx()\floor=Min
   ProgressBarEx()\ceiling=Max
  Else
   ProgressBarEx()\floor=Max
   ProgressBarEx()\ceiling=Min
  EndIf
  ProgressBarEx()\state=Min
  ProgressBarEx()\resolution=ProgressBarEx()\w/(1.0*(ProgressBarEx()\ceiling-ProgressBarEx()\floor))
  ProgressBarEx()\color=RGB($00,$D3,$28)
  r=Red(ProgressBarEx()\color)
  g=Green(ProgressBarEx()\color)
  b=Blue(ProgressBarEx()\color)
  ProgressBarEx()\colordark=RGB(r-(r>>2),g-(g>>2),b-(b>>2))
  ProgressBarEx()\colorlight=RGB(255-((255-r)>>1),255-((255-g)>>1),255-((255-b)>>1))
  ProgressBarEx()\bgcolor=RGB($CC,$CC,$CC)
  r=Red(ProgressBarEx()\bgcolor)
  g=Green(ProgressBarEx()\bgcolor)
  b=Blue(ProgressBarEx()\bgcolor)
  ProgressBarEx()\bgcolordark=RGB(r-(r>>2),g-(g>>2),b-(b>>2))
  ProgressBarEx()\bgcolorlight=RGB(255-((255-r)>>1),255-((255-g)>>1),255-((255-b)>>1))
  image=CreateImage(#PB_Any,Width,Height)
  If IsImage(image)
   ProgressBarEx()\image=image
   ProgressBarEx()\imageid=ImageID(image)
   If StartDrawing(ImageOutput(image))
    Box(2,2,ProgressBarEx()\w,ProgressBarEx()\h,ProgressBarEx()\bgcolor)
    Line(1,1,ProgressBarEx()\w+2,0,ProgressBarEx()\bgcolorlight)
    Line(1,2,0,ProgressBarEx()\h+1,ProgressBarEx()\bgcolorlight)
    Line(1,ProgressBarEx()\h+2,ProgressBarEx()\w+2,0,ProgressBarEx()\bgcolordark)
    Line(ProgressBarEx()\w+2,2,0,ProgressBarEx()\h,ProgressBarEx()\bgcolordark)
    StopDrawing()
    handle=ImageGadget(Gadget,x,y,Width,Height,ProgressBarEx()\imageid,Flags)
    If Gadget=#PB_Any
     ProgressBarEx()\gadget=handle
    EndIf
   EndIf
  EndIf
  If handle=#False
   If IsImage(image)
    FreeImage(image)
   EndIf
   DeleteElement(ProgressBarEx())
  EndIf
 EndIf
 ProcedureReturn handle
EndProcedure

Procedure SetProgressBarExAttribute(Gadget.l,Attribute.l,Value.l)
 Protected Min.l,Max.l
 ForEach ProgressBarEx()
  If ProgressBarEx()\gadget=Gadget
   Min=ProgressBarEx()\floor
   Max=ProgressBarEx()\ceiling
   Select Attribute
    Case #PB_ProgressBar_Minimum
     Min=Value
    Case #PB_ProgressBar_Maximum
     Max=Value
   EndSelect
   If Max>Min
    ProgressBarEx()\floor=Min
    ProgressBarEx()\ceiling=Max
   Else
    ProgressBarEx()\floor=Max
    ProgressBarEx()\ceiling=Min
   EndIf
   ProgressBarEx()\resolution=ProgressBarEx()\w/(1.0*(ProgressBarEx()\ceiling-ProgressBarEx()\floor))
   Break
  EndIf
 Next
EndProcedure

Procedure.l GetProgressBarExAttribute(Gadget.l,Attribute.l)
 Protected result.l
 ForEach ProgressBarEx()
  If ProgressBarEx()\gadget=Gadget
   Select Attribute
    Case #PB_ProgressBar_Minimum
     result=ProgressBarEx()\floor
    Case #PB_ProgressBar_Maximum
     result=ProgressBarEx()\ceiling
   EndSelect
   Break
  EndIf
 Next
 ProcedureReturn result
EndProcedure

Procedure FreeProgressBarExGadget(Gadget.l)
 ForEach ProgressBarEx()
  If ProgressBarEx()\gadget=Gadget
   If IsGadget(gadget)
    FreeGadget(gadget)
   EndIf
   If IsImage(ProgressBarEx()\image)
    FreeImage(ProgressBarEx()\image)
   EndIf
   DeleteElement(ProgressBarEx())
   Break
  EndIf
 Next
EndProcedure

Procedure.l SetProgressBarExState(Gadget.l,State.l)
 Protected w.l,result.l=#False,output.l
 ForEach ProgressBarEx()
  If ProgressBarEx()\gadget=Gadget
   If State<ProgressBarEx()\floor ;Ensure State is within the valid range, clip to floor or ceiling where needed.
    State=ProgressBarEx()\floor
   ElseIf State>ProgressBarEx()\ceiling
    State=ProgressBarEx()\ceiling
   EndIf
   If (ProgressBarEx()\state<>State) Or ProgressBarEx()\redraw ;Is the state different from last time? If so, let's draw.
    If IsImage(ProgressBarEx()\image)
     output=ImageOutput(ProgressBarEx()\image)
     If output
      If StartDrawing(output)
       If State<ProgressBarEx()\state ;Redraw background only if State is less than previously.
        ProgressBarEx()\redraw=#True
       EndIf
       If ProgressBarEx()\redraw
        ProgressBarEx()\redraw=#False
        Box(2,2,ProgressBarEx()\w,ProgressBarEx()\h,ProgressBarEx()\bgcolor)
        Line(1,1,ProgressBarEx()\w+2,0,ProgressBarEx()\bgcolorlight)
        Line(1,2,0,ProgressBarEx()\h+1,ProgressBarEx()\bgcolorlight)
        Line(1,ProgressBarEx()\h+2,ProgressBarEx()\w+2,0,ProgressBarEx()\bgcolordark)
        Line(ProgressBarEx()\w+2,2,0,ProgressBarEx()\h,ProgressBarEx()\bgcolordark)
       EndIf
       If State>ProgressBarEx()\floor ;Do we need to draw the progress bar or not?
        w=Round(ProgressBarEx()\resolution*(State-ProgressBarEx()\floor),#PB_Round_Nearest)
        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
       StopDrawing()
       If IsGadget(Gadget)
        SetGadgetState(Gadget,ProgressBarEx()\imageid)
       EndIf
       ProgressBarEx()\state=State ;Store new state.
       result=#True
      EndIf
     EndIf
    EndIf
   EndIf
   Break
  EndIf
 Next
 ProcedureReturn result
EndProcedure

Procedure.l GetProgressBarExState(Gadget.l)
 Protected result.l=#Null
 ForEach ProgressBarEx()
  If ProgressBarEx()\gadget=Gadget
   result=ProgressBarEx()\state
   Break
  EndIf
 Next
 ProcedureReturn result
EndProcedure

Procedure.l SetProgressBarExColor(Gadget.l,ColorType.l,Color.l)
 Protected result.l=#False,r.l,g.l,b.l
 ForEach ProgressBarEx()
  If ProgressBarEx()\gadget=Gadget
   Select ColorType
    Case #PB_Gadget_FrontColor
     ProgressBarEx()\color=Color
     r=Red(Color)
     g=Green(Color)
     b=Blue(Color)
     ProgressBarEx()\colordark=RGB(r-(r>>2),g-(g>>2),b-(b>>2))
     ProgressBarEx()\colorlight=RGB(255-((255-r)>>1),255-((255-g)>>1),255-((255-b)>>1))
     ProgressBarEx()\redraw=#True
    Case #PB_Gadget_BackColor
     ProgressBarEx()\bgcolor=Color
     r=Red(Color)
     g=Green(Color)
     b=Blue(Color)
     ProgressBarEx()\bgcolordark=RGB(r-(r>>2),g-(g>>2),b-(b>>2))
     ProgressBarEx()\bgcolorlight=RGB(255-((255-r)>>1),255-((255-g)>>1),255-((255-b)>>1))
     ProgressBarEx()\redraw=#True
   EndSelect
   result=#True
   Break
  EndIf
 Next
 ProcedureReturn result
EndProcedure

Procedure.l GetProgressBarExColor(Gadget.l,ColorType.l)
 Protected result.l=#False
 ForEach ProgressBarEx()
  If ProgressBarEx()\gadget=Gadget
   Select ColorType
    Case #PB_Gadget_FrontColor
     result=ProgressBarEx()\color
    Case #PB_Gadget_BackColor
     result=ProgressBarEx()\bgcolor
   EndSelect
   Break
  EndIf
 Next
 ProcedureReturn result
EndProcedure

Procedure Demo(gadget.l)
 Protected Statev1.l=0,Statev2.l=0
 Repeat

  If Statev1 = 101
   Statev1 = 0
  EndIf
  If Random(9)=5
   Select Random(3)
    Case 0
     SetProgressBarExColor(5,#PB_Gadget_FrontColor,RGB($D2,$00,$0)) ;Error
    Case 1
     SetProgressBarExColor(5,#PB_Gadget_FrontColor,RGB($00,$D3,$28)) ;Normal
    Case 2
     SetProgressBarExColor(5,#PB_Gadget_FrontColor,RGB($D2,$CA,$0)) ;Paused
    Case 3
     SetProgressBarExColor(5,#PB_Gadget_FrontColor,RGB($33,$99,$FF)) ;Classic
   EndSelect
  EndIf
  SetProgressBarExState(5,Statev1)
  Statev1 + 1

  If Statev2 = -101
   Statev2 = 0
  EndIf
  If Random(9)=5
   Select Random(3)
    Case 0
     SetProgressBarExColor(6,#PB_Gadget_FrontColor,RGB($D2,$00,$0)) ;Error
    Case 1
     SetProgressBarExColor(6,#PB_Gadget_FrontColor,RGB($00,$D3,$28)) ;Normal
    Case 2
     SetProgressBarExColor(6,#PB_Gadget_FrontColor,RGB($D2,$CA,$0)) ;Paused
    Case 3
     SetProgressBarExColor(6,#PB_Gadget_FrontColor,RGB($33,$99,$FF)) ;Classic
   EndSelect
  EndIf
  SetProgressBarExColor(6,#PB_Gadget_BackColor,RGB(Random(255),Random(255),Random(255)))
  SetProgressBarExState(6,Statev2)
  Statev2 - 1

  Sleep_(50)
 ForEver
EndProcedure

Define event.l,thread.l,gadget1.l,gadget2.l

If OpenWindow(0, 0, 0, 300, 100, "progressmeter",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))

 gadget1=ProgressBarExGadget(5,10,10,280,30,0,100)
 gadget2=ProgressBarExGadget(6,10,60,280,30,0,-100,#PB_Image_Border)
 ;Except for the FreeProgressBarExGadget(), this progressbar gadget behaves like a imagegadget
 ;so you can use a gadget tooltip, catch imagegadget events and so on.
 GadgetToolTip(6,"Cool huh?")

 thread=CreateThread(@Demo(),#Null)

  Repeat
   event = WaitWindowEvent()
   If event=#PB_Event_Gadget
    If EventGadget()=6
     If EventType()=#PB_EventType_LeftClick
      Debug "Click!"
     EndIf
    EndIf
   EndIf
  Until event = #PB_Event_CloseWindow
EndIf

FreeProgressBarExGadget(5) ;Make sure we free not just the gadget but the image we draw on and the list element as well.
FreeProgressBarExGadget(6) ;You only need to do this if you plan to free the gadget or the window, otherwise PureBasic will clean up when it quits as usual.

KillThread(thread)

End

Posted: Wed Sep 03, 2008 3:46 pm
by Rook Zimbabwe
Inf0 this is a great bit of code... Rescator... nice tweaks! likewise good work eJan! :D