Справочное руководство по TDMS 7.0 API
VBScript
Смотри также Отправить замечание

Glossary Item Box

Исходный текст

Option Explicit
Call TestCmdCollection(ThisApplication.Shell.SelObjects)


'=====================================================================
' Найти команду Test в коллекции, если ее нет - создать, а затем удалить.
' Для выполнения скрипта нужны права системного администратора
'=====================================================================
Sub TestCmdCollection(Objects)

    If Objects.Count = 0 Then
        Msgbox "Нет выделенных объектов.", vbInformation
        Exit Sub
    End If

    Dim  Cmd, appCmds, objCmds, bExist, CmdID, Object, RetVal
    Set Object = Objects(0)
    CmdID = "CMD_TEST2"
    Set Cmd = Nothing

    'Получить ссылку на коллекцию команд приложения
    Set appCmds = ThisApplication.Commands

    ' Если команда "Test" не найдена в коллекции, создать ее
    If Not appCmds.Has(CmdID) Then    
        Set Cmd = appCmds.Create
        Cmd.SysName = CmdID
        Call FillCmdProperties(Cmd) 'определить свойства нового объекта...
        bExist = False
    Else 'иначе - получить ссылку на существующую команду
        MsgBox "Команда " & CmdID & " существует" & Chr(13) & _
            "в коллекции приложения под номером " & appCmds.Index(CmdID), vbInformation
        Set Cmd = appCmds.Item(CmdID)
    End If

    'Получить коллекцию команд объекта, переданного в параметре процедуры
    Set objCmds = Object.ObjectDef.Commands

    'Наличие команды в коллекции можно проверить и через свойство Index
    '(если объект не найден, свойство будет содержать -1)
    If objCmds.Index(Cmd) < 0 Then  

        'Если команды нет в коллекции объекта, добавить ее. Метод никак не влияет
        'ни на коллекцию типа объекта, ни на коллекции команд других объектов этого типа
        objCmds.Add Cmd   

        MsgBox "Коллекция команд объекта " & Object.Description & Chr(13) & "содержит " _
        & objCmds.Count & " элемент(ов) вместе с добавленной командой.", vbInformation

        'Теперь удалить команду методом Remove (это приведет только к удалению 
        'ее только из коллекции объекта; в коллекции приложения она все еще есть)
        objCmds.Remove Cmd
    End If

    'Если команда создана нами, удалить ее. Метод Erase удаляет информацию о команде
    'из базы данных
    If bExist <> True Then    
        RetVal = MsgBox("Удалить команду Test из приложения?", vbQuestion + vbYesNo)
        If RetVal <> vbNo Then Cmd.Erase
    End If
End Sub
'======================================================================

Sub FillCmdProperties(Cmd)
    'Здесь определяются свойства нового объекта TDMSCommand
End Sub
'======================================================================
© 2023 CSoft Development. Все права защищены.