Barre de progression couleur

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Barre de progression couleur

Message par Gillou »

Ce code permet de créer des barres de progression en couleur

Partie 1


; Gillou
; 14/01/2006
; PureBasic 3.94

DeclareDLL SetProgressBarColorState(IDGadget, State.f)

Procedure PossibleColor(Color.f) ; Test si la couleur est comprise entre 0 et 255 et renvoie la valeur la plus juste
     If color > 255 : color = 255
     ElseIf color < 0 : color = 0
     EndIf
     ProcedureReturn color
EndProcedure

Procedure TableToImage(Image, Table) ; Crée une image à partir du tableau Image=#Image, Table=@Tableau(), ex : Dim Tableau(ImageWidth(),ImageHeight()) -> @Tableau()
     If IsImage (Image) And Table
         ImageID = UseImage (Image)
        bm.BITMAP
         GetObject_ ( ImageID , SizeOf(BITMAP), @bm.BITMAP)
        bmi.BITMAPINFO
        bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
        bmi\bmiheader\biWidth = bm\bmWidth
        bmi\bmiheader\biHeight = bm\bmHeight
        bmi\bmiheader\biPlanes = 1
        bmi\bmiheader\biBitCount = 32
        bmi\bmiheader\biCompression = #BI_RGB
        pixel = AllocateMemory (bm\bmHeight * bm\bmWidth * 4)
         For nn = 0 To bm\bmwidth - 1
             For n = 0 To bm\bmheight - 1
                s = Table + n * 4 + nn * bm\bmHeight * 4
                d = pixel + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4
                 CopyMemory (s, d + 2, 1)
                 CopyMemory (s + 1, d + 1, 1)
                 CopyMemory (s + 2, d, 1)
             Next
            table + 4
         Next
        HDC = StartDrawing ( ImageOutput ())
             SetDIBits_ (HDC, ImageID , 0, ImageHeight (), pixel, bmi, #DIB_RGB_COLORS )
         StopDrawing ()
         FreeMemory (pixel)
         ProcedureReturn 1
     EndIf
EndProcedure
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Re: Barre de progression couleur

Message par Gillou »

Partie 2


Procedure ProgressBarColorGadget(IDGadget, x, y, Width, Height, Radius, Min, Max, BorderColor1, CenterColor1, BorderColor2, CenterColor2, Vertical, TextColor, NBDecimal, Symbol.s) ; Retourne 1 si la fonction réussi ou le numéro du gadget si #PB_Any est utilisé
     Structure PBCG
        ID.l
        Img.l
        W.l
        H.l
        R.l
        Min.L
        Max.l
        BC1.l
        CC1.l
        BC2.l
        CC2.l
        TC.l
        NBD.l
        S.s
        V.l
        Av.f
        Font.l
        Pix.l
        FC.l
        FH.l
        Mem.l
        B.l
     EndStructure
     If IsGadget (IDGadget) = 0 And Width > 4 And Height > 4 And Max > Min And Min >= 0
        Global PBCG
         If PBCG = 0 : PBCG = 1 : NewList PBCG.PBCG() : EndIf
         AddElement (PBCG()) : PBCG()\ID = IDGadget
        PBCG()\W = Width : PBCG()\H = Height : PBCG()\R = Radius : PBCG()\Min = Min : PBCG()\Max = Max : PBCG()\BC1 = BorderColor1 : PBCG()\CC1 = CenterColor1 : PBCG()\V = Vertical : PBCG()\S = Symbol : PBCG()\Av = Min
        PBCG()\TC = TextColor : PBCG()\Font = LoadFont ( #PB_Any , "times new roman" , PBCG()\H / 2)
        PBCG()\Pix = -1 : PBCG()\FC = GetSysColor_ ( #COLOR_BTNFACE ) : PBCG()\B = 0
        PBCG()\mem = AllocateMemory (PBCG()\W * PBCG()\H * 4 + PBCG()\W * 4)
         If IsImage (IDGadget) Or IDGadget = -1
            PBCG()\Img = CreateImage ( #PB_Any , PBCG()\W, PBCG()\H) : HImg = UseImage (PBCG()\Img)
         Else
            PBCG()\Img = IDGadget : HImg = CreateImage (PBCG()\Img, PBCG()\W, PBCG()\H)
         EndIf
         If PBCG()\V
            PBCG()\Av = Max
             If PBCG()\nbd > 0
                t.s = StrF (PBCG()\Av)
                t = Left (t, FindString (t, "." , 0) + PBCG()\nbd)
                 Repeat
                     If Val ( Right (t, 1)) = 0
                        t = Left (t, Len (t) - 1)
                     EndIf
                 Until Val ( Right (t, 1)) <> 0
             Else
                t.s = Str (PBCG()\Av)
             EndIf
            
             Repeat
                 StartDrawing ( WindowOutput ())
                     DrawingFont ( UseFont (PBCG()\Font))
                    textl = TextLength (t + PBCG()\S)
                 StopDrawing ()
                 If textl > PBCG()\W - 4
                    b = b + 1
                     CloseFont (PBCG()\Font)
                    PBCG()\Font = LoadFont ( #PB_Any , "times new roman" , (PBCG()\H / 2 - b))
                     If (PBCG()\H / 2 - b) = < 2
                        ok = 1
                     EndIf
                 Else
                    ok = 1
                 EndIf
             Until Ok = 1
            PBCG()\Av = Min
            PBCG()\FH = (PBCG()\H / 2 - b) * 1.6
         EndIf
         If BorderColor2 < 0 Or CenterColor2 < 0
            PBCG()\CC2 = #White
            PBCG()\BC2 = GetSysColor_ ( #COLOR_BTNFACE )
         Else
            PBCG()\CC2 = CenterColor2
            PBCG()\BC2 = BorderColor2
         EndIf
         If BorderColor1 < 0 Or CenterColor1 < 0
            PBCG()\CC1 = RGB (220, 255, 200)
            PBCG()\BC1 = #White
         Else
            PBCG()\CC1 = CenterColor1
            PBCG()\BC1 = BorderColor1
         EndIf
        
         If NBDecimal < 0 : PBCG()\NBD = 0 : Else : PBCG()\NBD = NBDecimal : EndIf
        
         If PBCG()\R < 0 : PBCG()\R = 1 : ElseIf PBCG()\W > PBCG()\H And PBCG()\R > PBCG()\H / 2 : PBCG()\R = PBCG()\H / 2 : ElseIf PBCG()\H > PBCG()\W And PBCG()\R > PBCG()\W / 2 : PBCG()\R = PBCG()\W / 2 : EndIf
         StartDrawing ( ImageOutput ())
             Box (0, 0, PBCG()\W, PBCG()\H, GetSysColor_ ( #COLOR_BTNFACE ))
         StopDrawing ()
         If IDGadget = -1
            PBCG()\ID = ImageGadget (IDGadget, X, Y, PBCG()\W, PBCG()\H, HImg)
            SetProgressBarColorState(PBCG()\ID, Min)
             ProcedureReturn PBCG()\ID
         Else
            G = ImageGadget (IDGadget, X, Y, PBCG()\W, PBCG()\H, HImg)
             If G
                SetProgressBarColorState(PBCG()\ID, Min)
                 ProcedureReturn 1
             EndIf
         EndIf
     EndIf
EndProcedure
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Message par Gillou »

Partie 3


Procedure SetProgressBarColorState(IDGadget, State.f)
     If IsGadget (IDGadget) And PBCG = 1 And CountList (PBCG()) > 0
        sel = -1 : ForEach PBCG() : If PBCG()\ID = IDGadget : sel = a : EndIf : a = a + 1 : Next
         If sel = -1 : ProcedureReturn sel : Else : SelectElement (PBCG(), sel) : EndIf
        PBCG()\Av = State
         If PBCG()\Av < PBCG()\Min : PBCG()\Av = PBCG()\Min : ElseIf PBCG()\Av > PBCG()\Max : PBCG()\Av = PBCG()\Max : EndIf
        av = 0 : Dim Image(PBCG()\W, PBCG()\H)
         If PBCG()\V = 0
            pos.f = ((PBCG()\Av - PBCG()\Min) * PBCG()\W) / (PBCG()\Max - PBCG()\Min)
             If PBCG()\Pix <> Int (pos) And Int (Pos) >= 0
                PBCG()\Pix = Int (pos) : av = 1
                 If PBCG()\R > PBCG()\H / 2 Or PBCG()\R > PBCG()\W / 2
                     If PBCG()\W > PBCG()\H
                        PBCG()\R = PBCG()\H / 2
                     Else
                        PBCG()\R = PBCG()\W / 2
                     EndIf
                 EndIf
                rouge.f = ( Red (PBCG()\BC2) - Red (PBCG()\CC2)) / (PBCG()\H / 2)
                vert.f = ( Green (PBCG()\BC2) - Green (PBCG()\CC2)) / (PBCG()\H / 2)
                bleu.f = ( Blue (PBCG()\BC2) - Blue (PBCG()\CC2)) / (PBCG()\H / 2)
                 For a = 1 To PBCG()\H / 2
                    c = RGB (PossibleColor( Red (PBCG()\BC2) - a * rouge), PossibleColor( Green (PBCG()\BC2) - a * vert), PossibleColor( Blue (PBCG()\BC2) - a * bleu))
                     For b = PBCG()\Pix To PBCG()\W
                        Image(b, a) = c
                        Image(b, PBCG()\H - 1 - a) = c
                     Next
                 Next
                 If pos > 0
                    rouge = ( Red (PBCG()\BC1) - Red (PBCG()\CC1)) / (PBCG()\H / 2)
                    vert = ( Green (PBCG()\BC1) - Green (PBCG()\CC1)) / (PBCG()\H / 2)
                    bleu = ( Blue (PBCG()\BC1) - Blue (PBCG()\CC1)) / (PBCG()\H / 2)
                     For a = 1 To PBCG()\H / 2
                        c = RGB (PossibleColor( Red (PBCG()\BC1) - a * rouge), PossibleColor( Green (PBCG()\BC1) - a * vert), PossibleColor( Blue (PBCG()\BC1) - a * bleu))
                         For b = 0 To PBCG()\Pix
                            Image(b, a) = c
                            Image(b, PBCG()\H - 1 - a) = c
                         Next
                     Next
                 EndIf
             EndIf
         Else
            pos.f = ((PBCG()\Max - (State - PBCG()\Min)) * PBCG()\H) / (PBCG()\Max - PBCG()\Min)
             If PBCG()\Pix <> Int (pos) And Int (Pos) >= 0
                PBCG()\Pix = Int (pos) : av = 1
                 If PBCG()\R > PBCG()\H / 2 Or PBCG()\R > PBCG()\W / 2
                     If PBCG()\W > PBCG()\H
                        PBCG()\R = PBCG()\H / 2
                     Else
                        PBCG()\R = PBCG()\W / 2
                     EndIf
                 EndIf
                rouge.f = ( Red (PBCG()\BC1) - Red (PBCG()\CC1)) / (PBCG()\W / 2)
                vert.f = ( Green (PBCG()\BC1) - Green (PBCG()\CC1)) / (PBCG()\W / 2)
                bleu.f = ( Blue (PBCG()\BC1) - Blue (PBCG()\CC1)) / (PBCG()\W / 2)
                 For a = 1 To PBCG()\W / 2
                    c = RGB (PossibleColor( Red (PBCG()\BC1) - a * rouge), PossibleColor( Green (PBCG()\BC1) - a * vert), PossibleColor( Blue (PBCG()\BC1) - a * bleu))
                     For b = PBCG()\Pix To PBCG()\H
                        Image(a, b) = c
                        Image(PBCG()\W - 1 - a, b) = c
                     Next
                 Next
                 If pos > 0
                    rouge = ( Red (PBCG()\BC2) - Red (PBCG()\CC2)) / (PBCG()\W / 2)
                    vert = ( Green (PBCG()\BC2) - Green (PBCG()\CC2)) / (PBCG()\W / 2)
                    bleu = ( Blue (PBCG()\BC2) - Blue (PBCG()\CC2)) / (PBCG()\W / 2)
                     For a = 1 To PBCG()\W / 2
                        c = RGB (PossibleColor( Red (PBCG()\BC2) - a * rouge), PossibleColor( Green (PBCG()\BC2) - a * vert), PossibleColor( Blue (PBCG()\BC2) - a * bleu))
                         For b = 0 To PBCG()\Pix
                            Image(a, b) = c
                            Image(PBCG()\W - 1 - a, b) = c
                         Next
                     Next
                 EndIf
             EndIf
         EndIf
         If av = 1
             For a = PBCG()\R To PBCG()\H - PBCG()\R
                image(0, a) = PBCG()\B
                Image(PBCG()\W - 1, a) = PBCG()\B
             Next
             For a = PBCG()\R To PBCG()\W - PBCG()\R
                image(a, 0) = PBCG()\B
                Image(a, PBCG()\H - 1) = PBCG()\B
             Next
             Dim Zone.f(2 * (PBCG()\R + 1), 2 * (PBCG()\R + 1))
             For n = 0 To PBCG()\R * PBCG()\R
                angle.f = #PI * n / (PBCG()\R * PBCG()\R * 2)
                X.f = PBCG()\R * Cos (angle)
                Y.f = PBCG()\R * Sin (angle)
                xx.l = Int (X + 0.5)
                yy.l = Int (Y + 0.5)
                 For dx = -1 To 1
                     For dy = -1 To 1
                        CoefX.f = 1 - Abs (X - xx - dx)
                        CoefY.f = 1 - Abs (Y - yy - dy)
                         If CoefX > 0 And CoefY > 0
                            Coef.f = Pow (CoefX * CoefY, 0.8 )
                         Else
                            Coef.f = 0
                         EndIf
                         If Coef > Zone(xx + dx + PBCG()\R + 1, yy + dy + PBCG()\R + 1)
                            Zone(PBCG()\R + 1 + (xx + dx), PBCG()\R + 1 + (yy + dy)) = Coef
                            Zone(PBCG()\R + 1 - (xx + dx), PBCG()\R + 1 + (yy + dy)) = Coef
                            Zone(PBCG()\R + 1 + (xx + dx), PBCG()\R + 1 - (yy + dy)) = Coef
                            Zone(PBCG()\R + 1 - (xx + dx), PBCG()\R + 1 - (yy + dy)) = Coef
                         EndIf
                     Next
                 Next
             Next
             ; Nord-Est
            cx = PBCG()\W - PBCG()\R - 1 : cy = PBCG()\R
             For dx = PBCG()\R + 1 To 2 * PBCG()\R + 1
                 For dy = 1 To PBCG()\R + 1
                    image(cx - PBCG()\R - 1 + dx, cy - PBCG()\R - 1 + dy)
                     If Zone(dx, dy) > 0
                         If cy - PBCG()\R - 2 + dy >= 0
                             For a = cx - PBCG()\R + dx To PBCG()\W
                                image(a, cy - PBCG()\R - 2 + dy) = PBCG()\FC
                             Next
                         EndIf
                        Couleur_origine = image(cx - PBCG()\R - 1 + dx, cy - PBCG()\R - 1 + dy)
                        Rouge = Int ((1 - Zone(dx, dy)) * Red (Couleur_origine) + Zone(dx, dy) * Red (PBCG()\B))
                        Vert = Int ((1 - Zone(dx, dy)) * Green (Couleur_origine) + Zone(dx, dy) * Green (PBCG()\B))
                        Bleu = Int ((1 - Zone(dx, dy)) * Blue (Couleur_origine) + Zone(dx, dy) * Blue (PBCG()\B))
                        image(cx - PBCG()\R - 1 + dx, cy - PBCG()\R - 1 + dy) = RGB (Rouge, Vert, Bleu)
                     EndIf
                 Next
             Next
             ; Sud-Est
            cx = PBCG()\W - PBCG()\R - 1 : cy = PBCG()\H - PBCG()\R - 1 : If PBCG()\V : l = PBCG()\H : Else : l = PBCG()\W : EndIf
             For dx = PBCG()\R + 1 To 2 * PBCG()\R + 1
                 For dy = PBCG()\R + 1 To 2 * PBCG()\R + 1
                     If Zone(dx, dy) > 0
                         If cy - PBCG()\R + dy = < l
                             For a = cx - PBCG()\R + dx To PBCG()\W
                                image(a, cy - PBCG()\R + dy) = PBCG()\FC
                             Next
                         EndIf
                        Couleur_origine = image(cx - PBCG()\R - 1 + dx, cy - PBCG()\R - 1 + dy)
                        Rouge = Int ((1 - Zone(dx, dy)) * Red (Couleur_origine) + Zone(dx, dy) * Red (PBCG()\B))
                        Vert = Int ((1 - Zone(dx, dy)) * Green (Couleur_origine) + Zone(dx, dy) * Green (PBCG()\B))
                        Bleu = Int ((1 - Zone(dx, dy)) * Blue (Couleur_origine) + Zone(dx, dy) * Blue (PBCG()\B))
                        image(cx - PBCG()\R - 1 + dx, cy - PBCG()\R - 1 + dy) = RGB (Rouge, Vert, Bleu)
                     EndIf
                 Next
             Next
             ; Sud-Ouest
            cx = PBCG()\R : cy = PBCG()\H - PBCG()\R - 1 : If PBCG()\V : l = PBCG()\H : Else : l = PBCG()\W : EndIf
             For dx = 1 To PBCG()\R + 1
                 For dy = PBCG()\R + 1 To 2 * PBCG()\R + 1
                     If Zone(dx, dy) > 0
                         If cy - PBCG()\R - 1 + dy = < l
                             For a = 0 To cx - PBCG()\R - 2 + dx
                                image(a, cy - PBCG()\R + dy) = PBCG()\FC
                             Next
                         EndIf
                     EndIf
                 Next
             Next
             For dx = 1 To PBCG()\R + 1
                 For dy = PBCG()\R + 1 To 2 * PBCG()\R + 1
                     If Zone(dx, dy) > 0
                        Couleur_origine = image(cx - PBCG()\R - 1 + dx, cy - PBCG()\R - 1 + dy)
                        Rouge = Int ((1 - Zone(dx, dy)) * Red (Couleur_origine) + Zone(dx, dy) * Red (PBCG()\B))
                        Vert = Int ((1 - Zone(dx, dy)) * Green (Couleur_origine) + Zone(dx, dy) * Green (PBCG()\B))
                        Bleu = Int ((1 - Zone(dx, dy)) * Blue (Couleur_origine) + Zone(dx, dy) * Blue (PBCG()\B))
                        image(cx - PBCG()\R - 1 + dx, cy - PBCG()\R - 1 + dy) = RGB (Rouge, Vert, Bleu)
                     EndIf
                 Next
             Next
             ; Nord-Ouest
            cx = PBCG()\R : cy = PBCG()\R
             For dx = 1 To PBCG()\R + 1
                 For dy = 1 To PBCG()\R + 1
                     If Zone(dx, dy) > 0
                         If cy - PBCG()\R - 2 + dy >= 0
                             For a = 0 To cx - PBCG()\R - 2 + dx
                                image(a, cy - PBCG()\R - 2 + dy) = PBCG()\FC
                             Next
                         EndIf
                     EndIf
                 Next
             Next
             For dx = 1 To PBCG()\R + 1
                 For dy = 1 To PBCG()\R + 1
                     If Zone(dx, dy) > 0
                        Couleur_origine = image(cx - PBCG()\R - 1 + dx, cy - PBCG()\R - 1 + dy)
                        Rouge = Int ((1 - Zone(dx, dy)) * Red (Couleur_origine) + Zone(dx, dy) * Red (PBCG()\B))
                        Vert = Int ((1 - Zone(dx, dy)) * Green (Couleur_origine) + Zone(dx, dy) * Green (PBCG()\B))
                        Bleu = Int ((1 - Zone(dx, dy)) * Blue (Couleur_origine) + Zone(dx, dy) * Blue (PBCG()\B))
                        image(cx - PBCG()\R - 1 + dx, cy - PBCG()\R - 1 + dy) = RGB (Rouge, Vert, Bleu)
                     EndIf
                 Next
             Next
            TableToImage(PBCG()\Img, Image())
             CopyMemory (Image(), PBCG()\mem, PBCG()\W * PBCG()\H * 4 + PBCG()\W * 4)
         Else
             If PBCG()\Pix >= 0 And PBCG()\TC >= 0 And PBCG()\mem <> 0
                TableToImage(PBCG()\Img, PBCG()\mem)
             EndIf
         EndIf
         If PBCG()\Pix >= 0 And PBCG()\TC >= 0
             If PBCG()\nbd > 0
                t.s = StrF (PBCG()\Av)
                t = Left (t, FindString (t, "." , 0) + PBCG()\nbd)
                 If PBCG()\Av = 0
                    t.s = "0"
                 Else
                     Repeat
                         If Right (t, 1) = "0"
                            t = Left (t, Len (t) - 1)
                         EndIf
                     Until Right (t, 1) <> "0"
                     If Right (t, 1) = "." : t = Left (t, Len (t) - 1) : EndIf
                 EndIf
             Else
                t.s = Str (PBCG()\Av)
             EndIf
            t.s = t.s + PBCG()\S
             UseImage (PBCG()\Img)
             StartDrawing ( ImageOutput ())
                 DrawingFont ( UseFont (PBCG()\Font))
                 DrawingMode (1)
                len = TextLength (t)
                 FrontColor ( Red (PBCG()\TC), Green (PBCG()\TC), Blue (PBCG()\TC))
                 If PBCG()\V = 1
                     Locate ((PBCG()\W - len) / 2, (PBCG()\H - PBCG()\FH) / 2)
                 Else
                     Locate ((PBCG()\W - len) / 2, (PBCG()\H - (PBCG()\H / 2 * 1.6)) / 2)
                 EndIf
                 DrawText (t)
             StopDrawing ()
             SetGadgetState (PBCG()\ID, UseImage (PBCG()\Img))
         Else
             SetGadgetState (PBCG()\ID, UseImage (PBCG()\Img))
         EndIf
     EndIf
EndProcedure
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Message par Gillou »

Partie 4


Procedure.f GetProgressBarColorState(IDGadget) ; si la fonction échoue retourne -1, sinon retourne la position de la barre de progression
     If IsGadget (IDGadget) And PBCG = 1 And CountList (PBCG()) > 0
        sel = -1 : ForEach PBCG() : If PBCG()\ID = IDGadget : sel = a : EndIf : a = a + 1 : Next
         If sel = -1 : ProcedureReturn sel : Else : SelectElement (PBCG(), sel) : EndIf
         ProcedureReturn PBCG()\Av
     EndIf
EndProcedure

Procedure ResizeProgressBarColor(IDGadget, x, y, Width, Height, Radius) ; Retourne 1 si la fonction a réussi
     If IsGadget (IDGadget) And PBCG = 1 And CountList (PBCG()) > 0
        sel = -1 : ForEach PBCG() : If PBCG()\ID = IDGadget : sel = a : EndIf : a = a + 1 : Next
         If sel = -1 : ProcedureReturn 0 : Else : SelectElement (PBCG(), sel) : EndIf
         If Width = -1 : Width = PBCG()\W : EndIf
         If Height = -1 : Height = PBCG()\H : EndIf
         If Radius = -1 : Radius = PBCG()\R : EndIf
        
         If Width > 4 And Height > 4 And Radius > 0
            PBCG()\mem = ReAllocateMemory (PBCG()\mem, width * height * 4 + Width * 4)
            PBCG()\W = Width : PBCG()\H = Height : PBCG()\R = Radius
             CloseFont (PBCG()\Font)
            PBCG()\Font = LoadFont ( #PB_Any , "times new roman" , PBCG()\H / 2)
             If PBCG()\V
                 StartDrawing ( WindowOutput ())
                    PBCG()\Av = Max
                     If PBCG()\nbd > 0
                        t.s = StrF (PBCG()\Av)
                        t = Left (t, FindString (t, "." , 0) + PBCG()\nbd)
                         Repeat
                             If Val ( Right (t, 1)) = 0
                                t = Left (t, Len (t) - 1)
                             EndIf
                         Until Val ( Right (t, 1)) <> 0
                     Else
                        t.s = Str (PBCG()\Av)
                     EndIf
                     Repeat
                         DrawingFont ( UseFont (PBCG()\Font))
                        textl = TextLength (t + PBCG()\S)
                         If textl > PBCG()\W - 4
                            b = b + 1
                             CloseFont (PBCG()\Font)
                            PBCG()\Font = LoadFont ( #PB_Any , "times new roman" , (PBCG()\H / 2 - b))
                             If (PBCG()\H / 2 - b) = < 2
                                ok = 1
                             EndIf
                         Else
                            ok = 1
                         EndIf
                     Until Ok = 1
                    PBCG()\Av = Min
                    PBCG()\FH = (PBCG()\H / 2 - b) * 1.6
                 StopDrawing ()
             EndIf
             ProcedureReturn ResizeImage (PBCG()\Img, Width, Height) & ResizeGadget (IDGadget, x, y, Width, Height) & SetProgressBarColorState(IDGadget, PBCG()\Av)
         EndIf
     EndIf
EndProcedure

#test = 1
#ProgressBar = 1
#ProgressBar2 = 2
#ProgressBar3 = 3
#text = 4
CreateImage (2, 1, 1)
OpenWindow ( #test , 0, 0, 1000, 150, #PBWIN0 , "TEST PROGRESS - Click On ProgressBar ; )" )
CreateGadgetList ( WindowID ( #test ))
ProgressBarGadget (0, 5, 100, 790, 20, 0, 100, #PB_ProgressBar_Smooth )
SetGadgetState (0, 50)
ProgressBarColorGadget( #ProgressBar , 5, 5, 790, 15, 30, 0, 100, #White , #Green , #Red , #Yellow , 0, #Blue , 1, " %" )
ProgressBarColorGadget( #ProgressBar2 , 5, 25, 790, 25, 30, 0, 100, #White , RGB (229, 126, 63), -1, -1, 0, #Yellow , 0, " %" )
ProgressBarColorGadget( #ProgressBar3 , 5, 55, 790, 20, 30, 20, 90, #White , #Green , -1, -1, 0, 255, 0, "°C" )
TextGadget ( #text , 10, 130, 780, 20, "" , #PB_Text_Center )
ProgressBar4 = ProgressBarColorGadget( #PB_Any , 800, 5, 40, 140, 15, 0, 100, #White , #Blue , RGB (179, 179, 255), #White , 1, #Red , 0, "" )
ProgressBar5 = ProgressBarColorGadget( #PB_Any , 845, 5, 150, 140, 6, 0, 100, #White , #Green , -1, -1, 0, #Red , 0, "" )
SetProgressBarColorState(ProgressBar5, 100)

Repeat
     UseWindow ( #test )
     Select WaitWindowEvent ()
         Case #PB_EventGadget
             Select EventGadgetID ()
                 Case #ProgressBar
                    a.f = 0
                     Repeat
                        a.f = a.f + 0.1
                        SetProgressBarColorState( #ProgressBar , a)
                        t$ = StrF (GetProgressBarColorState( #ProgressBar ))
                         SetGadgetText ( #text , Left (t$, FindString (t$, "." , 0) + 1))
                     Until a >= 60.5
                 Case #ProgressBar2
                    SetProgressBarColorState( #ProgressBar2 , 50)
                     SetGadgetText ( #text , Str (GetProgressBarColorState( #ProgressBar2 )))
                 Case #ProgressBar3
                    ResizeProgressBarColor( #ProgressBar3 , 5, 55, 790, 40, 5)
                    SetProgressBarColorState( #ProgressBar3 , 50)
                     SetGadgetText ( #text , Str (GetProgressBarColorState( #ProgressBar3 )))
                 Case ProgressBar4
                     For b = 1 To 50
                         Delay (100)
                        SetProgressBarColorState(ProgressBar4, b)
                        SetProgressBarColorState(ProgressBar5, 100 - b)
                         SetGadgetText ( #text , Str (GetProgressBarColorState(ProgressBar4)))
                     Next
             EndSelect
         Case #PB_Event_CloseWindow
            quit = 1
     EndSelect
Until quit = 1
CameleonTH
Messages : 333
Inscription : sam. 25/juin/2005 11:18
Localisation : Laon (02)
Contact :

Message par CameleonTH »

Sa a l'air intérréssant mais ton systéme en plusieurs parti c'est pas trés facile à gérer donc si tu pouvait refaire au claire avec exmple S'il te plait.
Sa m'arrangerais bien et les autres avec :D.
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Message par Gillou »

Le lien pour le téléchargement:

PureProgress_2.pb
Image
CameleonTH
Messages : 333
Inscription : sam. 25/juin/2005 11:18
Localisation : Laon (02)
Contact :

Message par CameleonTH »

C'est bien fait.
Bravo. :D
Avatar de l’utilisateur
Droopy
Messages : 1151
Inscription : lun. 19/juil./2004 22:31

Message par Droopy »

Nickel :wink:
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Message par Gillou »

Merci :D

J'avais fait une première version, en utilisant les fonctions images, drawtext, drawimage, grabimage,...

Mais c'était beaucoup trop lent.

Je l'ai donc refait en utilisant les tableaux.

J'espère donc que c'est un peu mieux (j'ai un p4 à 3.4GHz), à vous de me dire si ça n'est trop lent :roll:

je met 19750 ms pour le code ci-dessous :roll:


#ProgressBar = 1

OpenWindow (1, 0, 0, 800, 75, #PBWIN0 , "TEST PROGRESS - Click On ProgressBar ; )" )
CreateGadgetList ( WindowID (1))
ProgressBarColorGadget( #ProgressBar , 5, 5, 790, 30, 8, 0, 100, #White , #Green , -1, -1,0, #Blue , 2, " %" )
ProgressBarGadget (0,5,40,790,30,0,100)
AddKeyboardShortcut (1, #PB_Shortcut_F1 ,0)
Repeat
     Select WaitWindowEvent ()
         Case #PB_EventGadget
             Select EventGadgetID ()
                 Case #ProgressBar
                    a.f=0 : t= ElapsedMilliseconds ()
                     Repeat
                        a.f=a.f+0.01
                        SetProgressBarColorState( #ProgressBar , a)
                     Until a>=100
                     Debug Str ( ElapsedMilliseconds ()-t)+ " ms"
             EndSelect
         Case #PB_EventMenu
             Select EventMenuID ()
                 Case 0
                    a.f=0 : t= ElapsedMilliseconds ()
                     Repeat
                        a.f=a.f+0.01
                         SetGadgetState (0, a)
                     Until a>=100
                     Debug Str ( ElapsedMilliseconds ()-t)+ " ms"
             EndSelect
         Case #PB_Event_CloseWindow
            quit = 1
     EndSelect
Until quit = 1
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Message par Gillou »

J'ai apporté une petite modif au fichier en téléchargement, il est toujours au même endroit

PureProgress_2.pb
Image
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Bel effet en effet! :D
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

Superbe! :D
Très belle réussite que ces progressbar. Félicitations.

J'ai été obligé de modifier la constante #PBWIN0 (non reconnue) pour faire fonctionner. Je l'ai remplacé par #PB_Window_SystemMenu
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Gillou a écrit :Merci :D
je met 19750 ms pour le code ci-dessous :roll:


#ProgressBar = 1

OpenWindow (1, 0, 0, 800, 75, #PBWIN0 , "TEST PROGRESS - Click On ProgressBar ; )" )
CreateGadgetList ( WindowID (1))
ProgressBarColorGadget( #ProgressBar , 5, 5, 790, 30, 8, 0, 100, #White , #Green , -1, -1,0, #Blue , 2, " %" )
ProgressBarGadget (0,5,40,790,30,0,100)
AddKeyboardShortcut (1, #PB_Shortcut_F1 ,0)
Repeat
Select WaitWindowEvent ()
Case #PB_EventGadget
Select EventGadgetID ()
Case #ProgressBar
a.f=0 : t= ElapsedMilliseconds ()
Repeat
a.f=a.f+0.01
SetProgressBarColorState( #ProgressBar , a)
Until a>=100
Debug Str ( ElapsedMilliseconds ()-t)+ " ms"
EndSelect
Case #PB_EventMenu
Select EventMenuID ()
Case 0
a.f=0 : t= ElapsedMilliseconds ()
Repeat
a.f=a.f+0.01
SetGadgetState (0, a)
Until a>=100
Debug Str ( ElapsedMilliseconds ()-t)+ " ms"
EndSelect
Case #PB_Event_CloseWindow
quit = 1
EndSelect
Until quit = 1
Excellent ces barres

Avec le code ci-dessus si je déplace la fenêtre avec la souris en cliquant sur la barre de titre en maintenant en foncé le bouton de la souris, la progression s'arrête et ça plante (il faut souvent tenter plusieurs fois de dépalcer la fenêtre car ça ne la déplace plus à tous les coups)
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Message par Gillou »

Ok, merci,

#PBWIN0=1|13107200|13238272

@Denis

Je regardes ça :D
Gillou
Messages : 373
Inscription : sam. 28/août/2004 17:35
Localisation : Bretagne, 22
Contact :

Message par Gillou »

Une petite rectification du fichier en téléchargement (un petit bug lorsque la fenêtre changé de taille)

@Denis

Chez moi, en changeant les répétitions de la barre par défaut, elle fait pareil (Touche F1)
Si on veux supprimer ce défaut, je suis obligé de passé par les threads (et c'est pas hyper stable), je vais essayer autre chose :idea:

En attendant, le code que j'ai testé


#PBWIN0 =1|13107200|13238272
OpenWindow (1, 0, 0, 800, 75, #PBWIN0 |#PB_Window_SizeGadget , "TEST PROGRESS - Click On ProgressBar ; )" )
CreateGadgetList ( WindowID (1))
ProgressBarColorGadget( 1 , 5, 5, 790, 30, 8, 0, 100, #White , #Green , -1, -1,0, #Blue , 2, " %" )
ProgressBarGadget (0,5,40,790,30,0,100)
AddKeyboardShortcut (1, #PB_Shortcut_F1 ,0)
; SetWindowCallback(@WCB())
Repeat
     Select WaitWindowEvent ()
         Case #PB_Event_SizeWindow
            WW= WindowWidth ()
            ResizeProgressBarColor(1, -1,-1,WW-10, -1,-1)
             ResizeGadget (0, -1,-1,WW-10,-1)
         Case #PB_EventGadget
             Select EventGadgetID ()
                 Case 1
                    a.f=0 : t= ElapsedMilliseconds ()
                     Repeat
                        a.f=a.f+0.01
                        SetProgressBarColorState( 1 , a)
                     Until a>=100
                     Debug Str ( ElapsedMilliseconds ()-t)+ " ms"
             EndSelect
         Case #PB_EventMenu
             Select EventMenuID ()
                 Case 0
                    a.f=0 : t= ElapsedMilliseconds ()
                     Repeat
                        a.f=a.f+0.0001
                         SetGadgetState (0, a)
                     Until a>=100
                     Debug Str ( ElapsedMilliseconds ()-t)+ " ms"
             EndSelect
         Case #PB_Event_CloseWindow
        quit = 1
     EndSelect
Until quit = 1
Répondre