VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Public Kompas As Object
Public attr As Object
Public doc As Object

Sub ShowCol(par As Object, iCol As Integer, fl As Boolean)
  Dim s As String
  If fl Then
    s = ""
  Else
    s = ""
  End If

  '     
  Kompas.ksMessage s & " i = " & iCol & " header=" & par.Header & " type=" & par.Type & _
                   " def=" & par.Def & " flagEnum=" & par.FlagEnum
  If par.Type = RECORD_ATTR_TYPE Then         ' 
    Dim pCol As Object
    Set pCol = par.GetColumns
    If Not pCol Is Nothing Then
      ShowColumns pCol, True
      pCol.ksDeleteArray
      Set pCol = Nothing
    End If
  End If
End Sub

Sub ShowColumns(pCol As Object, fl As Boolean)
  Dim par As Object
  Set par = Kompas.GetParamStruct(ko_ColumnInfoParam)
  If Not par Is Nothing Then
    par.Init
    Dim n As Integer
    n = pCol.ksGetArrayCount

    Dim i As Integer
    For i = 0 To n - 1
      If pCol.ksGetArrayItem(i, par) = 0 Then
        Kompas.ksMessageBoxResult  '     
      Else
        ShowCol par, i, fl
      End If
    Next i
    Set par = Nothing
  End If
End Sub

'   
Sub FuncAttrType()
  Dim type_ As Object
  Dim col As Object
  Set type_ = Kompas.GetParamStruct(ko_AttributeType)
  Set col = Kompas.GetParamStruct(ko_ColumnInfoParam)
  If Not type_ Is Nothing And Not col Is Nothing Then
    type_.Init
    col.Init
    type_.Header = "double_str_long"          ' o- 
    type_.RowsCount = 1                       ' -   
    type_.FlagVisible = True                  ' ,     
    type_.password = ""                       ' ,      -     
    type_.Key1 = 10
    type_.Key2 = 20
    type_.Key3 = 30
    type_.Key4 = 0
    Dim arr As Object
    Set arr = type_.GetColumns
    If Not arr Is Nothing Then
      '    
      col.Header = "double"               ' o- 
      col.Type = DOUBLE_ATTR_TYPE         '     - .
      col.Key = 0                         '  ,        
      col.Def = "123456789"               '   
      col.FlagEnum = False                '   ,    
      arr.ksAddArrayItem -1, col

      '   
      col.Header = "str"                  ' o- 
      col.Type = STRING_ATTR_TYPE         '     - .
      col.Key = 0                         '  ,        
      col.Def = "string"                  '   
      col.FlagEnum = False                '   ,    
      arr.ksAddArrayItem -1, col

      '   
      col.Header = "long"                 ' o- 
      col.Type = LINT_ATTR_TYPE           '     - .
      col.Key = 0                         '  ,        
      col.Def = "1000000"                 '   
      col.FlagEnum = False                '   ,    
      arr.ksAddArrayItem -1, col
      Set arr = Nothing
    End If
    Dim nameFile As String
    nameFile = ""
    '   
    nameFile = Kompas.ksChoiceFile("*.lat", "", False)
    '   
    Dim numbType As Double
    numbType = attr.ksCreateAttrType(type_, nameFile)
    If numbType > 1 Then
      Kompas.ksMessage "numbType = " & numbType
    Else
      Kompas.ksMessageBoxResult  '     
    End If

    '    
'    arr.ksDeleteArray
    Set type_ = Nothing
    Set col = Nothing
  End If
End Sub

Sub DelTypeAttr()
  Dim numb As Double
  Dim j As Integer
  Dim password As String
  password = ""
  '   
  Dim nameFile As String
  nameFile = ""
  nameFile = Kompas.ksChoiceFile("*.lat", "", False)
  Do
    j = Kompas.ksReadDouble("   ", 1000#, 0, 1000000000000#, numb)
    If j <> 0 Then
      password = Kompas.ksReadString("   ", "")
      If attr.ksDeleteAttrType(numb, nameFile, password) = 0 Then
        Kompas.ksMessageBoxResult  '     
      End If
    End If
  Loop While (j <> 0)
End Sub

'   
Sub ShowTypeAttr()
  Dim numb As Double
  '   
  Dim nameFile As String
  nameFile = Kompas.ksChoiceFile("*.lat", "", False)

  Dim type_ As Object
  Set type_ = Kompas.GetParamStruct(ko_AttributeType)
  If Not type_ Is Nothing Then
    type_.Init

    Do
      numb = attr.ksChoiceAttrTypes(nameFile)
      If numb <> 0 Then
        If attr.ksGetAttrType(numb, nameFile, type_) = 0 Then
          Kompas.ksMessageBoxResult  '     
        Else
          Kompas.ksMessage "key1 = " & type_.Key1 & " key2 = " & type_.Key2 & " key3 = " & _
                           type_.Key3 & " key4 = " & type_.Key4
          Kompas.ksMessage "header = " & type_.Header & " rowsCount = " & type_.RowsCount & _
                           " flagVisible = " & type_.FlagVisible & " password = " & type_.password
          Dim pCol As Object
          Set pCol = type_.GetColumns
          If Not pCol Is Nothing Then
            ShowColumns pCol, False
            pCol.ksDeleteArray
            Set pCol = Nothing
          End If
'          ShowColumns attrType.columns, FALSE  '  
        End If
      End If
    Loop While (numb)
    '    
'    DeleteArray attrType.columns
    Set type_ = Nothing
  End If
End Sub

'   
Sub ChangeType()
  Dim numb As Double
  Dim password As String
  password = ""
  '   
  Dim nameFile As String
  nameFile = Kompas.ksChoiceFile("*.lat", "", False)
  Dim j As Integer

  Dim type_ As Object
  Set type_ = Kompas.GetParamStruct(ko_AttributeType)
  If Not type_ Is Nothing Then
    type_.Init
    Do
      j = Kompas.ksReadDouble("   ", 1000#, 0, 1000000000000#, numb)
      If j <> 0 Then
        password = Kompas.ksReadString("   ", "")
        '   
        If attr.ksGetAttrType(numb, nameFile, type_) = 0 Then
          Kompas.ksMessageBoxResult  '     
        Else
          type_.password = password
          Dim arr As Object
          Dim par1 As Object
          Dim parN As Object
          Set arr = type_.GetColumns()
          Set par1 = Kompas.GetParamStruct(ko_ColumnInfoParam)
          Set parN = Kompas.GetParamStruct(ko_ColumnInfoParam)
          If Not arr Is Nothing And Not par1 Is Nothing And Not parN Is Nothing Then
            par1.Init
            parN.Init
            '  
            Dim n As Integer
            n = arr.ksGetArrayCount()
            '   
            arr.ksGetArrayItem 0, par1
            '   
            arr.ksGetArrayItem n - 1, parN
            '   
            arr.ksSetArrayItem 0, parN
            '   
            arr.ksSetArrayItem n - 1, par1

            '       
            Dim numbType As Double
            numbType = attr.ksSetAttrType(numb, nameFile, type_, password)
            If numbType > 1 Then
              Kompas.ksMessage "numbType = " & numbType
            Else
              Kompas.ksMessageBoxResult  '   -     
            End If
            arr.ksDeleteArray
            Set arr = Nothing
            Set par1 = Nothing
            Set parN = Nothing
          End If
        End If
      End If
    Loop While (j <> 0)
    Set type_ = Nothing
  End If
End Sub

'   ,   FuncTypeAttr
Sub NewAttr()
  Dim attrPar As Object
  Dim usPar As Object
  Dim fVisibl As Object
  Dim colKeys As Object
  Set attrPar = Kompas.GetParamStruct(ko_Attribute)
  Set usPar = Kompas.GetParamStruct(ko_UserParam)
  Set fVisibl = Kompas.GetDynamicArray(LTVARIANT_ARR)
  Set colKeys = Kompas.GetDynamicArray(LTVARIANT_ARR)
  If Not attrPar Is Nothing And Not usPar Is Nothing And Not fVisibl Is Nothing And _
        Not colKeys Is Nothing Then
    attrPar.Init
    usPar.Init
    attrPar.setValues usPar
    attrPar.setColumnKeys colKeys
    attrPar.setFlagVisible fVisibl
    attrPar.Key1 = 1
    attrPar.Key2 = 10
    attrPar.Key3 = 100
    attrPar.password = "111"

    Dim item As Object
    Dim arr As Object
    Set item = Kompas.GetParamStruct(ko_LtVariant)
    Set arr = Kompas.GetDynamicArray(LTVARIANT_ARR)
    If Not item Is Nothing And Not arr Is Nothing Then
      usPar.setUserArray arr
      item.Init
      item.DoubleVal = 987654321#
      arr.ksAddArrayItem -1, item
      item.Init
      item.StrVal = "qwerty"
      arr.ksAddArrayItem -1, item
      item.Init
      item.LongVal = 999991
      arr.ksAddArrayItem -1, item

      item.Init
      item.UCharVal = 1
      fVisibl.ksAddArrayItem -1, item
      fVisibl.ksAddArrayItem -1, item
      fVisibl.ksAddArrayItem -1, item
      Set item = Nothing
      Set arr = Nothing
    End If

    Dim info As Object
    Set info = Kompas.GetParamStruct(ko_RequestInfo)
    If Not info Is Nothing Then
      info.Init
      info.Prompt = " "
      Dim x As Double
      Dim y As Double
      Dim j As Integer
      j = doc.ksCursor(info, x, y, Nothing)
      If j <> 0 Then
        Dim pObj As Long
        pObj = doc.ksFindObj(x, y, 1000000#)
        If doc.ksExistObj(pObj) <> 0 Then
          doc.ksLightObj pObj, 1
          '   
          Dim nameFile As String
          nameFile = Kompas.ksChoiceFile("*.lat", "", False)
          Dim numb As Double
          j = Kompas.ksReadDouble("   ", 1000#, 0, 1000000000000#, numb)
          If j <> 0 Then
            Dim pAttr As Long
            pAttr = attr.ksCreateAttr(pObj, attrPar, numb, nameFile)
            If pAttr = 0 Then
              Kompas.ksMessageBoxResult  '   -     
            End If
          End If
          doc.ksLightObj pObj, 0
        End If
      End If
      Set info = Nothing
    End If
    Set attrPar = Nothing
    Set usPar = Nothing
    Set fVisibl = Nothing
    Set colKeys = Nothing
  End If
End Sub

'       
Sub DelObjAttr()
  Dim info As Object
  Set info = Kompas.GetParamStruct(ko_RequestInfo)
  If Not info Is Nothing Then
    info.Init
    info.Prompt = " "
    Dim x As Double
    Dim y As Double
    Dim j As Integer
    Do
      j = doc.ksCursor(info, x, y, Nothing)
      If j <> 0 Then
        Dim pObj As Long
        pObj = doc.ksFindObj(x, y, 1000000#)
        If doc.ksExistObj(pObj) <> 0 Then
          doc.ksLightObj pObj, 1
          '       
          Dim iter As Object
          Set iter = Kompas.GetIterator
          If Not iter Is Nothing Then
            If iter.ksCreateAttrIterator(pObj, 0, 0, 0, 0, 0) <> 0 Then
              '    
              Dim pAttr As Long
              Dim n As Long
              pAttr = iter.ksMoveAttrIterator("F", n)
              If pAttr <> 0 Then
                Dim password As String
                password = Kompas.ksReadString("   ", "")
                If attr.ksDeleteAttr(pObj, pAttr, password) = 0 Then
                  Kompas.ksMessageBoxResult
                End If
              Else
                Kompas.ksMessage "  "
              End If
                
              doc.ksLightObj pObj, 0
            End If
          End If
        End If
      End If
    Loop While (j <> 0)
    Set info = Nothing
  End If
End Sub

'      double_str_long
Sub ReadObjAttr()
  Dim res As Boolean
  res = False
  Dim usPar As Object
  Set usPar = Kompas.GetParamStruct(ko_UserParam)
  If Not usPar Is Nothing Then
    usPar.Init
    Dim item As Object
    Dim arr As Object
    Set item = Kompas.GetParamStruct(ko_LtVariant)
    Set arr = Kompas.GetDynamicArray(LTVARIANT_ARR)
    If Not item Is Nothing And Not arr Is Nothing Then
      usPar.setUserArray arr
      item.Init
      item.DoubleVal = 987654321#
      arr.ksAddArrayItem -1, item
      item.Init
      item.StrVal = "qwerty"
      arr.ksAddArrayItem -1, item
      item.Init
      item.LongVal = 999991
      arr.ksAddArrayItem -1, item
      res = True
      Set item = Nothing
      Set arr = Nothing
    End If
  End If
  If res Then
    Dim info As Object
    Set info = Kompas.GetParamStruct(ko_RequestInfo)
    If Not info Is Nothing Then
      info.Init
      info.Prompt = " "
      Dim x As Double
      Dim y As Double
      Dim j As Integer
      Do
        j = doc.ksCursor(info, x, y, Nothing)
        If j <> 0 Then
          Dim pObj As Long
          pObj = doc.ksFindObj(x, y, 1000000#)
          If doc.ksExistObj(pObj) <> 0 Then
            doc.ksLightObj pObj, 1
            '       
            Dim iter1 As Object
            Set iter1 = Kompas.GetIterator
            If Not iter1 Is Nothing Then
              If iter1.ksCreateAttrIterator(pObj, 0, 0, 0, 0, 0) <> 0 Then
                '    
                Dim pAttr As Long
                Dim n As Long
                pAttr = iter1.ksMoveAttrIterator("F", n)
                If pAttr <> 0 Then
                  Kompas.ksMessage "   "
                  Dim k1 As Long
                  Dim k2 As Long
                  Dim k3 As Long
                  Dim k4 As Long
                  Dim numb As Double
                  attr.ksGetAttrKeysInfo pAttr, k1, k2, k3, k4, numb
                  Kompas.ksMessage "k1 = " & k1 & " k2 = " & k2 & " k3 = " & k3 & " k4 = " & k4 & _
                                   " numb = " & numb
  
                  Kompas.ksMessage " "
                  attr.ksGetAttrRow pAttr, 0, Nothing, Nothing, usPar
  
                  Kompas.ksMessage "  "
                  Dim item1 As Object
                  Dim arr1 As Object
                  Set item1 = Kompas.GetParamStruct(ko_LtVariant)
                  Set arr1 = usPar.GetUserArray
                  If Not item1 Is Nothing And Not arr1 Is Nothing Then
                    item1.Init
                    item1.DoubleVal = numb
                    arr1.ksSetArrayItem 0, item1
                    item1.Init
                    item1.StrVal = "1234567\nasdfgh\nzxcvb"
                    arr1.ksSetArrayItem 1, item1
                    item1.Init
                    item1.LongVal = 888881
                    arr1.ksSetArrayItem 2, item1
                    attr.ksSetAttrRow pAttr, 0, Nothing, Nothing, usPar, "111"
                    Set item1 = Nothing
                    Set arr1 = Nothing
                  End If
                Else
                  Kompas.ksMessage "  "
                End If
              End If
            End If
            doc.ksLightObj pObj, 0
          End If
        End If
      Loop While (j <> 0)
      Set info = Nothing
    End If
    Set usPar = Nothing
  End If
End Sub

'   
Sub ShowObjAttr()
  Dim info As Object
  Set info = Kompas.GetParamStruct(ko_RequestInfo)
  If Not info Is Nothing Then
    info.Init
    info.Prompt = " "
    Dim x As Double
    Dim y As Double
    Dim j As Integer
    Do
      j = doc.ksCursor(info, x, y, Nothing)
      If j <> 0 Then
        Dim pObj As Long
        pObj = doc.ksFindObj(x, y, 1000000#)
        If doc.ksExistObj(pObj) <> 0 Then
          doc.ksLightObj pObj, 1
          attr.ksChoiceAttr pObj
          doc.ksLightObj pObj, 0
        End If
      End If
    Loop While (j <> 0)
    Set info = Nothing
  End If
End Sub

Sub ShowLib()
  '   
  Dim nameFile As String
  nameFile = Kompas.ksChoiceFile("*.lat", "", False)

  Dim numb As Double
  numb = attr.ksChoiceAttrTypes(nameFile)
  If numb > 1 Then
    Kompas.ksMessage "numbType = " & numb
  End If
End Sub

Sub ShowType()
  '   
  Dim nameFile As String
  nameFile = Kompas.ksChoiceFile("*.lat", "", False)
  Dim password As String
  Dim numb As Double
  Dim j As Integer
  j = Kompas.ksReadDouble("   ", 1000#, 0, 1000000000000#, numb)
  If j <> 0 Then
    password = Kompas.ksReadString("   ", "")
    attr.ksViewEditAttrType nameFile, 2, numb, password
  End If
End Sub

'   ,     
' key1=10          
Sub WalkFromObjWithAttr()
  Dim info As Object
  Set info = Kompas.GetParamStruct(ko_RequestInfo)
  If Not info Is Nothing Then
    info.Init
    info.Prompt = " "
    Dim x As Double
    Dim y As Double
    Dim j As Integer
    Do
      j = doc.ksCursor(info, x, y, Nothing)
      If j <> 0 Then
        Dim pObj As Long
        pObj = doc.ksFindObj(x, y, 1000000#)
        If doc.ksExistObj(pObj) <> 0 Then
          '         10
          Dim iter As Object
          Set iter = Kompas.GetIterator
          If Not iter Is Nothing Then
            If iter.ksCreateAttrIterator(pObj, 0, 0, 0, 0, 0) <> 0 Then
              doc.ksLightObj pObj, 1
              '    
              Dim pAttr As Long
              Dim n As Long
              pAttr = iter.ksMoveAttrIterator("F", n)
              If pAttr <> 0 Then
                Do
                  attr.ksViewEditAttr pAttr, 1, ""
                  pAttr = iter.ksMoveAttrIterator("N", n)
                Loop While (pAttr <> 0)
              End If
              doc.ksLightObj pObj, 0
            End If
            Set iter = Nothing
          End If
        End If
      End If
    Loop While (j <> 0)
    Set info = Nothing
  End If
End Sub

Public Function GetLibraryName() As String
  GetLibraryName = "  "
End Function

Public Sub ExternalRunCommand(ByVal command As Integer, ByVal mode As Integer, ByVal kompas_ As Object)
  Set Kompas = kompas_
    
  '   2D 
  Set doc = Kompas.ActiveDocument2D    '   
  Set attr = Kompas.GetAttributeObject '    
  
  Select Case command
    
    Case 1
      FuncAttrType        '   
    Case 2
      DelTypeAttr         '    
    Case 3
      ShowTypeAttr        '    
    Case 4
      ChangeType          '    
    Case 5
      NewAttr             '    
    Case 6
      DelObjAttr          '  
    Case 7
      ReadObjAttr         '  
    Case 8
      ShowObjAttr         '  
    Case 9
      ShowLib             '  
    Case 10
      ShowType            '  
    Case 11
      WalkFromObjWithAttr '  
  
  End Select
End Sub

Public Function ExternalMenuItem(ByVal number As Integer, itemType As Integer, command As Integer) As String
    itemType = 3 '"ENDMENU"'
    ExternalMenuItem = ""
    command = -1

    Select Case number
        Case 1
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "  "
            command = 1
        Case 2
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "  "
            command = 2
        Case 3
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "  "
            command = 3
        Case 4
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "  "
            command = 4
        
        Case 5
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "   "
            command = 5
        Case 6
            itemType = 1 'MENUITEM'
            ExternalMenuItem = " "
            command = 6
        Case 7
            itemType = 1 'MENUITEM'
            ExternalMenuItem = " "
            command = 7
        Case 8
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "  "
            command = 8
        Case 9
            itemType = 1 'MENUITEM'
            ExternalMenuItem = " "
            command = 9
        Case 10
            itemType = 1 'MENUITEM'
            ExternalMenuItem = " "
            command = 10
        Case 11
            itemType = 1 'MENUITEM'
            ExternalMenuItem = " "
            command = 11
        Case 12
            itemType = 3 '"ENDMENU"'
            ExternalMenuItem = ""
            command = -1
    End Select
End Function

