OOP TrendControl

mk-soft · Post by **mk-soft** » Sat May 24, 2008 3:04 am

First step for TrendControl.
Added max 8 Trendarchives pro Trendcontrol.

Todo:
- Scales and line types

ClassTrendControl

Code: Select all

;-TOP
; Kommentar     : Class TrendControl
; Author        : mk-soft
; Second Author : 
; Datei         : ClassTrendControl.pb
; Version       : 1.02
; Erstellt      : 
; Geändert      :
; 
; Compilermode  :
;
; ***************************************************************************************

EnableExplicit

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

; ***************************************************************************************

#TD_Max_Archiv = 8
#TD_DataSizeOf = 4

#TD_ScaleLeft = 1
#TD_ScaleRight = 2

Class(TrendArchiv)
  linecolor.l
  size.l
  min.f
  max.f
  scale_type.l
  scale_step.f
  scale_text.s
  *mem.udtData
EndClass

Class(TrendControl)
  backcolor.l
  *archiv.ITrendArchiv[#TD_Max_Archiv]
EndClass

; ***************************************************************************************

; 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

; 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

; Werte als Array übergeben
Method TrendArchiv_SetArray(*this.TrendArchiv, *Array, count)
  Protected len, c
  With *this
    If count >= \size
      len = \size * #TD_DataSizeOf
      CopyMemory(*array, \mem, len)
    Else
      len = count * #TD_DataSizeOf
      CopyMemory(*array, \mem, len)
      For c = count To \size - 1
        \mem\value[c] = 0.0
      Next
    EndIf
  EndWith
EndMethod

; Private ------------------------------------------------------------------------------

; Init: Speicher anfordern und Grundeinstellung setzen
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) * #TD_DataSizeOf)
    ProcedureReturn \mem
  EndWith
EndMethod

; Archiv zeichnen
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

; Archiv löschen
Method Overwrite TrendArchiv_Release(*this.TrendArchiv)
  Protected c
  With *this
    ; Speicher freigeben
    FreeMemory(\mem)
    DeleteObject(*this)
    ProcedureReturn #Null
  EndWith
EndMethod

; ***************************************************************************************

; Public --------------------------------------------------------------------------------

; Init Object
Method TrendControl_InitObject(*this.TrendControl)
  With *this
    \backcolor = $FFFFFF
  EndWith
EndMethod

; 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 #TD_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

; Entfernt ein Archiv
Method TrendControl_DeleteArchiv(*this.TrendControl, *archiv.ITrendArchiv)
  Protected c
  With *this
    For c = 0 To #TD_Max_Archiv - 1
      If \archiv[c] = *archiv
        *archiv\Release()
        \archiv[c] = #Null
        ProcedureReturn #True
      EndIf
    Next
    ProcedureReturn #False
  EndWith
EndMethod

; Setzt Hintergrundfarbe
Method TrendControl_BackColor(*this.TrendControl, backcolor.l)
  With *this
    \backcolor = backcolor
  EndWith
EndMethod

; 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 #TD_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

; Entfernt alle Archive und entfernt das Control 
Method Overwrite TrendControl_Release(*this.TrendControl)
  Protected c
  With *this
    For c = 0 To #TD_Max_Archiv - 1
      If \archiv[c]
        \archiv[c]\Release()
      EndIf
    Next
    DeleteObject(*this)
    ProcedureReturn #Null
  EndWith
EndMethod

DisableExplicit

Test TrendControl

Code: Select all

;-TOP
; Kommentar     : Test TrendControl
; Author        : mk-soft
; Second Author : 
; Datei         : TestTrendControl.pb
; Version       : 1.02
; Erstellt      : 
; Geändert      :
; 
; Compilermode  : ThreadSafe
;
; ***************************************************************************************


;- 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 "ClassTrendControl.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 DrawTrend()
Declare ValuesTrend(time)

; 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($C0C0C0)
  
  ; 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))
  
  hTread = CreateThread(@ValuesTrend(), 100)
  
  ; 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
        DrawTrend()
    EndSelect
    
  Until Exit
  
  Delay(1000)
  *control\Release()
  
EndIf

End

; *****************************************************************************

Procedure DrawTrend()

  Protected value.l
  
  *control\Draw(ImageOutput(#Image), 10, 10, GadgetWidth(#ImageGadget)-20, GadgetHeight(#ImageGadget)-20, 0, 200)
  SetGadgetState(#ImageGadget, ImageID(#Image))
  
EndProcedure

Procedure ValuesTrend(time)

  While exit = 0
    value = Random(300) + 50
    *trend1\AddLeft(value)
    
    value = Random(200) + 100
    *trend2\Addleft(value)
    
    value = Random(150) + 125
    *trend3\AddLeft(value)
    Delay(time)
  Wend
EndProcedure

Download OOP-PreCompiler v0.39

Who cooperates to the project.

GT

Ollivier · Post by **Ollivier** » Mon Jun 02, 2008 8:18 am

Hi man,

I was intersted by your code, then from a first time to a second one, I recepted a slap in my face : «Class() is not a macro, function, etc...»

How could I process to get this golden nut ?

Ollivier

mk-soft · Post by **mk-soft** » Mon Jun 02, 2008 4:42 pm

You download my oop-precompiler from
http://www.purebasic.fr/english/viewtop ... highlight=

GT

Ollivier · Post by **Ollivier** » Mon Jun 02, 2008 7:52 pm

Hi man,

Thx for answer. I prefer ask you my questions in pm hoping you understand me...

Ollivier