Парсер формата в одну строку.
Добрый день, уважаемые коллеги.
К сожалению, язык форматирования ИРБИС 64 сложно назвать легкочитаемым - особенно для новичков. Положение усугубляется тем, что вся конструкция зачастую укладывается в одну строку (например в стат.формах)
Решением проблемы стал макрос для MS Word - он разносит отделенные запятыми строчки а так же выстраивает вложенные конструкции if классической иерархической елочкой с табуляцией. Программка решает задачу в лоб, написано на скорую руку и не является идеальным решением. Но зато работает. :)
Макрос использует дополнительную функцию для генерирования спецсимволов.
Также разработан макрос для обратной свертки в одну строку.
Алгоритм примерно такой:
0. Добавить макросы в Normal.dotm
1. Строку скопировали
2. Вставили в любой Документ WORD
3. Выделили строку
4. Вызвали макрос - результат заменит собою. строку и будет в буфере обмена
5. Вставили в редактор форматов.
Примечание: Если в обычных редакторах елочка строится табуляцией, то редактор Ирбиса не считает символ табуляции валидным, т.к. в самом редакторе табуляция подменяется 8-ью пробелами. Поэтому генератор вместо табуляции также добавляет пробелы.
P.S. Если разработчики добавят подобный функционал в свой редактор, будет просто великолепно.
Sub ИРБИС64_Формат_из_строки()
'
' ИРБИС64_Формат_из_строки Макрос
' Из строки в нормальный вид с табуляцией
'
Dim mOut As String
Dim mBuf As String
Dim b As String
Dim mreg(1 To 6) As Integer ' if, then, else, uf, () , tab
Dim mInp As Variant
mInp = Selection.Text
mBuf = CStr(mInp)
q = Len(mBuf)
For i = 1 To q
b = Mid(mInp, i, 1)
Select Case b
Case "i"
If Mid(mInp, i, 2) = "if" Then
mreg(1) = mreg(1) + 1
mOut = mOut + genSS(1, 1) + genSS(2, mreg(6)) + b
Else
mOut = mOut + b
End If
Case "f"
If Mid(mInp, i, 2) = "fi" Then
mreg(6) = mreg(6) - 1
If mreg(1) > 0 Then mreg(1) = mreg(1) - 1
If mreg(2) > 0 Then mreg(2) = mreg(2) - 1
If mreg(3) > 0 Then mreg(3) = mreg(3) - 1
mOut = mOut + genSS(1, 1) + genSS(2, mreg(6)) + b
Else
mOut = mOut + b
End If
Case "t"
If Mid(mInp, i, 4) = "then" Then
mreg(6) = mreg(6) + 1
mreg(2) = mreg(2) + 1
mOut = mOut + genSS(1, 1) + genSS(2, mreg(6)) + b
Else
mOut = mOut + b
End If
Case "e"
If Mid(mInp, i, 4) = "else" Then
mreg(3) = mreg(3) + 1
mOut = mOut + genSS(1, 1) + genSS(2, mreg(6)) + b
Else
mOut = mOut + b
End If
Case "&"
If Mid(mInp, i, 2) = "&u" Then
mOut = mOut + b
Else
mOut = mOut + b
End If
Case "("
mreg(5) = mreg(5) + 1
mOut = mOut + b
Case ")"
mreg(5) = mreg(5) - 1
mreg(4) = 0
mOut = mOut + b
Case ","
If mreg(1) + mreg(2) + mreg(3) + mreg(4) + mreg(5) = 0 Then mOut = mOut + b + genSS(1, 1) Else mOut = mOut + b
Case Else
mOut = mOut + b
End Select
Next i
Selection.Delete
Selection.InsertAfter (mOut)
Selection.Copy
End Sub
Private Function genSS(tType As Integer, mN As Integer) As String
Dim mbuffer As String
Select Case tType
Case 1
mbuffer = vbCrLf
Case 2
mbuffer = " "
End Select
For i = 1 To mN
genSS = genSS + mbuffer
Next i
End Function
Sub ИРБИС64_Формат_в_строку()
'
' ИРБИС64_Формат_в_строку Макрос
' Из елочки в одну строку
'
Dim mOut As String
Dim mBuf As String
Dim b As String
Dim mInp As Variant
mInp = Selection.Text
mBuf = CStr(mInp)
q = Len(mBuf)
For i = 2 To q
b = Mid(mInp, i, 1)
If b = vbTab Or b = vbCr Then b = " "
If b = " " And Mid(mInp, i - 1, 1) = " " Then Else mOut = mOut + b
Next i
Selection.Delete
Selection.InsertAfter (mOut)
Selection.Copy
End Sub