regarding a color of Extrend Trend
Hi, All
Good day!
using a zenon 7.10.
Regarding a trend color ,
I wanner get a fixed color, not random color
but, it just show a red color only. what 's wrong ???
============================== vba ==========
Option Explicit
Const myTrendScreenName As String = "00_Trend"
'
'Const myOpenTrendFunctionName As String = "00_Open_Trend"
'names of the trend screen switches
Const sOpenHistTrend As String = "00_Open_Trend"
Const sOpenAggregatedTrend As String = "00_Open_Trend_Main"
'NOTE: MODIFY NEXT LINE FOR SUPPORTING ONLINE TREND
Const sOpenOnlineTrend As String = "scrTrend"
'new type used for the array which stores the archives
Public Type ArchiveArray
SourceArchive As Archive
AggregatedArchive As Archive
End Type
'helper enum for the aggregated trend
Public Enum AggregatedEnum
tpAvg = 50
tpMin = 51
tpMax = 52
End Enum
Public Sub LeftClickDown_OpenSettings(obElem As Element)
Dim strScreenSwitchName As String
Dim zScreenSwitchFunction As RtFunction
'get the variable name from the element under the mouse click
strScreenSwitchName = "Open_AI_" + obElem.ItemVariable(0).Name
'replace the variable end with an empty string
strScreenSwitchName = Replace(strScreenSwitchName, Right(strScreenSwitchName, 6), "")
'get the screen switch function with the correct name and start it
Set zScreenSwitchFunction = thisProject.RtFunctions.Item(strScreenSwitchName)
'check if the function exists
If zScreenSwitchFunction Is Nothing Then
MsgBox "Function with name " + strScreenSwitchName + " not found."
Exit Sub
End If
'start
zScreenSwitchFunction.Start
End Sub
''###############################################################################################################################################################
''
'' TREND
''
''###############################################################################################################################################################
'########################################################################### new code ###########################################################################
'##################################################################################################'
' '
' LeftClick Up Event for adding a curve to an aggregated trend screen '
' '
' '
'##################################################################################################'
Public Sub LeftClickUp_AddAggregatedCurve(obElem As Element)
Call PrepareCurve(obElem)
obElem.LeftClickUp
End Sub
'##################################################################################################'
' '
' RightClick Down Event for adding a curve to an archive trend '
' (renamed to AddCurve for compatibility to old project) '
' '
'##################################################################################################'
Public Sub RightClickDown_AddCurve(obElem As Element)
Call PrepareCurve(obElem)
obElem.RightClickDown
End Sub
'##################################################################################################'
' '
' Sub used by event handlers to get the variable out of the element / search for it, get infos if '
' the click comes from an element named "avg", "min" or "max" and then call AddSingleCurve sub '
' with correct information
' '
'##################################################################################################'
Public Sub PrepareCurve(obElem As Element)
Dim zarrArchive As ArchiveArray
Dim strVarName As String
Dim zItemVar As Variable
Set zItemVar = obElem.ItemVariable(0)
'if no variable is linked to the element, we assume it is a button
If zItemVar Is Nothing Then
If thisProject.Variables.Item(obElem.Name) Is Nothing Then
MsgBox "Could not get variable from element " + obElem.Name + ". Make sure there is a variable with the same name or if it is a combined element make sure it has a variable linked to it."
Exit Sub
Else
strVarName = obElem.Name
End If
Else
strVarName = zItemVar.Name
' Important: if the name of the object suggests that an average, min or max curve should be drawn but there is no aggregated archive,
' the AddSingleCurve will make a normal historian trend curve
If obElem.Name = "avg" Then
zarrArchive = GetArchiveItem(strVarName, True)
Call AddSingleCurve(strVarName, zarrArchive, tpAvg)
Exit Sub
ElseIf obElem.Name = "min" Then
zarrArchive = GetArchiveItem(strVarName, True)
Call AddSingleCurve(strVarName, zarrArchive, tpMin)
Exit Sub
ElseIf obElem.Name = "max" Then
zarrArchive = GetArchiveItem(strVarName, True)
Call AddSingleCurve(strVarName, zarrArchive, tpMax)
Exit Sub
End If
End If
If Not strVarName = "" Then
zarrArchive = GetArchiveItem(strVarName)
Call AddSingleCurve(strVarName, zarrArchive)
Else
MsgBox "No valid variable name on the clicked element or combined element (if used for aggregated trend) has wrong name (should be named 'avg', 'min' or 'max' for aggregated trend)."
End If
End Sub
'##################################################################################################'
' '
' This sub is used to add one online variable or one variable from the historian to the '
' trend screen sOpenOnlineTrend (for online) or sOpenHistTrend (for historical data) '
' '
'##################################################################################################'
Public Sub AddSingleCurve(sVarName As String, zArchiveArray As ArchiveArray, Optional tpAggregation As AggregatedEnum)
Dim iCurveEmpty As Integer
Dim iCurvesEmpty As Integer
Dim iCurves As Integer
Dim iCurveCurrent As Integer
Dim zvar As Variable
Dim sOpenTrend As String
Set zvar = thisProject.Variables.Item(sVarName)
'Davids Code:
'total amount of curves
iCurves = 0
'which one is empty
iCurveEmpty = 0
'how many curves are empty
iCurvesEmpty = 0
'if there is no source archive, we are using an online trend, otherwise an historian or an aggregated trend
If zArchiveArray.SourceArchive Is Nothing Then
'NOTE: IF YOU WANT TO EXTEND THIS TO SUPPORT ONLINE TREND, JUST CREATE A TREND FUNCTION LIKE 00_OPEN_TREND BUT FOR ONLINE DATA, MODIFY CONSTANT AND UNCOMMENT NEXT LINE
'sOpenTrend = sOpenOnlineTrend
'NOTE CONTINUED: THEN COMMENT NEXT TWO LINES OUT
MsgBox "Variable not found in archive or tried to open online trend."
Exit Sub
ElseIf Not zArchiveArray.SourceArchive Is Nothing And zArchiveArray.AggregatedArchive Is Nothing Then
sOpenTrend = sOpenHistTrend
ElseIf Not zArchiveArray.SourceArchive Is Nothing And Not zArchiveArray.AggregatedArchive Is Nothing Then
sOpenTrend = sOpenAggregatedTrend
End If
If thisProject.RtFunctions.Item(sOpenTrend) Is Nothing Then
MsgBox "Function with name " + sOpenTrend + " does not exist in project. Was the function renamed or the constants in the VB code modified?"
Exit Sub
End If
With thisProject.RtFunctions.Item(sOpenTrend)
'get the number of curves shown in the ETM
Do While .DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.VarName") <> ""
'test if curve is actually shown in the ETM
If StrComp(zvar.Name, .DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.VarName")) = 0 Then
'if it is an aggregated, we need to check more because we can have three variables with the same name
If Not zArchiveArray.AggregatedArchive Is Nothing Then
'get the mode of calculation for the current curve
Dim iTrendCalcSetting As Integer
iTrendCalcSetting = .DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.Calculation")
'if it matches with the curve we want to display, just open the screen instead of creating a new curve
If iTrendCalcSetting = tpAggregation Then
.Start
Exit Sub
ElseIf iTrendCalcSetting = tpAggregation Then
.Start
Exit Sub
ElseIf iTrendCalcSetting = tpAggregation = tpMax Then
.Start
Exit Sub
End If
Else
'already open, switch to screen and exit sub
.Start
Exit Sub
End If
End If
'test empty curves
If .DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.VarName") = "empty" Then
iCurveEmpty = iCurves
iCurvesEmpty = iCurvesEmpty + 1
End If
iCurves = iCurves + 1
Loop
iCurves = iCurves - iCurvesEmpty
'test the number of curves (8)
If iCurves >= 8 Then
MsgBox ("The maximum number of curves has been reached!!")
Exit Sub
End If
'if there are no curves to use, create new ones
If iCurvesEmpty = 0 Then
.CreateDynProperty ("PictFilter[0].Curve")
.CreateDynProperty ("PictFilter[0].Curve[" & iCurves & "].VarInfo")
.CreateDynProperty ("PictFilter[0].Curve[" & iCurves & "].YAxe")
.CreateDynProperty ("PictFilter[0].Curve[" & iCurves & "].YAxe[0].Scale")
End If
'if there is an empty curve, use it
If iCurvesEmpty <> 0 Then
iCurves = iCurveEmpty
End If
.DynProperties("PictFilter[0].Curve[" & iCurves & "].HasYAxis") = True
'adjust the exiting curves
.DynProperties("PictFilter[0].Curve[" & iCurves & "].GraphName") = zvar.Name 'variable name
.DynProperties("PictFilter[0].Curve[" & iCurves & "].Titel") = CStr(zvar.Tagname) 'variable tagname
.DynProperties("PictFilter[0].Curve[" & iCurves & "].IsShow") = True 'show the curve
.DynProperties("PictFilter[0].Curve[" & iCurves & "].IsInterpolation") = True 'set interpolation option
.DynProperties("PictFilter[0].Curve[" & iCurves & "].Color") = getColor(arrColor) 'set a random colour
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.VarName") = zvar.Name 'variable name
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.Variable") = zvar.Name 'variable name
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.VarMaxValue") = CDbl(zvar.RangeMax) 'max scale of the variable
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.VarMinValue") = CDbl(zvar.RangeMin) 'min scale of the variable
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.IsAutoScale") = False
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.IsYAutoScale") = True 'Automatic scaling
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.Color") = .DynProperties("PictFilter[0].Curve[" & iCurves & "].Color") 'use the same color as chosen before randomly
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.Scale.ScaleTop") = CDbl(zvar.RangeMax) 'max scale of the variable
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.Scale.ScaleBotton") = CDbl(zvar.RangeMin) 'min scale of the variable
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.IsTitelLeftBotton") = True 'put the title of the y-axis to the right
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.DivCount") = 4 'number of sub-ticks
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.MainDiv") = 4 'number of main ticks
'if there is an archive in the array, add information to curve
If Not zArchiveArray.SourceArchive Is Nothing And zArchiveArray.AggregatedArchive Is Nothing Then
.DynProperties("PictFilter[0].Curve[" & iCurves & "].GraphName") = zvar.Name + ", " + zArchiveArray.SourceArchive.Name 'variable name
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.Archive") = zArchiveArray.SourceArchive.Identifier
.DynProperties("PictFilter[0].DataSource") = 2
.DynProperties("PictFilter[0].Curve[" & iCurves & "].IsInterpolation") = True
'if SourceArchive and AggregatedArchive are there, we will have to make either average, minimum or maximum
ElseIf Not zArchiveArray.SourceArchive Is Nothing And Not zArchiveArray.AggregatedArchive Is Nothing Then
'depending on what we get as parameter from the call (which we get by the different RightClickDown events), we create a curve: avg, min or max
Select Case tpAggregation
Case tpAvg
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.Calculation") = 50
.DynProperties("PictFilter[0].Curve[" & iCurves & "].GraphName") = zvar.Name + " AVERAGE" 'variable name
.DynProperties("PictFilter[0].Curve[" & iCurves & "].Titel") = zvar.Name + " Avg" 'CStr(zvar.Tagname) + " Avg" 'variable tagname
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.Archive") = zArchiveArray.AggregatedArchive.Identifier
.DynProperties("PictFilter[0].DataSource") = 2
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.ArvVar") = zArchiveArray.SourceArchive.Identifier
.DynProperties("PictFilter[0].Curve[" & iCurves & "].IsInterpolation") = True
Case tpMin
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.Calculation") = 51
.DynProperties("PictFilter[0].Curve[" & iCurves & "].GraphName") = zvar.Name + " MINIMUM" 'variable name
.DynProperties("PictFilter[0].Curve[" & iCurves & "].Titel") = zvar.Name + " Min" 'CStr(zvar.Tagname) + " Min" 'variable tagname
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.Archive") = zArchiveArray.AggregatedArchive.Identifier
.DynProperties("PictFilter[0].DataSource") = 2
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.ArvVar") = zArchiveArray.SourceArchive.Identifier
.DynProperties("PictFilter[0].Curve[" & iCurves & "].IsInterpolation") = True
Case tpMax
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.Calculation") = 52
.DynProperties("PictFilter[0].Curve[" & iCurves & "].GraphName") = zvar.Name + " MAXIMUM" 'variable name
.DynProperties("PictFilter[0].Curve[" & iCurves & "].Titel") = zvar.Name + " Max" 'CStr(zvar.Tagname) + " Max" 'variable tagname
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.Archive") = zArchiveArray.AggregatedArchive.Identifier
.DynProperties("PictFilter[0].DataSource") = 2
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.ArvVar") = zArchiveArray.SourceArchive.Identifier
.DynProperties("PictFilter[0].Curve[" & iCurves & "].IsInterpolation") = True
End Select
End If
.Start
End With
End Sub
'##################################################################################################'
' '
' This function is used to return a random RGB color
' '
'##################################################################################################'
Public Function RandomRGBColor() As Long
'RandomRGBColor = RGB(250, 0, 0)
RandomRGBColor = RGB( _
Int(Rnd() * 256), _
Int(Rnd() * 256), _
Int(Rnd() * 256))
End Function
'##################################################################################################'
' '
' This function is used to clear one curve out of the trend '
' '
'##################################################################################################'
Public Sub delOneCurve(zFct As RtFunction, idx As Integer)
Dim myStr As String
With zFct
myStr = "PictFilter[0].Curve[" & idx & "]"
.DynProperties(myStr & ".HasYAxis") = True
'adjust the exiting curves
.DynProperties(myStr & ".GraphName") = "" 'variable name
.DynProperties(myStr & ".Titel") = "" 'variable tagname
.DynProperties(myStr & ".IsShow") = False 'show the curve
.DynProperties(myStr & ".IsInterpolation") = True 'set interpolation option
.DynProperties(myStr & ".Color") = vbBlack 'set color
.DynProperties(myStr & ".VarInfo.VarName") = "empty" 'variable name
.DynProperties(myStr & ".VarInfo.Variable") = "" 'variable name
.DynProperties(myStr & ".VarInfo.VarMaxValue") = 0 'max scale of the variable
.DynProperties(myStr & ".VarInfo.VarMinValue") = 0 'min scale of the variable
.DynProperties(myStr & ".YAxe.IsAutoScale") = False 'Number of main ticks automatically
.DynProperties(myStr & ".YAxe.IsYAutoScale") = True
.DynProperties(myStr & ".YAxe.Color") = .DynProperties(myStr & ".Color") 'use the same color as chosen before randomly
.DynProperties(myStr & ".YAxe.Scale.ScaleTop") = 0 'max scale of the variable
.DynProperties(myStr & ".YAxe.Scale.ScaleBotton") = 0 'min scale of the variable
.DynProperties(myStr & ".YAxe.IsTitelLeftBotton") = False 'put the title of the y-axis to the right
.DynProperties(myStr & ".YAxe.DivCount") = 4 'number of sub-ticks
.DynProperties(myStr & ".YAxe.MainDiv") = 4 'number of main ticks
End With
End Sub
'##################################################################################################'
' '
' This function is used to clear selected curve out of the trend '
' '
'##################################################################################################'
Public Sub LeftClickDown_DelCurve(obElem As Element)
Dim zPicture As DynPicture
Dim zFilter As PictureFilter
Dim zFunction As RtFunction
Dim i As Integer
Dim k As Integer
Dim cnt As Integer
Dim curStr As String
Dim arrCur
Dim myStr As String
Dim theStr As String
'create a object of the screen
Set zPicture = thisProject.DynPictures.Item(myTrendScreenName)
'create a object of the picturefilter
Set zFilter = zPicture.PictureFilter
'create a object of open function
Set zFunction = thisProject.RtFunctions.Item(sOpenHistTrend)
'filter in ETM
With zFilter
i = 0
cnt = 0
'search inactive curve in the ETM
Do While .DynProperties("Curve[" & i & "].VarInfo.VarName") <> ""
If Not .DynProperties("Curve[" & i & "].IsShow") Then
cnt = cnt + 1
Else
'active curve variable name string
curStr = curStr & "," & .DynProperties("Curve[" & i & "].VarInfo.VarName")
End If
i = i + 1
Loop
End With
'filter in function
With zFunction
'if exist inactived curve
If cnt > 0 Then
i = 0
'clear all curves
Do While .DynProperties("PictFilter[0].Curve[" & i & "].VarInfo.VarName") <> ""
'clear one curve
delOneCurve zFunction, i
i = i + 1
Loop
'if exist active curve
If curStr <> "" Then
'curve number in function
cnt = i
'create array of active curve
curStr = Mid(curStr, 2)
arrCur = Split(curStr, ",")
'create function property of active curve
For i = 0 To UBound(arrCur)
'curve does not exist -> create new curve
If cnt <= i Then
myStr = "PictFilter[0].Curve[" & i & "]"
.CreateDynProperty ("PictFilter[0].Curve")
.CreateDynProperty (myStr & ".VarInfo")
.CreateDynProperty (myStr & ".YAxe")
.CreateDynProperty (myStr & ".YAxe[0].Scale")
End If
k = 0
'loop curves in the ETM
Do While zFilter.DynProperties("Curve[" & k & "].VarInfo.VarName") <> ""
'search variable in the ETM
If arrCur(i) = zFilter.DynProperties("Curve[" & k & "].VarInfo.VarName") Then
'assign ETM property -> function property
myStr = "PictFilter[0].Curve[" & i & "]"
theStr = "Curve[" & k & "]"
.DynProperties(myStr & ".HasYAxis") = zFilter.DynProperties(theStr & ".HasYAxis")
'adjust the exiting curves
.DynProperties(myStr & ".GraphName") = zFilter.DynProperties(theStr & ".GraphName")
.DynProperties(myStr & ".Titel") = zFilter.DynProperties(theStr & ".Titel")
.DynProperties(myStr & ".IsShow") = zFilter.DynProperties(theStr & ".IsShow")
.DynProperties(myStr & ".IsInterpolation") = zFilter.DynProperties(theStr & ".IsInterpolation")
.DynProperties(myStr & ".Color") = zFilter.DynProperties(theStr & ".Color")
.DynProperties(myStr & ".VarInfo.VarName") = zFilter.DynProperties(theStr & ".VarInfo.VarName")
.DynProperties(myStr & ".VarInfo.Variable") = zFilter.DynProperties(theStr & ".VarInfo.Variable")
.DynProperties(myStr & ".VarInfo.VarMaxValue") = zFilter.DynProperties(theStr & ".VarInfo.VarMaxValue")
.DynProperties(myStr & ".VarInfo.VarMinValue") = zFilter.DynProperties(theStr & ".VarInfo.VarMinValue")
.DynProperties(myStr & ".YAxe.IsAutoScale") = zFilter.DynProperties(theStr & ".YAxe.IsAutoScale")
.DynProperties(myStr & ".YAxe.IsTitelLeftBotton") = zFilter.DynProperties(theStr & ".YAxe.IsTitelLeftBotton")
.DynProperties(myStr & ".YAxe.FirstOrd") = zFilter.DynProperties(theStr & ".YAxe.FirstOrd")
.DynProperties(myStr & ".YAxe.Color") = zFilter.DynProperties(theStr & ".YAxe.Color")
.DynProperties(myStr & ".YAxe.DivCount") = zFilter.DynProperties(theStr & ".YAxe.DivCount")
.DynProperties(myStr & ".YAxe.MainDiv") = zFilter.DynProperties(theStr & ".YAxe.MainDiv")
.DynProperties(myStr & ".YAxe.IsYAutoScale") = zFilter.DynProperties(theStr & ".YAxe.IsYAutoScale")
.DynProperties(myStr & ".YAxe.DivCount") = zFilter.DynProperties(theStr & ".YAxe.DivCount")
.DynProperties(myStr & ".YAxe.MainDiv") = zFilter.DynProperties(theStr & ".YAxe.MainDiv")
Exit Do
End If
k = k + 1
Loop
Next
End If
'execute the function
.Start
End If
End With
'release objects
Set zFunction = Nothing
Set zFilter = Nothing
Set zPicture = Nothing
End Sub
'##################################################################################################'
' '
' This sub is used to reset the trend screens back to initial values '
' '
'##################################################################################################'
Public Sub LeftClickDown_DeleteAll(obElem As Element)
'reset aggregated trend
Call ResetFunction(sOpenAggregatedTrend, True, True)
'reset historian trend
Call ResetFunction(sOpenHistTrend, True, True)
'reset online trend
'Call ResetFunction(sOpenOnlineTrend, False, True)
End Sub
'##################################################################################################'
' '
' This sub is used to reset the trend screen with the name sTrend back to initial values '
' '
'##################################################################################################'
Public Sub ResetFunction(sTrend As String, Optional IsArchiveTrend, Optional StartFunctionAfterReset As Boolean)
Dim iCurves As Integer
With thisProject.RtFunctions.Item(sTrend)
iCurves = 0
'clear all curves
Do While .DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.VarName") <> ""
.DynProperties("PictFilter[0].Curve[" & iCurves & "].HasYAxis") = False
'adjust the exiting curves
.DynProperties("PictFilter[0].Curve[" & iCurves & "].GraphName") = "" 'variable name
.DynProperties("PictFilter[0].Curve[" & iCurves & "].Titel") = "" 'variable tagname
.DynProperties("PictFilter[0].Curve[" & iCurves & "].IsShow") = False 'show the curve
.DynProperties("PictFilter[0].Curve[" & iCurves & "].IsInterpolation") = True 'set interpolation option
.DynProperties("PictFilter[0].Curve[" & iCurves & "].Color") = getColor(arrColor) 'set a random colour
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.VarName") = "empty" 'variable name
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.Variable") = "" 'variable name
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.VarMaxValue") = 0 'max scale of the variable
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.VarMinValue") = 0 'min scale of the variable
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.IsAutoScale") = False
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.IsYAutoScale") = True
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.Color") = .DynProperties("PictFilter[0].Curve[" & iCurves & "].Color") 'use the same color as chosen before randomly
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.Scale.ScaleTop") = 0 'max scale of the variable
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.Scale.ScaleBotton") = 0 'min scale of the variable
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.IsTitelLeftBotton") = False 'put the title of the y-axis to the right
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.DivCount") = 4 'number of sub-ticks
.DynProperties("PictFilter[0].Curve[" & iCurves & "].YAxe.MainDiv") = 4 'number of main ticks
If IsArchiveTrend Then
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.Archive") = "ZZ"
.DynProperties("PictFilter[0].Curve[" & iCurves & "].VarInfo.ArvVar") = ""
.DynProperties("PictFilter[0].DataSource") = 2
.DynProperties("PictFilter[0].Curve[" & iCurves & "].IsInterpolation") = True
End If
iCurves = iCurves + 1
Loop
If StartFunctionAfterReset Then
.Start
End If
End With
End Sub
'##################################################################################################'
' '
' This sub is used to search through all archives for the archive and the aggregated archive '
' which contain the variable with name from strVarName '
' '
'##################################################################################################'
Public Function GetArchiveItem(strVarName As String, Optional AggregatedArchiveNeeded As Boolean) As ArchiveArray
Dim zArchive As Archive
Dim i, j As Integer
'go through all archives
For i = 0 To thisProject.Archives.Count - 1
'get archive with first index, go through all variables
For j = 0 To thisProject.Archives.Item(i).ArchiveVariables.Count - 1
'if variable with name from parameter found, set archive as return
If thisProject.Archives.Item(i).ArchiveVariables.Item(j).Name = strVarName Then
'we are seaching for the archive that does NOT have the name Trend in it - that's the one for the 7days trend - we want the 1 hour archive
If AggregatedArchiveNeeded And InStr(UCase(thisProject.Archives.Item(i).Name), "TREND") = 0 Then
'get the source archive
If thisProject.Archives.Item(i).ArchiveVariables.Item(j).Calculation = 0 And GetArchiveItem.SourceArchive Is Nothing Then
Set GetArchiveItem.SourceArchive = thisProject.Archives.Item(i)
'if the array is fully set, exit function to gain performance
If Not GetArchiveItem.AggregatedArchive Is Nothing Then Exit Function
'get the aggregated archive
ElseIf thisProject.Archives.Item(i).ArchiveVariables.Item(j).Calculation <> 0 And GetArchiveItem.AggregatedArchive Is Nothing Then
Set GetArchiveItem.AggregatedArchive = thisProject.Archives.Item(i)
'if the array is fully set, exit function to gain performance
If Not GetArchiveItem.SourceArchive Is Nothing Then Exit Function
End If
'if we need no aggregated archive, get the source archive which contains the name "Trend" and exit the function
ElseIf Not AggregatedArchiveNeeded And thisProject.Archives.Item(i).ArchiveVariables.Item(j).Calculation = 0 And InStr(UCase(thisProject.Archives.Item(i).Name), "TREND") <> 0 Then
Set GetArchiveItem.SourceArchive = thisProject.Archives.Item(i)
Exit Function
End If
End If
Next j
Next i
End Function
'get color of curve
Public Function getColor(arrColor) As Long
Dim theColor(8) As Long
Dim i As Integer
Dim k As Integer
Dim isExist As Boolean
theColor(0) = RGB(256, 0, 0)
theColor(1) = RGB(0, 256, 0)
theColor(2) = RGB(256, 256, 0)
theColor(3) = RGB(0, 256, 256)
theColor(4) = RGB(256, 0, 256)
theColor(5) = RGB(256, 128, 0)
theColor(6) = RGB(0, 192, 0)
theColor(7) = RGB(0, 128, 256)
theColor(8) = RGB(0, 0, 256)
For i = 0 To UBound(theColor)
isExist = False
For k = 0 To UBound(arrColor)
If theColor(i) = arrColor(k) Then
isExist = True
Exit For
End If
Next
If Not isExist Then
getColor = theColor(i)
Exit For
End If
Next
End Function
======================================= end of vba =========
This is a migrated post! Originally posted on 02.10.2013 by user gyu. Please be aware that information can be outdated.
Disclaimer
This document governs the use of our Community Forum. By registering and using the platform, you accept these conditions.
The COPA-DATA Community Forum serves to encourage the exchange of information and experience about the zenon software between forum users respectively zenon users.
Please mind that any published information on the Community Forum is the subjective opinion and view based on the experience and the level of knowledge of the author. COPA-DATA does not overtake any responsibility for the content and the accuracy of the shared information.
Users of the Community Forum are encouraged to share only well-founded experiences and to point out any risks associated with the implementation of proposed solutions to problems. COPA-DATA at its absolute discretion, reserves the right to moderate the forum. In this connection COPA-DATA may remove any information containing false facts, potentially dangerous solutions, bad language or content that may insult, degrade or discriminate others. COPA-DATA may block a non-complying user from forum access if the user violated this provision.
COPA-DATA reserves the right to change this document from time to time at own discretion.
Ing. Punzenberger COPA-DATA GmbH
Karolingerstraße 7b · 5020 Salzburg · Austria
www.copadata.com