Attribute VB_Name = "DocumentProcessor"
'=====================================
'==== Модуль обработки документов ====
'=====================================
Option Explicit

Public Const Style0A = "НПА_01 Ссылка на внешний документ"

Public Const Style10 = "НПА_02 Ссылка не обработана"
Public Const Style11 = "НПА_03 Аспектирование"
Public Const Style12 = "НПА_04 Обоснование"
Public Const Style13 = "НПА_05 Конкретизация"

Public Const Style20 = "НПА_02 Ссылка не обработана"
Public Const Style21 = "НПА_03 Аспектирование"
Public Const Style22 = "НПА_04 Обоснование"
Public Const Style23 = "НПА_05 Конкретизация"

Public Const Style30 = "НПА_02 Ссылка не обработана"
Public Const Style31 = "НПА_03 Аспектирование"
Public Const Style32 = "НПА_04 Обоснование"
Public Const Style33 = "НПА_05 Конкретизация"

Public Const Style4A = "НПА_06 Игнорируемый внешний документ"

Public Const STYLE_KEY_PREFIX = "Style"
Public Const STYLE_KEY_FAIL_POSTFIX = "A"

Public Enum TLinkSystem
  PT_INVALID = -1
  PT_LOCAL = 1
  PT_MOBILE = 2
  PT_INTERNET = 3
End Enum

Public Const DEFAULT_LINK_SYSTEM = TLinkSystem.PT_INTERNET

Public Function GetAllLinkStyles() As Collection
  Static s_Styles As Collection
  If Not s_Styles Is Nothing Then
    Set GetAllLinkStyles = s_Styles
    Exit Function
  End If
  
  Set s_Styles = New Collection
  With s_Styles
    Call .Add(Style0A, "Style0A")
    
    Call .Add(Style10, "Style10")
    Call .Add(Style11, "Style11")
    Call .Add(Style12, "Style12")
    Call .Add(Style13, "Style13")
    
    Call .Add(Style20, "Style20")
    Call .Add(Style21, "Style21")
    Call .Add(Style22, "Style22")
    Call .Add(Style23, "Style23")
    
    Call .Add(Style30, "Style30")
    Call .Add(Style31, "Style31")
    Call .Add(Style32, "Style32")
    Call .Add(Style33, "Style33")
    
    Call .Add(Style4A, "Style4A")
  End With
  Set GetAllLinkStyles = s_Styles
End Function

Public Function IsHyperlinkValid(target As Word.Hyperlink) As Boolean
  IsHyperlinkValid = Not ParseHyperlink(target) Is Nothing
End Function

Public Function GetFirstValidHyperlinkIn(target As Word.Range) As Word.Hyperlink
  Dim docHLink As Word.Hyperlink
  For Each docHLink In target.Hyperlinks
    If IsHyperlinkValid(docHLink) Then
      Set GetFirstValidHyperlinkIn = docHLink
      Exit Function
    End If
  Next docHLink
End Function

Public Function ScanLawIDs(target As Word.Range) As Scripting.Dictionary
  Dim docs As New Scripting.Dictionary
  
  Dim docHLink As Word.Hyperlink
  Dim iLink As ItemHyperlink
  For Each docHLink In target.Hyperlinks
    Set iLink = ParseHyperlink(docHLink)
    If Not iLink Is Nothing Then
      Dim targetID&: targetID = iLink.DocumentID
      If Not docs.Exists(targetID) Then _
        Call docs.Add(targetID, 0)
    End If
  Next docHLink
  
  Set ScanLawIDs = docs
End Function

Public Function PrepareDocumentText(doc As Word.Document, iMods As ItemDocumentModification)
  If iMods.deleteRevision_ Then
    On Error Resume Next
    With doc.Content.Find
      .ClearFormatting
      .Format = True
      .Text = vbNullString
      .Replacement.Text = vbNullString
      .wrap = wdFindContinue
      .Style = "Информация об изменениях документа"
      .Execute Replace:=wdReplaceAll
    
    On Error Resume Next
      .ClearFormatting
      .Format = False
      .Text = "Информация об изменениях:?"
      .MatchWildcards = True
      .Replacement.Text = vbNullString
      .wrap = wdFindContinue
      .Execute Replace:=wdReplaceAll
    
    On Error Resume Next
      .ClearFormatting
      .Format = True
      .Text = vbNullString
      .Replacement.Text = vbNullString
      .wrap = wdFindContinue
      .Style = "Информация о версии"
      .Execute Replace:=wdReplaceAll
    On Error GoTo 0
    
    End With
  End If
  
  If iMods.deleteComment_ Then
    Call DeleteLinksByText(doc, "комментари[ий]")
    Call DeleteLinksByText(doc, "[Уу]тратил силу")
    Call DeleteLinksByText(doc, "[Уу]тратил[иоа] силу")
  End If
  
  If iMods.deleteImages_ Then
    Dim iShp As Word.InlineShape
    Do While doc.InlineShapes.Count > 0
      Set iShp = doc.InlineShapes.Item(1)
      Dim pasteRange As Word.Range: Set pasteRange = iShp.Range.Duplicate
      Call pasteRange.Collapse(wdCollapseStart)
      Call iShp.Delete
      pasteRange.Text = "[изображение удалено]"
      pasteRange.Font.Bold = True
    Loop
  End If
End Function

Public Function CreateBookmarkFor(target As Word.Range) As String
  Dim bmCount&: bmCount = target.Document.Bookmarks.Count
  Dim newName$: newName = "lnk_" & CStr(bmCount + 1)
  Do While target.Document.Bookmarks.Exists(newName)
    bmCount = bmCount + 1
    newName = "lnk_" & CStr(bmCount)
  Loop
  
  Call target.Bookmarks.Add(newName)
  CreateBookmarkFor = newName
End Function

Public Function GetLinkStatusStyle(sSource As TLawStatus, sDestination As TLawStatus, nType As TLinkType) As String
  Dim sStyle$: sStyle = STYLE_KEY_PREFIX
  If sDestination = T_LAWS_IGNORE _
      Or sSource = T_LAWS_OUTER _
      Or (sSource = T_LAWS_FRINGE And sDestination = T_LAWS_NOTDEFINED) Then
    sStyle = sStyle & CStr(T_LAWS_IGNORE) & STYLE_KEY_FAIL_POSTFIX
  Else
    sStyle = sStyle & CStr(sDestination) & IIf(sDestination = T_LAWS_NOTDEFINED, STYLE_KEY_FAIL_POSTFIX, CStr(nType))
  End If
  
  If InCollection(sStyle, GetAllLinkStyles) Then
    GetLinkStatusStyle = GetAllLinkStyles.Item(sStyle)
  Else
    GetLinkStatusStyle = "Обычный"
  End If
End Function

' =======
Private Function DeleteLinksByText(aDoc As Word.Document, sMask$)
  Dim hLink As Word.Hyperlink
  Dim i&: i = aDoc.Hyperlinks.Count
  Do While i > 0
    Set hLink = aDoc.Hyperlinks(i)
    If hLink.TextToDisplay Like sMask Then _
      hLink.Delete
    i = i - 1
  Loop
End Function
