TrendControl->AddArchiv(...) legt bis zu 8 Objekte von Type TrendArchiv an. Alle angelegten Archive werden mit TrendControl->Draw(...) gezeichnet. Zomen und Archivfenster ausgeben gehen auch schon.
Scalen fehlen noch.
Werte zu den Archiven werden mit TrendArchiv->AddLeft oder AddRight hinzugefügt.
Bugfix:
Code: Alles auswählen
;-TOP
; Kommentar : Class TrendControl
; Author : mk-soft
; Second Author :
; Datei : ClassTrendControl.pb
; Version : 1.02
; Erstellt :
; Geändert :
;
; Compilermode :
;
; ***************************************************************************************
Structure udtData
Value.f[0]
EndStructure
; Private
Procedure.f Linear(in.f, ogr_in.f, ugr_in.f, ogr_out.f, ugr_out.f)
Protected delta_in.f, delta_out.f, x.f
delta_in = ogr_in - ugr_in
delta_out = ogr_out - ugr_out
x = (in - ugr_in) / delta_in
x = x * delta_out + ugr_out
ProcedureReturn x
EndProcedure
; ***************************************************************************************
#max_archiv = 8
Class(TrendArchiv)
linecolor.l
size.l
min.f
max.f
*mem.udtData
EndClass
Class(TrendControl)
linecolor.l
backcolor.l
*archiv.ITrendArchiv[#max_archiv]
EndClass
; ***************************************************************************************
; Private: Wird aus TrendControl aufgerufen
Method TrendArchiv_Init(*this.TrendArchiv, size.l, min.f, max.f, linecolor)
Protected *mem
With *this
\size = size
\min = min
\max = max
\linecolor = linecolor
\mem = AllocateMemory((\size+1) * 4)
ProcedureReturn \mem
EndWith
EndMethod
; Private: Wird aus TrendControl aufgerufen
Method TrendArchiv_Draw(*this.TrendArchiv, x, y, dx, dy, start=0, ende=0)
Protected pos1, pos2, x1, y1, x2, y2, x0, y0
With *this
If start >= \size
ProcedureReturn #False
EndIf
If ende = 0
ende = \size - 1
EndIf
x0 = dx + x - 1
y0 = dy + y
FrontColor(\linecolor)
For pos1 = start To ende -1
pos2 = pos1 + 1
x1 = Linear(pos1, start, ende, x, x0)
x2 = Linear(pos2, start, ende, x, x0)
y1 = Linear(\mem\value[pos1], \min, \max, y0, y)
y2 = Linear(\mem\value[pos2], \min, \max, y0, y)
LineXY(x1, y1, x2, y2)
Next
EndWith
EndMethod
; Public: Wert links hinzufügen
Method TrendArchiv_AddLeft(*this.TrendArchiv, Value.l)
Protected pos, start
With *this
If \mem
start = \size ; - 1
For pos = start To 1 Step -1
\mem\value[pos] = \mem\value[pos-1]
Next
\mem\value[0] = Value
EndIf
EndWith
EndMethod
; Public: Wert rechts hinzufügen
Method TrendArchiv_AddRight(*this.TrendArchiv, Value.l)
Protected pos, ende
With *this
If \mem
ende = \size - 2
For pos = 0 To ende
\mem\value[pos] = \mem\value[pos+1]
Next
pos = \size - 1
\mem\value[pos] = Value
EndIf
EndWith
EndMethod
; Public: Archiv löschen
Method Overwrite TrendArchiv_Release(*this.TrendArchiv)
Protected *pdata.TrendControl = *this\parent
Protected c
With *this
; Aus Parent Archivliste entfernen
For c = 0 To #max_archiv - 1
If *pdata\archiv[c] = *this
*pdata\archiv[c] = #Null
Break
EndIf
Next
; Speicher freigeben
FreeMemory(\mem)
DeleteObject(*this)
ProcedureReturn #Null
EndWith
EndMethod
; ***************************************************************************************
; Public: Legt ein Archiv an und gibt das Objekt TrendArchiv zurück
Method TrendControl_AddArchiv(*this.TrendControl, size.l, min.f, max.f, linecolor=0)
Protected c
With *this
For c = 0 To #max_archiv - 1
If \archiv[c] = 0
\archiv[c] = NewObject(TrendArchiv)
If \archiv[c]
\archiv[c]\Init(size, min, max, linecolor)
ProcedureReturn \archiv[c]
Else
ProcedureReturn #Null
EndIf
EndIf
Next
ProcedureReturn #Null
EndWith
EndMethod
; Public: Setzt hintergrundfarbe
Method TrendControl_BackColor(*this.TrendControl, backcolor.l)
With *this
\backcolor = backcolor
EndWith
EndMethod
; Public: Zeichnet alle Archive (2d drawing)
Method TrendControl_Draw(*this.TrendControl, OutputID.l, x, y, dx, dy, start=0, ende=0)
Protected c
With *this
If StartDrawing(OutputID)
Box(x,y,dx,dy, \backcolor)
For c = 0 To #max_archiv - 1
If \archiv[c]
\archiv[c]\Draw(x, y, dx, dy, start, ende)
EndIf
Next
StopDrawing()
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndWith
EndMethod
; Public: Entfernt alle Archive und entfernt das Control
Method Overwrite TrendControl_Release(*this.TrendControl)
Protected c
With *this
For c = 0 To #max_archiv - 1
If \archiv[c]
\archiv[c]\Release()
EndIf
Next
DeleteObject(*this)
ProcedureReturn #Null
EndWith
EndMethod
Code: Alles auswählen
;- Konstanten
Enumeration ; Window ID
#Window
EndEnumeration
Enumeration ; Menu ID
#Menu
EndEnumeration
Enumeration ; MenuItem ID
#Menu_Exit
EndEnumeration
Enumeration ; Statusbar ID
#Statusbar
EndEnumeration
Enumeration ; Gadget ID
#ImageGadget
EndEnumeration
Enumeration ; Image
#Image
EndEnumeration
; ***************************************************************************************
IncludeFile "ClassTrendControlv1.02.pb"
; ***************************************************************************************
Procedure UpdateWindow()
Protected x,y,dx,dy
Protected mn,st,tb
x = 0
y = 0
mn = MenuHeight()
st = StatusBarHeight(#StatusBar)
;tb = ToolBarHeight(#ToolBar)
dx = WindowWidth(#Window)
dy = WindowHeight(#Window) - mn - st - tb
ResizeGadget(#ImageGadget, x, y, dx, dy)
If dy <= 0
dy = 100
EndIf
CreateImage(#Image, dx, dy)
EndProcedure
;
Declare StartTrend()
; Objekte TrendControl
Global *control.ITrendControl, *trend1.ITrendArchiv, *trend2.ITrendArchiv, *trend3.ITrendArchiv
;- Globale Variablen
Global exit = 0
;- Fenster
style = #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
If OpenWindow(#Window, #PB_Ignore, #PB_Ignore, 400, 300, "Fenster", style)
; Menu
If CreateMenu(#Menu, WindowID(#Window))
MenuTitle("&Datei")
MenuItem(#Menu_Exit, "Be&enden")
EndIf
; Statusbar
CreateStatusBar(#Statusbar, WindowID(#Window))
; Gadgets
If CreateGadgetList(WindowID(#Window))
ImageGadget(#ImageGadget, 0,0,0,0,0)
EndIf
; Object TrendControl anlegen
*control = NewObject(TrendControl)
; Hintergrundfarbe setzen
*control\BackColor($FFFFFF)
; Archive anlegen - max 8 Archive
; Parameter:
; 1 - Anzahl Werte (X-Achse)
; 2 - Minimaler Y-Wert
; 3 - Maximaler Y-Wert
; 4 - Linienfarbe
; Result:
; Objekt TrendArchiv
*trend1 = *control\AddArchiv(400, 0, 400, RGB(255,0,0))
*trend2 = *control\AddArchiv(400, 0, 400, RGB(0,255,0))
*trend3 = *control\AddArchiv(400, 0, 400, RGB(0,0,255))
; Test Timer setzen
SetTimer_(WindowID(#Window), 1, 100, 0)
;-- Hauptschleife
Repeat
event = WaitWindowEvent()
window = EventWindow()
menu = EventMenu()
type = EventType()
Select event
Case #PB_Event_Menu
Select menu
Case #Menu_Exit
Exit = 1
EndSelect
Case #PB_Event_Gadget
Case #PB_Event_CloseWindow
Exit = 1
Case #PB_Event_Repaint
Case #PB_Event_SizeWindow
UpdateWindow()
Case #PB_Event_MoveWindow
Case #PB_Event_ActivateWindow
Case #PB_Event_SysTray
Case #WM_TIMER
StartTrend()
EndSelect
Until Exit
*control\Release()
EndIf
End
; *****************************************************************************
Procedure StartTrend()
Protected value.l
value = Random(300) + 50
*trend1\AddLeft(value)
value = Random(200) + 100
*trend2\AddLeft(value)
value = Random(200) + 100
*trend3\AddLeft(value)
*control\Draw(ImageOutput(#Image), 0, 0, GadgetWidth(#ImageGadget), GadgetHeight(#ImageGadget), 0, 200)
SetGadgetState(#ImageGadget, ImageID(#Image))
EndProcedure
P.S. Benötigt OPP-PreCompiler v0.39
http://www.purebasic.fr/english/viewtopic.php?t=30774
P.S. Wer möchte am Ausbau des TrendControl mitmachen.
[/b]