Схематическое отображение корреспонденции счетов с помощью GraphViz

Option Explicit
Sub gvPrepareCorrespondence
 
  ' 1) установить GraphViz с сайта http://www.graphviz.org/
  ' 2) выполнить скрипт
  ' 3) запустить команду для генерации схемы:
  '
  '    dot -Tpng input_file.gv -o output_file.png
  
  Const fmCreate = &HFFFF&
 
  ' имя файла со сгенерированным скриптом
  Const FileName = "c:\golden\ns\test\test.gv"
 
  Dim out, FS, Creator, nodeID, nodeName, dict, nodeColor, ctNode, dtNode, nodeShape
 
  Set dict = CreateObject("Scripting.Dictionary")
  Set Creator = New TCreator
  Set out = Creator.GetObject(nil, "TMemoryStream", "")
  nodeID = 0
 
  ' параметры построения графа. см документацию на сайте
  out.WriteLn("digraph chart {")
  out.WriteLn("overlap=scale;")
  out.WriteLn("splines=true;")
  out.WriteLn("fontsize=12;")
  out.WriteLn("rankdir=""LR"";")
  out.WriteLn("graph [fontname=""Verdana""];")
  out.WriteLn("node [fontname=""Verdana""];")
  out.WriteLn("edge [fontname=""Verdana""];")
 
  Dim q
  Set q = Creator.GetObject(nil, "TIBSQL", "")
  q.Transaction = gdcBaseManager.ReadTransaction
  '***********************************************************************
  '
  '  Откоментируйте участок ниже, если на граф надо вынести все
  '  счета и субсчета из плана счетов. Даже если они не участвуют
  '  в проводках.
  '
  '  План счетов задается по имени. Непосредственно в запросе.
  '
  '  q.SQL.Text = _
  '    "SELECT " & _
  '    "  prnt.alias AS prnt, " & _
  '    "  acc.alias, " & _
  '    "  acc.activity, " & _
  '    "  prnt.ACCOUNTTYPE AS prnt_type, " & _
  '    "  acc.ACCOUNTTYPE " & _
  '    "FROM " & _
  '    "  ac_account acc " & _
  '    "  LEFT JOIN ac_account prnt " & _
  '    "    ON acc.parent = prnt.id " & _
  '    "  JOIN ac_account chart " & _
  '    "    ON chart.lb <= acc.lb AND chart.rb >= acc.rb " & _
  '    "WHERE " & _
  '    "  chart.alias = 'План счетов' " & _
  '    "  AND ( " & _
  '    "    prnt.accounttype = 'F' " & _
  '    "    OR " & _
  '    "    EXISTS (SELECT * FROM ac_entry WHERE accountkey = acc.id) " & _
  '    "  ) "
  '
  '  q.ExecQuery
  '
  '  While Not q.EOF
  '    if q.FieldByName("prnt_type").AsString <> "F" then
  '      out.WriteLn("""" + q.FieldByName("alias").AsString + """->""" + q.FieldByName("prnt").AsString + """;")
  '    elseif q.FieldByName("accounttype").AsString <> "F" then
  '      out.WriteLn("""" + q.FieldByName("alias").AsString + """;")
  '    end if
  '    q.Next
  '  WEnd
  '***********************************************************************

  q.Close
  q.SQL.Text = _
    "SELECT " & _
    "  acc_d.alias AS dt, " & _
    "  acc_d.activity AS dt_activity, " & _
    "  acc_c.alias AS ct, " & _
    "  acc_c.activity AS ct_activity, " & _
    "  tr.name AS opname, " & _
    "  /* IIF(dt.name = 'Хозяйственная операция', tr.name, dt.name || '/' || tr.name) AS opname, */" & _
    "  SUM(e_d.debitncu) AS sumd, " & _
    "  SUM(e_c.creditncu) AS sumc " & _
    "FROM " & _
    "  ac_entry e_d JOIN ac_entry e_c " & _
    "    ON e_d.recordkey = e_c.recordkey " & _
    "      AND e_d.ID <> e_c.ID " & _
    "  JOIN gd_document d " & _
    "    ON d.id = e_c.masterdockey " & _
    "  JOIN gd_documenttype dt " & _
    "    ON dt.id = d.documenttypekey " & _
    "  JOIN ac_account acc_c " & _
    "    ON e_c.accountkey = acc_c.id " & _
    "  JOIN ac_account acc_d " & _
    "    ON e_d.accountkey = acc_d.id " & _
    "  JOIN ac_record r " & _
    "    ON r.id = e_d.recordkey " & _
    "  JOIN ac_transaction tr " & _
    "    ON r.transactionkey = tr.id " & _
    "  JOIN ac_account chart " & _
    "    ON chart.lb <= acc_c.lb AND chart.rb >= acc_c.rb " & _
    "WHERE " & _
    "  e_d.ACCOUNTPART = 'D' " & _
    "  AND " & _
    "  e_c.ACCOUNTPART = 'C' " & _
    "  AND " & _
    "  chart.name = 'План счетов' " & _
    "  AND " & _
    "  tr.name <> 'Проводки за прошлые года' " & _
    "  /* AND (acc_d.alias = '51' OR acc_c.alias = '51') */" & _
    "GROUP BY " & _
    "  1, 2, 3, 4, 5 "
 
  '***********************************************************************
  '
  '  Откоментируйте код ниже, если надо построить только корреспонденцию
  '  одного счета. В примере приведен 51-й счет.
  '
  '  q.ExecQuery
  '  While Not q.EOF
  '    If q.FieldByName("dt").AsString = "51" Then
  '      out.WriteLn("""" + q.FieldByName("ct").AsString + """ [rank=0];")
  '    End If
  '    q.Next
  '  WEnd
  '
  '  out.WriteLn("""51"" [rank=1];")
  '
  '  q.Close
  '  q.ExecQuery
  '  While Not q.EOF
  '    If q.FieldByName("ct").AsString = "51" Then
  '      out.WriteLn("""" + q.FieldByName("dt").AsString + """ [rank=2];")
  '    End If
  '    q.Next
  '  WEnd
  '  q.Close
  '***********************************************************************

  q.ExecQuery
  While Not q.EOF
    nodeID = nodeID + 1
    nodeName = "opnode" & nodeID
    out.WriteLn(nodeName & " [shape=box style=filled fillcolor=bisque label=""" & _
      "Д" & q.FieldByName("dt").AsString & "-" & _
      "К" & q.FieldByName("ct").AsString & " " & _
      Replace(q.FieldByName("opname").AsString, """", "") & """];")
 
    ctNode = q.FieldByName("ct").AsString
    While Len(ctNode) < 12
      ctNode = " " & ctNode & " "
    WEnd
    ctNode = """" & ctNode & """"
 
    dtNode = q.FieldByName("dt").AsString
    While Len(dtNode) < 12
      dtNode = " " & dtNode & " "
    WEnd
    dtNode = """" & dtNode & """"
 
    If Not dict.Exists(q.FieldByName("ct").AsString) Then
      dict.Add q.FieldByName("ct").AsString, 1
      If q.FieldByName("ct_activity").AsString = "A" Then
        nodeColor = "gold"
      ElseIf q.FieldByName("ct_activity").AsString = "B" Then
        nodeColor = "orchid"
      Else
        nodeColor = "cyan"
      End If
      If InStr(q.FieldByName("ct").AsString, ".") > 0 Then
        nodeShape = "circle"
      Else
        nodeShape = "doublecircle"
      End If
      out.WriteLn(ctNode & " [shape=" & nodeShape & " style=filled fillcolor=" & nodeColor & "];")
    End If
 
    If Not dict.Exists(q.FieldByName("dt").AsString) Then
      dict.Add q.FieldByName("dt").AsString, 1
      If q.FieldByName("dt_activity").AsString = "A" Then
        nodeColor = "gold"
      ElseIf q.FieldByName("dt_activity").AsString = "B" Then
        nodeColor = "orchid"
      Else
        nodeColor = "cyan"
      End If
      If InStr(q.FieldByName("dt").AsString, ".") > 0 Then
        nodeShape = "circle"
      Else
        nodeShape = "doublecircle"
      End If
      out.WriteLn(dtNode & " [shape=" & nodeShape & " style=filled fillcolor=" & nodeColor & "];")
    End If
 
    If q.FieldByName("dt_activity").AsString = "A" Then
      out.WriteLn(ctNode & "->" + nodeName + ";")
      out.WriteLn(nodeName & "->" & dtNode & ";")
    Else
      out.WriteLn(dtNode & "->" + nodeName + ";")
      out.WriteLn(nodeName & "->" & ctNode & ";")
    End If
    q.Next
  WEnd
 
  out.WriteLn("}")
 
  Set FS = Creator.GetObject(Array(FileName, fmCreate), "TFileStream", "")
  Call System.WIN1251ToUTF8(out, FS)
 
End Sub