PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Diagramme zeichnen lassen

https://www.purebasic.fr/german/viewtopic.php?t=23689

Seite 1 von 1

Diagramme zeichnen lassen

Verfasst: 04.01.2011 13:11
von Dostej
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

Re: Diagramme zeichnen lassen

Verfasst: 04.01.2011 13:42
von Kiffi
Fein! Dank Dir, Dostej :allright:

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

Re: Diagramme zeichnen lassen

Verfasst: 04.01.2011 14:16
von ts-soft
:allright:
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 ? /:->

Re: Diagramme zeichnen lassen

Verfasst: 04.01.2011 14:20
von Kiffi
ts-soft hat geschrieben:Hab gerade mal die Kuchenabbildung gescheckt.
ich auch :-)

Re: Diagramme zeichnen lassen

Verfasst: 04.01.2011 14:20
von STARGÅTE
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 :allright:

Re: Diagramme zeichnen lassen

Verfasst: 04.01.2011 14:40
von Dostej
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. :wink: ) und es gleichzeitig als include nutzen.

Re: Diagramme zeichnen lassen

Verfasst: 04.01.2011 16:25
von HeX0R
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 :allright:
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...
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de