PureBoard

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