结构分析.frm

本程序是用来计算系统工程当中结构分析的。

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   8595
   ClientLeft      =   195
   ClientTop       =   450
   ClientWidth     =   11550
   LinkTopic       =   "Form1"
   ScaleHeight     =   8595
   ScaleWidth      =   11550
   Begin VB.PictureBox Picture3 
      Height          =   3255
      Left            =   8400
      ScaleHeight     =   3195
      ScaleWidth      =   3195
      TabIndex        =   12
      Top             =   3960
      Width           =   3255
   End
   Begin VB.PictureBox Picture2 
      AutoRedraw      =   -1  'True
      Height          =   3255
      Left            =   4200
      ScaleHeight     =   3195
      ScaleWidth      =   4155
      TabIndex        =   11
      Top             =   3960
      Width           =   4215
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   3255
      Left            =   0
      ScaleHeight     =   3195
      ScaleWidth      =   4155
      TabIndex        =   10
      Top             =   3960
      Width           =   4215
   End
   Begin VB.PictureBox Picture4 
      AutoRedraw      =   -1  'True
      Height          =   855
      Left            =   120
      ScaleHeight     =   795
      ScaleWidth      =   8115
      TabIndex        =   9
      Top             =   7800
      Width           =   8175
   End
   Begin VB.TextBox T2 
      Height          =   300
      Index           =   0
      Left            =   120
      TabIndex        =   8
      Text            =   "0"
      Top             =   3240
      Width           =   400
   End
   Begin VB.CommandButton Rearray 
      Caption         =   "元素重排"
      Height          =   495
      Left            =   9120
      TabIndex        =   6
      Top             =   2400
      Width           =   1215
   End
   Begin VB.CommandButton Shuchu1 
      Caption         =   "要素关系"
      Height          =   495
      Left            =   7920
      TabIndex        =   5
      Top             =   2400
      Width           =   1215
   End
   Begin VB.CommandButton Shuru 
      Caption         =   "确定"
      Height          =   495
      Left            =   7920
      TabIndex        =   4
      Top             =   1440
      Width           =   1215
   End
   Begin VB.CommandButton Shuchu 
      Caption         =   "输出关系"
      Height          =   495
      Left            =   9120
      TabIndex        =   3
      Top             =   1920
      Width           =   1215
   End
   Begin VB.CommandButton Qiu 
      Caption         =   "求可达矩阵　"
      Height          =   495
      Left            =   7920
      TabIndex        =   2
      Top             =   1920
      Width           =   1215
   End
   Begin VB.CommandButton Reinput 
      Caption         =   "重新输入"
      Height          =   495
      Left            =   9120
      TabIndex        =   1
      Top             =   1440
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   9360
      TabIndex        =   0
      Text            =   "14"
      Top             =   1080
      Width           =   855
   End
   Begin VB.Label Label4 
      Caption         =   "R(si)A(si)"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   8760
      TabIndex        =   16
      Top             =   3720
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "A(si)"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4440
      TabIndex        =   15
      Top             =   3720
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "R(si)"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   14
      Top             =   3720
      Width           =   735
   End
   Begin VB.Label Label5 
      Caption         =   "要素关系"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   13
      Top             =   7440
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "输入元素的个数（默认为14）"
      Height          =   375
      Left            =   7920
      TabIndex        =   7
      Top             =   1080
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Max As Integer
Dim A() As Integer
Dim B() As Integer
Dim C() As Integer
Dim R() As Integer
Dim Asi() As Integer
Dim RA() As Integer
Dim T() As Integer
Private Sub Form_Load()
Qiu.Enabled = False
Shuchu.Enabled = False
Shuchu1.Enabled = False
Rearray.Enabled = False
Reinput.Enabled = False
T2(0).Visible = False
Label4.Visible = False
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
Label5.Visible = False
Picture1.Visible = False
Picture2.Visible = False
Picture3.Visible = False
Picture4.Visible = False
Me.Left = 200
Me.Top = 100
Me.Width = 12000
Me.Height = 10000
Me.Caption = "系统工程"
End Sub

Private Sub Qiu_Click()
Dim l, m, n As Integer
Dim k, flag As Integer
Max = Val(Text1.Text)
Shuchu.Enabled = True
ReDim A(1 To Max, 1 To Max)
ReDim B(1 To Max, 1 To Max)
For i = 1 To Max
  For j = 1 To Max
 T2((i - 1) * Max + j - 1).Visible = False
  A(i, j) = T2((i - 1) * Max + j - 1)
  B(i, j) = A(i, j)
 Next
 Next
flag = 1
Form1.Cls
For ii = 1 To 20
For g = 1 To Max
For i = 1 To Max
    For k = 1 To Max
    m = 0
        For l = 1 To Max
        m = m + B(i, l) * A(l, k)
        Next l
        If m >= 1 Then
        B(i, k) = 1
        Else
        B(i, k) = 0
        End If
    Next k
Next i
Next g
Next ii
For i = 1 To Max
    For j = 1 To Max
    Print B(i, j);
    Next
    Print
    Next
End Sub

Private Sub Rearray_Click()
Dim k As Integer
ReDim C(1 To Max, 1 To Max)
For i = 1 To Max
k = T(i)
If k = 0 Then Exit For
For j = 1 To Max
  C(i, j) = B(k, j)
  Next
Next
For i = 1 To Max
For j = 1 To Max
  B(i, j) = C(i, j)
  Next
Next
For i = 1 To Max
k = T(i)
If k = 0 Then Exit For
For j = 1 To Max
  C(j, i) = B(j, k)
  Next
Next
Form1.Cls
Form1.Refresh
For i = 1 To Max
For j = 1 To Max
  Form1.Print C(i, j);
  Next
  Print
Next
Rearray.Enabled = False
End Sub
Private Sub Reinput_Click()
Max = Text1.Text
For i = 1 To Max
  For j = 1 To Max
  If (i - 1) * 14 + j - 1 = 0 Then
  T2((i - 1) * 14 + j - 1).Visible = False
  Else
  Unload T2((i - 1) * Max + j - 1)
  End If
  Next
  Next
Qiu.Enabled = False
Shuru.Enabled = True
Shuchu.Enabled = False
Shuchu1.Enabled = False
Rearray.Enabled = False
T2(0).Visible = False
Label4.Visible = False
Label2.Visible = False
Label3.Visible = False
Label5.Visible = False
Picture1.Visible = False
Picture2.Visible = False
Picture3.Visible = False
Picture4.Visible = False
Reinput.Enabled = False
Form1.Cls
Text1.SetFocus
End Sub

Private Sub shuchu_Click()
Shuchu1.Enabled = True
Rearray.Enabled = True
ReDim R(1 To Max, 1 To Max)
ReDim Asi(1 To Max, 1 To Max)
ReDim RA(1 To Max, 1 To Max)
Form1.Cls
Picture1.Cls
Picture2.Cls
Picture3.Cls
Picture1.Visible = True
Picture2.Visible = True
Picture3.Visible = True
Label4.Visible = True
Label2.Visible = True
Label3.Visible = True
Picture1.Refresh
Picture2.Refresh
Picture3.Refresh
For i = 1 To Max
 For j = 1 To Max
 If B(i, j) = 1 Then R(i, j) = j: Picture1.Print j;
 If B(j, i) = 1 Then Asi(i, j) = j: Picture2.Print j;
 If B(i, j) = 1 And B(j, i) = 1 Then RA(i, j) = j: Picture3.Print j;
 Next
   Picture1.Print
   Picture2.Print
   Picture3.Print
 Next
 Shuchu.Enabled = False
End Sub

Private Sub Shuchu1_Click()
ReDim T(Max)
Dim k, m, n As Integer
Picture4.Visible = True
Picture4.Cls
Picture4.Refresh
Label5.Visible = True
n = 0
For ii = 1 To Max
For i = 1 To Max
  k = 0
  m = 0
  For j = 1 To Max
   If R(i, j) > 0 Then k = k + 1
   If RA(i, j) > 0 Then m = m + 1
   Next j
      If k = m Then
     For j = 1 To Max
      If R(i, j) = RA(i, j) And R(i, j) > 0 Then
      n = n + 1
       T(n) = R(i, j)
       Picture4.Print R(i, j);
       For l = 1 To Max
            R(l, j) = 0
            RA(l, j) = 0
          Next l
       End If
       Next j
       If n > Max Then Exit For
       If m And n < Max Then Picture4.Print ",";
   End If
Next i
Next ii
Shuchu1.Enabled = False
End Sub

Private Sub shuru_Click()
Qiu.Enabled = True
Reinput.Enabled = True
Shuru.Enabled = False
Max = Val(Text1.Text)
If Max > 1 Then
ReDim A(1 To Max, 1 To Max)
ReDim B(1 To Max, 1 To Max)
ReDim C(1 To Max, 1 To Max)
Label4.Visible = False
Label2.Visible = False
Label3.Visible = False
Picture1.Visible = False
Picture2.Visible = False
Picture3.Visible = False
'T2(0).Visible = True
Me.Caption = "系统工程"
With T2(0)
.Top = 3500
.Left = 1200
.Height = 300
.Width = 400
.Text = 0
End With
AddText
For i = 1 To Max
  For j = 1 To Max
 T2((i - 1) * Max + j - 1).Visible = True
 Next
 Next
T2(0).SetFocus
 T2(0).SelStart = 0
 T2(0).SelLength = Len(T2(0).Text)
 Else
 bb = MsgBox("输入的数据只能是0或1", vbOKOnly, "警告")
 Text1.SelStart = 0
     Text1.SelLength = Len(Text1.Text)
 End If
 End Sub
Private Sub AddText()
Dim i As Integer
Dim Num As Integer
Dim k As Integer
Dim n As Integer
Num = 0
k = 0
n = 0
T2(0).Text = 0
For i = 1 To Max * Max - 1
Num = Num + 1
Load T2(Num)
Select Case k
Case 0
T2(Num).Left = T2(Num - 1).Left + T2(0).Width + 30
If Num = Max Then n = n + 1: k = n
Case n
T2(n * Max).Left = T2(0).Left
T2(n * Max).Top = T2(0).Height * n + T2(0).Top
T2(Num).Top = T2(0).Height * n + T2(0).Top
T2(Num).Left = T2(Num - 1).Left + T2(0).Width + 30
If Num = (n + 1) * Max Then n = n + 1: k = n
End Select
T2(Num).Text = 0
T2(Num).Visible = True
Next
End Sub
Private Sub Text1_GotFocus()
     Text1.SelStart = 0
     Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub T2_KeyPress(Index As Integer, KeyAscii As Integer)
If Index < Max * Max - 1 Then
   If KeyAscii = 13 Then
      If Val(T2(Index).Text) = 0 Or Val(T2(Index).Text) = 1 Then
         T2(Index + 1).SetFocus
         T2(Index + 1).SelStart = 0
         T2(Index + 1).SelLength = Len(T2(Index).Text)
      Else
         T2(Index).SetFocus
         T2(Index).SelStart = 0
         T2(Index).SelLength = Len(T2(Index).Text)
      End If
    End If
End If
End Sub