formknowledge.frm

用XML做专家系统的一个编译器,有说明书,使用简单,有模板

            Strikethrough   =   0   'False
         EndProperty
         Height          =   780
         ItemData        =   "FormKnowledge.frx":0008
         Left            =   2400
         List            =   "FormKnowledge.frx":000A
         TabIndex        =   6
         Top             =   1560
         Width           =   2055
      End
      Begin VB.CommandButton Command5 
         Caption         =   "删除对象"
         Height          =   375
         Left            =   5040
         TabIndex        =   5
         Top             =   1500
         Width           =   1095
      End
      Begin VB.CommandButton Command6 
         Caption         =   "删除属性"
         Height          =   375
         Left            =   5040
         TabIndex        =   4
         Top             =   2040
         Width           =   1095
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "对象"
         Height          =   195
         Left            =   240
         TabIndex        =   37
         Top             =   480
         Width           =   360
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "属性"
         Height          =   195
         Left            =   240
         TabIndex        =   36
         Top             =   840
         Width           =   360
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "对象列表"
         Height          =   195
         Left            =   240
         TabIndex        =   9
         Top             =   1320
         Width           =   720
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "属性列表"
         Height          =   195
         Left            =   2400
         TabIndex        =   8
         Top             =   1320
         Width           =   720
      End
   End
   Begin TabDlg.SSTab SSTab1 
      Height          =   6495
      Left            =   120
      TabIndex        =   38
      Top             =   0
      Width           =   6495
      _ExtentX        =   11456
      _ExtentY        =   11456
      _Version        =   393216
      TabOrientation  =   1
      Style           =   1
      Tabs            =   2
      TabHeight       =   564
      TabCaption(0)   =   "文档编辑   "
      TabPicture(0)   =   "FormKnowledge.frx":000C
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).ControlCount=   0
      TabCaption(1)   =   "文档预览  "
      TabPicture(1)   =   "FormKnowledge.frx":0028
      Tab(1).ControlEnabled=   0   'False
      Tab(1).ControlCount=   0
   End
End
Attribute VB_Name = "FormKnowledge"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim newobject As Integer
Dim countx As Integer
Dim county As Integer
Dim countrule As Integer
Dim countif As Integer
Dim countthen As Integer
Dim ObjectIndex As Integer '用来标识当前显示的对象

Dim IfIndex As Integer     '用来标识当前选择的规则前提
Dim IfSel As Boolean       '用来标识当前是否选择规则结论
Dim ThenIndex As Integer   '用来标识当前选择的规则结论
Dim ThenSel As Boolean     '用来标识当前是否选择规则前提

Dim ObjectRIndex As Integer '用来标识规则前提或结论所用的对象
Dim AttRIndex As Integer   '用来标识规则前提或结论所用的对象的属性
Dim RuleIndex As Integer   '用来标识当前显示的规则
Dim HasRule(20) As Boolean
Dim RuleSel As Boolean     '用来标识是否选择了规则，以备删除规则所用
Dim ObjSel As Boolean      '用来标识插入规则前提或结论时是否选择了对象
Dim AttSel As Boolean      '用来标识插入规则前提或结论时是否选择了对象相应的属性
Dim ObjectIni As Boolean

Private Function SearchLastRName() As Integer
Dim i As Integer
Dim Index As Integer
i = 0
Do
If (Not RuleNameArray(ObjectIndex, i) = "") Then
 i = i + 1
Else
Exit Do
End If
Loop
If i >= 1 Then
 Index = CInt(RuleNameArray(ObjectIndex, i - 1))
Else
 Index = 1
End If
SearchLastRName = Index
End Function

Private Sub ExchangeData(ByVal Index As Integer)
For i = 0 To 50
 AttributeArray(Index, i) = AttributeArray(Index + 1, i)
Next

For i = 0 To 50
 For j = 0 To 50
  RuleArray(Index, i, 0, j, 0) = RuleArray(Index + 1, i, 0, j, 0)
  RuleArray(Index, i, 0, j, 1) = RuleArray(Index + 1, i, 0, j, 1)
  RuleArray(Index, i, 0, j, 2) = RuleArray(Index + 1, i, 0, j, 2)
  RuleArray(Index, i, 0, j, 3) = RuleArray(Index + 1, i, 0, j, 3)
  RuleArray(Index, i, 1, j, 0) = RuleArray(Index + 1, i, 1, j, 0)
  RuleArray(Index, i, 1, j, 1) = RuleArray(Index + 1, i, 1, j, 1)
  RuleArray(Index, i, 1, j, 2) = RuleArray(Index + 1, i, 1, j, 2)
  RuleArray(Index, i, 1, j, 3) = RuleArray(Index + 1, i, 1, j, 3)
 Next
Next
End Sub

Private Sub AttributeList_Click()
RuleAttText.Text = AttributeArray(ObjectRIndex, AttributeList.ListIndex)
AttRIndex = AttributeList.ListIndex
AttSel = True
End Sub

Private Sub Command2_Click() '添加if
If HasRule(ObjectIndex) = False Then
 MsgBox "必须先建立规则！", vbOKOnly, "注意！"
Else
 If RuleObjText.Text = "" Or RuleAttText.Text = "" Or RRelationText.Text = "" Or RValueText.Text = "" Then
  MsgBox "对象、属性、规则关系和值均不能为空！", vbOKOnly, "注意！"
 Else
  RuleArray(ObjectIndex, RuleIndex, 0, countif, 0) = RuleObjText.Text
  RuleArray(ObjectIndex, RuleIndex, 0, countif, 1) = RuleAttText.Text
  RuleArray(ObjectIndex, RuleIndex, 0, countif, 2) = RRelationText.Text
  RuleArray(ObjectIndex, RuleIndex, 0, countif, 3) = RValueText.Text
  IfList.AddItem RuleArray(ObjectIndex, RuleIndex, 0, countif, 0) & "." & RuleArray(ObjectIndex, RuleIndex, 0, countif, 1) & RuleArray(ObjectIndex, RuleIndex, 0, countif, 2) & RuleArray(ObjectIndex, RuleIndex, 0, countif, 3)
  countif = countif + 1
 End If
End If
ObjSel = False
AttSel = False
End Sub

Private Sub command3_Click() '添加then
If HasRule(ObjectIndex) = False Then
 MsgBox "必须先建立规则！", vbOKOnly, "注意！"
Else
 'If RuleObjText.Text = "" Or RuleAttText.Text = "" Or RRelationText.Text = "" Or RValueText.Text = "" Then
  'MsgBox "对象、属性、规则关系和值均不能为空！", vbOKOnly, "注意！"
 'Else
  RuleArray(ObjectIndex, RuleIndex, 1, countthen, 0) = RuleObjText.Text
  RuleArray(ObjectIndex, RuleIndex, 1, countthen, 1) = RuleAttText.Text
  RuleArray(ObjectIndex, RuleIndex, 1, countthen, 2) = RRelationText.Text
  RuleArray(ObjectIndex, RuleIndex, 1, countthen, 3) = RValueText.Text
  ThenList.AddItem RuleArray(ObjectIndex, RuleIndex, 1, countthen, 0) & "." & RuleArray(ObjectIndex, RuleIndex, 1, countthen, 1) & RuleArray(ObjectIndex, RuleIndex, 1, countthen, 2) & RuleArray(ObjectIndex, RuleIndex, 1, countthen, 3)
  'countthen = countthen + 1
 'End If
End If
ObjSel = False
AttSel = False
End Sub

Private Sub Command4_Click()
Dim Index As Integer
HasRule(ObjectIndex) = True
RuleIndex = countrule
If countrule = 0 Then
 Index = 1
Else
 Index = SearchLastRName() + 1
End If
countrule = countrule + 1
RuleNameArray(ObjectIndex, RuleIndex) = CStr(Index)
RuleList.AddItem RuleNameArray(ObjectIndex, RuleIndex)
IfList.Clear
ThenList.Clear
countif = 0
countthen = 0
RuleSel = False
End Sub

Private Sub Command5_Click() 'delete selected object
Dim i As Integer
Dim j As Integer
ObjectArray(ObjectList.ListIndex) = ""

For i = 0 To 50
 AttributeArray(ObjectList.ListIndex, i) = ""
Next

For i = 0 To 50
 For j = 0 To 50
  RuleArray(ObjectList.ListIndex, i, 0, j, 0) = ""
  RuleArray(ObjectList.ListIndex, i, 0, j, 1) = ""
  RuleArray(ObjectList.ListIndex, i, 0, j, 2) = ""
  RuleArray(ObjectList.ListIndex, i, 0, j, 3) = ""
  RuleArray(ObjectList.ListIndex, i, 1, j, 0) = ""
  RuleArray(ObjectList.ListIndex, i, 1, j, 1) = ""
  RuleArray(ObjectList.ListIndex, i, 1, j, 2) = ""
  RuleArray(ObjectList.ListIndex, i, 1, j, 3) = ""
 Next
Next

i = ObjectList.ListIndex
ObjectList.RemoveItem (i)
ObjectCombo.RemoveItem (i)

Do While ObjectArray(i + 1) <> ""
 ObjectArray(i) = ObjectArray(i + 1)
 ExchangeData (i)
 i = i + 1
Loop
ObjectArray(i) = ""
ExchangeData (i)

ObjectList.Clear
i = 0
Do While ObjectArray(i) <> ""
 ObjectList.AddItem ObjectArray(i)
 i = i + 1
Loop

countx = countx - 1
End Sub

Private Sub Command6_Click()
Dim i As Integer
If AttributeList.ListIndex = -1 Then
 MsgBox "必须先选择一个属性", vbOKOnly, "注意！"
Else
  
 i = AttributeList.ListIndex
 Do While AttributeArray(ObjectIndex, i + 1) <> ""
  AttributeArray(ObjectIndex, i) = AttributeArray(ObjectIndex, i + 1)
  i = i + 1
 Loop
 AttributeArray(ObjectIndex, i) = ""
 
 AttributeList.Clear
 
 i = 0
 Do While AttributeArray(ObjectIndex, i) <> ""
  AttributeList.AddItem AttributeArray(ObjectIndex, i)
  i = i + 1
 Loop
 
 county = county - 1
 
End If
End Sub

Private Sub CommandDelIf_Click()
Dim i As Integer
If IfSel = False Then
 MsgBox "必须先选择一条前提", vbOKOnly, "注意！"
Else
 i = IfIndex
 Do While RuleArray(ObjectIndex, RuleIndex, 0, i + 1, 0) <> ""
  RuleArray(ObjectIndex, RuleIndex, 0, i, 0) = RuleArray(ObjectIndex, RuleIndex, 0, i + 1, 0)
  RuleArray(ObjectIndex, RuleIndex, 0, i, 1) = RuleArray(ObjectIndex, RuleIndex, 0, i + 1, 1)
  RuleArray(ObjectIndex, RuleIndex, 0, i, 2) = RuleArray(ObjectIndex, RuleIndex, 0, i + 1, 2)
  RuleArray(ObjectIndex, RuleIndex, 0, i, 3) = RuleArray(ObjectIndex, RuleIndex, 0, i + 1, 3)
  i = i + 1
 Loop
 RuleArray(ObjectIndex, RuleIndex, 0, i, 0) = ""
 RuleArray(ObjectIndex, RuleIndex, 0, i, 1) = ""
 RuleArray(ObjectIndex, RuleIndex, 0, i, 2) = ""
 RuleArray(ObjectIndex, RuleIndex, 0, i, 3) = ""
 
 IfSel = False
 
 IfList.Clear
 i = 0
 Do
 If (Not RuleArray(ObjectIndex, RuleIndex, 0, i, 0) = "") Then
  IfList.AddItem RuleArray(ObjectIndex, RuleIndex, 0, i, 0) & "." & RuleArray(ObjectIndex, RuleIndex, 0, i, 1) & RuleArray(ObjectIndex, RuleIndex, 0, i, 2) & RuleArray(ObjectIndex, RuleIndex, 0, i, 3)
  i = i + 1
 Else
  Exit Do
 End If
 Loop
End If
End Sub

Private Sub CommandDelRule_Click()
Dim i As Integer
Dim j As Integer
i = 0
j = 0
If RuleSel = False Then
 MsgBox "必须先选择一条规则", vbOKOnly, "注意！"
Else
 For i = RuleIndex To 49 '规则前移
  RuleNameArray(ObjectIndex, i) = RuleNameArray(ObjectIndex, i + 1)
  For j = 0 To 50
   RuleArray(ObjectIndex, i, 0, j, 0) = RuleArray(ObjectIndex, i + 1, 0, j, 0)
   RuleArray(ObjectIndex, i, 0, j, 1) = RuleArray(ObjectIndex, i + 1, 0, j, 1)
   RuleArray(ObjectIndex, i, 0, j, 2) = RuleArray(ObjectIndex, i + 1, 0, j, 2)
   RuleArray(ObjectIndex, i, 0, j, 3) = RuleArray(ObjectIndex, i + 1, 0, j, 3)
   RuleArray(ObjectIndex, i, 1, j, 0) = RuleArray(ObjectIndex, i + 1, 1, j, 0)
   RuleArray(ObjectIndex, i, 1, j, 1) = RuleArray(ObjectIndex, i + 1, 1, j, 1)
   RuleArray(ObjectIndex, i, 1, j, 2) = RuleArray(ObjectIndex, i + 1, 1, j, 2)
   RuleArray(ObjectIndex, i, 1, j, 3) = RuleArray(ObjectIndex, i + 1, 1, j, 3)
  Next
 Next
 RuleNameArray(ObjectIndex, i) = ""
 For j = 0 To 50
   RuleArray(ObjectIndex, 50, 0, j, 0) = ""
   RuleArray(ObjectIndex, 50, 0, j, 1) = ""
   RuleArray(ObjectIndex, 50, 0, j, 2) = ""
   RuleArray(ObjectIndex, 50, 0, j, 3) = ""
   RuleArray(ObjectIndex, 50, 1, j, 0) = ""
   RuleArray(ObjectIndex, 50, 1, j, 1) = ""
   RuleArray(ObjectIndex, 50, 1, j, 2) = ""
   RuleArray(ObjectIndex, 50, 1, j, 3) = ""
 Next
 
 IfList.Clear
 ThenList.Clear
 
 RuleList.Clear 'refresh RuleList
 i = 0
 Do
 If (Not RuleNameArray(ObjectIndex, i) = "") Then
 RuleList.AddItem RuleNameArray(ObjectIndex, i)
 i = i + 1
 Else
 Exit Do
 End If
 Loop
 
 countrule = countrule - 1
End If
End Sub

Private Sub CommandDelThen_Click()
Dim i As Integer
If ThenSel = False Then
 MsgBox "必须先选择一条前提", vbOKOnly, "注意！"
Else
 i = ThenIndex
 Do While RuleArray(ObjectIndex, RuleIndex, 1, i + 1, 0) <> ""
  RuleArray(ObjectIndex, RuleIndex, 1, i, 0) = RuleArray(ObjectIndex, RuleIndex, 1, i + 1, 0)
  RuleArray(ObjectIndex, RuleIndex, 1, i, 1) = RuleArray(ObjectIndex, RuleIndex, 1, i + 1, 1)
  RuleArray(ObjectIndex, RuleIndex, 1, i, 2) = RuleArray(ObjectIndex, RuleIndex, 1, i + 1, 2)
  RuleArray(ObjectIndex, RuleIndex, 1, i, 3) = RuleArray(ObjectIndex, RuleIndex, 1, i + 1, 3)
  i = i + 1
 Loop
 RuleArray(ObjectIndex, RuleIndex, 1, i, 0) = ""
 RuleArray(ObjectIndex, RuleIndex, 1, i, 1) = ""
 RuleArray(ObjectIndex, RuleIndex, 1, i, 2) = ""
 RuleArray(ObjectIndex, RuleIndex, 1, i, 3) = ""
 
 ThenSel = False
 
 ThenList.Clear
 i = 0
 Do
 If (Not RuleArray(ObjectIndex, RuleIndex, 1, i, 0) = "") Then
  ThenList.AddItem RuleArray(ObjectIndex, RuleIndex, 1, i, 0) & "." & RuleArray(ObjectIndex, RuleIndex, 1, i, 1) & RuleArray(ObjectIndex, RuleIndex, 1, i, 2) & RuleArray(ObjectIndex, RuleIndex, 1, i, 3)
  i = i + 1
 Else