for my newsreader, i needed a download speed display. Because i didn't find one, i wrote my own. Here is a screenshot how it looks like:
The latest changes are:
- automatically count of grid separator lines
- support of floating point values
- fixed code for users with more than one desktop
- SpeedBarFree() command to avoid memory leak on heavy use
If you find a bug, please let me know. If anyone is interested in an NNTP component, please let me know. I can post it here as well.
Here is the source code:
Code: Select all
;SpeedBar-Gadget, written by Uwe Keller, 5.10.2012
EnableExplicit
Macro New(Object)
AllocateMemory(SizeOf(Object))
EndMacro
Enumeration ;flags
#SpeedBarBorder = 1
EndEnumeration
Enumeration ;attributes
#SpeedBarMaximum
#SpeedBarSmooth
#SpeedBarBackColor
#SpeedBarGridColor
#SpeedBarValueColor
#SpeedBarSplitsX
#SpeedBarSplitsY
#SpeedBarDigits
#SpeedBarFont
EndEnumeration
Structure _SpeedBarValue
Time.l
Value.f
EndStructure
Structure _SpeedBar
;variables
Canvas.i ;canvas gadget id
Flags.i ;canvas gadget flags
MaxItems.i ;maximum number of items (screenwidth)
Font.i ;font id used for labels
List Values._SpeedBarValue()
;attributes
Maximum.i ;maximum possible value
Smooth.i ;number of values to calculate an average (will smooth line)
BackColor.i ;back color of the diagramm
GridColor.i ;grid color of the diagramm
ValueColor.i ;value color of the diagramm
SplitsX.i ;number of horizontal sections (0=auto)
SplitsY.i ;number of vertical sections (0=auto)
Digits.i ; number of digits for values
EndStructure
Procedure _SpeedBarPaintLabel(x, y, w, h, Text.s, BackColor, ForeColor)
;draw a speed or time label
;background
Box(x, y, w, h, BackColor)
;text centered
x + (w - TextWidth(Text)) / 2
y + (h - TextHeight(Text)) / 2
DrawText(x, y, Text, ForeColor, BackColor)
EndProcedure
Procedure.f SpeedBarValue(Gadget)
;returns the most recent speed value
Protected *d._SpeedBar = GetGadgetData(Gadget)
If LastElement(*d\Values())
ProcedureReturn *d\Values()\Value
EndIf
EndProcedure
Procedure SpeedBarFree(Gadget)
;frees all memory related to the speed bar gadget (it cannot be further used!)
Protected *d._SpeedBar = GetGadgetData(Gadget)
FreeFont(*d\Font)
FreeList(*d\Values())
FreeMemory(*d)
FreeGadget(Gadget)
EndProcedure
Procedure SpeedBarSet(Gadget, Setting, Value)
;sets a speed bar attribute
Protected *d._SpeedBar = GetGadgetData(Gadget)
Select Setting
Case #SpeedBarMaximum
*d\Maximum = Value
Case #SpeedBarSmooth
*d\Smooth = Value
Case #SpeedBarBackColor
*d\BackColor = Value
Case #SpeedBarGridColor
*d\GridColor = Value
Case #SpeedBarValueColor
*d\ValueColor = Value
Case #SpeedBarSplitsX
*d\SplitsX = Value
Case #SpeedBarSplitsY
*d\SplitsY = Value
Case #SpeedBarDigits
*d\Digits = Value
Case #SpeedBarFont
*d\Font = Value
EndSelect
EndProcedure
Procedure SpeedBarGet(Gadget, Setting)
;returns a speed bar attribute
Protected *d._SpeedBar = GetGadgetData(Gadget)
Select Setting
Case #SpeedBarMaximum
ProcedureReturn *d\Maximum
Case #SpeedBarSmooth
ProcedureReturn *d\Smooth
Case #SpeedBarBackColor
ProcedureReturn *d\BackColor
Case #SpeedBarGridColor
ProcedureReturn *d\GridColor
Case #SpeedBarValueColor
ProcedureReturn *d\ValueColor
Case #SpeedBarSplitsX
ProcedureReturn *d\SplitsX
Case #SpeedBarSplitsY
ProcedureReturn *d\SplitsY
Case #SpeedBarDigits
ProcedureReturn *d\Digits
Case #SpeedBarFont
ProcedureReturn *d\Font
EndSelect
EndProcedure
Procedure SpeedBarPaint(Gadget)
Protected *d._SpeedBar, x, y, w, h, tw, th, sx, sy, i, n, lh, lasty, color, speed.f, time.s
;repaint the SpeedBar
If StartDrawing(CanvasOutput(Gadget))
*d = GetGadgetData(Gadget)
;paint area size
w = OutputWidth()
h = OutputHeight()
;set drawing font
DrawingFont(FontID(*d\Font))
;background
Box(0, 0, w, h, *d\BackColor)
;x-grid
#_SpeedBarTextPadding = 2
tw = TextWidth("00:00") + #_SpeedBarTextPadding
th = TextHeight("00:00") + #_SpeedBarTextPadding
;horizontal split count
If *d\SplitsX
sx = *d\SplitsX ;fixed
Else
sx = w / (tw * 1.25) ;variable (use 25% padding)
EndIf
;paint horizontal grid with label
If sx
For i = 0 To sx
x = (w - 1) * i / sx
Line(x, 0, 1, h, *d\GridColor)
If i > 0 And i < sx
n = ListSize(*d\Values()) - (w - x)
If n >= 0
If SelectElement(*d\Values(), n)
time = FormatDate("%hh:%ii", *d\Values()\Time)
_SpeedBarPaintLabel(x - tw / 2, h - th, tw, th, time, *d\GridColor, *d\BackColor)
EndIf
EndIf
EndIf
Next
EndIf
;y-grid
tw = TextWidth(StrD(*d\Maximum, *d\Digits)) + #_SpeedBarTextPadding
;vertical split
If *d\SplitsY
sy = *d\SplitsY
Else
sy = h / (th * 2) ;variable (use 100% padding)
EndIf
;paint vertical grid with label
If sy
For i = 0 To sy
y = (h - 1) * i / sy
Line(0, y, w, 1, *d\GridColor)
If i < sy
speed = *d\Maximum * (sy - i) / sy
_SpeedBarPaintLabel(0, y, tw, th, StrD(speed, *d\Digits), *d\GridColor, *d\BackColor)
EndIf
Next
EndIf
;value
If LastElement(*d\Values())
color = RGBA(Red(*d\ValueColor), Green(*d\ValueColor), Blue(*d\ValueColor), 48)
x = w - 1
Repeat
;calculate line height (take care of position inside drawing area)
lh = (h - 1) * *d\Values()\Value / *d\Maximum
If lh > 0
;upper bound limit
If lh >= h
lh = h - 1
EndIf
y = h - lh
;transparent fill
DrawingMode(#PB_2DDrawing_AlphaBlend)
Line(x, y, 1, lh, color)
DrawingMode(#PB_2DDrawing_Default)
;value line
If Not lasty Or lasty = y
Line(x, y, 1, 1, *d\ValueColor)
Else
LineXY(x, y, x + 1, lasty, *d\ValueColor)
EndIf
lasty = y
Else
lasty = 0
EndIf
x - 1
Until x = 0 Or Not PreviousElement(*d\Values())
EndIf
StopDrawing()
EndIf
EndProcedure
Procedure SpeedBarAdd(Gadget, Value.f)
;stores cached value with timestamp and update display
Protected *d._SpeedBar = GetGadgetData(Gadget)
;smooth value (calculate average of latest available values)
If Value > 0 And *d\Smooth > 0 And LastElement(*d\Values())
Protected n = 1
Repeat
If *d\Values()\Value = 0
Break
EndIf
Value + *d\Values()\Value
n + 1
Until n > *d\Smooth Or Not PreviousElement(*d\Values())
Value / n
EndIf
;add value to collection
LastElement(*d\Values())
AddElement(*d\Values())
*d\Values()\Time = Date()
*d\Values()\Value = Value
;limit number of values to screen width
If ListSize(*d\Values()) > *d\MaxItems
FirstElement(*d\Values())
DeleteElement(*d\Values())
EndIf
;show value
SpeedBarPaint(Gadget)
EndProcedure
Procedure SpeedBarGadget(Gadget, x, y, w, h, Flags=0)
;create new speedbar
Protected f, *d._SpeedBar, desktops, i
;build canvas flags
If Flags & #SpeedBarBorder
f | #PB_Canvas_Border
EndIf
;create additional speedbar object data
*d = New(_SpeedBar)
*d\Canvas = CanvasGadget(Gadget, x, y, w, h, f)
*d\Flags = Flags
*d\Font = LoadFont(#PB_Any, "", 8)
*d\Maximum = 100
*d\BackColor = $000000
*d\GridColor = $1C1C1C
*d\ValueColor = $0000FF
NewList *d\Values()
;store object in gadget data
If Gadget = #PB_Any
SetGadgetData(*d\Canvas, *d)
Else
SetGadgetData(Gadget, *d)
EndIf
;maximum number of values to store is limited to desktop width
desktops = ExamineDesktops()
For i = 0 To desktops - 1
If *d\MaxItems < DesktopWidth(i)
*d\MaxItems = DesktopWidth(i)
EndIf
Next
;return gadget id
ProcedureReturn *d\Canvas
EndProcedure
DisableExplicit
CompilerIf #PB_Compiler_IsMainFile
If OpenWindow(0, 0, 0, 460, 180, "Speedbar-Demo", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
sb = SpeedBarGadget(#PB_Any, 10, 10, 440, 160, #SpeedBarBorder)
SpeedBarSet(sb, #SpeedBarMaximum, 1)
SpeedBarSet(sb, #SpeedBarDigits, 2)
SpeedBarSet(sb, #SpeedBarBackColor, $000000)
SpeedBarSet(sb, #SpeedBarValueColor, $0000FF)
SpeedBarSet(sb, #SpeedBarGridColor, $202020)
AddWindowTimer(0, 0, 100)
value.f = 0.5
Repeat
Select WaitWindowEvent()
Case #PB_Event_SizeWindow
ResizeGadget(sb, #PB_Ignore, #PB_Ignore, WindowWidth(0) - 20, WindowHeight(0) - 20)
SpeedBarPaint(sb)
Case #PB_Event_Timer
;change color once a second
n + 1
If Not n % 10
SpeedBarSet(sb, #SpeedBarValueColor, RGB(Random(256), Random(256), Random(256)))
EndIf
;update speedbar once a second
value + (Random(30) - 15) / 1000
SpeedBarAdd(sb, value)
Case #PB_Event_CloseWindow
Break
EndSelect
ForEver
SpeedBarFree(sb)
EndIf
CompilerEndIf
Uwe