Пошук мінімального кістяка графа (Visual Basic)
43

 

' -- Зображення вершин графа

For I = 1 To N

  Set Vert(I)= ActiveSheet.Shapes.AddShape(msoShapeOval, Xvert(I) _

  Yvert(I)+ YSdvig, 16, 16)

  Vert(I).TextFrame.Characters.Text = CStr(I)

  Vert(I).TextFrame.Characters.Font.Size = 10

  Vert(I).TextFrame.Characters.Font.Bold = True

Next I

 

' - Зображення ребер графа

For I = 1 To N - 1

  For J = I + 1 To N

    If Tree(I, J)<> 0 Then ' -- зображаємо тільки ті ребра, для яких

' зв'язок не рівний 0

  Set Sh = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 0, 0, 0, 0)

      With Sh.ConnectorFormat

           .BeginConnect ConnectedShape:=Vert(I), ConnectionSite:=1

           .EndConnect ConnectedShape:=Vert(J), ConnectionSite:=1

           Sh.RerouteConnections

      End With

 

' -   Зображення ваги поряд з відповідним ребром

      If Xvert(I)= Xvert(J) Then ' - дві вершини розташовано на одній

' вертикалі

      Set Sh = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal _

          (Xvert(I)+ Xvert(J)) / 2 - 5 (Yvert(I)+ Yvert(J)) / 2 + YSdvig, 60, 150)

      Else ' - дві вершини не розташовано на одній вертикалі

      Set Sh = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal _

          (Xvert(I)+ Xvert(J)) / 2 (Yvert(I)+ Yvert(J)) / 2 + YSdvig - 10, 60, 150)

      End If

      Sh.TextFrame.Characters.Text = CStr(Dis(I, J))

      Sh.TextFrame.Characters.Font.Size = 12