PureBasic Forums - English

Posted: **Mon Jul 02, 2012 4:09 pm**

Hi,

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

Best regards
Uwe

Posted: **Mon Jul 02, 2012 4:32 pm**

thx, looks very good!

Posted: **Mon Jul 02, 2012 5:49 pm**

Thanks. I have a small suggestion to simplify a portion of the paint procedure.

Make these modification.s

Code: Select all

    ;paint area size
    ;w = GadgetWidth(Gadget)
    ;h = GadgetHeight(Gadget)
    w = OutputWidth()
    h = OutputHeight()

    ;this code is now unnecessary
    ;;reduce width and height if canvas gadget has border
    ;If *d\Flags & #SpeedBarBorder
    ;  w - 4
    ;  h - 4
    ;EndIf

Posted: **Mon Jul 02, 2012 6:18 pm**

Cool nice gadget, works fine on XP thanks

Posted: **Mon Jul 02, 2012 7:14 pm**

@Demivec: I updated the code above. Also, my code always expected a border with of 2 pixels, what must not be true on any system. Thank you!

Posted: **Mon Jul 02, 2012 7:30 pm**

Very nice and good looking, thank you.

uwekel wrote: If anyone is interested in an NNTP component, please let me know. I can post it here as well.

I would be certainly interested. Are you writing a news reader in PB ? Cool project

Posted: **Mon Jul 02, 2012 7:51 pm**

Yes, i am porting my newsreader, which i have written with VB.Net under Windows, to PB, because i've left the Windows world a while ago. Of course, everything has to be rewritten

The NNTP component is mainly designed to handle articles with binary attachments, so it can also decode articles with encodings like MIME/Base64, UU or yEnc.
Before i can post it, i have to prepare it a little bit and write a demo. The file has about 1000 lines of code. What is the best way to publish it?

Posted: **Mon Jul 02, 2012 8:15 pm**

"The best way to publish it" form my point of view is the one who permits to access it again in a couple of years.

If it's only code probably a post or multiple posts in a thread will be ok (not everyone will be happy http://www.purebasic.fr/english/viewtop ... 07#p348407)

If contains binary data (not your case I imagine) you can convert the data in hexadecimal data sections and still post it as text.

Or if you have a reliable (in time I mean) host you can upload all there in zip format. IMHO probably the best way for large includes when it can be done.

What I done in the past is to put some links to my current home page, but since I don't own a domain I used a redirector service to point to it. The links in the posts are using that, so if in the future I will change my hosting domain I'll just have to update the redirector. That's the hope at least.

Just do as you wish.

Posted: **Mon Jul 02, 2012 8:45 pm**

Hm, for 1000 lines a file hosting should be more convenient. I just uploaded the Speedbar to my Dropbox and got this link:
Speedbar.pb
Hope this works for a long time

For the NNTP i will start another thread in a couple of days.

Posted: **Mon Jul 02, 2012 9:07 pm**

uwekel wrote:Hm, for 1000 lines a file hosting should be more convenient. I just uploaded the Speedbar to my Google docs and got this link:
Speedbar.pb
Hope this works for a long time
For the NNTP i will start another thread in a couple of days.

History shows the external links are rarely reliable over years. Almost every thread on here with an external link has a post requesting an updated link.

Have you considered buffering the drawing? Or, perhaps Shifting the entire thing to the left, then adding to it? I have not looked at your drawing method closely, but it flickers on my laptop. Granted, it is getting dated at 4 years old, but I know there are ways to draw such undemanding motion without flicker on something even much slower.

Posted: **Tue Jul 03, 2012 7:09 am**

Shifting one pixel left wouldn't work because of the underlaying grid with timestamps. Each value added to the speedbar gets a timestamp, so it is not required to add values only in a time loop. The demo probably flickers because it refreshes 10 times a second, which is uncommon for the real use. If i remember right, Windows provides an API command LockWindowUpdate(WindowId) which can be called before drawing starts and called again with Null argument after drawing has completed. Maybe you can try it.

Posted: **Tue Jul 03, 2012 8:16 am**

nice, thanks uwekel

Posted: **Tue Jul 03, 2012 11:15 am**

nice work and very clearly coded. Could be a tutorial on how to create your own gadgets!

Posted: **Tue Jul 03, 2012 5:09 pm**

I just uploaded the Speedbar to my Google docs and got this link:
Speedbar.pb

It doesn't work! Non Goggle members just get an advert for Goggle drive and if a member logs-in, the association with your Goggle drive page is lost......

Posted: **Tue Jul 03, 2012 6:22 pm**

IdeasVacuum wrote:
I just uploaded the Speedbar to my Google docs and got this link:
Speedbar.pb
It doesn't work! Non Goggle members just get an advert for Goggle drive and if a member logs-in, the association with your Goggle drive page is lost......

I changed the link to my Dropbox. Would you mind testing it once more?

PureBasic Forums - English

SpeedbarGadget

SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget

Re: SpeedbarGadget