Diagramme zeichnen lassen

Dostej · Beitrag von **Dostej** » 04.01.2011 13:11

So, aus meinen aktuellen Projektchen hat sich ein bischen Code ergeben, der evtl. für anderen interessant sein könnte.
Die Proc zeichnet Diagramme.
Es hat fünf verschiedene Diagrammtypen:
Liniendiagramme
LinienPunkte
Punktediagramm
Histogramm
Balkendiagramm
Kuchendiagramm

Dazu kann man noch verschiedene Hilfslinien ein- bzw. ausschalten:
Hilfslinien x
Hilfslinien y
Skalierung x
Skalierung y
Legende

Naja, es ist nicht die Super-Proc, aber geht grundsätzlich...

Code: Alles auswählen

; Diagramme zeichnen
; (c) 2010 by Stefan Mahr

EnableExplicit

Structure Datas
  id.i ; welche Daten gehören zusammen
  x.i
  y.i
  Text.s ; Beschriftung der Daten, genügt bei einem Datensatz
EndStructure

Procedure DrawDiagramm(ImageID_I.i, Titel_S.s, DiagrammArt_I.i, Mode_I.i, List Daten.Datas()) ; zeichnet aus den übergebenen Daten Diagramme
  ; Modus: 0=Liniendiagramme   1=LinienPunkte  2=Punktediagramm   3=Histogramm    4=Balkendiagramm    5=Kuchendiagramm
  ; Mode(|): 0= ohne  1=Hilfslinien x  2=Hilfslinien y   4=Skalierung x    8=Skalierung y   16=Legende
  Protected MinY_I.i,  MaxY_I.i, MaxX_I.i, ScaleX_F.f, ScaleY_F.f, f.f, f2.f
  Protected OK_I.i, a.i, c.i, i.i, n.i, t.i, w.i, h.i, x.i, x1.i, x2.i, y.i, y1.i, y2.i, r.i, z.i, t1.i
  Protected px.i, py.i, MX.i, MY.i
  Protected TitelBar.i, dw.i, dh.i, Min_I.i, Max_I.i, Count.i, LeftWidth.i
  Protected LineHeight.i, TextFontHeight.i, AngleStart.f, AngleEnd.f, Radius.i, Sum.i
  NewList Legende.Datas()
  NewList Kummuliert.Datas()
  NewList SelDaten.Datas()
  
  ;{ bestimme Werte für die Darstellung
  ForEach Daten()
    If Daten()\y < MinY_I
      MinY_I = Daten()\y
    EndIf
    If Daten()\y > MaxY_I
      MaxY_I = Daten()\y
    EndIf
    If Daten()\x > MaxX_I
      MaxX_I = Daten()\x
    EndIf
    
    OK_I = 1
    ForEach Legende() ; exisitert schon ein Datensatz mit dieser ID
      If Legende()\id = Daten()\id
        OK_I = 0
        Break
      EndIf
    Next
    If OK_I = 1
      AddElement(Legende())
    EndIf
    ; Die Daten eintragen
    Legende()\id = Daten()\id
    If Daten()\Text <> ""
      Legende()\Text = Daten()\Text
    EndIf
    If DiagrammArt_I = 5 ; Kreis
      Legende()\y + Daten()\y ; Für das Kreisdiagramm
    EndIf 
    
    If DiagrammArt_I = 3 ; kummulierte Daten
      OK_I = 1
      ForEach Kummuliert()
        If Kummuliert()\x = Daten()\x
          OK_I = 0
          Kummuliert()\y + Daten()\y ; Für das Stapelbalkendiagramm
        EndIf
      Next
      If OK_I = 1
        AddElement(Kummuliert())
        Kummuliert()\x = Daten()\x
        Kummuliert()\y + Daten()\y ; Für das Stapelbalkendiagramm
      EndIf
      If Kummuliert()\y > MaxY_I
        MaxY_I = Kummuliert()\y
        Debug MaxY_I
      EndIf
    EndIf
  Next
  If DiagrammArt_I = 3 ; kummulierte Daten
    ForEach Kummuliert()
      If Kummuliert()\y > MaxY_I
        MaxY_I = Kummuliert()\y
        Debug MaxY_I
      EndIf
    Next
  EndIf
  
  ;{ Max Y und Y nach oben aufrunden
  n = Len(Str(MaxX_I))
  If n > 1 ; wenn mindestens 2 Stellen
    t = Val(Left("1000000000000", n))
    MaxX_I = Round(MaxX_I/t, 1) * t
  EndIf
  n = Len(Str(MaxY_I))
  If n > 1 ; wenn mindestens 2 Stellen
    t = Val(Left("1000000000000", n))
    MaxY_I = Round(MaxY_I/t, 1) * t
  EndIf
  ;}
  
  If Mode_I & %10000
    w = ImageWidth(ImageID_I) * 0.65
  Else
    w = ImageWidth(ImageID_I)
  EndIf 
  h = ImageHeight(ImageID_I)
  
  If Titel_S <> ""
    TitelBar = 15
  EndIf
  
  dh = h-35- TitelBar
  dw = w-30
  
  ScaleX_F = MaxX_I / dw
  If MinY_I < 0
    ScaleY_F = dh / (MaxY_I - MinY_I)
  Else
    ScaleY_F = dh / (MaxY_I)
  EndIf
  
  ;}
  
  ; Zeichne die Zusatz-Linien
  If StartDrawing(ImageOutput(ImageID_I))
    Box(0, 0, ImageWidth(ImageID_I), h, $FFFFFF) ; HG über das ganze Bild
    ; DrawingFont(DiagrammFontID_GI)
    ;{ Die Koord., Hilfslinien und Legende einzeichnen
    ; 0-Linie bestimmen
    If Min_I < 0
      f.f = (Max_I * 1.0) / (Max_I - Min_I); 
      z = 10 + f * dh
    Else
      f.f = 1.0
      z = h-19
    EndIf
    
    ; von dort aus die Hilfslinien zeichnen und die Skalierung
    DrawingMode(#PB_2DDrawing_Transparent)
    If Mode_I & %1 And DiagrammArt_I <> 5 ; 1=Hilfslinien x und nicht Kuchendiagramm
      ; parallel zur x-Achse nach oben
      
      f = (h-34-TitelBar) / 8.0
      c = 0
      While z - c*f > 15+TitelBar ; obere Grenze beachten
        LineXY(19, z-c*f, w-10, z-c*f, $CDCDCD)
        c + 1
      Wend
      LineXY(19, 15+TitelBar, w-10, 15+TitelBar, $CDCDCD) ; Abschluss Hilfslinie oben
      
      ; parallel zur x-Achse nach unten
      c = 0
      While z + c*f < h-19 ; untere Grenze beachten
        LineXY(19, z+c*f, w-10, z+c*f, $CDCDCD)
        c + 1
      Wend
    EndIf
    
    f = (w-29) / 8.0
    If Mode_I & %10 And DiagrammArt_I <> 5 ; 2=Hilfslinien y und nicht Kuchendiagramm
      c = 0
      While c*f < w-10 ; untere Grenze beachten
        LineXY(19+c*f, h-19, 19+c*f, 15+TitelBar, $CDCDCD)
        c + 1
        If c = 4 And Mode_I & %100 ; Mitte und Skalierung X-Achse
          DrawText(19+c*f, h-19, Str(MaxX_I/2), $808080)
        EndIf
      Wend
      LineXY(w-10, h-19, w-10, 15+TitelBar, $CDCDCD) ; Abschluss Hilfslinie rechts
    EndIf
    
    If Mode_I & %100 And DiagrammArt_I <> 5 ; 4=Skalierung x und nicht Kuchendiagramm
      a = TextWidth(Str(MaxX_I))
      DrawText(w - a, h-19, Str(MaxX_I), $808080)
    EndIf
    
    If Mode_I & %1000 And DiagrammArt_I <> 5 ; 8=Skalierung y und nicht Kuchendiagramm
      DrawText(3, 1+TitelBar, Str(MaxY_I), $808080)
      DrawText(3, h-19, Str(MinY_I), $808080)
    EndIf
    
    ; Koord.
    If DiagrammArt_I <> 5
      LineXY(19, z, w-10, z, $808080) ; x-Achse auf 0
      LineXY(19, h-19, 19, 10+TitelBar, $808080) ; y-Achse
    EndIf
    ;}
    
    ; Titel
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawText((w-TextWidth(Titel_S))/2, 3, Titel_S, 0)
    
    ;{ Gibt es Texte für Legenden
    If Mode_I & %10000
      ; Now draw the descriptions on the right side
      Count = ListSize(Legende())
      LineHeight = TextFontHeight + 4
      #LineSpace = 14
      
      t1 = 0
      ; Find the widthest string
      ForEach Legende()
        If Legende()\y = 0
          a = TextWidth(Legende()\Text)
        Else
          a = TextWidth(Legende()\Text + " (" + Str(Legende()\y) + ")")
        EndIf
        If a > t1
          t1 = a
        EndIf
      Next
      t1 * 1.2
      
      px = w + 20
      t = (LineHeight * Count) + (#LineSpace * (Count-1))
      py = TitelBar + ((h - t - TitelBar) / 2)  ; Image height decreased by needed height for the text descriptions
      
      ; paint white background box with black borders
      DrawingMode(#PB_2DDrawing_Default)
      Box(px-4,py-4,t1+10,(LineHeight+#LineSpace)*Count+4, $FFFFFF)
      DrawingMode(#PB_2DDrawing_Outlined)
      Box(px-5,py-5,t1+10,(LineHeight+#LineSpace)*Count+5,0)
      ; Line(px-3+t1,py-4,0,(LineHeight+#LineSpace)*Count+5)
      ; Line(px-4,py+(LineHeight+#LineSpace)*Count,temp1,0)
      
      ; paint the color boxes with relating description
      Restore Piecolor
      ; DrawingFont(DiagrammFontID_GI)
      ForEach Legende()
        Read.i c
        Box(px,py+#LineSpace/2,LineHeight,LineHeight,0)
        DrawingMode(#PB_2DDrawing_Default)
        Box(px+1,py+#LineSpace/2+1,LineHeight-2,LineHeight-2, c)
        DrawingMode(#PB_2DDrawing_Transparent)
        If Legende()\y = 0
          DrawText(px + LineHeight + 4, py-1, Legende()\Text, c)
        Else
          DrawText(px + LineHeight + 4, py-1, Legende()\Text + " (" + Str(Legende()\y) + ")", c)
        EndIf
        py + LineHeight + #LineSpace
      Next
      
    Else
      LeftWidth = w
    EndIf
    ;}
    
    ;{ Die Daten einzeichnen
    If DiagrammArt_I <> 3
      Restore Piecolor
      SortStructuredList(Legende(), #PB_Sort_Ascending, OffsetOf(Datas\id), #PB_Sort_Integer)
      ForEach Legende()
        Read.i c
        ClearList(SelDaten())
        ForEach Daten()
          If Daten()\id = Legende()\id
            AddElement(SelDaten())
            SelDaten()\x = Daten()\x
            SelDaten()\y = Daten()\y
          EndIf
        Next
        SortStructuredList(SelDaten(), #PB_Sort_Ascending, OffsetOf(Datas\x), #PB_Sort_Integer)
        
        Select DiagrammArt_I 
          Case 0 ;{ Liniendiagramme
            x = 19
            y = z
            f = (w-30.0) / MaxX_I
            FirstElement(SelDaten())  ; 1. Wert festlegen
            x1 = 19+SelDaten()\x * f
            y1 = y - SelDaten()\y * ScaleY_F
            
            While NextElement(SelDaten())
              x2 = x + SelDaten()\x * f
              y2 = y - SelDaten()\y * ScaleY_F
              LineXY(x1, y1, x2, y2, c)
              y1 = y2
              x1 = x2
            Wend
            ;}
            
          Case 1 ;{ LinienPunkte
            DrawingMode(#PB_2DDrawing_Outlined)
            x = 19
            y = z
            f = (w-30.0) / MaxX_I
            r = Round(w/100, 1)
            
            FirstElement(SelDaten()) ; 1. Wert festlegen
            x1 = 19 + SelDaten()\x * f
            y1 = y - SelDaten()\y * ScaleY_F
            Circle(x1, y1, r, c)
            While NextElement(SelDaten())
              i = SelDaten()\x
              x2 = x + i * f
              y2 = y - SelDaten()\y * ScaleY_F
              LineXY(x1, y1, x2, y2, c)
              Circle(x2, y2, r, c)
              y1 = y2
              x1 = x2
            Wend
            ;}
            
          Case 2 ;{ Punktediagramm
            x = 19
            y = z
            f = (w-30.0) / MaxX_I
            r = Round(w/100, 1)
            ForEach SelDaten()
              i = SelDaten()\x
              x1 = x + i * f
              y1 = y - SelDaten()\y * ScaleY_F
              Circle(x1, y1, r, c)
            Next
            ;}
            
          Case 4 ;{ Balkendiagramm
            ; hier die Balkendiagramme nebeneinander anordnen
            ; Dazu die Breite mit der Listsize(Legende()) anpassen, auf Abstand zu 
            f = (w-30.0) / (MaxX_I + 1)
            f2 = f / ListSize(Legende())
            x = 21
            y = z
            n = Round((f-2) / ListSize(Legende()), 0)
            If n < 1
              n = 1
            EndIf
            
            ForEach SelDaten()
              x1 = x + SelDaten()\x * f + ListIndex(Legende()) * f2
              y1 = -SelDaten()\y * ScaleY_F
              Box(x1, z, n, y1, c)
            Next
            ;}
            
          Case 5 ;{ Kuchendiagramm
            Restore PieColor
            ; Initial values
            AngleStart.f = -#PI    ; needed later for calculating the circle-parts
            AngleEnd.f = -#PI/2         ; defines where the drawing starts: 0 = right, #Pi = left, #Pi/2 = bottom, -#Pi/2 = top
            
            If dh > dw 
              Radius = dw/2
            Else
              Radius = dh/2
            EndIf
            
            If ListSize(Legende()) = 1 ; nur die Daten einer Sorte
              ; Count the sum of all graphs value (=100%)
              ForEach SelDaten()
                If SelDaten()\y < 0
                  SelDaten()\y = 0
                EndIf
                Sum + SelDaten()\y
              Next
              
              MX = 10 + dw/2
              MY = 15 + TitelBar + dh/2
              
              ForEach SelDaten()
                AngleStart = AngleEnd
                AngleEnd = AngleStart + (SelDaten()\y * 2 * #PI / Sum)
                
                ; Set black as default color for all border lines
                ; Draw the lines from inside the circle to the border
                LineXY(MX,MY,Cos(AngleStart)*(Radius+1)+MX,Sin(AngleStart)*(Radius+1)+MY, 0)    ; note: Radius must be increases by 1 here,
                LineXY(MX,MY,Cos(AngleEnd)*(Radius+1)+MX,Sin(AngleEnd)*(Radius+1)+MY, 0)        ; because otherwise sometimes misses a pixel
                
                ; Draw the circle
                For a = AngleStart * Radius To AngleEnd * Radius  ;Step 2
                  px = Cos(a / Radius) * Radius + MX
                  py = Sin(a / Radius) * Radius + MY
                  Plot(px, py, 0)
                Next
                
                ; Calc the coordinates for filling point and finally fill the selected area
                px = Cos((AngleEnd + AngleStart) / 2)*(Radius/ 2) + MX
                py = Sin((AngleEnd + AngleStart) / 2)*(Radius / 2) + MY
                Read.i c
                FillArea(px,py,0, c)
              Next
              
            Else ; wenn die Kuchengrafik aus Daten mehrerer ID besteht, dann werden die aufaddierten Werte verwendet
              ; Count the sum of all graphs value (=100%)
              ForEach Legende()
                If Legende()\y < 0
                  Legende()\y = 0
                EndIf
                Sum + Legende()\y
              Next
              
              MX = 10 + dw/2
              MY = 15 + TitelBar + dh/2
              
              ForEach Legende()
                AngleStart = AngleEnd
                AngleEnd = AngleStart + (Legende()\y * 2 * #PI / Sum)
                
                ; Set black as default color for all border lines
                ; Draw the lines from inside the circle to the border
                LineXY(MX,MY,Cos(AngleStart)*(Radius+1)+MX,Sin(AngleStart)*(Radius+1)+MY, 0)    ; note: Radius must be increases by 1 here,
                LineXY(MX,MY,Cos(AngleEnd)*(Radius+1)+MX,Sin(AngleEnd)*(Radius+1)+MY, 0)        ; because otherwise sometimes misses a pixel
                
                ; Draw the circle
                For a = AngleStart * Radius To AngleEnd * Radius  ;Step 2
                  px = Cos(a / Radius) * Radius + MX
                  py = Sin(a / Radius) * Radius + MY
                  Plot(px, py, 0)
                Next
                
                ; Calc the coordinates for filling point and finally fill the selected area
                px = Cos((AngleEnd + AngleStart) / 2)*(Radius/ 2) + MX
                py = Sin((AngleEnd + AngleStart) / 2)*(Radius / 2) + MY
                Read.i c
                FillArea(px,py,0, c)
              Next
            EndIf
            ;}
            
        EndSelect
      Next
      
    Else ; modus = 3
      
      SortStructuredList(Kummuliert(), #PB_Sort_Ascending, OffsetOf(Datas\x), #PB_Sort_Integer)
      ForEach Kummuliert()
        ClearList(SelDaten())
        ForEach Daten()
          If Daten()\x = Kummuliert()\x
            AddElement(SelDaten())
            SelDaten()\id = Daten()\id
            SelDaten()\y = Daten()\y
          EndIf
        Next
        
        SortStructuredList(SelDaten(), #PB_Sort_Ascending, OffsetOf(Datas\id), #PB_Sort_Integer)
        
        Select DiagrammArt_I 
          Case 3 ;{ Stapelbaken
            f = (w-30.0) / (MaxX_I + 1)
            x = 21
            y = z
            n = Round((f-2), 0)
            If n < 1
              n = 1
            EndIf
            
            x1 = x + Kummuliert()\x * f
            a = 0
            Restore Piecolor
            ForEach SelDaten()
              Read.i c
              y1 = -SelDaten()\y * ScaleY_F
              Box(x1, z-a, n, y1, c)
              a - y1
            Next
            ;}
            
        EndSelect
        
      Next
    EndIf
    ;}
    
    StopDrawing()
  EndIf
  
EndProcedure

DataSection
  PieColor:
  Data.i $0000FF, $00FF00, $FF0000
  Data.i $FF00FF, $00C0C0, $FFFF00
  Data.i $C48040, $8040C4, $80C440, $C48040
  Data.i $C44000, $C440C4, $40C4C4, $C4C440, $4000C4, $40C400, $C44000
  Data.i $8000FF, $80FF00, $FF8000, $FF80FF, $80C0C0, $FFFF80
  Data.i $8080FF, $80FF80, $FF8080
  Data.i $4000FF, $40FF00, $FF4000, $FF40FF, $40FFFF, $FFFF40, $4000FF, $40FF00, $FF4000, $FF40FF, $40C0C0, $FFFF40
  Data.i $4040FF, $40FF40, $FF4040, $8040FF, $80FF40  
  Data.i $0000C4, $00C400, $C40000, $C400C4, $00C4C4, $C4C400, $8000C4, $80C400, $C48000, $C480C4, $80C4C4, $C4C480
  Data.i $8080C4, $80C480, $C48080, $4000C4, $40C400, $C44000, $C440C4, $40C4C4, $C4C440, $4000C4, $40C400, $C44000
EndDataSection

CompilerIf 1
;{ Demo
;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Image_0
EndEnumeration

NewList Daten.Datas()

If OpenWindow(#Window_0,100,0,700, 400,"Diagramm",#PB_Window_SystemMenu)
  ImageGadget(#Image_0, 10, 10, 680, 380, 0)
  
  RandomSeed(3)
  Define n.i = Random(400) + 200
  Define c.i = 100
  Define n.i = 10
  Define a.i, x.i, y.i, ImageID_I.i
  Define Event.i, WindowID.i, GadgetID.i, EventType.i
  
  For y = 0 To 4
    a = 0
    For x = 0 To n
      AddElement(Daten())
      c = 40 + Random(20)
      Daten()\id = y
      Daten()\x = a
      Daten()\y = c
      a + 1 + Random(1)
    Next
    Daten()\Text = "Test " + Str(y)
  Next
  
  ImageID_I = CreateImage(#PB_Any, 500, 300)
  
  
  DrawDiagramm(ImageID_I, "Testdiagramm", 3, %11111, Daten())
  
  
  
  SetGadgetState(#Image_0, ImageID(ImageID_I))
  
  Repeat ; Start of the event loop
    
    Event = WaitWindowEvent()
    WindowID = EventWindow()
    GadgetID = EventGadget()
    EventType = EventType()
    
    
    If Event = #PB_Event_Gadget
      
      If GadgetID = #Image_0
        
      EndIf
      
    EndIf
    
  Until Event = #PB_Event_CloseWindow ; End of the event loop
  
EndIf
End
;}

CompilerEndIf


; IDE Options = PureBasic 4.51 (Linux - x64)
; CursorPosition = 473
; FirstLine = 448

//EDIT: EnableExplicit mit eingebaut

Beitrag von **Kiffi** » 04.01.2011 13:42

Fein! Dank Dir, Dostej

Wäre klasse, wenn Du das ganze auch noch ein wenig
EnableExplicit-Freundlicher machen würdest

Code: Alles auswählen

Procedure DrawDiagramm( ...
  [...]
  Protected MinY_I.i
  Protected MaxY_I.i
  Protected MaxX_I.i
  Protected ScaleX_F.f
  Protected ScaleY_F.f
  Protected f.f
  Protected f2.f
  Protected OK_I
  Protected n, t, w, h, z, c, a, t1, py, px, x, y, x1, y1, x2, y2, r, i
  Protected TitelBar
  Protected dh, dw
  Protected Count, LineHeight, TextFontHeight, LeftWidth
  Protected AngleStart.f, AngleEnd.f
  Protected Radius, Sum, MX, MY
  Protected Min_I, Max_I

so, in der Art...

Grüße ... Kiffi

ts-soft · Beitrag von **ts-soft** » 04.01.2011 14:16

Gefällt mir auch!
Hab gerade mal die Kuchenabbildung gescheckt.

Crossplattform usw., so soll es sein, aber das mit EnableExplicit solltest Du noch integrieren.

Gruß
Thomas

PS: Wofür ist das CompilerIf ?

Beitrag von **Kiffi** » 04.01.2011 14:20

ts-soft hat geschrieben:Hab gerade mal die Kuchenabbildung gescheckt.

ich auch

STARGÅTE · Beitrag von **STARGÅTE** » 04.01.2011 14:20

Zum nicht compilieren (auf 0 setzen), wenn man es nicht mehr testen will, sonden als Include nutzen will, das Beispiel aber nicht löschen will
Nutze ich auch

Dostej · Beitrag von **Dostej** » 04.01.2011 14:40

Danke für die Rückmeldungen.

Danke Stargate - genau das.
Damit kann ich das recht schnell testen, wenn ich noch fehler finde oder was ergänze (enable Explizit z.B.

) und es gleichzeitig als include nutzen.

HeX0R · Beitrag von **HeX0R** » 04.01.2011 16:25

STARGÅTE hat geschrieben:Zum nicht compilieren (auf 0 setzen), wenn man es nicht mehr testen will, sonden als Include nutzen will, das Beispiel aber nicht löschen will
Nutze ich auch

Naja, ich nutze dafür eine Konstante, die ich im Header des Sources platziere.
Die nennt sich dann "#USE_DEMO = 1", o.ä.

Vermutlich sinnvoller, als sich durch den Quelltext zu kämpfen und die CompilerIF 1 - Zeile zu finden...

PureBoard

Diagramme zeichnen lassen

Diagramme zeichnen lassen

Re: Diagramme zeichnen lassen

Re: Diagramme zeichnen lassen

Re: Diagramme zeichnen lassen

Re: Diagramme zeichnen lassen

Re: Diagramme zeichnen lassen

Re: Diagramme zeichnen lassen