Es ist sicher nicht perfekt, aber als Grundlage für Anfänger sicher brauchbar. Mir reicht es.
im Beispiel sind es 31 Balken = 31 Tage. Mehr Balken sind möglich, aber bei
zu vielen Balken sieht es nicht mehr gut aus.
In der Höhe skaliert es sich automatisch, abhängig vom Maxwert im Datenfeld. Die Werte sollten 6 Stellen nicht überschreiten
Weitere Erklärungen im Code
Es läuft bei mir unter Windows XP 32 Bit
Code: Alles auswählen
Procedure Balkendiagramm2(info$, Array dinfo$(1), Array daten(1), parent)
;sollte ein Fix-Font sein !!!
fontnr = LoadFont(#PB_Any, "Courier New", 8)
winbr = 600
winhh = 400
winnr = OpenWindow(#PB_Any,0,0,winbr,winhh,info$,#PB_Window_SystemMenu|1,WindowID(parent))
;max des Datenfeldes finden
size = ArraySize(daten())
For j = 0 To size
If daten(j) > maxwert: maxwert = daten(j): EndIf
Next
;Mod wert x
Select maxwert
Case 0 To 10: x = 1
Case 11 To 100: x = 10
Case 101 To 1000: x = 10
Case 1001 To 10000: x = 100
Case 10001 To 100000: x = 100
Default: x = 1000
EndSelect
;max des Datenfeldes bis nächsten glatten Wert erhöhen
While maxwert % x ;für senkrechte Y Skala
maxwert + 1
Wend
; -----------------------------------------------------------------
;nur für Höhe + Breite eines Zeichens, sollte Fix-Font sein
StartDrawing(WindowOutput(winnr))
DrawingFont(FontID(fontnr))
chrbr = TextWidth("X")
chrhh = TextHeight("X")
StopDrawing()
balken = ArraySize(daten())
rows = 10
baseX = chrbr * 7 ;senkrechte Linie vom linken Fensterrand
baseY = winhh - chrhh * 3 ;waagerechte Linie von unten
;Balkenabstand in Pixel, -1 kann auch wegfallen
pixelX = ((winbr - baseX) / balken) - 1
If pixelX < 1: pixelX = 1: EndIf ;null verhindern
scaleY = maxwert / rows ;Abstand der Zahlen pro Reihe
pixelY = baseY / rows ;Abstand der Reihen in Pixel
If scaleY < 1: scaleY = 1: EndIf ;null verhindern
If pixelY < 1: pixelY = 10: EndIf
nr = CreateImage(#PB_Any, winbr, winhh, 16) ;16 Bit Farbtiefe
dc = StartDrawing(ImageOutput(nr))
Box(0, 0, winbr, winhh, #White)
Line(baseX, 0, 0, baseY, #Blue) ;senkrechteLinie
Line(baseX, baseY, winbr - baseX, 0, #Blue) ;waagerechte Linie
; gestrichelte Linien + Text links der senkrechten Linie
DrawingFont(FontID(fontnr))
pen = CreatePen_(#PS_DOT,0,#Gray) ;für gestrichelte Linie
SelectObject_(dc,pen)
r.rect
y = baseY ;Basis unten für 0
For j = 0 To rows
If j
MoveToEx_(dc, baseX, y, 0)
LineTo_(dc, winbr, y) ;gestrichelte Linie
EndIf
txt$ = Str(scaleY * j) ;Text links z.B.0,5,10,15...50
r\top = y - chrhh / 3
r\left = 0
r\right = baseX - 2
r\bottom = r\top + chrhh
SetTextAlign_(dc, #TA_TOP)
DrawText_(dc, txt$, -1, r, 2) ;2 = #DT_RIGHT
y - pixelY ;Y-Pixelwert ist für nächste Zahl
Next
DeleteObject_(pen)
; -------------------------------------------
baseX + 4 ;etwas Abstand zur senkrechten Linie für Text + Balken
;Text unten für Balken
altX = 0
For j = 1 To balken
x = baseX + ((j-1) * pixelX) ;pixelposi für nächsten Balken
txt$ = dinfo$(j)
breite = TextWidth(txt$)
br = breite: If pixelX > breite: br = pixelX: EndIf
If altX + br <= x ;kein Platz, kein Text
r\top = baseY + 3 ;r.rect definiert den Raum für Text
r\left = x - 2 ; -2 um baseX + 4 auszugleichen
r\right = r\left + br ; + br ist Textbreite oder Balkenabstand
r\bottom = r\top + TextHeight(txt$)
SetTextAlign_(dc, #TA_TOP) ;ohne geht nix
DrawText_(dc, txt$, -1, r, 1) ;1 = #DT_CENTER
;DrawTextR(dc, r, txt$, 90, 0, 12)
altX = x
InflateRect_(r,1,1) ;vergrößert r.rect für DrawEdge
DrawEdge_(dc,r,1,#BF_RECT) ;nur für die Optik
EndIf
Next
;Balken
balkenbr = pixelX - 4
If balkenbr < 1: balkenbr = 1: EndIf
For j = 1 To balken
lh = (daten(j) * pixelY) / scaleY ;höhe des Balken
x = baseX + ((j-1) * pixelX) ;pixelposi für nächsten Balken
farbe = #Cyan ;
If lh > 3 * pixelY: farbe = #Blue: EndIf
If lh > 6 * pixelY: farbe = #Green: EndIf
Box(x, baseY, balkenbr, -lh, farbe) ;-lh, damit Balken von unten
Next ; nach oben gemalt wird
StopDrawing()
ImageGadget(#PB_Any,0,0, 0,0,ImageID(nr))
FreeFont(fontnr)
ProcedureReturn winnr
EndProcedure
Procedure BalkenDiagramm(main)
;zwischen geschobene Prozedur, welche die Daten bereitstellt
DisableWindow(main, 1)
max = 31 ;31 Balken
Dim tt$(max)
Dim dtn(max)
For j = 1 To max
tt$(j) = Str(j)
dtn(j) = Random(441) ;Wert zwischen 0 und 441
Next
ProcedureReturn Balkendiagramm2(Str(max) + " Werte", tt$(), dtn(), main)
EndProcedure
;------------------------------------
main = 0
OpenWindow(main,0,0,800,600,"",#PB_Window_SystemMenu|1)
subwin = Balkendiagramm(main)
Repeat: event = WaitWindowEvent()
If event = #PB_Event_CloseWindow
If EventWindow() = subwin
event = 0
DisableWindow(0, 0)
CloseWindow(subwin)
EndIf
EndIf
Until event = #PB_Event_CloseWindow
EndMan muß dann aber in der Zeile, baseY = winhh - chrhh * 3, aus der 3 eventuell eine 6 machen.
Und anstatt von DrawText_ DrawTextR aufrufen.
Code: Alles auswählen
Procedure DrawTextR(dc, *r.rect, txt$, angle, fontid, fontsize, quality=2)
; Diese Procedure gibt gedrehten Text aus
GetObject_(fontid,SizeOf(LOGFONT),NewFont.LOGFONT)
NewFont\lfEscapement = angle * 10
NewFont\lfHeight = fontsize
NewFont\lfWeight = quality*100
hFont = CreateFontIndirect_(NewFont)
oldFont = SelectObject_(dc,hFont)
*r\bottom + 5 ; diesen Wert bei Wörtern erhöhen
SetTextAlign_(dc, #TA_RIGHT)
DrawText_(dc, txt$, -1, *r, 1) ;1 = #DT_CENTER
SelectObject_(dc,oldFont)
DeleteObject_(hFont)
EndProcedure Thread wurde verschoben
Anfänger>Code, Tipps und Tricks
08.08.2009
RSBasic