' v 1.0.0 Const NUMERATOR_ID = "{8851DE5C-3CB9-427B-B4BD-43AC9190E7B6}" Function DoEvent(UserSession, CardFrame, CardData, ActivateFlags, ModeID, FolderID) DoEvent = 2 Dim NumberText NumberText = GetProp(CardData, "Номер запроса", Null) If Not (IsNull(NumberText) Or NumberText = vbNullString) Then Exit Function Dim Number, NumberID, Fmt, GotNumber, IsOk GotNumber = GetNumber(UserSession, NUMERATOR_ID, Number, NumberID, Fmt) If GotNumber Then NumberText = FormatStr("{0}", Array( _ FormatNum("0000", Number))) ', GetDeptCode(UserSession, CardData, NUMERATOR_ID, IsOk))) SetProp CardData, "Номер запроса", NumberText, NumberText End If End Function ' Получение кода подразделения Function GetDeptCode(UserSession, CardData, NumeratorID, IsOk) GetDeptCode = vbNullString Dim DeptID, Numerators If CardData.Type.Alias = "CardOrd" Then DeptID = MainInfo(CardData).Value("RecipientDep") ElseIf CardData.Type.Alias = "CardOut" Then DeptID = MainInfo(CardData).Value("SenderDep") ElseIf CardData.Type.Alias = "CardInc" Then DeptID = MainInfo(CardData).Value("RecipientDep") End If If Not IsNull(DeptID) Then Set Numerators = Sect(RefNumerators(UserSession), "Numerators") Dim Row: Set Row = Nothing On Error Resume Next Set Row = Numerators.GetRow(NumeratorID) On Error GoTo 0 If Not Row Is Nothing Then Dim Depts, DeptRow Set Depts = SubSect(Row, "Departments") For Each DeptRow In Depts.Rows If DeptRow.Value("DepartmentID") = DeptID Then GetDeptCode = DeptRow.Value("NumberSuffix") Exit Function End If Next End If End If IsOk = True If GetDeptCode = vbNullString Then MsgBox "Код подразделения не определен", vbOKOnly Or vbExclamation, "Передупреждение" IsOk = False End If End Function ' Получение первой буквы фамилии отправителя Function GetSenderLetter(CardData, IsOk) Dim SenderLastName SenderLastName = MainInfo(CardData).Value("Sender_LName") If IsNull(SenderLastName) Then SenderLastName = MainInfo(CardData).Value("SenderName") End If If IsNull(SenderLastName) Then GetSenderLetter = vbNullString Else GetSenderLetter = Mid(SenderLastName, 1, 1) End If IsOk = True If GetSenderLetter = vbNullString Then MsgBox "Не задан отравитель", vbOKOnly Or vbExclamation, "Передупреждение" IsOk = False End If End Function ' Дополнить число нулями Function FormatNum(FmtString, Num) Dim S: S = FmtString & Num FormatNum = Mid(S, Len(S) - Len(FmtString) + 1) End Function ' Форматное преобразование строки Function FormatStr(FmtString, Pars()) Dim I, Marker FormatStr = FmtString For I = LBound(Pars) To UBound(Pars) Marker = "{" & CStr(I) & "}" FormatStr = Replace(FormatStr, Marker, Pars(I)) Next End Function ' Получить номер из указанного нумератора и указанной зоны Function GetNumber(UserSession, NumeratorID, OutNumber, OutNumberID, Fmt) Dim Numerators Set Numerators = Sect(RefNumerators(UserSession), "Numerators") Dim Row: Set Row = Nothing On Error Resume Next Set Row = Numerators.GetRow(NumeratorID) On Error GoTo 0 If Not Row Is Nothing Then Dim Numerator, Zone Set Numerator = UserSession.CardManager.Card(Row.Value("NumeratorID")) Fmt = Row.Value("NumberFormat") Set Zone = Nothing On Error Resume Next Set Zone = Numerator.Zones.GetByName("Y" & CStr(Year(Date))) On Error GoTo 0 If Not Zone Is Nothing Then OutNumber = Zone.GetNumber(StaffObject(UserSession).GetCurrentUserID) OutNumberID = Zone.GetNumberID(OutNumber) GetNumber = True Exit Function End If End If GetNumber = False End Function ' Получение StaffObject Function StaffObject(UserSession) Set StaffObject = CreateObject("TOHelperObjects.StaffObject") Set StaffObject.UserSession = UserSession End Function ' Универсальный справочник Function RefUniversal(UserSession) Set RefUniversal = UserSession.CardManager.DictionaryData("{B2A438B7-8BB3-4B13-AF6E-F2F8996E148B}") End Function ' Справочник нумераторов Function RefNumerators(UserSession) Set RefNumerators = UserSession.CardManager.DictionaryData("{D4491E04-F030-4798-BD11-7912C0CA6714}") End Function ' Получение секции карточки по имени Function Sect(CardData, Alias) Set Sect = CardData.Sections(CardData.Type.AllSections.GetByAlias(Alias).ID) End Function ' Получение подчиненной секции по имени Function SubSect(RowData, Alias) Set SubSect = RowData.ChildSections(RowData.Section.Type.ChildSections.GetByAlias(Alias).ID) End Function ' Нулевая строка секции MainInfo Function MainInfo(CardData) Set MainInfo = Sect(CardData, "MainInfo").FirstRow End Function ' Строка свойства Function Prop(CardData, Alias) Set Prop = Nothing Dim Row: For Each Row In Sect(CardData, "Properties").Rows If Row.Value("Name") = Alias Then Set Prop = Row Exit Function End If Next End Function ' Получение значения свойства Function GetProp(CardData, Alias, DefaultValue) Dim Row: Set Row = Prop(CardData, Alias) If Row Is Nothing Then GetProp = DefaultValue Else GetProp = Row.Value("Value") If IsNull(GetProp) Then GetProp = DefaultValue End If End Function ' Установка значения свойства Sub SetProp(CardData, Alias, Value, DisplayValue) Prop(CardData, Alias).Value("Value") = Value Prop(CardData, Alias).Value("DisplayValue") = DisplayValue End Sub