kleines Balkendiagramm mit 2 Werten

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
Makke
Beiträge: 156
Registriert: 24.08.2011 18:00
Computerausstattung: AMD Ryzen 7 5700X - AMD Radeon RX 6800 XT - 32 GB DDR4 SDRAM
Wohnort: Ruhrpott
Kontaktdaten:

kleines Balkendiagramm mit 2 Werten

Beitrag von Makke »

Hallo,

ich bastelte an einem kleinen Programm rum und wollte eine grafische Auswertung (Vergleich als Balkendiagram). Hier ist der (hoffentlich selbsterklärende) Code:

Code: Alles auswählen


EnableExplicit

Enumeration 
  #DIAGRAM_IMG
  #CONTAINER_GRAPHS
  #IMG_GRAPHS
EndEnumeration

Structure DiagramData
  name.s
  value1.f
  value2.f
EndStructure

Procedure.i CreateDiagramImage(Image.i, Title.s, List dData.DiagramData(), Value1Name.s="", Value2Name.s="", ShowValueAsFloat.i=#False, SortListByName.i=#True) ; Image.i=#Image
  
  Protected startTime.i = ElapsedMilliseconds()
  
  Protected n.i
  Protected multiplier.f
  
  Protected listEntries = ListSize(dData())
  Protected size.RECT ; size of image
  
  Protected fontTitle.i = LoadFont(#PB_Any, "Calibri", 10, #PB_Font_Bold|#PB_Font_HighQuality)
  Protected fontX.i     = LoadFont(#PB_Any, "Calibri",  8, #PB_Font_HighQuality)
  Protected fontY.i     = LoadFont(#PB_Any, "Calibri", 10, #PB_Font_HighQuality)
  
  Protected colorBg.i   = RGB(255, 248, 220)
  Protected colorLine.i = RGB(0, 0, 0)
  Protected colorHigh.i = RGB(230, 230, 230)
  Protected colorHelp.i = RGB(220, 220, 220)
  Protected colorVal1.i = RGB(178, 34, 34)
  Protected colorVal2.i = RGB(34, 178, 34)
  
  Protected highestValue.f
  Protected highestValuePx.POINT
  Protected longestText.s
  Protected longestTextPx.POINT
  
  Protected titlePx.RECT
  Protected val1Px.RECT
  Protected val2Px.RECT
  
  Protected diagram.RECT ; the diagram size
  
  Protected ySpace.i 
  Protected xSpace.i ; the space on axis between the names
  
  Protected boxSize.i ; size of boxes in x-pixels
  
  If listEntries = 0
    ProcedureReturn 0
  EndIf
  
  ; get size of container gadget ...
  If IsGadget(#IMG_GRAPHS)
    size\top    = 0
    size\left   = 0
    size\right  = GadgetWidth(#CONTAINER_GRAPHS)-4
    size\bottom = GadgetHeight(#CONTAINER_GRAPHS)-4
  Else
    ProcedureReturn 0
  EndIf
  
  ; ... and resize image
  If IsImage(Image)
    ResizeImage(Image, size\right, size\bottom)
  Else
    CreateImage(Image, size\right, size\bottom)
  EndIf
  
  ; check for diagram title
  If Title = ""
    Title = "Diagram"
  EndIf
  
  If Value1Name <> "" And Value2Name <> ""
    Value1Name = " = "+Value1Name
    Value2Name = " = "+Value2Name
  EndIf
  
  ; sort list by NAME
  If SortListByName
    SortStructuredList(dData(), #PB_Sort_Descending, OffsetOf(DiagramData\name), #PB_Sort_String)
  EndIf
  
  ; get highest values for text sizes
  ForEach dData()
    With dData()
      If \value1 >= highestValue
        highestValue = \value1
      EndIf
      If \value2 >= highestValue
        highestValue = \value2
      EndIf
      If Len(\name) >= Len(longestText)
        longestText = \name
      EndIf
    EndWith
  Next
  
  ; get sizes of text
  StartDrawing(ImageOutput(Image))
  
  ; diagram title
  DrawingFont(FontID(fontTitle))
  titlePx\right  = TextWidth(Title)
  titlePx\bottom = TextHeight(Title)
  titlePx\left   = (size\right - titlePx\right) / 2
  titlePx\top    = 5
  
  ; value 1 and 2 description
  DrawingFont(FontID(fontX))
  If Value1Name <> "" And Value2Name <> ""
    val1Px\right  = TextWidth(Value1Name)
    val1Px\bottom = TextHeight(Value1Name)
    val1Px\top    = 5
    val2Px\right  = TextWidth(Value2Name)
    val2Px\bottom = TextHeight(Value2Name)
    val2Px\top    = val1Px\top + val1Px\bottom + 5
    If val1Px\right > val2Px\right
      val1Px\left   = size\right - val1Px\right - 10
      val2Px\left   = size\right - val1Px\right - 10
    Else
      val1Px\left   = size\right - val2Px\right - 10
      val2Px\left   = size\right - val2Px\right - 10
    EndIf
  EndIf
  
  ; get name text sizes
  longestTextPx\x = TextWidth(longestText)
  longestTextPx\y = TextHeight(longestText)
  
  ; get value text sizes
  DrawingFont(FontID(fontY))
  If ShowValueAsFloat
    highestValuePx\x = TextWidth(StrF(highestValue, 1))
  Else
    highestValuePx\x = TextWidth(Str(highestValue))
  EndIf
  highestValuePx\y = TextHeight(Str(highestValue))
  
  StopDrawing()
  
  ; calculate the RECT for the whole diagram
  diagram\left = 5 + highestValuePx\x + 5
  If Value1Name = "" Or Value2Name = ""
    diagram\top = titlePx\top + titlePx\bottom + 5
  Else
    diagram\top = val2Px\top + val2Px\bottom + 5
  EndIf
  diagram\right  = size\right - diagram\left - 5
  diagram\bottom = size\bottom - 5 - longestTextPx\y - 5
  
  ; now fill the image an draw the coordinate system
  StartDrawing(ImageOutput(Image))
  
  DrawingMode(#PB_2DDrawing_Transparent)
  
  Box(size\left, size\top, size\right, size\bottom, colorBg)
  
  DrawingFont(FontID(fontTitle))
  DrawText(titlePx\left, titlePx\top, Title, colorLine)
  
  If Value1Name <> "" And Value2Name <> ""
    DrawingFont(FontID(fontX))
    DrawText(val1Px\left, val1Px\top, Value1Name, colorLine)
    DrawText(val2Px\left, val2Px\top, Value2Name, colorLine)
    Box(val1Px\left, val1Px\top, -val1Px\bottom, val1Px\bottom, colorVal1)
    Box(val2Px\left, val2Px\top, -val1Px\bottom, val1Px\bottom, colorVal2)
  EndIf
  
  LineXY(diagram\left, diagram\bottom+5, diagram\left, diagram\top-5, colorLine)
  LineXY(diagram\left-5, diagram\bottom, diagram\right+5, diagram\bottom, colorLine)
  
  StopDrawing()
  
  ; calculate x- and y-axis
  xSpace = Round((diagram\right - diagram\left) / listEntries, #PB_Round_Up)
  If highestValue < 5
    ySpace = Round((diagram\bottom - diagram\top) / 5, #PB_Round_Up)                     : multiplier = 0.5
  ElseIf highestValue >= 5 And highestValue < 10
    ySpace = Round((diagram\bottom - diagram\top) / 10, #PB_Round_Up)                    : multiplier = 1
  ElseIf highestValue >= 10 And highestValue < 100
    ySpace = Round((diagram\bottom - diagram\top) / (highestValue / 10), #PB_Round_Up)   : multiplier = 10
  ElseIf highestValue >= 100 And highestValue < 1000
    ySpace = Round((diagram\bottom - diagram\top) / (highestValue / 50), #PB_Round_Up)   : multiplier = 50
  ElseIf highestValue >= 1000 And highestValue < 10000
    ySpace = Round((diagram\bottom - diagram\top) / (highestValue / 500), #PB_Round_Up)  : multiplier = 500
  ElseIf highestValue >= 10000
    ySpace = Round((diagram\bottom - diagram\top) / (highestValue / 5000), #PB_Round_Up) : multiplier = 5000
  EndIf
  
  ; draw x- and y-axis
  StartDrawing(ImageOutput(Image))
  
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(fontX))
  
  FirstElement(dData())
  For n = 1 To listEntries
    Line(diagram\left + (n * xSpace), diagram\bottom, 1, 5, colorLine)
    DrawText(diagram\left + ((n-1) * xSpace) + ((xSpace - TextWidth(dData()\name)) / 2), diagram\bottom + 3, dData()\name, colorLine)
    NextElement(dData())
  Next
  
  DrawingFont(FontID(fontY))
  For n = 1 To (diagram\bottom / ySpace)
    If diagram\top <= diagram\bottom - (n * ySpace)
      Line(diagram\left, diagram\bottom - (n * ySpace), -5, 1, colorLine)
      Line(diagram\left + 1, diagram\bottom - (n * ySpace), diagram\right - diagram\left, 1, colorHelp)
      If ShowValueAsFloat
        DrawText(diagram\left - 5 - highestValuePx\x, diagram\bottom - (n * ySpace) - (TextHeight(Str(n)) / 2), StrF(n*multiplier, 1), colorLine)
      Else
        DrawText(diagram\left - 5 - highestValuePx\x, diagram\bottom - (n * ySpace) - (TextHeight(Str(n)) / 2), Str(n*multiplier), colorLine)
      EndIf
    EndIf
  Next
  
  StopDrawing()
  
  ; calculate boxes and draw them
  boxSize = Round(xSpace / 3, #PB_Round_Nearest)
  
  StartDrawing(ImageOutput(Image))
  
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(fontY))
  
  FirstElement(dData())
  For n = 1 To listEntries
    Box(diagram\left + ((n-1) * xSpace) + (boxSize / 2), diagram\bottom, boxSize, -((dData()\value1 / multiplier) * ySpace), colorVal1)
    If ShowValueAsFloat
      If dData()\value1 <= 0
        DrawText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + ((boxSize - TextWidth(StrF(dData()\value1, 1))) / 2), diagram\bottom - TextHeight(Str(dData()\value1)), StrF(dData()\value1, 1), colorLine)
      Else
        DrawText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + ((boxSize - TextWidth(StrF(dData()\value1, 1))) / 2), diagram\bottom - ((dData()\value1 / multiplier) * ySpace), StrF(dData()\value1, 1), colorHigh)
      EndIf
    Else
      If dData()\value1 <= 0
        DrawText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + ((boxSize - TextWidth(Str(dData()\value1))) / 2), diagram\bottom - TextHeight(Str(dData()\value1)), Str(dData()\value1), colorLine)
      Else
        DrawText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + ((boxSize - TextWidth(Str(dData()\value1))) / 2), diagram\bottom - ((dData()\value1 / multiplier) * ySpace), Str(dData()\value1), colorHigh)
      EndIf
    EndIf
    Box(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + boxSize, diagram\bottom, boxSize, -((dData()\value2 / multiplier) * ySpace), colorVal2)
    If ShowValueAsFloat
      If dData()\value2 <= 0
        DrawText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + boxSize + ((boxSize - TextWidth(StrF(dData()\value2, 1))) / 2), diagram\bottom - TextHeight(Str(dData()\value2)), StrF(dData()\value2, 1), colorLine)
      Else
        DrawText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + boxSize + ((boxSize - TextWidth(StrF(dData()\value2, 1))) / 2), diagram\bottom - ((dData()\value2 / multiplier) * ySpace), StrF(dData()\value2, 1), colorHigh)
      EndIf
    Else
      If dData()\value2 <= 0
        DrawText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + boxSize + ((boxSize - TextWidth(Str(dData()\value2))) / 2), diagram\bottom - TextHeight(Str(dData()\value2)), Str(dData()\value2), colorLine)
      Else
        DrawText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + boxSize + ((boxSize - TextWidth(Str(dData()\value2))) / 2), diagram\bottom - ((dData()\value2 / multiplier) * ySpace), Str(dData()\value2), colorHigh)
      EndIf
    EndIf
    NextElement(dData())
  Next
  
  StopDrawing()
  
  Debug "done in " + Str(ElapsedMilliseconds() - startTime) + " ms"
  
  ProcedureReturn ImageID(Image)
  
EndProcedure


If OpenWindow(0, 0, 0, 800, 500, "Diagram Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  If ContainerGadget(#CONTAINER_GRAPHS, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10, #PB_Container_Raised)
    ImageGadget(#IMG_GRAPHS, 0, 0, GadgetWidth(#CONTAINER_GRAPHS), GadgetHeight(#CONTAINER_GRAPHS), 0)
    CloseGadgetList()
  EndIf
Else
  End
EndIf

NewList DiagramData.DiagramData()
AddElement(DiagramData())
DiagramData()\name   = "Anbieter TEU"
DiagramData()\value1 = 51.9
DiagramData()\value2 = 0
AddElement(DiagramData())
DiagramData()\name   = "Anbieter Mittel"
DiagramData()\value1 = 0
DiagramData()\value2 = 40.6
AddElement(DiagramData())
DiagramData()\name   = "Anbieter SAUteu"
DiagramData()\value1 = 60.7
DiagramData()\value2 = 88.0
AddElement(DiagramData())
DiagramData()\name   = "Anbieter Mittel"
DiagramData()\value1 = 45.6
DiagramData()\value2 = 0
AddElement(DiagramData())
DiagramData()\name   = "Anbieter TEUA"
DiagramData()\value1 = 56.9
DiagramData()\value2 = 70.0
AddElement(DiagramData())
DiagramData()\name   = "Anbieter BIL"
DiagramData()\value1 = 30.2
DiagramData()\value2 = 38.3
AddElement(DiagramData())
DiagramData()\name   = "Anbieter BILIGA"
DiagramData()\value1 = 20.3
DiagramData()\value2 = 30.4



If CreateDiagramImage(#DIAGRAM_IMG, "Durchschnittliche Preise nach Anbieter", DiagramData(), "Bären", "Stiere", #True)
  SetGadgetState(#IMG_GRAPHS, ImageID(#DIAGRAM_IMG))
Else
  Debug "image creation failed"
EndIf

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

End
Viel Spass damit falls den jemand brauchen sollte.
Zuletzt geändert von Makke am 12.04.2012 20:57, insgesamt 1-mal geändert.
---
Windows 11 (64 bit)
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8807
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Re: kleines Balkendiagramm mit 2 Werten

Beitrag von NicTheQuick »

Ein kleiner Hinweis: Innerhalb Procedures nutzt man Protected und nicht Define. :wink:
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: kleines Balkendiagramm mit 2 Werten

Beitrag von ts-soft »

Dann von mir auch noch ein Tipp:

Code: Alles auswählen

; aus so etwas:
Define titlePx.RECT
Define val1Px.RECT
Define val2Px.RECT

; kann man so etwas machen:
Protected.RECT titlePx, val1Px, val2Px
macht die Sache IMHO übersichtlicher, als für jede Declaration eine Zeile zu nutzen.

Ansonsten :allright: , sehr schöne Grafik, danke
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7028
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: kleines Balkendiagramm mit 2 Werten

Beitrag von STARGÅTE »

Auch von mir ein paar Tips:
  • Die Skalierung wird ja automatisch gewählt, jedoch nicht, wenn es negative Werte gibt.
  • Für den Datenwert in den Balken solltest du prüfen, ob die Zahl in den Balken passt, sonst ist der Wert zB bei DiagramData()\value2 = 1 nicht zu sehen.
  • Für den Zeichenbereich lieber OutputWidth() und OutputHeight() nutzen, statt die GadgetDimension, da durch einen Rahmen (wie hier) der eigentliche Zeichenbereich kleiner ist.
Ansonsten nette grafische Umsetzung, für die praktische Nutzung (für andere) jedoch noch zu unflexibel (z.B. nur 2 Datensätze möglich), obwohl es ja schon recht gut gemacht ist mit der dynamischen Datensatzgröße.

Ich hatte früher auch mal vor, eine Art Diagramm-Gadget zu bauen mit allem drum und dran, nur hab ich mich mit mir gestritten (ja ich kann sowas^^), in welcher Weise ich die Daten übergeben könnte, weil halt Listen als Parameter immer eine gegebene Struktur brauchen. Vielleicht als XML ...

Code: Alles auswählen

BarChartGadget(#Gadget, X, Y, Width, Height, #XML)
... in dem dann alle nötigen Attribute und Daten als Knoten definiert werden können (über PB oder als Datei)

PS: in deinem Beispiel fehlt unten ein AddElement() oder es sind 3 Zeilen zu viel:

Code: Alles auswählen

AddElement(DiagramData())
DiagramData()\name   = "Anbieter BIL"
DiagramData()\value1 = 30.2
DiagramData()\value2 = 38.3
DiagramData()\name   = "Anbieter BILIGA"
DiagramData()\value1 = 20.3
DiagramData()\value2 = 30.4
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
Makke
Beiträge: 156
Registriert: 24.08.2011 18:00
Computerausstattung: AMD Ryzen 7 5700X - AMD Radeon RX 6800 XT - 32 GB DDR4 SDRAM
Wohnort: Ruhrpott
Kontaktdaten:

Re: kleines Balkendiagramm mit 2 Werten

Beitrag von Makke »

Hallo !

erstmal danke für Eure Reaktionen und die Kritik. Ich finde allgemein hier im Forum herrscht ein sehr angenehmes Klima und über solche Kritik freue ich mich immer. Nun aber zu Euren Ratschlägen.

@Nic: Habe ich geändert.

@ts-soft: Für mich ist meine Version irgendwie klarer, aber ich werde es mal mit Deinem Vorschlag versuchen.

@STARGATE: Also ... so etwas was Du vorgeschlagen hast traue ich mir auch (noch?) nicht zu. Ich habe zB gar nicht an negative Wertte gedacht (kam mir irgendwie nicht in den Sinn), das mit den Mini-Zahlen ist eine gute Idee, zudem ich ja die Zeichengröße habe. Und das mit dem Zeichenbereich finde ich Super, an dem Programm an dem ich sitze hatte ich nämlich das Problem, dass die Zeichnung bei mehrmaligen Ausführen immer größer wurde und ich wusste nicht warum.

Und, Dein Vorschlag in Ehren (XML usw.) aber an so etwas traue ich mich noch nicht heran. Obwohl ein Excel-Diagramm-Assistenten in Purebasic wäre bestimmt eine tolle Sache.

Also vielen Dank. Sobald ich die Prozedur verbessere und ändere werde ich die o. stehende anpassen.

vG
---
Windows 11 (64 bit)
PBFetischist
Beiträge: 55
Registriert: 26.10.2004 19:42

Re: kleines Balkendiagramm mit 2 Werten

Beitrag von PBFetischist »

Finde ich richtig gut, ich habe mal ein paar Sachen geändert und es gleich in eine Anwendung von mir eingebaut. Danke.

Der Float in der Y Achse funktionierte nicht, Farben geändert und Grid ist optional, Werte sind jetzt außerhalb wenn der Balken kleiner ist als die Texthöhe. Wenn jetzt noch die negativen Werte funktionieren... ;-)

Gruss aus Hamburg

Code: Alles auswählen


Enumeration
  #DIAGRAM_IMG
  #CONTAINER_GRAPHS
  #IMG_GRAPHS
EndEnumeration

Structure DiagramData
  name.s
  value1.f
  value2.f
EndStructure

Procedure.i CreateDiagramImage(Image.i, Title.s, List dData.DiagramData(), Value1Name.s="", Value2Name.s="", ShowValueAsFloat.i=#False, SortListByName.i=#True, ShowGrid.i=#True) ; Image.i=#Image
 
  Protected startTime.i = ElapsedMilliseconds()
 
  Protected n.i
  Protected multiplier.f
 
  Protected listEntries = ListSize(dData())
  Protected size.RECT ; size of image
 
  Protected fontTitle.i = LoadFont(#PB_Any, "Calibri", 10, #PB_Font_Bold|#PB_Font_HighQuality)
  Protected fontX.i     = LoadFont(#PB_Any, "Calibri",  8, #PB_Font_HighQuality)
  Protected fontY.i     = LoadFont(#PB_Any, "Calibri", 10, #PB_Font_HighQuality)
 
  Protected colorBg.i   = RGB(255, 255, 255)
  Protected colorLine.i = RGB(0, 0, 0)
  Protected colorHigh.i = RGB(33, 33, 33)
  Protected colorHelp.i = RGB(221, 221, 221)
  Protected colorVal1.i = RGB(238, 197, 73)
  Protected colorVal2.i = RGB(171, 214, 248)
 
  Protected highestValue.f
  Protected highestValuePx.POINT
  Protected longestText.s
  Protected longestTextPx.POINT
 
  Protected titlePx.RECT
  Protected val1Px.RECT
  Protected val2Px.RECT
 
  Protected diagram.RECT ; the diagram size
 
  Protected ySpace.i
  Protected xSpace.i ; the space on axis between the names
 
  Protected boxSize.i ; size of boxes in x-pixels
 
  If listEntries = 0
    ProcedureReturn 0
  EndIf
 
  If ShowValueAsFloat
    decimal = 1
  Else
    decimal = 0
  EndIf
  
  ; get size of container gadget ...
  If IsGadget(#IMG_GRAPHS)
    size\top    = 0
    size\left   = 0
    size\right  = GadgetWidth(#CONTAINER_GRAPHS)-4
    size\bottom = GadgetHeight(#CONTAINER_GRAPHS)-4
  Else
    ProcedureReturn 0
  EndIf
 
  ; ... and resize image
  If IsImage(Image)
    ResizeImage(Image, size\right, size\bottom)
  Else
    CreateImage(Image, size\right, size\bottom)
  EndIf
 
  ; check for diagram title
  If Title = ""
    Title = "Diagram"
  EndIf
 
  If Value1Name <> "" And Value2Name <> ""
    Value1Name = " = "+Value1Name
    Value2Name = " = "+Value2Name
  EndIf
 
  ; sort list by NAME
  If SortListByName
    SortStructuredList(dData(), #PB_Sort_Descending, OffsetOf(DiagramData\name), #PB_Sort_String)
  EndIf
 
  ; get highest values for text sizes
  ForEach dData()
    With dData()
      If \value1 >= highestValue
        highestValue = \value1
      EndIf
      If \value2 >= highestValue
        highestValue = \value2
      EndIf
      If Len(\name) >= Len(longestText)
        longestText = \name
      EndIf
    EndWith
  Next
 
  ; get sizes of text
  StartDrawing(ImageOutput(Image))
 
  ; diagram title
  DrawingFont(FontID(fontTitle))
  titlePx\right  = TextWidth(Title)
  titlePx\bottom = TextHeight(Title)
  titlePx\left   = (size\right - titlePx\right) / 2
  titlePx\top    = 5
 
  ; value 1 and 2 description
  DrawingFont(FontID(fontX))
  If Value1Name <> "" And Value2Name <> ""
    val1Px\right  = TextWidth(Value1Name)
    val1Px\bottom = TextHeight(Value1Name)
    val1Px\top    = 5
    val2Px\right  = TextWidth(Value2Name)
    val2Px\bottom = TextHeight(Value2Name)
    val2Px\top    = val1Px\top + val1Px\bottom + 5
    If val1Px\right > val2Px\right
      val1Px\left   = size\right - val1Px\right - 10
      val2Px\left   = size\right - val1Px\right - 10
    Else
      val1Px\left   = size\right - val2Px\right - 10
      val2Px\left   = size\right - val2Px\right - 10
    EndIf
  EndIf
  
  
 
  ; get name text sizes
  longestTextPx\x = TextWidth(longestText)
  longestTextPx\y = TextHeight(longestText)
 
  ; get value text sizes
  DrawingFont(FontID(fontY))
  If ShowValueAsFloat
    highestValuePx\x = TextWidth(StrF(highestValue, 1))
  Else
    highestValuePx\x = TextWidth(Str(highestValue))
  EndIf
  highestValuePx\y = TextHeight(Str(highestValue))
 
  StopDrawing()
 
  ; calculate the RECT for the whole diagram
  diagram\left = 5 + highestValuePx\x + 5
  If Value1Name = "" Or Value2Name = ""
    diagram\top = titlePx\top + titlePx\bottom + 5
  Else
    diagram\top = val2Px\top + val2Px\bottom + 5
  EndIf
  diagram\right  = size\right - diagram\left - 5
  diagram\bottom = size\bottom - 5 - longestTextPx\y - 5
 
  ; now fill the image an draw the coordinate system
  StartDrawing(ImageOutput(Image))
 
  DrawingMode(#PB_2DDrawing_Transparent)
 
  Box(size\left, size\top, size\right, size\bottom, colorBg)
 
  
  DrawingFont(FontID(fontTitle))
  DrawText(titlePx\left, titlePx\top, Title, colorLine)
 
  If Value1Name <> "" And Value2Name <> ""
    DrawingFont(FontID(fontX))
    DrawText(val1Px\left, val1Px\top, Value1Name, colorLine)
    DrawText(val2Px\left, val2Px\top, Value2Name, colorLine)
    
    Box(val1Px\left, val1Px\top, -val1Px\bottom, val1Px\bottom, colorHelp)
    Box(val1Px\left - 1, val1Px\top + 1, -val1Px\bottom + 2, val1Px\bottom - 2, #White)
    Box(val2Px\left, val2Px\top, -val2Px\bottom, val2Px\bottom, colorHelp)
    Box(val2Px\left - 1, val2Px\top + 1, -val2Px\bottom + 2, val2Px\bottom - 2, #White)
    
    Box(val1Px\left - 2, val1Px\top + 2, -val1Px\bottom + 4, val1Px\bottom - 4, colorVal1)
    Box(val2Px\left - 2, val2Px\top + 2, -val1Px\bottom + 4, val1Px\bottom - 4, colorVal2)
  EndIf
 
;  LineXY(diagram\left, diagram\top-5, diagram\right, diagram\top-5, colorLine)
  LineXY(diagram\left, diagram\bottom+5, diagram\left, diagram\top-5, colorLine)
  LineXY(diagram\left-5, diagram\bottom, diagram\right+5, diagram\bottom, colorLine)
 
  StopDrawing()
 
  ; calculate x- and y-axis
  xSpace = Round((diagram\right - diagram\left) / listEntries, #PB_Round_Up)
  If highestValue < 5
    ySpace = Round((diagram\bottom - diagram\top) / 5, #PB_Round_Up)                     : multiplier = 0.5
  ElseIf highestValue >= 5 And highestValue < 10
    ySpace = Round((diagram\bottom - diagram\top) / 10, #PB_Round_Up)                    : multiplier = 1
  ElseIf highestValue >= 10 And highestValue < 100
    ySpace = Round((diagram\bottom - diagram\top) / (highestValue / 10), #PB_Round_Up)   : multiplier = 10
  ElseIf highestValue >= 100 And highestValue < 1000
    ySpace = Round((diagram\bottom - diagram\top) / (highestValue / 50), #PB_Round_Up)   : multiplier = 50
  ElseIf highestValue >= 1000 And highestValue < 10000
    ySpace = Round((diagram\bottom - diagram\top) / (highestValue / 500), #PB_Round_Up)  : multiplier = 500
  ElseIf highestValue >= 10000
    ySpace = Round((diagram\bottom - diagram\top) / (highestValue / 5000), #PB_Round_Up) : multiplier = 5000
  EndIf
 
  ; draw x- and y-axis
  StartDrawing(ImageOutput(Image))
 
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(fontX))
 
  FirstElement(dData())
  For n = 1 To listEntries
    If ShowGrid
      Line(diagram\left + (n * xSpace), diagram\top - 5, 1, diagram\bottom - diagram\top + 5, colorHelp)
    EndIf     
    Line(diagram\left + (n * xSpace), diagram\bottom, 1, 5, colorLine)
    DrawText(diagram\left + ((n-1) * xSpace) + ((xSpace - TextWidth(dData()\name)) / 2), diagram\bottom + 3, dData()\name, colorLine)
    NextElement(dData())
  Next
 
  DrawingFont(FontID(fontY))
  For n = 1 To (diagram\bottom / ySpace)
    If diagram\top <= diagram\bottom - (n * ySpace)
      Line(diagram\left, diagram\bottom - (n * ySpace), -5, 1, colorLine)
      Line(diagram\left + 1, diagram\bottom - (n * ySpace), diagram\right - diagram\left, 1, colorHelp)
      DrawText(diagram\left - 6 - highestValuePx\x, diagram\bottom - (n * ySpace) - (TextHeight(Str(n)) / 2), StrF(n*multiplier, decimal), colorLine)
    EndIf
  Next
 
  StopDrawing()
 
  ; calculate boxes and draw them
  boxSize = Round(xSpace / 3, #PB_Round_Nearest)
 
  StartDrawing(ImageOutput(Image))
 
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(fontY))
 
  FirstElement(dData())
  For n = 1 To listEntries
    Box(diagram\left + ((n-1) * xSpace) + (boxSize / 2), diagram\bottom, boxSize - 1, -((dData()\value1 / multiplier) * ySpace), colorVal1)
    Box(2 + diagram\left + ((n-1) * xSpace) + (boxSize / 2), diagram\bottom, boxSize - 5, -((dData()\value1 / multiplier) * ySpace) + 2, RGB(248, 231, 179))
    ValueOutsideBar = #False  
    If ((dData()\value1 / multiplier) * ySpace) < TextHeight(Str(dData()\value1)) 
      ValueOutsideBar = #True
    EndIf
    
    If ValueOutsideBar
      DrawRotatedText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + ((boxSize - TextWidth(StrF(dData()\value1, decimal))) / 2), diagram\bottom - (2 * TextHeight(Str(dData()\value1))), StrF(dData()\value1, decimal), 0, colorLine)
    Else
      DrawRotatedText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + ((boxSize - TextWidth(StrF(dData()\value1, decimal))) / 2), diagram\bottom - ((dData()\value1 / multiplier) * ySpace), StrF(dData()\value1, decimal), 0, colorHigh)
    EndIf
    
    Box(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + boxSize, diagram\bottom, boxSize - 1, -((dData()\value2 / multiplier) * ySpace), colorVal2)
    Box(2 + diagram\left + ((n-1) * xSpace) + (boxSize / 2) + boxSize, diagram\bottom, boxSize - 5, -((dData()\value2 / multiplier) * ySpace) + 2, RGB(223, 239, 252))
    
    ValueOutsideBar = #False  
    If ((dData()\value2 / multiplier) * ySpace) < TextHeight(Str(dData()\value2)) 
      ValueOutsideBar = #True
    EndIf

    If ValueOutsideBar
      DrawRotatedText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + boxSize + ((boxSize - TextWidth(StrF(dData()\value2, decimal))) / 2), diagram\bottom - (2 * TextHeight(Str(dData()\value2))), StrF(dData()\value2, decimal), 0, colorLine)
    Else
      DrawRotatedText(diagram\left + ((n-1) * xSpace) + (boxSize / 2) + boxSize + ((boxSize - TextWidth(StrF(dData()\value2, decimal))) / 2), diagram\bottom - ((dData()\value2 / multiplier) * ySpace), StrF(dData()\value2, decimal), 0, colorHigh)
    EndIf
    
    NextElement(dData())
  Next
 
  StopDrawing()
 
  ProcedureReturn ImageID(Image)
 
EndProcedure


If OpenWindow(0, 0, 0, 800, 300, "Diagram Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  If ContainerGadget(#CONTAINER_GRAPHS, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10, #PB_Container_Raised)
    ImageGadget(#IMG_GRAPHS, 0, 0, GadgetWidth(#CONTAINER_GRAPHS), GadgetHeight(#CONTAINER_GRAPHS), 0)
    CloseGadgetList()
  EndIf
Else
  End
EndIf

NewList DiagramData.DiagramData()
For x = 1 To (Random(15) + 1)
  AddElement(DiagramData())
  DiagramData()\name   = "Wert " + Str(x)
  DiagramData()\value1 = Random(200) 
  DiagramData()\value2 = Random(200) 
Next



If CreateDiagramImage(#DIAGRAM_IMG, "Warenbewegungen", DiagramData(), "Warenausgang", "Wareneingang", #False, #False, #True)
  SetGadgetState(#IMG_GRAPHS, ImageID(#DIAGRAM_IMG))
Else
  Debug "image creation failed"
EndIf

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

End
PB 4.30 auf Windows Vista / XP SP2 und Linux
Benutzeravatar
Makke
Beiträge: 156
Registriert: 24.08.2011 18:00
Computerausstattung: AMD Ryzen 7 5700X - AMD Radeon RX 6800 XT - 32 GB DDR4 SDRAM
Wohnort: Ruhrpott
Kontaktdaten:

Re: kleines Balkendiagramm mit 2 Werten

Beitrag von Makke »

Hi Fetischist ;)

Schön das Du damit was anfangen konntest, ich habe hier noch ein Liniendiagram (das aber arg eingeschränkt ist), evtl. kannst Du das auch noch gebrauchen:

Code: Alles auswählen

Enumeration
  #DIAGRAM_IMG
  #CONTAINER_GRAPHS
  #IMG_GRAPHS
EndEnumeration

Structure LineDiagramData
  duration.i
  name.s
  owner.s
  damage.i
  ability.s
EndStructure

Structure LineDiagramDataTooltip
  coords.RECT
  tooltip.s
EndStructure

NewList DiagramData.LineDiagramData()
NewList LineDiagramTooltip.LineDiagramDataTooltip()


Procedure.i CreateLineDiagramImage(Image.i, Title.s, List dData.LineDiagramData(), XAxisName.s="", YAxisName.s="", WithLineDots.i=0) ; Image.i = #Image
  
  Shared LineDiagramTooltip()
  
  Protected startTime.i = ElapsedMilliseconds()
  
  Protected NewMap dmgMap.i()
  
  Protected Dim names.s(12)
  Protected Dim owner.s(12)
  Protected Dim color.i(12)
  
  Protected n.i
  Protected multiX.i
  Protected multiY.i
  
  Protected listEntries = ListSize(dData())
  Protected size.RECT ; size of image
  
  Protected maxDuration.i
  Protected highestDmg.i
  
  Protected tFont.i = LoadFont(#PB_Any, "Calibri", 10, #PB_Font_Bold|#PB_Font_HighQuality)
  Protected xFont.i = LoadFont(#PB_Any, "Calibri", 10, #PB_Font_HighQuality)
  Protected yFont.i = LoadFont(#PB_Any, "Calibri",  8, #PB_Font_HighQuality)
  
  Protected colorBg.i   = RGB(255, 248, 220)
  Protected colorLine.i = RGB(0, 0, 0)
  Protected colorTemp.i
  
  Protected titlePx.RECT
  Protected diagram.RECT
  Protected XdescPt.POINT
  Protected YdescPt.POINT
  Protected legend.POINT
  
  Protected PxPerSecond.f
  Protected PxPerDamage.f
  
  Protected lastX.f
  Protected lastY.f
  Protected newX.f
  Protected newY.f
  
  color(0)  = RGB(255, 0, 0)
  color(1)  = RGB(0, 255, 0)
  color(2)  = RGB(0, 0, 255)
  color(3)  = RGB(255, 0, 255)
  color(4)  = RGB(0, 255, 255)
  color(5)  = RGB(170, 0, 0)
  color(6)  = RGB(0, 170, 0)
  color(7)  = RGB(0, 0, 170)
  color(8)  = RGB(170, 0, 170)
  color(9)  = RGB(0, 170, 170)
  color(10) = RGB(85, 0, 0)
  color(11) = RGB(0, 85, 0)
  color(12) = RGB(0, 0, 85)
  
  If listEntries = 0
    ProcedureReturn 0
  EndIf
  
  If ListSize(LineDiagramTooltip()) > 0
    ClearList(LineDiagramTooltip())
  EndIf
  
  ; get max duration (x) and highest damage (y)
  LastElement(dData())
  maxDuration = Round(dData()\duration / 1000, #PB_Round_Up)
  ForEach dData()
    If dData()\owner = ""
      dmgMap(dData()\name) + dData()\damage
    Else
      dmgMap(dData()\name + " (" + dData()\owner + ")") + dData()\damage
    EndIf
  Next
  n=0
  ForEach dmgMap()
    If dmgMap() > highestDmg
      highestDmg = dmgMap()
    EndIf
    names(n) = MapKey(dmgMap())
    n + 1
  Next
  
  If highestDmg < 10
    highestDmg = 10
  ElseIf highestDmg >= 10 And highestDmg < 100
    highestDmg = 100
  ElseIf highestDmg >= 100 And highestDmg < 1000
    highestDmg = Round(highestDmg /10, #PB_Round_Up) * 10
  ElseIf highestDmg >= 1000 And highestDmg < 10000
    highestDmg = Round(highestDmg /100, #PB_Round_Up) * 100
  ElseIf highestDmg >= 10000 And highestDmg < 50000
    highestDmg = Round(highestDmg /1000, #PB_Round_Up) * 1000
  ElseIf highestDmg >= 50000 And highestDmg < 100000
    highestDmg = Round(highestDmg /5000, #PB_Round_Up) * 5000
  ElseIf highestDmg >= 100000  
    highestDmg = Round(highestDmg /10000, #PB_Round_Up) * 10000
  EndIf
  
  ; get size of container gadget ...
  If IsGadget(#IMG_GRAPHS)
    size\top    = 0
    size\left   = 0
    size\right  = GadgetWidth(#IMG_GRAPHS)-4
    size\bottom = GadgetHeight(#IMG_GRAPHS)-4
  Else
    ProcedureReturn 0
  EndIf
  
  ; ... and resize image
  If IsImage(Image)
    ResizeImage(Image, size\right, size\bottom)
  Else
    CreateImage(Image, size\right, size\bottom)
  EndIf
  
  ; check for diagram title
  If Title = ""
    Title = "Line Diagram"
  EndIf
  
  ; get size of x- and y-axis descriptions and size of diagram and draw both
  StartDrawing(ImageOutput(Image))
  
  DrawingFont(tFont)
  titlePx\left   = (size\right - TextWidth(Title)) / 2
  titlePx\right  = titlePx\left + TextWidth(Title)
  titlePx\top    = 5
  titlePx\bottom = titlePx\top + TextHeight(Title)
  
  DrawingFont(yFont)
  diagram\left   = 5 + TextWidth(Str(highestDmg)) + 5
  diagram\right  = size\right - diagram\left - 5
  diagram\top    = size\top + titlePx\bottom + 5
  
  YdescPt\x = diagram\left + 3
  YdescPt\y = diagram\top + 5
  
  legend\x = YdescPt\x
  legend\y = YdescPt\y + TextHeight(YAxisName) + 5
  
  DrawingFont(xFont)
  diagram\bottom = size\bottom - (5 + TextHeight(Str(maxDuration)) + 5)
  
  XdescPt\x = diagram\right - TextWidth(XAxisName)
  XdescPt\y = diagram\bottom - TextHeight(XAxisName) - 3
  
  DrawingMode(#PB_2DDrawing_Transparent)
  
  Box(size\left, size\top, size\right, size\bottom, colorBg)
  
  DrawingFont(FontID(tFont))
  DrawText(titlePx\left, titlePx\top, Title, colorLine)
  
  If XAxisName <> "" And YAxisName <> ""
    DrawingFont(FontID(xFont))
    DrawText(XdescPt\x, XdescPt\y, XAxisName, colorLine)
    DrawText(YdescPt\x, YdescPt\y, YAxisName, colorLine)
  EndIf
  
  LineXY(diagram\left, diagram\bottom+5, diagram\left, diagram\top, colorLine)
  LineXY(diagram\left-5, diagram\bottom, diagram\right, diagram\bottom, colorLine)

  StopDrawing()
  
  ; calculate x- and y-axis units and draw both
  PxPerSecond = (diagram\right - diagram\left) / maxDuration
  PxPerDamage = (diagram\bottom - diagram\top) / highestDmg
  
  If maxDuration < 60
    multiX = 5
  ElseIf maxDuration >= 60 And maxDuration < 300
    multiX = 10
  ElseIf maxDuration >= 300
    multiX = 30
  EndIf
  
  If highestDmg < 10
    multiY = 1
  ElseIf highestDmg >= 10 And highestDmg < 100
    multiY = 10
  ElseIf highestDmg >= 100 And highestDmg < 1000
    multiY = 50
  ElseIf highestDmg >= 1000 And highestDmg < 3000
    multiY = 100
  ElseIf highestDmg >= 3000 And highestDmg < 6000
    multiY = 200
  ElseIf highestDmg >= 6000 And highestDmg < 10000
    multiY = 500
  ElseIf highestDmg >= 10000 And highestDmg < 50000
    multiY = 1000
  ElseIf highestDmg >= 50000 And highestDmg < 100000
    multiY = 5000
  ElseIf highestDmg >= 100000
    multiY = 10000
  EndIf
  
  StartDrawing(ImageOutput(Image))
  
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(xFont))
  For n = 1 To (maxDuration / multiX)
    Line(diagram\left + (n * (multiX*PxPerSecond)), diagram\bottom, 1, 5, colorLine)
    DrawText((diagram\left + (n * (multiX*PxPerSecond))) - (TextWidth(Str(n*multiX)) / 2), diagram\bottom + 5, Str(n*multiX), colorLine)
  Next
  
  DrawingFont(FontID(yFont))
  For n = 1 To (highestDmg / multiY)
    Line(diagram\left, diagram\bottom - (n * (multiY*PxPerDamage)), -5, 1, colorLine)
    DrawText(5, (diagram\bottom - (n * (multiY*PxPerDamage))) - (TextHeight(Str(n*multiY)) / 2), Str(n*multiY), colorLine)
  Next
  
  For n = 0 To 11
    If names(n) <> ""
      DrawText(legend\x + 10, legend\y + (n * TextHeight(names(n))) - 3, names(n), colorLine)
      Box(legend\x, legend\y + (n * TextHeight(names(n))), 8, 8, color(n))
    EndIf
  Next
  
  StopDrawing()
  
  ; calculate values and draw them
  SortStructuredList(dData(), #PB_Sort_Ascending, OffsetOf(LineDiagramData\duration), #PB_Sort_Integer)
  
  StartDrawing(ImageOutput(Image))
  
  For n = 0 To 11
    newX  = 0
    newY  = 0
    lastX = 0
    lastY = 0
    ForEach dData()
      If names(n) = dData()\name
        newX = dData()\duration / 1000
        newY + dData()\damage
        If WithLineDots
          Circle(diagram\left + Round(newX*PxPerSecond, #PB_Round_Nearest), diagram\bottom - Round(newY*PxPerDamage, #PB_Round_Nearest), 2, color(n))
          AddElement(LineDiagramTooltip())
          LineDiagramTooltip()\coords\left   = diagram\left + Round(newX*PxPerSecond, #PB_Round_Nearest)
          LineDiagramTooltip()\coords\top    = diagram\bottom - Round(newY*PxPerDamage, #PB_Round_Nearest)
          LineDiagramTooltip()\coords\right  = LineDiagramTooltip()\coords\left + 5
          LineDiagramTooltip()\coords\bottom = LineDiagramTooltip()\coords\top + 5
          LineDiagramTooltip()\tooltip       = dData()\ability
        EndIf
        LineXY(diagram\left + Round(lastX*PxPerSecond, #PB_Round_Nearest), diagram\bottom - Round(lastY*PxPerDamage, #PB_Round_Nearest), diagram\left + Round(newX*PxPerSecond, #PB_Round_Nearest), diagram\bottom - Round(newY*PxPerDamage, #PB_Round_Nearest), color(n))
        lastX = newX
        lastY = newY
      EndIf
      If names(n) = dData()\name + " (" + dData()\owner + ")"
        newX = dData()\duration / 1000
        newY + dData()\damage
        If WithLineDots
          Circle(diagram\left + Round(newX*PxPerSecond, #PB_Round_Nearest), diagram\bottom - Round(newY*PxPerDamage, #PB_Round_Nearest), 2, color(n))
          AddElement(LineDiagramTooltip())
          LineDiagramTooltip()\coords\left   = diagram\left + Round(newX*PxPerSecond, #PB_Round_Nearest) - 2
          LineDiagramTooltip()\coords\top    = diagram\bottom - Round(newY*PxPerDamage, #PB_Round_Nearest) - 2
          LineDiagramTooltip()\coords\right  = LineDiagramTooltip()\coords\left + 4
          LineDiagramTooltip()\coords\bottom = LineDiagramTooltip()\coords\top + 4
          LineDiagramTooltip()\tooltip       = dData()\ability
        EndIf
        LineXY(diagram\left + Round(lastX*PxPerSecond, #PB_Round_Nearest), diagram\bottom - Round(lastY*PxPerDamage, #PB_Round_Nearest), diagram\left + Round(newX*PxPerSecond, #PB_Round_Nearest), diagram\bottom - Round(newY*PxPerDamage, #PB_Round_Nearest), color(n))
        lastX = newX
        lastY = newY
      EndIf
    Next
  Next
  
  StopDrawing()
    
  ProcedureReturn ImageID(Image)
  
EndProcedure

If OpenWindow(0, 0, 0, 800, 600, "Diagram Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  If ContainerGadget(#CONTAINER_GRAPHS, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10, #PB_Container_Raised)
    ImageGadget(#IMG_GRAPHS, 0, 0, GadgetWidth(#CONTAINER_GRAPHS), GadgetHeight(#CONTAINER_GRAPHS), 0)
    CloseGadgetList()
  EndIf
Else
  End
EndIf
    
For x = 1 To (Random(2) + 2)
  For x2 = 1 To Random(5)+10
    AddElement(DiagramData())
    DiagramData()\name     = "Name " + Str(x)
    DiagramData()\owner    = ""
    DiagramData()\ability  = "Fähigkeit " + Str(Random(3))
    DiagramData()\duration = Random(120000)
    DiagramData()\damage   = Random(400) + 100
  Next
Next

If CreateLineDiagramImage(#DIAGRAM_IMG, "Schadensentwicklung", DiagramData(), "Dauer (in Sekunden)", "Schaden", #True)
  SetGadgetState(#IMG_GRAPHS, ImageID(#DIAGRAM_IMG))
Else
  Debug "image creation failed"
EndIf

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

End    
Viel Spass.
---
Windows 11 (64 bit)
Antworten