Текущий статус объекта.
Read-write свойство
Visual Basic |
---|
Public Property Status As TDMSStatus |
Изменение текущего статуса приведет к автоматическому изменению значения свойства StatusName Свойство.
VB Script (Visual Basic) | ![]() |
---|---|
Option Explicit Call ChangeStatus(ThisObject) '============================================================================== 'Изменить текущий статус объекта на указанный пользователем. '============================================================================== Sub ChangeStatus(Obj) Dim FinalStat, Stat, ChildObj, i, SelDlg, RetVal, ChosenSts 'Заполнить массив ссылками на допустимые статусы объекта (кроме текущего) i=-1 For Each Stat In Obj.ObjectDef.Statuses If Stat.SysName <> Obj.Status.SysName Then i=i+1 ReDim Preserve ArStatus(i) Set ArStatus(i) = Stat End If Next 'Открыть диалог выбора, передав на вход массив допустимых статусов Set SelDlg = ThisApplication.Dialogs.SelectDlg SelDlg.SelectFrom = ArStatus SelDlg.Caption = "Статусы объекта" SelDlg.Prompt = "Выберите статус для установки:" RetVal = SelDlg.Show 'Если пользователь отменил диалог или выбрал не один статус, выйти из процедуры If (Not RetVal) Or (UBound(SelDlg.Objects)<>0) Then Exit Sub 'Получить ссылку на выбранный статус ChosenSts = SelDlg.Objects Set Stat = ChosenSts(0) 'Если статус - конечный, то для его установки все объекты состава также должны 'иметь конечный статус. If Stat.Final Then 'Проверяем все объекты состава For Each ChildObj In Obj.Content If ChildObj.Status.Final<>TRUE Then MsgBox "Смена статуса на конечный невозможна" & Chr(13) &_ "(не все объекты состава имеют конечный статус.)", vbExclamation Exit Sub End If Next End If 'Включим собственный перехват ошибок On Error Resume Next 'Пробуем сменить статус объекта. Obj.Permissions = SysAdminPermissions Obj.Status = Stat 'Выводим первый комментарий и описание, если есть. В логах отладчика выводим идентификатор If Stat.Comments.Count <> 0 Then MsgBox "Комментарии нового статуса: " & Chr(13) & Stat.Comments(0).Text If Stat.Description <> "" Then MsgBox "Описание нового статуса: " & Chr(13) & Stat.Description ThisApplication.DebugPrint("Идентификатор нового статуса - " & Stat.Handle) 'Если была ошибка... If Err<>0 Then MsgBox "Ошибка смены статуса " & StrSysName & "." &_ Chr(13) & "Код ошибки: " & Err, vbExclamation End Sub '============================================================================== |