wincc.script

Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
   ByVal dwBytes As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
   ByVal lpString2 As Any) As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat _
   As Long, ByVal hMem As Long) As Long

Private Const GHND = &H42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 4096

Function MyJoin(first As String, second As String) As String
    fLen& = Len(first)
    sLen& = Len(second)
    total& = fLen& + sLen&
   
    Dim result As String
    result = String(total&, " ")
    For i = 1 To Len(first)
        Mid(result, i, 1) = Mid(first, i, 1)
    Next i
    For i = 1 To Len(second)
        Mid(result, i + fLen&, 1) = Mid(second, i, 1)
    Next i
    delka& = Len(result)
    MyJoin = result
End Function

Function functionCorrection(ByRef script As String) As String
    result$ = Replace(Replace(Replace(script, "'||'", "' or '"), "'||", "' or"), "||'", "or '")
    result$ = Replace(Replace(Replace(result$, "'&&'", "' and '"), "'&&", "' and"), "&&'", "and '")
    result$ = Replace(Replace(Replace(script, "'|'", "' bor '"), "'|", "' bor"), "|'", "bor '")
    result$ = Replace(Replace(Replace(result$, "'&'", "' band '"), "'&", "' band"), "&'", "band '")
    result$ = Replace(Replace(Replace(result$, "'=='", "' eq '"), "'==", "' eq"), "=='", "eq '")
    result$ = Replace(Replace(Replace(result$, "'!='", "' ne '"), "'!=", "' ne"), "!='", "ne '")
    result$ = Replace(Replace(Replace(result$, "'>='", "' ge '"), "'>=", "' ge"), ">='", "ge '")
    result$ = Replace(Replace(Replace(result$, "'<='", "' le '"), "'<=", "' le"), "<='", "le '")
    result$ = Replace(Replace(Replace(result$, "'>'", "' gt '"), "'>", "' gt"), ">'", "gt '")
    result$ = Replace(Replace(Replace(result$, "'<'", "' lt '"), "'<", "' lt"), "<'", "lt '")
    result$ = Replace(Replace(Replace(Replace(result$, "||", "or"), "&&", "and"), "|", "bor"), "&", "band")
    result$ = Replace(result$, "!", " not ")
    functionCorrection = Replace(Replace(Replace(Replace(Replace(Replace(result$, "==", " eq "), "!=", " ne "), ">=", " ge "), ">", " gt "), "<=", " le "), "<", " lt ")
End Function

Function actionVisible(obj As HMIObject) As String
    result$ = ""
    If (obj.ObjectName Like "*ext73") Then
    result$ = ""
    End If
    If (obj.Visible.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.Visible.Dynamic
        result = "|scriptVisible=" & script2hex(script.SourceCode)
    ElseIf (obj.Visible.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.Visible.Dynamic
        result$ = MyJoin("|dialogVisible=", functionCorrection(dialog.SourceCode))
        If (dialog.ResultType = hmiResultTypeBool) Then
            result$ = result$ & "|dialogVisiblePositive=" & dialog.BinaryResultInfo.PositiveValue
            result$ = result$ & "|dialogVisibleNegative=" & dialog.BinaryResultInfo.NegativeValue
        End If
    ElseIf (obj.Visible.DynamicStateType = hmiDynamicStateTypeVariableDirect) Then
        Set dialog = obj.Visible.Dynamic
        result$ = "|dialogVisible='" & functionCorrection(dialog.VarName) & "'"
    ElseIf (obj.Visible.DynamicStateType > 0) Then

    End If
    
    actionVisible = result$
End Function

Function actionBackColor(obj As HMIObject) As String
    result$ = ""
    If (obj.BackColor.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.BackColor.Dynamic
        result$ = result$ & "|scriptBackColor=" & script2hex(script.SourceCode)
    ElseIf (obj.BackColor.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.BackColor.Dynamic
        result$ = result$ & "|dialogBackColor=" & functionCorrection(dialog.SourceCode)
        If (dialog.ResultType = hmiResultTypeBool) Then
            result$ = result$ & "|dialogBackColorPositive=" & dialog.BinaryResultInfo.PositiveValue
            result$ = result$ & "|dialogBackColorNegative=" & dialog.BinaryResultInfo.NegativeValue
        ElseIf (dialog.ResultType = hmiResultTypeAnalog) Then
            'MsgBox "hmiResultTypeAnalog not implemented"
        Else
            'MsgBox dialog.ResultType & " not implemented"
        End If
    ElseIf (obj.BackColor.DynamicStateType > 0) Then
        result$ = result$
    End If
    
    actionBackColor = result$
End Function

Function actionForeColor(obj As HMIObject) As String
    result$ = ""
    If (obj.ForeColor.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.ForeColor.Dynamic
        result$ = result$ & "|scriptForeColor=" & script2hex(script.SourceCode)
    ElseIf (obj.ForeColor.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.ForeColor.Dynamic
        result$ = result$ & "|dialogForeColor=" & functionCorrection(dialog.SourceCode)
    ElseIf (obj.ForeColor.DynamicStateType > 0) Then
        result$ = result$
    End If
    
    actionForeColor = result$
End Function

Function actionFlashingLine(obj As HMIObject) As String
    result$ = ""
    
    If (obj.FlashBorderColor.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.FlashBorderColor.Dynamic
        result$ = result$ & "|scriptFlashingLine=" & script2hex(script.SourceCode)
    ElseIf (obj.FlashBorderColor.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.FlashBorderColor.Dynamic
        result$ = result$ & "|dialogFlashingLine=" & functionCorrection(dialog.SourceCode)
    ElseIf (obj.FlashBorderColor.DynamicStateType > 0) Then
        
    End If
    
    If (Len(result$) > 0) Then
        result$ = result$ & "|flashingLineColorOn=" & obj.BorderFlashColorOn
        result$ = result$ & "|flashingLineColorOff=" & obj.BorderFlashColorOff
    End If
    
    actionFlashingLine = result$
End Function

Function actionFlashingBackground(obj As HMIObject) As String
    result$ = ""
    
    If (obj.FlashBackColor.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.FlashBackColor.Dynamic
        result$ = result$ & "|scriptFlashingBackground=" & script2hex(script.SourceCode)
    ElseIf (obj.FlashBackColor.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.FlashBackColor.Dynamic
        result$ = result$ & "|dialogFlashingBackground=" & functionCorrection(dialog.SourceCode)
    ElseIf (obj.FlashBackColor.DynamicStateType > 0) Then
        
    End If
    
    If (Len(result$) > 0) Then
        result$ = result$ & "|backgroundColorOn=" & obj.BackFlashColorOn
        result$ = result$ & "|backgroundColorOff=" & obj.BackFlashColorOff
    End If
    
    actionFlashingBackground = result$
End Function

Function actionFlashingText(obj As HMIObject) As String
    result$ = ""
    
    If (obj.FlashForeColor.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.FlashForeColor.Dynamic
        result$ = result$ & "|scriptFlashingText=" & script2hex(script.SourceCode)
    ElseIf (obj.FlashForeColor.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.FlashForeColor.Dynamic
        result$ = result$ & "|dialogFlashingText=" & functionCorrection(dialog.SourceCode)
    ElseIf (obj.FlashForeColor.DynamicStateType > 0) Then
        
    End If
    
    If (Len(result$) > 0) Then
        result$ = result$ & "|flashingTextColorOn=" & obj.ForeFlashColorOn
        result$ = result$ & "|flashingTextColorOff=" & obj.ForeFlashColorOff
    End If
    
    actionFlashingText = result$
End Function

Function actionX(obj As HMIObject) As String
    result$ = ""
    If (obj.Left.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.Left.Dynamic
        result$ = result$ & "|scriptX=" & script2hex(script.SourceCode)
    ElseIf (obj.Left.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.Left.Dynamic
        result$ = result$ & "|dialogX=" & functionCorrection(dialog.SourceCode)
        result$ = result$ & "|dialogXPositive=" & dialog.BinaryResultInfo.PositiveValue
        result$ = result$ & "|dialogXNegative=" & dialog.BinaryResultInfo.NegativeValue
    ElseIf (obj.Left.DynamicStateType > 0) Then
        result$ = result$
    End If
    
    actionX = result$
End Function

Function actionY(obj As HMIObject) As String
    result$ = ""
    If (obj.Top.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.Top.Dynamic
        result$ = result$ & "|scriptY=" & script2hex(script.SourceCode)
    ElseIf (obj.Top.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.Left.Dynamic
        result$ = result$ & "|dialogY=" & functionCorrection(dialog.SourceCode)
        result$ = result$ & "|dialogYPositive=" & dialog.BinaryResultInfo.PositiveValue
        result$ = result$ & "|dialogYNegative=" & dialog.BinaryResultInfo.NegativeValue
    ElseIf (obj.Top.DynamicStateType > 0) Then
        result$ = result$
    End If
    
    actionY = result$
End Function

Function eventLeftButton(obj As HMIObject) As String
    result$ = ""
    picname$ = ""
    destname$ = ""
    If (obj.Events.Count > 0) Then
        For i = 1 To obj.Events.Count
            If (obj.Events(i).EventType = hmiEventTypeMouseLButtonDown) Then
                If (obj.Events(i).Actions.Count > 0) Then
                    If (obj.Events(i).Actions(1).ActionType = hmiActionTypeScript) Then
                        Dim script As HMIScriptInfo
                        Set script = obj.Events(i).Actions(1)
                        result$ = "|eventLeftButton=" & script2hex(script.SourceCode)
                    ElseIf (obj.Events(i).Actions(1).ActionType = hmiActionTypeDirectConnection) Then
                        If (obj.Events(i).Actions(1).DestinationLink.AutomationName = "PictureName") Then
                            picname$ = obj.Events(i).Actions(1).SourceLink.ObjectName
                            If (LCase(Right(picname$, 4)) Like ".pdl") Then
                                picname$ = Left(picname$, Len(picname$) - 4)
                            End If
                            result$ = "|eventLeftButtonPicture=" & picname$
                        End If
                    End If
                End If
                Exit For
            End If
        Next i
    End If
    eventLeftButton = result$
End Function

Function eventLeftButtonUp(obj As HMIObject) As String
    result$ = ""
    If (obj.Events.Count > 0) Then
        For i = 1 To obj.Events.Count
            If (obj.Events(i).EventType = hmiEventTypeMouseLButtonUp) Then
                If (obj.Events(i).Actions.Count > 0) Then
                    If (obj.Events(i).Actions(1).ActionType = hmiActionTypeScript) Then
                        Dim script As HMIScriptInfo
                        Set script = obj.Events(i).Actions(1)
                        result$ = "|eventLeftButtonUp=" & script2hex(script.SourceCode)
                    ElseIf (obj.Events(i).Actions(1).ActionType = hmiActionTypeDirectConnection) Then
                        If (obj.Events(i).Actions(1).DestinationLink.AutomationName = "PictureName") Then
                            picname$ = obj.Events(i).Actions(1).SourceLink.ObjectName
                            If (Right(picname$, 4) Like ".PDL" Or Right(picname$, 4) Like ".pdl") Then
                                picname$ = Left(picname$, Len(picname$) - 4)
                            End If
                            result$ = "|eventLeftButtonPicture=" & picname$
                        End If
                    End If
                End If
                Exit For
            End If
        Next i
    End If
    eventLeftButtonUp = result$
End Function

Function eventRightButton(obj As HMIObject) As String
    result$ = ""
    If (obj.Events.Count > 0) Then
        For i = 1 To obj.Events.Count
            If (obj.Events(i).EventType = hmiEventTypeMouseRButtonDown) Then
                If (obj.Events(i).Actions.Count > 0) Then
                    If (obj.Events(i).Actions(1).ActionType = hmiActionTypeScript) Then
                        Dim script As HMIScriptInfo
                        Set script = obj.Events(i).Actions(1)
                        result$ = "|eventRightButton=" & script2hex(script.SourceCode)
                    End If
                End If
                Exit For
            End If
        Next i
    End If
    eventRightButton = result$
End Function

Function eventRightButtonUp(obj As HMIObject) As String
    result$ = ""
    If (obj.Events.Count > 0) Then
        For i = 1 To obj.Events.Count
            If (obj.Events(i).EventType = hmiEventTypeMouseRButtonUp) Then
                If (obj.Events(i).Actions.Count > 0) Then
                    If (obj.Events(i).Actions(1).ActionType = hmiActionTypeScript) Then
                        Dim script As HMIScriptInfo
                        Set script = obj.Events(i).Actions(1)
                        result$ = "|eventRightButtonUp=" & script2hex(script.SourceCode)
                    End If
                End If
                Exit For
            End If
        Next i
    End If
    eventRightButtonUp = result$
End Function

Function processHMIStatusDisplay(obj As HMIStatusDisplay)
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMIStatusDisplay = "Name=" & getObjectName(obj.ObjectName) & "|Type=StatusDisplay|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    processHMIStatusDisplay = processHMIStatusDisplay & "|basePicture=" & obj.BasePicture
    
    If (obj.index.IsDynamicable And obj.index.DynamicStateType = 3) Then
        Dim script As HMIScriptInfo
        Set script = obj.index.Dynamic
        
        processHMIStatusDisplay = processHMIStatusDisplay & "|scriptState=" & script2hex(script.SourceCode)
    End If
    processHMIStatusDisplay = processHMIStatusDisplay & actionVisible(obj) & actionX(obj) & actionY(obj) & eventLeftButton(obj) & eventLeftButtonUp(obj) & eventRightButtonUp(obj)
End Function

Function processHMIStatusText(obj As HMIStaticText)
    Dim script As HMIScriptInfo
    Dim dialog As HMIDynamicDialog
    Dim variable As HMIVariableTrigger
    
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMIStatusText = "Name=" & getObjectName(obj.ObjectName) & "|Type=StaticText|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    processHMIStatusText = processHMIStatusText & "|backColor=" & obj.BackColor & "|foreColor=" & obj.ForeColor & "|fillStyle=" & obj.FillStyle.value
    processHMIStatusText = processHMIStatusText & "|xAlign=" & obj.AlignmentLeft & "|yAlign=" & obj.AlignmentTop & "|fontSize=" & obj.FONTSIZE
   
    If (obj.Text.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.Text.Dynamic
        processHMIStatusText = processHMIStatusText & "|scriptText=" & script2hex(script.SourceCode)
    ElseIf (obj.Text.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.Text.Dynamic
        processHMIStatusText = processHMIStatusText & "|dialogText=" & functionCorrection(dialog.SourceCode)
    ElseIf (obj.Text.DynamicStateType = hmiDynamicStateTypeVariableDirect) Then
        Set variable = obj.Text.Dynamic
        processHMIStatusText = processHMIStatusText & "|dialogText='" & functionCorrection(variable.VarName) & "'"
    ElseIf (obj.Text.DynamicStateType > 0) Then
        processHMIStatusText = processHMIStatusText
    End If
    
    processHMIStatusText = processHMIStatusText & actionVisible(obj) & actionBackColor(obj) & actionForeColor(obj) & actionFlashingLine(obj) & actionFlashingBackground(obj) & actionFlashingText(obj) & actionX(obj) & actionY(obj)
    
    processHMIStatusText = processHMIStatusText & "|text=" & Replace(Replace(obj.Text.value, Chr(13) & Chr(10), "@#$"), "=", "@#&")
    processHMIStatusText = processHMIStatusText & eventLeftButton(obj) & eventRightButton(obj) & eventLeftButtonUp(obj) & eventRightButtonUp(obj)
End Function

Function processHMIIOField(obj As HMIIOField)
    Dim script As HMIScriptInfo
    Dim dialog As HMIDynamicDialog
    Dim actiontrigger As HMIVariableTrigger
    
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMIIOField = "Name=" & getObjectName(obj.ObjectName) & "|Type=IOField|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    processHMIIOField = processHMIIOField & "|xAlign=" & obj.AlignmentLeft & "|yAlign=" & obj.AlignmentTop & "|fontSize=" & obj.FONTSIZE
    processHMIIOField = processHMIIOField & "|backColor=" & obj.BackColor & "|fillStyle=" & obj.FillStyle.value & "|foreColor=" & obj.ForeColor
    processHMIIOField = processHMIIOField & actionVisible(obj) & actionBackColor(obj) & actionForeColor(obj) & actionFlashingLine(obj) & actionFlashingBackground(obj) & actionFlashingText(obj) & actionX(obj) & actionY(obj)
    
    processHMIIOField = processHMIIOField & "|fieldType=" & obj.BoxType.value

    If (obj.OutputValue.DynamicStateType = hmiDynamicStateTypeVariableDirect) Then
        Set actiontrigger = obj.OutputValue.Dynamic
        processHMIIOField = processHMIIOField & "|outputValue=" & actiontrigger.VarName
    ElseIf (obj.OutputValue.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.OutputValue.Dynamic
        processHMIIOField = processHMIIOField & "|scriptOutputValue=" & script2hex(script.SourceCode)
    ElseIf (obj.OutputValue.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.OutputValue.Dynamic
        processHMIIOField = processHMIIOField & "|outputValue=" & functionCorrection(dialog.SourceCode)
    ElseIf (obj.OutputValue.DynamicStateType = hmiDynamicStateTypeVariableDirect) Then
        Set actiontrigger = obj.OutputValue.Dynamic
        processHMIIOField = processHMIIOField & "|outputValue='" & functionCorrection(actiontrigger.VarName) & "'"
    End If
    If (obj.InputValue.DynamicStateType = hmiDynamicStateTypeVariableDirect) Then
        Set actiontrigger = obj.InputValue.Dynamic
        processHMIIOField = processHMIIOField & "|inputValue=" & actiontrigger.VarName
    ElseIf (obj.InputValue.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.InputValue.Dynamic
        processHMIIOField = processHMIIOField & "|scriptInputValue=" & script2hex(script.SourceCode)
    ElseIf (obj.InputValue.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.InputValue.Dynamic
        processHMIIOField = processHMIIOField & "|inputValue=" & functionCorrection(dialog.SourceCode)
    ElseIf (obj.InputValue.DynamicStateType = hmiDynamicStateTypeVariableDirect) Then
        Set actiontrigger = obj.InputValue.Dynamic
        processHMIIOField = processHMIIOField & "|inputValue='" & functionCorrection(actiontrigger.VarName) & "'"
    End If
       
    processHMIIOField = processHMIIOField & "|dataFormat=" & obj.DataFormat & "|outputFormat=" & obj.OutputFormat
    processHMIIOField = processHMIIOField & eventLeftButton(obj) & eventLeftButtonUp(obj) & eventRightButtonUp(obj)
End Function

Function processHMIRectangle(obj As HMIRectangle)
    Dim script As HMIScriptInfo
    Dim dialog As HMIDynamicDialog
    
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMIRectangle = "Name=" & getObjectName(obj.ObjectName) & "|Type=Rectangle|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    
    processHMIRectangle = processHMIRectangle & "|backColor=" & obj.BackColor & "|borderColor=" & obj.BorderColor & "|fillStyle=" & obj.FillStyle.value
    processHMIRectangle = processHMIRectangle & actionVisible(obj) & actionBackColor(obj) & actionFlashingLine(obj) & actionFlashingBackground(obj) & actionX(obj) & actionY(obj)
    processHMIRectangle = processHMIRectangle & eventLeftButton(obj) & eventRightButton(obj) & eventLeftButtonUp(obj) & eventRightButtonUp(obj)
End Function

Function processHMIRoundRectangle(obj As HMIRoundRectangle)
    Dim script As HMIScriptInfo
    Dim dialog As HMIDynamicDialog

    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMIRoundRectangle = "Name=" & getObjectName(obj.ObjectName) & "|Type=RoundRectangle|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    processHMIRoundRectangle = processHMIRoundRectangle & "|roundCornerWidth=" & obj.RoundCornerWidth & "|roundCornerHeight=" & obj.RoundCornerHeight
    
    processHMIRoundRectangle = processHMIRoundRectangle & "|backColor=" & obj.BackColor & "|borderColor=" & obj.BorderColor & "|fillStyle=" & obj.FillStyle.value
    processHMIRoundRectangle = processHMIRoundRectangle & actionVisible(obj) & actionBackColor(obj) & actionFlashingLine(obj) & actionFlashingBackground(obj) & actionX(obj) & actionY(obj)
    processHMIRoundRectangle = processHMIRoundRectangle & eventLeftButton(obj) & eventRightButton(obj) & eventLeftButtonUp(obj) & eventRightButtonUp(obj)
End Function

Function processHMICircle(obj As HMICircle)
    Dim script As HMIScriptInfo
    Dim dialog As HMIDynamicDialog
    
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMICircle = "Name=" & getObjectName(obj.ObjectName) & "|Type=Circle|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    processHMICircle = processHMICircle & "|backColor=" & obj.BackColor & "|borderColor=" & obj.BorderColor & "|fillStyle=" & obj.FillStyle.value
    processHMICircle = processHMICircle & actionVisible(obj) & actionBackColor(obj) & actionFlashingLine(obj) & actionFlashingBackground(obj) & actionX(obj) & actionY(obj)
    processHMICircle = processHMICircle & eventLeftButton(obj) & eventRightButton(obj) & eventLeftButtonUp(obj) & eventRightButtonUp(obj)
End Function

Function processHMIEllipse(obj As HMIEllipse)
    Dim script As HMIScriptInfo
    Dim dialog As HMIDynamicDialog
    
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMIEllipse = "Name=" & getObjectName(obj.ObjectName) & "|Type=Ellipse|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    processHMIEllipse = processHMIEllipse & "|backColor=" & obj.BackColor & "|borderColor=" & obj.BorderColor & "|fillStyle=" & obj.FillStyle.value
    processHMIEllipse = processHMIEllipse & actionVisible(obj) & actionBackColor(obj) & actionFlashingLine(obj) & actionFlashingBackground(obj) & actionX(obj) & actionY(obj)
    processHMIEllipse = processHMIEllipse & eventLeftButton(obj) & eventRightButton(obj) & eventLeftButtonUp(obj) & eventRightButtonUp(obj)
End Function

Function processHMILine(obj As HMILine)
    Dim script As HMIScriptInfo
    Dim dialog As HMIDynamicDialog
    
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMILine = "Name=" & getObjectName(obj.ObjectName) & "|Type=Line|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    processHMILine = processHMILine & "|backColor=" & obj.BorderBackColor & "|borderColor=" & obj.BorderColor & "|lineStyle=" & obj.BorderStyle.value & "|lineWeight=" & obj.BorderWidth.value & "|lineEndStyle=" & obj.BorderEndStyle.value
    processHMILine = processHMILine & actionVisible(obj) & actionFlashingLine(obj) & actionX(obj) & actionY(obj)
End Function

Function processHMIPolyline(obj As HMIPolyLine)
    Dim script As HMIScriptInfo
    Dim dialog As HMIDynamicDialog
    
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMIPolyline = "Name=" & getObjectName(obj.ObjectName) & "|Type=Polyline|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    processHMIPolyline = processHMIPolyline & "|backColor=" & obj.BorderBackColor & "|borderColor=" & obj.BorderColor & "|lineStyle=" & obj.BorderStyle.value & "|lineWeight=" & obj.BorderWidth.value & "|lineEndStyle=" & obj.BorderEndStyle.value
    
    points$ = ""
    For i = 1 To obj.PointCount
        obj.index = i
        If (Len(points$) > 0) Then
            points$ = points$ & ";"
        End If
        points$ = points$ & obj.ActualPointLeft & "x" & obj.ActualPointTop
    Next i
    
    processHMIPolyline = processHMIPolyline & "|points=" & points$
    processHMIPolyline = processHMIPolyline & actionVisible(obj) & actionFlashingLine(obj) & actionX(obj) & actionY(obj)
End Function

Function processHMICircularArc(obj As HMICircularArc)
    Dim script As HMIScriptInfo
    Dim dialog As HMIDynamicDialog
    
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMICircularArc = "Name=" & getObjectName(obj.ObjectName) & "|Type=CircularArc|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    processHMICircularArc = processHMICircularArc & "|startAngle=" & obj.StartAngle & "|endAngle=" & obj.EndAngle & "|radius=" & obj.Radius
    processHMICircularArc = processHMICircularArc & "|backColor=" & obj.BorderBackColor & "|borderColor=" & obj.BorderColor & "|lineStyle=" & obj.BorderStyle.value & "|lineWeight=" & obj.BorderWidth.value
    processHMICircularArc = processHMICircularArc & actionVisible(obj) & actionFlashingLine(obj) & actionX(obj) & actionY(obj)
End Function

Function processHMIGroup(obj As HMIGroup)
    Dim script As HMIScriptInfo
    Dim dialog As HMIDynamicDialog
    
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = obj.GroupParent.ObjectName
    End If
    processHMIGroup = "Name=" & getObjectName(obj.ObjectName) & "|Type=Group|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    l% = obj.GroupedHMIObjects.Count
    groupObjects$ = ""
    For i = 1 To l%
        go$ = getObjectName(obj.GroupedHMIObjects.Item(i).ObjectName)
        
        If (Len(groupObjects$) > 0) Then
            groupObjects$ = groupObjects$ & ";"
        End If
        groupObjects$ = groupObjects$ & go$
    Next i
    
    processHMIGroup = processHMIGroup & "|groupObjects=" & groupObjects$
    processHMIGroup = processHMIGroup & actionVisible(obj) & actionX(obj) & actionY(obj)
    processHMIGroup = processHMIGroup & eventLeftButton(obj) & eventRightButton(obj) & eventLeftButtonUp(obj) & eventRightButtonUp(obj)
End Function

Function processHMI3DPipe(obj As HMIObject)
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMI3DPipe = "Name=" & getObjectName(obj.ObjectName) & "|Type=Pipe|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
End Function

Function processHMIObject(obj As HMIObject)
    Dim script As HMIScriptInfo
    Dim dialog As HMIDynamicDialog
    
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMIObject = "Name=" & getObjectName(obj.ObjectName) & "|Type=Object|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    
    processHMIObject = processHMIObject & actionVisible(obj) & eventLeftButton(obj) & eventRightButton(obj) & eventLeftButtonUp(obj) & eventRightButtonUp(obj)
End Function

Function processHMIButton(obj As HMIButton)
    group$ = ""
    If (Not obj.GroupParent Is Nothing) Then
        group$ = getObjectName(obj.GroupParent.ObjectName)
    End If
    processHMIButton = "Name=" & getObjectName(obj.ObjectName) & "|Type=Button|ToolTip=" & Replace(obj.ToolTipText, "=", "@#&") & "|group=" & group$ & "|x=" & obj.Left & "|y=" & obj.Top & "|w=" & obj.Width & "|h=" & obj.Height & "|layer=" & obj.Layer.value
    processHMIButton = processHMIButton & "|backColor=" & obj.BackColor & "|borderColor=" & obj.BorderColor & "|foreColor=" & obj.ForeColor & "|fillStyle=" & obj.FillStyle.value
    processHMIButton = processHMIButton & "|xAlign=" & obj.AlignmentLeft & "|yAlign=" & obj.AlignmentTop & "|fontSize=" & obj.FONTSIZE
   
    If (obj.Text.DynamicStateType = hmiDynamicStateTypeScript) Then
        Set script = obj.Text.Dynamic
        processHMIButton = processHMIButton & "|scriptText=" & script2hex(script.SourceCode)
    ElseIf (obj.Text.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
        Set dialog = obj.Text.Dynamic
        processHMIButton = processHMIButton & "|dialogText=" & functionCorrection(dialog.SourceCode)
    ElseIf (obj.Text.DynamicStateType > 0) Then
        processHMIButton = processHMIButton
    End If
    
    processHMIButton = processHMIButton & "|text=" & Replace(Replace(obj.Text.value, Chr(13) & Chr(10), "@#$"), "=", "@#&")
    processHMIButton = processHMIButton & actionVisible(obj) & actionBackColor(obj) & actionFlashingLine(obj) & actionFlashingBackground(obj) & actionX(obj) & actionY(obj)
    processHMIButton = processHMIButton & eventLeftButton(obj) & eventRightButton(obj) & eventLeftButtonUp(obj) & eventRightButtonUp(obj)
End Function

Function getAuthorization(obj As HMIObject)
    result$ = ""
    If (Not obj.Operation.Dynamic Is Nothing) Then
        If (obj.Operation.DynamicStateType = hmiDynamicStateTypeDynamicDialog) Then
            result$ = result$ & "|controlEnable=" & obj.Operation.Dynamic.SourceCode
            If (obj.Operation.Dynamic.ResultType = hmiResultTypeBool) Then
                result$ = result$ & "|controlEnablePositive=" & obj.Operation.Dynamic.BinaryResultInfo.PositiveValue
                result$ = result$ & "|controlEnableNegative=" & obj.Operation.Dynamic.BinaryResultInfo.NegativeValue
            End If
        Else
            MsgBox "getAuthorization - " & obj.ObjectName & " - Operation.DynamicStateType(" & Operation.DynamicStateType & ")not supported"
        End If
    End If
    
    result$ = result$ & "|passwordLevel=" & obj.PasswordLevel.value
    
    getAuthorization = result$
End Function

Function getCharts(doc As Document) As String
    result$ = ""
    For i = 1 To doc.HMIObjects.Count
        Dim obj As HMIObject
        Set obj = Application.ActiveDocument.HMIObjects(i)
        If (obj.Type Like "HMIButton") Then
            If (obj.Events.Count > 0) Then
                For j = 1 To obj.Events.Count
                    If (obj.Events(j).EventType = hmiEventTypeMouseRButtonDown) Then
                        If (obj.Events(j).Actions.Count > 0) Then
                            If (obj.Events(j).Actions(1).ActionType = hmiActionTypeScript) Then
                                Dim script As HMIScriptInfo
                                Set script = obj.Events(j).Actions(1)
                                pos& = InStr(1, script.SourceCode, "Dlg_Kurver(")
                                If (pos& > 0) Then
                                    pos& = pos& + Len("Dlg_Kurver(")
                                    pos2& = InStr(pos& + 1, script.SourceCode, ")")
                                    If (pos2& > 0) Then
                                        If (Len(result$) > 0) Then
                                            result$ = result$ & ";"
                                        End If
                                        result$ = result$ & Trim(Replace(Mid(script.SourceCode, pos&, pos2& - pos& - 1), """", ""))
                                    End If
                                End If
                            End If
                        End If
                        Exit For
                    End If
                Next j
            End If
        End If
    Next i
    
    getCharts = result$
End Function

Function getObjectName(name As String) As String
    getObjectName = Replace(name, "/", "_")
End Function


Function script2hex(ByRef script As String) As String
    l& = Len(script)
    i& = 0
    script2hex = ""
    Do While i& < l&
        i& = i& + 1
        script2hex = script2hex & Right$(Hex(&H1000000 Or CInt(Asc(Mid(script, i&, 1)))), 2)
    Loop
End Function

Sub objectsexport(doc As Document)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.CreateTextFile("c:\export\" & doc.name & ".txt", True)
    
    Count% = 0
    IsDynamicable% = 0
   
    For i = 1 To doc.HMIObjects.Count
        Dim obj As HMIObject
        Set obj = Application.ActiveDocument.HMIObjects(i)

        If (obj.Type Like "HMIStatusDisplay") Then
            Dim objd As HMIStatusDisplay
            Set objd = obj
            'If (objd.index.IsDynamicable And objd.index.DynamicStateType = 3) Then
                dataline$ = processHMIStatusDisplay(objd) & getAuthorization(objd)
                f.WriteLine (dataline$)
            '    IsDynamicable% = IsDynamicable% + 1
            'End If
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMIStaticText") Then
            Dim objt As HMIStaticText
            Set objt = obj
            If (objt.Text.DynamicStateType > 0 Or objt.BackColor.DynamicStateType > 0) Then
                IsDynamicable% = IsDynamicable% + 1
            End If
            
            dataline$ = processHMIStatusText(objt) & getAuthorization(objt)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMIIOField") Then
            Dim objf As HMIIOField
            Set objf = obj
            dataline$ = processHMIIOField(objf) & getAuthorization(objf)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMIRectangle") Then
            Dim objr As HMIRectangle
            Set objr = obj
            dataline$ = processHMIRectangle(objr) & getAuthorization(objr)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMIRoundRectangle") Then
            Dim objrr As HMIRoundRectangle
            Set objrr = obj
            dataline$ = processHMIRoundRectangle(objrr) & getAuthorization(objrr)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMICircle") Then
            Dim objc As HMICircle
            Set objc = obj
            dataline$ = processHMICircle(objc) & getAuthorization(objc)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMIEllipse") Then
            Dim obje As HMIEllipse
            Set obje = obj
            dataline$ = processHMIEllipse(obje) & getAuthorization(obje)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMILine") Then
            Dim objl As HMILine
            Set objl = obj
            dataline$ = processHMILine(objl) & getAuthorization(objl)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMIPolyLine") Then
            Dim objpl As HMIPolyLine
            Set objpl = obj
            dataline$ = processHMIPolyline(objpl) & getAuthorization(objpl)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMICircularArc") Then
            Dim objca As HMICircularArc
            Set objca = obj
            dataline$ = processHMICircularArc(objca) & getAuthorization(objca)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMIGroup") Then
            Dim objg As HMIGroup
            Set objg = obj
            dataline$ = processHMIGroup(objg) & getAuthorization(objg)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMICustom*" And obj.ObjectName Like "3DHorizontalPipe*") Then
            dataline$ = processHMI3DPipe(obj)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        ElseIf (obj.Type Like "HMIButton") Then
            Dim objb As HMIButton
            Set objb = obj
            dataline$ = processHMIButton(objb) & getAuthorization(objb)
            f.WriteLine (dataline$)
            
            Count% = Count% + 1
        Else
            'MsgBox obj.Type
            If (obj.Visible.DynamicStateType > 0) Then
                dataline$ = processHMIObject(obj)
                f.WriteLine (dataline$)
                IsDynamicable% = IsDynamicable% + 1
            End If
        End If
    Next i
    
    ch$ = getCharts(doc)
    If (Len(ch$) > 0) Then
        f.WriteLine ("Name=chart|Type=chart|ToolTip=|definition=" & ch$)
    End If
    
    f.Close
    'MsgBox "HMIStatusDisplay=" & Count% & "|IsDynamicable=" & IsDynamicable%
End Sub

Sub exportAll()

    Dim doc As Document
    screens& = 0
    processed& = 0
    
    fileName$ = Dir(Application.ApplicationDataPath & "\*pdl")
    
    Do While (Len(fileName$) > 0)
        If (Not (LCase(fileName$) Like "*old.pdl") And Not (LCase(fileName$) Like "*backup.pdl")) Then
            Set doc = Application.Documents.Open(fileName$, hmiOpenDocumentTypeInvisible)
            If (doc.Width = 1280 And doc.Height = 1024) Then
                objectsexport doc
                processed& = processed& + 1
            End If
            doc.Close
        End If
        fileName$ = Dir
        screens& = screens& + 1
    Loop
    
    
    MsgBox "Zpracovano " & processed& & "/" & screens&
End Sub

Sub exportCurrent()
    objectsexport Application.ActiveDocument
    MsgBox "Hotovo"
End Sub


Function ClipBoard_SetData(MyString As String)
'PURPOSE: API function to copy text to clipboard
'SOURCE: www.msdn.microsoft.com/en-us/library/office/ff192913.aspx

Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long

'Allocate moveable global memory
  hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

'Lock the block to get a far pointer to this memory.
  lpGlobalMemory = GlobalLock(hGlobalMemory)

'Copy the string to this global memory.
  lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

'Unlock the memory.
  If GlobalUnlock(hGlobalMemory) <> 0 Then
    MsgBox "Could not unlock memory location. Copy aborted."
    GoTo OutOfHere2
  End If

'Open the Clipboard to copy data to.
  If OpenClipboard(0&) = 0 Then
    MsgBox "Could not open the Clipboard. Copy aborted."
    Exit Function
  End If

'Clear the Clipboard.
  X = EmptyClipboard()

'Copy the data to the Clipboard.
  hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:
  If CloseClipboard() = 0 Then
    MsgBox "Could not close Clipboard."
  End If

End Function

Function getscreenName(name As String) As String
    If (Len(name) > 4) Then
        getscreenName = """" & Left(name, Len(name) - 4) & """"
    Else
        getscreenName = name
    End If
End Function


Function getscreenStructure(doc As Document, index) As String
    ' index 0 - nazev obrazovky na ktere se nachazim
    ' index 1 - obrazovka o uroven vysse
    ' index 2 - obrazovka AT
    ' index 3 - obrazovka VT
    ' index 4 - obrazovka FT
    ' index 5 - predchozi obrazovka
    ' index 6 - nasledujici obrazovka
    pic1$ = """" & """"
    pic2$ = """" & """"
    pic3$ = """" & """"
    pic4$ = """" & """"
    pic5$ = """" & """"
    pic6$ = """" & """"
    
    If (doc.Events.Count = 0) Then
        getscreenStructure = ""
        Exit Function
    End If
    For i = 1 To doc.Events.Count
        If (doc.Events(i).EventType = hmiEventTypePictureOpen) Then
            If (doc.Events(i).Actions.Count > 0) Then
                If (doc.Events(i).Actions(1).ActionType = hmiActionTypeScript) Then
                    Dim script As HMIScriptInfo
                    Set script = doc.Events(i).Actions(1)
                    scr$ = script.SourceCode
                    pos& = InStr(1, scr$, "#define PIC1")
                    If (pos& > 0) Then
                        pos& = InStr(pos&, scr$, """")
                        ep& = InStr(pos& + 1, scr$, """")
                        pic1$ = Mid(scr$, pos& + 1, ep& - pos& - 1)
                    End If
                    pos& = InStr(1, scr$, "#define PIC2")
                    If (pos& > 0) Then
                        pos& = InStr(pos&, scr$, """")
                        ep& = InStr(pos& + 1, scr$, """")
                        pic2$ = Mid(scr$, pos& + 1, ep& - pos& - 1)
                    End If
                    pos& = InStr(1, scr$, "#define PIC3")
                    If (pos& > 0) Then
                        pos& = InStr(pos&, scr$, """")
                        ep& = InStr(pos& + 1, scr$, """")
                        pic3$ = Mid(scr$, pos& + 1, ep& - pos& - 1)
                    End If
                    pos& = InStr(1, scr$, "#define PIC4")
                    If (pos& > 0) Then
                        pos& = InStr(pos&, scr$, """")
                        ep& = InStr(pos& + 1, scr$, """")
                        pic4$ = Mid(scr$, pos& + 1, ep& - pos& - 1)
                    End If
                End If
            End If
            Exit For
        End If
    Next i
    
    For i = 1 To doc.HMIObjects.Count
        Dim obj As HMIObject
        Set obj = Application.ActiveDocument.HMIObjects(i)
        If (obj.Type Like "HMIGroup") Then
            Dim objg As HMIGroup
            Set objg = obj
            If (objg.Width = 125 And objg.Height = 51 And objg.GroupedHMIObjects.Count = 2) Then
                picname$ = """" & """"
                For j = 1 To objg.Events.Count
                    If (objg.Events(j).EventType = hmiEventTypeMouseLButtonDown Or objg.Events(j).EventType = hmiEventTypeMouseLButtonUp Or objg.Events(j).EventType = hmiEventTypeMouseClick) Then
                        If (objg.Events(j).Actions.Count > 0) Then
                            If (objg.Events(j).Actions(1).ActionType = hmiActionTypeDirectConnection) Then
                                picname$ = objg.Events(j).Actions(1).SourceLink.ObjectName
                                Exit For
                            End If
                        End If
                    End If
                Next j
                    
                If (objg.Left < 50) Then
                    pic5$ = picname$
                ElseIf (objg.Left > 1100) Then
                    pic6$ = picname$
                End If
            End If
        End If
    Next i
    
    result$ = "    Structure(" & index & ", 0) = " & """" & Left(doc.name, Len(doc.name) - 4) & """" & Chr(13) & Chr(10)
    result$ = result$ & "    Structure(" & index & ", 1) = " & getscreenName(pic1$) & Chr(13) & Chr(10)
    result$ = result$ & "    Structure(" & index & ", 2) = " & getscreenName(pic2$) & Chr(13) & Chr(10)
    result$ = result$ & "    Structure(" & index & ", 3) = " & getscreenName(pic3$) & Chr(13) & Chr(10)
    result$ = result$ & "    Structure(" & index & ", 4) = " & getscreenName(pic4$) & Chr(13) & Chr(10)
    result$ = result$ & "    Structure(" & index & ", 5) = " & getscreenName(pic5$) & Chr(13) & Chr(10)
    result$ = result$ & "    Structure(" & index & ", 6) = " & getscreenName(pic6$) & Chr(13) & Chr(10)
    
    getscreenStructure = result$
End Function

Sub screenStructureAll()

    Dim doc As Document
    screens& = 0
    processed& = 0
    
    fileName$ = Dir(Application.ApplicationDataPath & "\*pdl")
    result$ = ""
    index& = 0
   
    Do While (Len(fileName$) > 0)
        If (Not (LCase(fileName$) Like "*old.pdl") And Not (LCase(fileName$) Like "*backup.pdl")) Then
            Set doc = Application.Documents.Open(fileName$, hmiOpenDocumentTypeInvisible)
            If (doc.Width = 1280 And doc.Height = 1024) Then
                result$ = result$ & Chr(13) & Chr(10) & getscreenStructure(doc, index&)
                index& = index& + 1
                processed& = processed& + 1
            End If
            doc.Close
        End If
        fileName$ = Dir
        screens& = screens& + 1
    Loop
    
    ClipBoard_SetData (result$)
    
    MsgBox "Zpracovano " & processed& & "/" & screens& & ". Vysledek ulozen do schranky"
End Sub

Function getObjectChanges(doc As Document, index) As String
    result$ = ""
    ocVypZap = 0
    ocTotal = 0
    For i = 1 To doc.HMIObjects.Count
        Dim obj As HMIObject
        Set obj = Application.ActiveDocument.HMIObjects(i)

        For j = 1 To obj.Events.Count
            If (obj.Events(j).EventType = hmiEventTypeObjectChange) Then
                If (obj.Events(j).Actions.Count > 0) Then
                    ocTotal = ocTotal + 1
                    If (obj.Events(j).Actions(1).ActionType = hmiActionTypeScript) Then
                        Dim script As HMIScriptInfo
                        Set script = obj.Events(j).Actions(1)
                        scr$ = script.SourceCode
'#define SKUT_ZAP "KL_KTLT_FT_202_SS00___bm_bm_bit_121"
'#define ZAD_VYP "KL_KTLT_FT_202_SS00___bs_soll_22"
                        posz& = InStr(1, scr$, "#define SKUT_ZAP")
                        posv& = InStr(1, scr$, "#define ZAD_VYP")
                        If (posz& > 0 And posv& > 0) Then
                            posz& = InStr(posz&, scr$, """") + 1
                            SKUT_ZAP = Mid(scr$, posz&, InStr(posz&, scr$, """") - posz&)
                            posv& = InStr(posv&, scr$, """") + 1
                            ZAD_VYP = Mid(scr$, posv&, InStr(posv&, scr$, """") - posv&)

                            'result$ = result$ & "Name=" & getObjectName(obj.ObjectName) & "|Type=" & obj.Type & "|SKUT_ZAP=" & SKUT_ZAP & "|ZAD_VYP=" & ZAD_VYP
                            result$ = result$ & SKUT_ZAP & ";" & ZAD_VYP
                            result$ = result$ & Chr(13) & Chr(10)
                            
                            ocVypZap = ocVypZap + 1
                        End If
                    End If
                End If
            End If
        Next j
    Next i
    
    getObjectChanges = result$
End Function

Function getObjectChangesCount(doc As Document, index) As Integer
    ocTotal = 0
    For i = 1 To doc.HMIObjects.Count
        Dim obj As HMIObject
        Set obj = Application.ActiveDocument.HMIObjects(i)

        For j = 1 To obj.Events.Count
            If (obj.Events(j).EventType = hmiEventTypeObjectChange) Then
                If (obj.Events(j).Actions.Count > 0) Then
                    ocTotal = ocTotal + 1
                End If
            End If
        Next j
    Next i
    
    getObjectChangesCount = ocTotal
End Function

Function getObjectChangesNoVZ(doc As Document, index) As String
    result$ = ""
    
    For i = 1 To doc.HMIObjects.Count
        Dim obj As HMIObject
        Set obj = Application.ActiveDocument.HMIObjects(i)

        For j = 1 To obj.Events.Count
            If (obj.Events(j).EventType = hmiEventTypeObjectChange) Then
                If (obj.Events(j).Actions.Count > 0) Then
                    If (obj.Events(j).Actions(1).ActionType = hmiActionTypeScript) Then
                        Dim script As HMIScriptInfo
                        Set script = obj.Events(j).Actions(1)
                        scr$ = script.SourceCode
                        posz& = InStr(1, scr$, "#define SKUT_ZAP")
                        posv& = InStr(1, scr$, "#define ZAD_VYP")
                        If (Not (posz& > 0 And posv& > 0)) Then
                            result$ = result$ & "Name=" & getObjectName(obj.ObjectName) & "|Type=" & obj.Type & "|Screen=" & doc.name
                            result$ = result$ & Chr(13) & Chr(10)
                        End If
                    ElseIf (obj.Events(j).Actions(1).ActionType = hmiActionTypeDirectConnection) Then
                        result$ = result$ & "Name=" & getObjectName(obj.ObjectName) & "|Type=" & obj.Type & "|Screen=" & doc.name
                        result$ = result$ & Chr(13) & Chr(10)
                    End If
                End If
            End If
        Next j
    Next i
    
    getObjectChangesNoVZ = result$
End Function

Sub triggerObjectsAll()

    Dim doc As Document
    screens& = 0
    processed& = 0
    ocTotal = 0
    
    fileName$ = Dir(Application.ApplicationDataPath & "\*pdl")
    result$ = ""
    index& = 0
   
    Do While (Len(fileName$) > 0)
        If (Not (LCase(fileName$) Like "*old.pdl") And Not (LCase(fileName$) Like "*backup.pdl")) Then
            Set doc = Application.Documents.Open(fileName$, hmiOpenDocumentTypeInvisible)
            If (doc.Width = 1280 And doc.Height = 1024) Then
                oc$ = getObjectChanges(doc, index&)
                'oc$ = getObjectChangesNoVZ(doc, index&)
                
                If (Len(oc$) > 0) Then
                    result$ = result$ & oc$
                End If
                index& = index& + 1
                processed& = processed& + 1
                
                ocTotal = ocTotal + getObjectChangesCount(doc, index&)
            End If
            doc.Close
        End If
        fileName$ = Dir
        screens& = screens& + 1
    Loop
    
    ClipBoard_SetData (result$)
    
    MsgBox "Zpracovano " & processed& & "/" & screens& & ". Vysledek ulozen do schranky. Nalezeno/odpovida " & ocTotal & "/" & UBound(Split(result$, vbCrLf))
End Sub