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

Glossary Item Box

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

Option Explicit
Call ExecuteCmd(ThisApplication.Shell.SelObjects)


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

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

        Dim  Cmd, appCmds, objCmds, Script, OldScript, bExist, CmdID, Object
        Set Object = Objects(0)
        CmdID = "CMD_TEST2"
        Set Cmd = Nothing
        
        'Получить ссылку на коллекцию команд приложения
        Set appCmds = ThisApplication.Commands
        
        ' Если команда "Test" не найдена в коллекции, создать ее
        If Not appCmds.Has(CmdID) Then        
                Call CreateNewCommand(Cmd, appCmds, CmdID)
                bExist = FALSE
        Else 'иначе - получить ссылку на существующую команду
                Set Cmd = appCmds.Item(CmdID)
                bExist = True
        End If
        
        'Получить коллекцию команд объекта
        Set objCmds = Object.ObjectDef.Commands
        
        'Если команды нет в коллекции, добавить ее
        If Not objCmds.Has(Cmd) Then        objCmds.Add Cmd     

        'Выполнить команду (можно и так: appCmds("CMD_TEST").Execute Object)
        ThisApplication.ExecuteCommand Cmd, Object    
        
        'Если команда создана нами, уничтожить ее
        If bExist <> TRUE Then        Cmd.Erase
End Sub
'======================================================================

'Создать команду с системным именем CmdID в указанной коллекции
Sub CreateNewCommand(Cmd, WhereToCreate, CmdID)
        Dim Script 
                
        'Создать команду в коллекции. Независимо от того что это за коллекция 
        '(объекта, типа, приложения или др) команда автоматически добавляется
        'в коллекцию команд приложения
        Set Cmd = WhereToCreate.Create
        
        'Дать описание, SysID и иконку
        Cmd.Description = "Test Command"    
        Cmd.SysName = CmdID
        Cmd.Icon = ThisApplication.Icons(0)
        Cmd.Comments(0) = "Тестовый комментарий"
    
        'Созданная команда будет иметь общий класс и тип "скрипт"
        Cmd.Class = tdmCommon
        Cmd.Type = tdmVBScript
        
        'Создадим скрипт команды. Он будет включать обработчики событий команды
        'и собственно команду - выводить сообщение на экран
        Script = "MsgBox ""Выполняется команда """"Test"""".""" & Chr(13) & _
                "Sub Command_BeforeExecute(Command, Obj, Cancel)"  & Chr(13) & _
                "        MsgBox ""Команда Test: событие BeforeExecute"""  & Chr(13) & _
                "End Sub"  & Chr(13) & "Sub Command_Completed(Command, Obj)"  & Chr(13) & _
                "        MsgBox ""Команда Test: событие Completed"""  & Chr(13) & "End Sub"
        
        'Присвоим команде созданный скрипт
        Cmd.Command = Script 
        'В логах отладчика выводим идентификатор
        ThisApplication.DebugPrint("Идентификатор новой команды - " & Cmd.Handle)
End Sub
'======================================================================
 
© 2023 CSoft Development. Все права защищены.