[Module] ChartGadgetModule.pbi

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Thorsten1867
Beiträge: 1359
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

[Module] ChartGadgetModule.pbi

Beitrag von Thorsten1867 »

ChartGadgetModule.pbi

Code: Alles auswählen

;/ =============================
;/ ||  ChartGadgetModule.pbi  ||
;/ =============================
;/
;/ ChartGadget for bars and lines [64Bit ready]
;/
;/ April 2014 by Uwe Keller (uwekel)  
;/ Module by Thorsten1867
;/

; ===== Module Commands =====
; Chart::RefreshGadget() - Refresh the gadget and repaint the whole chart
; Chart::SetAttribute()  - Setup the chart attributes
; Chart::AddRow()        - Add a row to the chart
; Chart::AddColumn()     - Add a column to the chart
; Chart::SetValue()      - Add or update chart value
; Chart::SetText()       - Set the text for titel, x-axis, y-axis and unit
; Chart::Clear()         - Remove all data from the chart
; Chart::Gadget()        - Create new chart gadget (from CanvasGadget)
; ===========================

DeclareModule Chart
  
  ; --- Constants ---
  
  Enumeration ;{ Flags
    #Border         = 1
    #LegendRight    = 1 << 1
    #LegendBottom   = 1 << 2
    #XAxis          = 1 << 3
    #YAxis          = 1 << 4
    #HGrid          = 1 << 5
    #VGrid          = 1 << 6
    #Stapled        = 1 << 7
    #BarsBorderless = 1 << 8
    #XAxisVAlign    = 1 << 9
    #SortColumns    = 1 << 10
    #SortRows       = 1 << 11
  EndEnumeration ;}
  
  Enumeration ;{ Attributes
    #SetFlags
    #SetFont
    #SetBackColor
    #SetFrontColor
    #SetAreaColor
    #SetGridColor
    #SetValueColor
    #SetAxisColor
    #SetLineWidth
    #SetPointSize
    #SetPadding
    #SetDecimalPlaces
    #SetFillStyle
  EndEnumeration ;}
  
  Enumeration ;{ Text Types
    #TextTitle
    #TextYAxis
    #TextXAxis
    #TextUnit
  EndEnumeration ;}
  
  Enumeration ;{ Row Types
    #RowTypeBar
    #RowTypeLine
  EndEnumeration ;}
  
  Enumeration ;{ Row Flags
    #RowValues = 1
    #RowPoints = 2
  EndEnumeration ;}
  
  Enumeration ;{ Value Flags
    #ValueReplace
    #ValueSum
  EndEnumeration ;}
  
  Enumeration ;{ Fill Styles
    #StyleSolid
    #StyleGradient
    #StyleEmbossed
  EndEnumeration ;}
  
  Enumeration ;{ Clear Flags
    #KeepRows    = 1
    #KeepColumns = 2
  EndEnumeration ;}
  
  ; --- Commands ---
  
  Declare RefreshGadget(Gadget.i)
  Declare SetAttribute(Gadget.i, Setting.i, Value.i)
  Declare AddRow(Gadget.i, Name.s, Type.i, Color.i, Flags.l=0)
  Declare AddColumn(Gadget.i, Name.s)
  Declare SetValue(Gadget.i, Row.s, Column.s, Value.f, Flags.l=0)
  Declare SetText(Gadget.i, Type.i, Text.s)
  Declare Clear(Gadget.i, Flags.l=0)
  Declare.i Gadget(Gadget.i, x.i, y.i, w.i, h.i, Flags.l=0)
  
EndDeclareModule   

Module Chart

  EnableExplicit

  Macro Section
  ;this macro is just for code folding and indentation
  EndMacro
  
  Macro EndSection
  EndMacro
  
  Macro Iter(Object, ListOrMap)
    ListOrMap
    Object=ListOrMap
  EndMacro

  Macro Max(a, b)
    ((a) * Bool((a) >=(b)) + (b) * Bool((b) > (a)))
  EndMacro
  
  Macro Min(a, b)
    ((a) * Bool((a) <=(b)) + (b) * Bool((b) < (a)))
  EndMacro
  
  Macro New(Object)
    AllocateMemory(SizeOf(Object))
  EndMacro

  Procedure.i ChangeColor(Color.i, Offset.i)
    Protected i.i, a.a
    ; split color
    For i = 0 To 2
      a = PeekA(@color + i)
      If a + Offset < 0
        a = 0
      ElseIf a + Offset > 255
        a = 255
      Else
        a + Offset
      EndIf
      PokeA(@color + i, a)
    Next
    ; return new color
    ProcedureReturn Color
  EndProcedure
  
  ;{ ----- Structures -----
  Structure _ChartRow
    Name.s
    Type.i
    Color.i
    Flags.i
    LastY.i
  EndStructure
  
  Structure _ChartColumn
    Name.s
    Minimum.f
    Maximum.f
  EndStructure
  
  Structure _ChartValue
    Row.s
    Column.s
    Value.f
  EndStructure
  
  Structure _Chart
    Title.s
    YTitle.s
    XTitle.s
    Unit.s
    BackColor.i
    FrontColor.i
    AreaColor.i
    GridColor.i
    ValueColor.i
    AxisColor.i
    LineWidth.i
    PointSize.i
    Padding.i
    DecimalPlaces.i
    FillStyle.i
    Minimum.f
    Maximum.f
    Flags.i
    Font.i
    TextHeight.i
    StepValue.f
    BarRowCount.i
    List Rows._ChartRow()
    List Columns._ChartColumn()
    List Values._ChartValue()
  EndStructure
  ;} --------------------------
  
  Procedure.i _ChartBlendColor(Color1.i, Color2.i, Index.i, Count.i)
    Protected.a r1, g1, b1, r2, g2, b2, r, g, b
    Protected.f f = Index / Count
    ;split first color
    r1 = Red(Color1)
    g1 = Green(Color1)
    b1 = Blue(Color1)
    ;split second color
    r2 = Red(Color2)
    g2 = Green(Color2)
    b2 = Blue(Color2)
    ;blend colors
    r = r1 + (r2 - r1) * f
    g = g1 + (g2 - g1) * f
    b = b1 + (b2 - b1) * f
    ;return new color
    ProcedureReturn RGB(r, g, b)
  EndProcedure
  
  Procedure.f _ChartRoundUp(Value.f, StepValue.f)
    ;rounds a value to the next higher step
    Protected negative.l, v.f
    ;convert negative to positive
    If Value < 0
      negative = #True
      Value * -1
    EndIf
    ;round value
    v = Int(Value / StepValue) * StepValue
    If v < Value
      v + StepValue
    EndIf
    ;restore negative value
    If negative
      v * -1
    EndIf
    ;return result
    ProcedureReturn v
  EndProcedure
  
  Procedure.f _ChartRoundStepValue(Value.f)
    ;returns a good step range value for a data point value
    Protected.i n
    ;avoid errors if value is zero
    If Not Value
      ProcedureReturn 1
    EndIf
    ;move value between 1 and 10
    While Value > 10
      Value / 10
      n - 1
    Wend
    While Value < 1
      Value * 10
      n + 1
    Wend
    ;round
    Select Value
      Case 1 To 2.5
        Value = 2.5
      Case 2.5 To 5
        Value = 5
      Default
        Value = 10
    EndSelect
    ;move value to original position
    While n > 0
      Value / 10
      n - 1
    Wend
    While n < 0
      Value * 10
      n + 1
    Wend
    ;return rounded result
    ProcedureReturn Value
  EndProcedure
  
  Procedure _ChartPoint(X.i, Y.i, Radius.i)
    Protected.i xl, xr, yt, yb, i, yo
    ;get corner positions
    xl = x - Radius
    xr = x + Radius
    yt = y - Radius
    yb = y + Radius
    ;filling
    For i = Radius To 0 Step -1
      yo = Radius - i
      LineXY(x - i, y - yo, x + i, y - yo)
      LineXY(x - i, y + yo, x + i, y + yo)
    Next
    ;border
    LineXY(xl, y, x, yt, 0)
    LineXY(x, yt, xr, y, 0)
    LineXY(xl, y, x, yb, 0)
    LineXY(x, yb, xr, y, 0)
  EndProcedure
  
  Procedure _ChartLine(X.i, Y.i, x3.i, y3.i, Color.i, Thickness.i)
    ;paints a chart line with anti-aliasing
    Protected.f thick, x2, y2, app, hypo, cosphi, sinphi
    Protected.i color1, color2, r, g, b, r1, g1, b1
    Protected.i signx, signy, n, nn, w, h, xp, yp
   
    w = x3 - X
    h = y3 - Y
   
    If w >= 0
      signx = 1
    Else
      signx = -1
      w = -w
    EndIf
    If h >= 0
      signy = 1
    Else
      signy = -1
      h = -h
    EndIf
   
    thick  = Thickness / 2
    hypo   = Sqr(w * w + h * h)
    cosphi = w / hypo
    sinphi = -Sin(ACos(cosphi))
   
    For n = -Thickness To w + Thickness
      For nn = -Thickness To h + Thickness
       
        x2 = n * cosphi - nn * sinphi
        y2 = Abs(n * sinphi + nn * cosphi)
       
        If y2 <= thick + 0.5
          app = 0.5 + thick - y2
          If app > 1
            app = 1
          EndIf
          If x2 > -1 And x2 < hypo + 1
            If x2 < 0
              app * (1 + x2)
            ElseIf x2 > hypo
              app * (1 - x2 + hypo)
            EndIf
          Else
            app = 0
          EndIf
          If app > 0
            xp = X + n * signx
            If xp >= 0 And xp < OutputWidth()
              yp = Y + nn * signy
              If yp >= 0 And yp < OutputHeight()
                If app >= 1
                  Plot(xp, yp, Color)
                Else
                  color1 = Point(xp, yp)
                  r = Color & $FF
                  g = Color >> 8 & $FF
                  b = Color >> 16
                  r1 = color1 & $FF
                  g1 = color1 >> 8 & $FF
                  b1 = color1 >> 16
                  r = r * app + r1 * (1 - app)
                  g = g * app + g1 * (1 - app)
                  b = b * app + b1 * (1 - app)
                  color2 = RGB(r, g, b)
                  Plot(xp, yp, color2)
                EndIf
              EndIf
            EndIf
          EndIf
        EndIf
      Next
    Next
   
  EndProcedure
  
  Procedure _ChartPaintValue(*c._Chart, X.i, Y.i, Value.f)
    ;paint value
    Protected w.i, h.i, s.s
    ;get value string
    s = StrF(Value, *c\DecimalPlaces)
    ;coordinates
    w = TextWidth(s)
    h = *c\TextHeight
    X - w / 2
    Y - *c\TextHeight / 2
    ;draw
    DrawText(X, Y, s, *c\FrontColor, *c\ValueColor)
    DrawingMode(#PB_2DDrawing_Outlined)
    X - 1: Y - 1: w + 2: h + 2
    Box(X, Y, w, h, *c\ValueColor)
    X - 1: Y - 1: w + 2: h + 2
    Box(X, Y, w, h, 0)
    DrawingMode(#PB_2DDrawing_Default)
  EndProcedure
  
  Procedure _ChartPaintBar(*c._Chart, *r._ChartRow, x.i, y.i, w.i, h.i)
    Protected.i i, c1, c2
    ;rotate coordinates if hight is negative (to avoid further problems when painting)
    If h < 0
      y + h
      h * -1
    EndIf
    ;paint bar
    Select *c\FillStyle
      Case #StyleSolid
        Box(x, y, w, h, *r\Color)
      Case #StyleGradient
        c1 = ChangeColor(*r\Color, $50)
        For i = 0 To w / 2
          c2 = _ChartBlendColor(*r\Color, c1, i, w / 2)
          Line(x + i, y, 1, h, c2)
          Line(x + w - 1 - i, y, 1, h, c2)
        Next
      Case #StyleEmbossed
        Box(x, y, w, h, *r\Color)
        For i = 1 To 4
          c1 = ChangeColor(*r\Color, 50 - i * 10) ;light
          c2 = ChangeColor(*r\Color, -50 + i * 10) ;dark
          Line(x + i, y + i, w - 1 - i * 2, 1, c1)
          Line(x + i, y + i, 1, h - 1 - i * 2, c1)
          Line(x + w - i, y + i, 1, h - i * 2, c2)
          Line(x + i, y + h - i, w - i * 2 + 1, 1, c2)
        Next
    EndSelect
    ;paint bar borders
    If Not *c\Flags & #BarsBorderless
      Line(x, y, 1, h, 0)
      Line(x, y, w, 1, 0)
      Line(x + w, y, 1, h, 0)
      Line(x, y + h, w + 1, 1, 0)
    EndIf
  EndProcedure
  
  Procedure _ChartPaintLegend(*c._Chart, *r._ChartRow, x.i, y.i)
    ;paint legend item
    Protected.i i, cx, cy, ps
    Select *r\Type
      Case #RowTypeBar
        _ChartPaintBar(*c, *r, x + 1, y + 1, *c\TextHeight - 3, *c\TextHeight - 2)
      Case #RowTypeLine
        cy = y + *c\TextHeight / 2
        _ChartLine(x + 1, cy, x + *c\TextHeight - 2, cy, *r\Color, *c\LineWidth)
        ;limit pointsize to textsize
        cx = x + *c\TextHeight / 2 - 1
        ps = Min(*c\PointSize, *c\TextHeight / 2 - 2)
        _ChartPoint(cx, cy, ps)
    EndSelect
    ;row name
    DrawText(x + *c\TextHeight + 1, y, *r\Name, *c\FrontColor, *c\BackColor)
  EndProcedure
 
  Procedure RefreshGadget(Gadget.i) ; <-- Paint(Gadget.i)
    ;paint the whole chart
    Protected *g._Chart, *c._ChartColumn, *r._ChartRow, *v._ChartValue
    Protected v.f, cw.f, s.s
    Protected.i x, y, w, h, font, xah, yaw, areah, splits, x1, y1, i, xr, tw, cx, bw, zypos, zyneg, zy, bx, vh, px, py, lx, ly, lw, pass
    #_ChartAxisLimiterLength = 8
    #_ChartLegendPad = 8
    #_ChartXAxisPad = 4
    *g = GetGadgetData(Gadget)
    With *g
      StartDrawing(CanvasOutput(Gadget))
        ;preparation
        Section
        ;drawing area size
        w = OutputWidth()
        h = OutputHeight()
        ;create and measure font
        DrawingFont(\Font)
        \TextHeight = TextHeight("Xg")
        ;paint background
        Box(x, y, w, h, \BackColor)
        ;add padding
        If \Padding
          x + \Padding
          y + \Padding
          w - \Padding * 2
          h - \Padding * 2
        EndIf
        EndSection
        ;paint top title
        Section
        If \Title
          tw = TextWidth(\Title)
          DrawText((w - tw) / 2, y, \Title, \FrontColor, \BackColor)
          y + \TextHeight + \Padding
          h - \TextHeight - \Padding
        ElseIf \Flags & #YAxis
          ;at least use half height of text as spacing for y-axis values
          y + \TextHeight / 2
          h - \TextHeight / 2
        EndIf
        EndSection
        ;paint legend
        Section
        If \Flags & #LegendRight
          ;maximum row name width
          ly = y + h / 2
          ForEach Iter(*r, \Rows())
            tw = TextWidth(*r\Name)
            If tw > lw
              lw = tw
            EndIf
            ly - (\TextHeight + #_ChartLegendPad) / 2
          Next
          tw + \TextHeight
          lx = x + w - tw
          ForEach Iter(*r, \Rows())
            _ChartPaintLegend(*g, *r, lx, ly)
            ly + \TextHeight + #_ChartLegendPad
          Next
          w - tw - \Padding
        ElseIf \Flags & #LegendBottom
          ;get total width
          ly = y + h - \TextHeight - \Padding
          lx = x + w / 2
          ForEach Iter(*r, \Rows())
            ;#_ChartLegendPad = 8
            lx - (TextWidth(*r\Name) + \TextHeight - #_ChartLegendPad) / 2
          Next
          ForEach Iter(*r, \Rows())
            tw = TextWidth(*r\Name)
            _ChartPaintLegend(*g, *r, lx, ly + \Padding)
            lx + tw + \TextHeight + #_ChartLegendPad
          Next
          h - \TextHeight - \Padding
        EndIf
        EndSection
        ;left title of y-axis
        Section
        If \YTitle
          tw = TextWidth(\YTitle)
          DrawRotatedText(x, y + (h + tw) / 2, \YTitle, 90, \FrontColor)
          x + \TextHeight + \Padding
          w - \TextHeight - \Padding
        EndIf
        EndSection
        ;bottom title of x-axis
        Section
        If \XTitle
          tw = TextWidth(\XTitle)
          DrawText(x + (w - tw) / 2, y + h - \TextHeight, \XTitle, \FrontColor, \BackColor)
          h - \TextHeight - \Padding
        EndIf
        EndSection
        ;x-axis height
        Section
        If \Flags & #XAxis
          xah = #_ChartAxisLimiterLength
          If \Flags & #XAxisVAlign
            ForEach \Columns()
              xah = Max(xah, TextWidth(\Columns()\Name))
            Next
          Else
            xah = Max(xah, \TextHeight)
          EndIf
          ;add small gap between
          xah + #_ChartXAxisPad * 2
          ;reduce remain space for area
          h - xah
        EndIf
        EndSection
        ;value range
        Section
        If h > 0
          ;get value range for each column
          ForEach Iter(*c, \Columns())
            *c\Minimum = 0
            *c\Maximum = 0
            ForEach Iter(*v, \Values())
              If *v\Column = *c\Name
                If \Flags & #Stapled ;sum stapled bars
                  ForEach Iter(*r, \Rows())
                    If *r\Name = *v\Row
                      If *r\Type = #RowTypeBar
                        If *v\Value > 0
                          *c\Maximum + *v\Value
                        Else
                          *c\Minimum + *v\Value
                        EndIf
                      EndIf
                      Break
                    EndIf
                  Next
                ElseIf *v\Value < *c\Minimum
                  *c\Minimum = *v\Value
                ElseIf *v\Value > *c\Maximum
                  *c\Maximum = *v\Value
                EndIf
              EndIf
            Next
          Next
          ;calculate min/max for chart (over all columns)
          \Minimum = 0
          \Maximum = 0
          ForEach Iter(*c, \Columns())
            If *c\Minimum < \Minimum
              \Minimum = *c\Minimum
            EndIf
            If *c\Maximum > \Maximum
              \Maximum = *c\Maximum
            EndIf
          Next
          ;widen range to avoid later errors (division by 0)
          If \Maximum = \Minimum
            \Maximum + 1
          EndIf
          ;number of splits
          Select h
            Case 0 To 50
              splits = 1
            Case 0 To 100
              splits = 2
            Case 100 To 500
              splits = 5
            Default
              splits = 10
          EndSelect
          ;calculate and round step value
          \StepValue = (\Maximum - \Minimum) / splits
          \StepValue = _ChartRoundStepValue(\StepValue)
          ;round min/max
          \Minimum = _ChartRoundUp(\Minimum, \StepValue)
          \Maximum = _ChartRoundUp(\Maximum, \StepValue)
        EndIf
        EndSection
        ;y-axis width
        Section
        If \Flags & #YAxis
          yaw = TextWidth(StrF(\Maximum, \DecimalPlaces) + \Unit)
          tw = TextWidth(StrF(\Minimum, \DecimalPlaces) + \Unit)
          If tw > yaw
            yaw = tw
          EndIf
          yaw + #_ChartAxisLimiterLength
          x + yaw
          w - yaw
        EndIf
        EndSection
        ;paint area
        Section
        If h > 0
          ;background
          Box(x, y, w, h, \AreaColor)
          ;paint horizontal grid of x-axis
          If \Flags & #HGrid
            v = \Minimum
            While v <= \Maximum
              y1 = y + h - h * (v - \Minimum) / (\Maximum - \Minimum)
              Line(x, y1, w, 1, \GridColor)
              v + \StepValue
            Wend
          EndIf
          ;paint vertical grid of y-axis
          If \Flags & #VGrid
            cw = w / ListSize(\Columns())
            Line(x, y, 1, h, \GridColor)
            ForEach \Columns()
              i + 1
              x1 = x + cw * i
              Line(x1, y, 1, h, \GridColor)
            Next
          EndIf
          ;black line at zero position
          y1 = y + h - h * -\Minimum / (\Maximum - \Minimum)
          If y1 >= y And y1 <= y + h
            Line(x, y1, w + 1, 1, \AxisColor)
          EndIf
        EndIf
        EndSection
        ;paint values
        Section
        If FirstElement(\Values())
          ;reset last y-positions per row (for line chart)
          ForEach \Rows()
            \Rows()\LastY = 0
          Next
          ;single column width
          #Gap = 0.125
          cw = w / ListSize(\Columns())
          ;single bar width
          bw = cw * (1 - #Gap - #Gap)
          ;share width of bars if not stapled
          If Not \Flags & #Stapled And \BarRowCount > 1
            bw / \BarRowCount
          EndIf
          ;paint bars then lines
          For pass = 1 To 3
            ForEach Iter(*c, \Columns())
              ;column x-position
              cx = x + ListIndex(\Columns()) * cw
              ;zero line y-position
              zypos = y + h - h * -\Minimum / (\Maximum - \Minimum)
              zyneg = zypos
              bx = cx + cw * #Gap
              ForEach Iter(*r, \Rows())
                ForEach Iter(*v, \Values())
                  If *v\Row = *r\Name And *v\Column = *c\Name
                    vh = h * *v\Value / (\Maximum - \Minimum)
                    If pass = 1 And *r\Type = #RowTypeBar
                      Section ;paint bars in first pass
                      ;positive values above zero line, negatives below
                      If *v\Value > 0 Or Not \Flags & #Stapled
                        zy = zypos
                      Else
                        zy = zyneg
                      EndIf
                      ;paint bar
                      _ChartPaintBar(*g, *r, bx, zy - vh, bw, vh)
                      ;paint value
                      If *r\Flags & #RowValues
                        _ChartPaintValue(*g, bx + bw / 2, zy - vh / 2, *v\Value)
                      EndIf
                      ;shift to next bar position
                      If Not \Flags & #Stapled
                        bx + bw ;next is right
                      ElseIf *v\Value > 0
                        zypos - vh ;next positve value is above
                      Else
                        zyneg - vh ;next negative value is below
                      EndIf
                      EndSection
                    ElseIf *r\Type = #RowTypeLine
                      ;value point position
                      px = cx + cw / 2
                      py = zypos - vh
                      If pass = 2
                        Section ;paint lines in second pass
                        ;line is possible from the second value
                        If \Rows()\LastY
                          _ChartLine(px - cw, *r\LastY, px, py, *r\Color, \LineWidth)
                        EndIf
                        ;remember this y-position so a line can be drawn next
                        *r\LastY = py
                        EndSection
                      ElseIf pass = 3
                        Section ;paint data points and values in third pass
                        _ChartPoint(px, py, \PointSize)
                        ;paint value
                        If *r\Flags & #RowValues
                          If *v\Value >= 0
                            ;positiv above line
                            py - \PointSize - \TextHeight + 4
                          Else
                            ;negative below line
                            py + \PointSize + \TextHeight - 4
                          EndIf
                          _ChartPaintValue(*g, px, py, *v\Value)
                        EndIf
                        EndSection
                      EndIf
                    EndIf
                  EndIf
                Next
              Next
            Next
          Next
        EndIf
        EndSection
        ;paint y-axis
        Section
        If \Flags & #YAxis
          ;vertical line
          Line(x, y, 1, h, \AxisColor)
          ;delimiters and values
          v = \Minimum
          While v <= \Maximum
            y1 = y + h - h * (v - \Minimum) / (\Maximum - \Minimum)
            Line(x - #_ChartAxisLimiterLength + 1, y1, #_ChartAxisLimiterLength, 1, \AxisColor)
            s = StrF(v, \DecimalPlaces) + \Unit
            DrawText(x - #_ChartAxisLimiterLength - TextWidth(s), y1 - \TextHeight / 2, s, \FrontColor, \BackColor)
            v + \StepValue
          Wend
        EndIf
        EndSection
        ;paint x-axis
        Section
        If \Flags & #XAxis
          y + h
          cw = w / ListSize(\Columns())
          Line(x, y, w + 1, 1, \AxisColor)
          Line(x, y, 1, #_ChartAxisLimiterLength, \AxisColor)
          i = 0
          ForEach Iter(*c, \Columns())
            i + 1
            xr = x + cw * i
            Line(xr, y, 1, #_ChartAxisLimiterLength, \AxisColor)
            If \Flags & #XAxisVAlign
              DrawRotatedText(xr - (cw + \TextHeight) / 2, y + xah - #_ChartXAxisPad, *c\Name, 90, \FrontColor)
            Else
              tw = TextWidth(*c\Name)
              DrawRotatedText(xr - cw / 2 - tw / 2, y + #_ChartXAxisPad, *c\Name, 0, \FrontColor)
            EndIf
          Next
        EndIf
        EndSection
      StopDrawing()
    EndWith
  EndProcedure
 
  Procedure SetAttribute(Gadget.i, Setting.i, Value.i) ; <-- Set(Gadget.i, Setting.i, Value.i)
    ;setup chart attributes
    Protected *g._Chart = GetGadgetData(Gadget)
    Select Setting
      Case #SetFlags
        *g\Flags = Value
      Case #SetFont
        *g\Font = Value
      Case #SetBackColor
        *g\BackColor = Value
      Case #SetFrontColor
        *g\FrontColor = Value
      Case #SetAreaColor
        *g\AreaColor = Value
      Case #SetGridColor
        *g\GridColor = Value
      Case #SetValueColor
        *g\ValueColor = Value
      Case #SetLineWidth
        *g\LineWidth = Value
      Case #SetPointSize
        *g\PointSize = Value
      Case #SetPadding
        *g\Padding = Value
      Case #SetDecimalPlaces
        *g\DecimalPlaces = Value
      Case #SetFillStyle
        *g\FillStyle = Value
    EndSelect
  EndProcedure
 
  Procedure AddRow(Gadget.i, Name.s, Type.i, Color.i, Flags.l=0) ; <-- Row(Gadget.i, Name.s, Type.i, Color.i, Flags.l=0)
    ;add a row to the chart
    Protected *g._Chart, *r._ChartRow
    *g = GetGadgetData(Gadget)
    ;insert sorted by name
    If *g\Flags & #SortRows
      ForEach *g\Rows()
        If *g\Rows()\Name > Name
          *r = InsertElement(*g\Rows())
          Goto Set:
        EndIf
      Next
    EndIf
    *r = AddElement(*g\Rows())
    Set:
    *r\Name = Name
    *r\Type = Type
    *r\Color = Color
    *r\Flags = Flags
    ;count number of rows with bars
    If Type = #RowTypeBar
      *g\BarRowCount + 1
    EndIf
  EndProcedure
 
  Procedure AddColumn(Gadget.i, Name.s) ; <-- Column(Gadget.i, Name.s)
    ;add a column to the chart
    Protected *g._Chart, *c._ChartColumn
    *g = GetGadgetData(Gadget)
    ;insert sorted by name
    If *g\Flags & #SortColumns
      ForEach *g\Columns()
        If *g\Columns()\Name > Name
          *c = InsertElement(*g\Columns())
          Goto Set
        EndIf
      Next
    EndIf
    ;append new column
    *c = AddElement(*g\Columns())
    Set:
    *c\Name = Name
  EndProcedure
 
  Procedure SetValue(Gadget.i, Row.s, Column.s, Value.f, Flags.l=0) ; <-- Value(Gadget.i, Row.s, Column.s, Value.f, Flags.l=0)
    ;add or update chart value
    Protected *g._Chart, *v._ChartValue
    *g = GetGadgetData(Gadget)
    ;update existing value
    ForEach Iter(*v, *g\Values())
      If *v\Row = Row And *v\Column = Column
        Select Flags
          Case #ValueReplace
            *v\Value = Value
          Case #ValueSum
            *v\Value + Value
        EndSelect
        ProcedureReturn
      EndIf
    Next
    ;add new value
    *v = AddElement(*g\Values())
    *v\Row = Row
    *v\Column = Column
    *v\Value = Value
  EndProcedure
 
  Procedure SetText(Gadget.i, Type.i, Text.s) ; <-- Text(Gadget.i, Type.i, Text.s)
    Protected *c._Chart = GetGadgetData(Gadget)
    Select Type
      Case #TextTitle
        *c\Title = Text
      Case #TextYAxis
        *c\YTitle = Text
      Case #TextXAxis
        *c\XTitle = Text
      Case #TextUnit
        *c\Unit = Text
    EndSelect
  EndProcedure
 
  Procedure Clear(Gadget.i, Flags.l=0)
    ;remove all data from the chart
    Protected *g._Chart = GetGadgetData(Gadget)
    *g\BarRowCount = 0
    ClearList(*g\Values())
    If Not Flags & #KeepColumns
      ClearList(*g\Columns())
    EndIf
    If Not Flags & #KeepRows
      ClearList(*g\Rows())
    EndIf
  EndProcedure
 
  Procedure.i Gadget(Gadget.i, x.i, y.i, w.i, h.i, Flags.l=0)
    ;create new chart gadget (from CanvasGadget)
    Protected *c._Chart, canvasflag.i, id.i
    If Flags & #Border
      canvasflag = #PB_Canvas_Border
    EndIf
    id = CanvasGadget(Gadget, x, y, w, h, canvasflag)
    ;support #PB_Any
    If Gadget = #PB_Any
      Gadget = id
    EndIf
    ;create and store additional object data
    *c = New(_Chart)
    SetGadgetData(Gadget, *c)
    NewList *c\Columns()
    NewList *c\Rows()
    NewList *c\Values()
    ;default settings
    *c\Font = GetGadgetFont(#PB_Default)
    *c\BackColor = $FFFFFF
    *c\FrontColor = $000000
    *c\AreaColor = $E0F0FF
    *c\GridColor = $D0E0F0
    *c\ValueColor = $8CE6F0
    *c\AxisColor = $000000
    *c\LineWidth = 3
    *c\PointSize = 5
    *c\Padding = 8
    *c\Flags = Flags
    ;initial paint
    RefreshGadget(Gadget)
    ;return result
    ProcedureReturn id
  EndProcedure

EndModule

CompilerIf #PB_Compiler_IsMainFile
 
  If OpenWindow(0, 0, 0, 800, 500, "Chart-Test", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
   
    UseModule Chart
   
    ;setup chart (comment lines out to see the result)
    flags = #Border
    flags | #LegendBottom
    flags | #YAxis
    flags | #XAxis
    ;flags | #XAxisVAlign
    flags | #HGrid
    flags | #VGrid
    flags | #Stapled
   
    Gadget(0, 10, 10, 780, 480, flags)
    SetText(0, #TextTitle, "Cost per Month")
    SetText(0, #TextYAxis, "Euro")
    SetText(0, #TextXAxis, "Month")
    SetText(0, #TextUnit, " EUR")
    ;SetAttribute(0, #SetPadding, 32)
    ;SetAttribute(0, #SetPointSize, 15)
    ;SetAttribute(0, #SetFont, FontID(LoadFont(#PB_Any, "", 12)))
    SetAttribute(0, #SetLineWidth, 6)
    SetAttribute(0, #SetFillStyle, #StyleEmbossed)
   
    ;add some data rows
    AddRow(0, "Positive", #RowTypeBar,  $009060)
    AddRow(0, "Negative", #RowTypeBar,  $2020E0)
    AddRow(0, "Average",  #RowTypeLine, $00D7FF, #RowValues)
   
    UnuseModule Chart
   
    ;add some data columns
    For i = 1 To 12
      month.s = StringField("Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec", i, "|")
      Chart::AddColumn(0, month)
     
      ;add a value for each row and column
      positive = Random(9, 1) * 10
      negative = Random(9, 1) * -10
      Chart::SetValue(0, "Positive", month, positive)
      Chart::SetValue(0, "Negative", month, negative)
      Chart::SetValue(0, "Average",  month, (positive + negative) / 2)
     
    Next
   
    ;refresh the chart
    Chart::RefreshGadget(0)
   
    ;run event loop
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_SizeWindow
          ;resize the chart and redraw it
          ResizeGadget(0, 10, 10, WindowWidth(0) - 20, WindowHeight(0) - 20)
          Chart::RefreshGadget(0)
        Case #PB_Event_CloseWindow
          Break
      EndSelect
    ForEver
   
  EndIf
 
CompilerEndIf
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild
Benutzeravatar
Thorsten1867
Beiträge: 1359
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

Re: [Module] ChartGadgetModule.pbi

Beitrag von Thorsten1867 »

Bild
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild
Benutzeravatar
Sicro
Beiträge: 955
Registriert: 11.08.2005 19:08
Kontaktdaten:

Re: [Module] ChartGadgetModule.pbi

Beitrag von Sicro »

Sehr cool :allright:

Kannst du bitte eine Lizenz zu deinem Code hinzufügen?
Ansonsten kann niemand dein Modul legal in eigene Codes inkludieren (https://choosealicense.com/no-permission/).
Schau dazu mal hier: https://choosealicense.com/
Am besten wäre die MIT-Lizenz.

Nach der Lizenzierung möchte ich dein Modul gerne zum CodeArchiv (siehe meine Signatur) hinzufügen, wenn es dir recht ist :)
Bild
Warum OpenSource eine Lizenz haben sollte :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (Syntax-Farbschema) :: RegEx-Engine (kompiliert RegExes zu NFA/DFA)
Manjaro Xfce x64 (Hauptsystem) :: Windows 10 Home (VirtualBox) :: Neueste PureBasic-Version
Antworten