Gadget Bargraph

[Droopy]

Création d'un bargraph avec gestion auto du seuil moyen / haut

Code : Tout sélectionner

; PureBasic 3.93
; Idea from Localmotion34

Structure Bargraph
  x.l
  y.l
  width.l
  height.l
  medium.f
  hight.f
  full.f
  Image.l
  Gadget.l
EndStructure

ProcedureDLL BargraphH(x,y,width,height,medium.f,hight.f,full.f)
  
  ; Initialise the LinkedList the first call
  Static Init
  If Init=0
    NewList BargraphHLList.Bargraph()
  EndIf
  Init=1
  
  ; Fill the Structure
  AddElement(BargraphHLList())
  BargraphHLList()\x=x
  BargraphHLList()\y=y
  BargraphHLList()\width=width
  BargraphHLList()\height=height
  BargraphHLList()\medium=medium
  BargraphHLList()\hight=hight
  BargraphHLList()\full=full
  BargraphHLList()\Image=CreateImage(#PB_Any,width,height)
  
  ; create the gadget & show the image
  BargraphHLList()\Gadget=ImageGadget(#PB_Any,x,y,width,height,UseImage(BargraphHLList()\Image),#PB_Image_Border) 
  
  ; Return the gadget id
  ProcedureReturn ListIndex(BargraphHLList())
  
EndProcedure

ProcedureDLL BargraphHSet(id,value.f)
  
  SelectElement(BargraphHLList(),id)
  
  Ptr.f= ( value /  BargraphHLList()\full )*BargraphHLList()\width
  
  ; Rouge
  color=RGB(255,0,0)
  
  ; Jaune
  If value > BargraphHLList()\medium
    color=RGB(255,255,0)
  EndIf
  
  ; Vert
  If value > BargraphHLList()\hight
    color=RGB(0,255,0)
  EndIf
  
  ; dessine
  UseImage(BargraphHLList()\Image)
  StartDrawing(ImageOutput())
  Box(0,0,Ptr,BargraphHLList()\height,color)
  StopDrawing()
  
  SetGadgetState(BargraphHLList()\Gadget,UseImage(BargraphHLList()\Image))
  
EndProcedure


;/ Test
OpenWindow(0, 0, 0, 250, 250, #PB_Window_SystemMenu | #PB_Window_ScreenCentered , "Bargraph")
CreateGadgetList(WindowID())
a=BargraphH(10,10,228,50,3000,6000,9000) 
b=BargraphH(10,80,228,10,1500,3000,4500) 
c=BargraphH(10,110,228,50,3000,8000,18000)

For n= -5000 To 9000 Step 20
  BargraphHSet(a,n)
  BargraphHSet(b,n)
  BargraphHSet(c,n)
  Delay(10)
  If WindowEvent()= #PB_Event_CloseWindow  : End : EndIf
Next

Delay(2000)

[Le Soldat Inconnu]

Avec ma lib ColorEffect, j'ai modifié l'apparence comme ceci

Code : Tout sélectionner

; PureBasic 3.93
; Idea from Localmotion34

Structure Bargraph
  x.l
  y.l
  width.l
  height.l
  medium.f
  hight.f
  full.f
  Image.l
  Gadget.l
EndStructure

ProcedureDLL BargraphH(x, y, width, height, medium.f, hight.f, full.f)
  
  ; Initialise the LinkedList the first call
  Static Init
  If Init = 0
    NewList BargraphHLList.Bargraph()
  EndIf
  Init = 1
  
  ; Fill the Structure
  AddElement(BargraphHLList())
  BargraphHLList()\x = x
  BargraphHLList()\y = y
  BargraphHLList()\width = width
  BargraphHLList()\height = height
  BargraphHLList()\medium = medium
  BargraphHLList()\hight = hight
  BargraphHLList()\full = full
  BargraphHLList()\Image = CreateImage(#PB_Any, width, height)
  
  ; create the gadget & show the image
  BargraphHLList()\Gadget = ImageGadget(#PB_Any, x, y, width, height, UseImage(BargraphHLList()\Image), #PB_Image_Border)
  
  ; Return the gadget id
  ProcedureReturn ListIndex(BargraphHLList())
  
EndProcedure

ProcedureDLL BargraphHSet(id, value.f)
  
  SelectElement(BargraphHLList(), id)
  
  Ptr = BargraphHLList()\width * value / BargraphHLList()\full
  
  ; dessine
  UseImage(BargraphHLList()\Image)
  StartDrawing(ImageOutput())
    For n = 0 To Ptr
      Line(n, 0, 0, BargraphHLList()\height, ColorBlending(RGB(0, 255, 0), RGB(255, 0, 0), n / BargraphHLList()\width))
    Next
  StopDrawing()
  
  SetGadgetState(BargraphHLList()\Gadget, UseImage(BargraphHLList()\Image))
  
EndProcedure


;/ Test
OpenWindow(0, 0, 0, 250, 250, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Bargraph")
CreateGadgetList(WindowID())
a = BargraphH(10, 10, 228, 50, 3000, 6000, 9000)
b = BargraphH(10, 80, 228, 10, 1500, 3000, 4500)
c = BargraphH(10, 110, 228, 50, 3000, 8000, 18000)

For n = -5000 To 9000 Step 20
  BargraphHSet(a, n)
  BargraphHSet(b, n)
  BargraphHSet(c, n)
  Delay(10)
  If WindowEvent() = #PB_Event_CloseWindow : End : EndIf
Next

Delay(2000)

[Jacobus]

Superbe ! Ca en jette.

[Le Soldat Inconnu]

Ah, un truc, si on fait marche arrière ça ne marche pas, il faut faire une Box qui efface l'image avant de dessiner, je viens juste de penser à ça.

Le must sera de mettre des couleurs paramétrable différement pour chaque Bargraph, c'est vite fait

[Droopy]

Joli avec le dégradé Soldat

Je vais ajouter une gestion de direction ( Bargraph horizontal / vertical ... )
+ définition des des couleurs min/moy/max

[nico]

J'avais vu ça sur le Forum Anglais et c'est vrai que ça en jette!

[Droopy]

Nouvelle version : Choix des couleurs, direction, gestion des évènements

Code : Tout sélectionner

; PureBasic 3.93
; Idea from Localmotion34

; 0 Right / 1 Left / 2 Up / 3 Down
; Manage Event
; You can choose color / Direction

Structure Bargraph
  x.l
  y.l
  width.l
  height.l
  medium.f
  hight.f
  full.f
  Image.l
  Gadget.l
  value.f
  color1.l
  color2.l
  color3.l
  Direction.l
EndStructure

ProcedureDLL Bargraph(x,y,width,height,Direction,medium.f,hight.f,full.f,color1,color2,color3)
  
  ; Initialise the LinkedList the first call
  Static Init
  If Init=0
    NewList BargraphLList.Bargraph()
  EndIf
  Init=1
  
  ; Fill the Structure
  AddElement(BargraphLList())
  BargraphLList()\x=x
  BargraphLList()\y=y
  BargraphLList()\width=width
  BargraphLList()\height=height
  BargraphLList()\medium=medium
  BargraphLList()\hight=hight
  BargraphLList()\full=full
  BargraphLList()\color1=color1
  BargraphLList()\color2=color2
  BargraphLList()\color3=color3
  BargraphLList()\Direction=Direction
  BargraphLList()\Image=CreateImage(#PB_Any,width,height)
  
  ; create the gadget & show the image
  BargraphLList()\Gadget=ImageGadget(#PB_Any,x,y,width,height,UseImage(BargraphLList()\Image),#PB_Image_Border) 
  
  ; Return the gadget id
  ProcedureReturn ListIndex(BargraphLList())
  
EndProcedure

ProcedureDLL BargraphSet(id,value.f)
  
  SelectElement(BargraphLList(),id)
  
  BargraphLList()\value=value
  
  ; Rouge
  color=BargraphLList()\color1
  
  ; Jaune
  If value > BargraphLList()\medium
    color=color=BargraphLList()\color2
  EndIf
  
  ; Vert
  If value > BargraphLList()\hight
    color=color=BargraphLList()\color3
  EndIf
  
  ; dessine
  UseImage(BargraphLList()\Image)
  StartDrawing(ImageOutput())
  
  Select BargraphLList()\Direction
    Case 0 
      Ptr.f= ( value /  BargraphLList()\full )*BargraphLList()\width
      Box(0,0,Ptr,BargraphLList()\height,color)
    Case 1
      Ptr.f= ( value /  BargraphLList()\full )*BargraphLList()\width
      Box(BargraphLList()\width,0,-(Ptr),BargraphLList()\height,color)
    Case 2
      Ptr.f= ( value /  BargraphLList()\full )*BargraphLList()\height
      Box(0,BargraphLList()\height,BargraphLList()\width,-(Ptr),color)
    Case 3
      Ptr.f= ( value /  BargraphLList()\full )*BargraphLList()\height
      Box(0,0,BargraphLList()\width,Ptr,color)
  EndSelect
  StopDrawing()
  
  SetGadgetState(BargraphLList()\Gadget,UseImage(BargraphLList()\Image))
  
EndProcedure

ProcedureDLL BargraphGet(id)
  SelectElement(BargraphLList(),id)
  ProcedureReturn BargraphLList()\value
EndProcedure

Procedure BargraphEvent(id)
  SelectElement(BargraphLList(),id)
  ProcedureReturn BargraphLList()\Gadget
EndProcedure  


;/ Test
OpenWindow(0, 0, 0, 280, 360, #PB_Window_SystemMenu | #PB_Window_ScreenCentered , "Bargraph")
CreateGadgetList(WindowID())
a=Bargraph(10,10,250,25,0,2500,7000,15000,RGB(255,0,0),color=RGB(255,255,0),color=RGB(0,255,0)) 
b=Bargraph(10,50,250,25,1,2000,5000,7500,color=RGB(255,255,0),color=RGB(0,255,0),RGB(255,0,0)) 
c=Bargraph(10,90,110,250,2,1000,2000,8000,16776960,16744448,16711680) 
d=Bargraph(150,90,110,250,3,5000,7500,12000,16744703,16711935,8388863) 


For n= 0 To 10000 Step 20
  BargraphSet(a,n)
  BargraphSet(b,n)
  BargraphSet(c,n)
  BargraphSet(d,n)
  
  Delay(10)
  Event=WindowEvent()
  If Event=#PB_Event_CloseWindow  : End : EndIf
  If Event=#PB_Event_Gadget
    Select EventGadgetID()
      Case BargraphEvent(a) 
        Beep_(400,25) 
      Case BargraphEvent(b) 
        Beep_(800,25) 
      Case BargraphEvent(c) 
        Beep_(1600,25) 
      Case BargraphEvent(d) 
        Beep_(3200,25) 
    EndSelect
  EndIf     
        
  
Next

Delay(2000)