formcg.frm

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

VERSION 5.00
Begin VB.Form FormCG 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Visual Input"
   ClientHeight    =   6090
   ClientLeft      =   2265
   ClientTop       =   1770
   ClientWidth     =   7215
   LinkTopic       =   "Form2"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   6090
   ScaleWidth      =   7215
   Begin VB.CommandButton ExitButton 
      Caption         =   "退出"
      Default         =   -1  'True
      Height          =   375
      Left            =   6600
      TabIndex        =   5
      Top             =   0
      Width           =   1095
   End
   Begin VB.CommandButton NextButton 
      Caption         =   "确定"
      Height          =   375
      Left            =   5400
      TabIndex        =   4
      ToolTipText     =   "进入下一步"
      Top             =   0
      Width           =   1095
   End
   Begin VB.TextBox Att 
      Appearance      =   0  'Flat
      Height          =   375
      Index           =   1
      Left            =   480
      TabIndex        =   3
      Text            =   "属性1 属性2"
      ToolTipText     =   "输入属性"
      Top             =   1440
      Width           =   975
   End
   Begin VB.TextBox Att 
      Appearance      =   0  'Flat
      Height          =   375
      Index           =   0
      Left            =   3000
      TabIndex        =   2
      Top             =   480
      Width           =   735
   End
   Begin VB.TextBox Object 
      Appearance      =   0  'Flat
      Height          =   375
      Index           =   1
      Left            =   480
      TabIndex        =   1
      Text            =   "对象名"
      ToolTipText     =   "双击新建子节点"
      Top             =   1080
      Width           =   975
   End
   Begin VB.TextBox Object 
      Appearance      =   0  'Flat
      Height          =   375
      Index           =   0
      Left            =   3000
      TabIndex        =   0
      Text            =   "工程名"
      ToolTipText     =   "双击新建子节点"
      Top             =   120
      Width           =   735
   End
   Begin VB.Line DevideLine 
      BorderColor     =   &H000000FF&
      Index           =   1
      X1              =   0
      X2              =   7200
      Y1              =   1800
      Y2              =   1800
   End
   Begin VB.Line DevideLine 
      BorderColor     =   &H000000FF&
      Index           =   0
      X1              =   0
      X2              =   7200
      Y1              =   840
      Y2              =   840
   End
   Begin VB.Menu mnuNodeAction 
      Caption         =   ""
      Begin VB.Menu mnuNewNode 
         Caption         =   "建立子节点"
      End
      Begin VB.Menu mnuEndInput 
         Caption         =   "结束输入"
      End
   End
End
Attribute VB_Name = "FormCG"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim CurrentNode As Integer
Dim NodeCount As Integer
Dim LineCount As Integer
Dim LocInd(10, 5) As Boolean 'False=empty, true=full
Dim WidthUnit As Double
Dim HeightUnit As Double

Private Sub ObjLoc(Index As Integer, loc() As Integer)
'把序号为index的方框放在坐标为loc的方格中
 Dim WidthUnit As Integer
 Dim HeightUnit As Integer
 WidthUnit = ScaleWidth / 110
 HeightUnit = ScaleHeight / 120
 Object(Index).Left = loc(0) / 11 * ScaleWidth + WidthUnit * 1
 Object(Index).Top = loc(1) / 6 * ScaleHeight + HeightUnit * 2
 Att(Index).Left = Object(Index).Left
 Att(Index).Top = Object(Index).Top + Object(Index).Height
 Object(Index).Text = "ID" & Index
 LocInd(loc(0), loc(1)) = True
End Sub
Private Sub Link(loc1() As Integer, loc2() As Integer)
'连接两个方格中的框，loc1为父，loc2为子
 Dim x1 As Integer
 Dim y1 As Integer
 Dim x2 As Integer
 Dim y2 As Integer
 Dim WidthUnit As Integer
 Dim HeightUnit As Integer
 WidthUnit = ScaleWidth / 110
 HeightUnit = ScaleHeight / 120
 x1 = loc1(0) / 11 * ScaleWidth + 5 * WidthUnit
 y1 = loc1(1) / 6 * ScaleHeight + 18 * HeightUnit
 x2 = loc2(0) / 11 * ScaleWidth + 5 * WidthUnit
 y2 = loc2(1) / 6 * ScaleHeight + 2 * HeightUnit
 Line (x1, y1)-(x2, y2)
End Sub
Private Sub SearchLoc(ByRef loc() As Integer, ByRef newloc() As Integer, ByRef Err As Boolean)
'找到loc方格下层的可利用的方格，把其赋给newloc
 Dim i As Integer
 newloc(1) = loc(1) + 1
 'loc(0)-1,loc(1)-1 'the original coordinate
 If loc(0) >= 1 And loc(0) <= 9 And loc(1) <= 5 Then
 
 If LocInd(loc(0) - 1, loc(1) + 1) = False Then
  newloc(0) = loc(0) - 1
  Exit Sub
 ElseIf LocInd(loc(0) + 1, loc(1) + 1) = False Then
  newloc(0) = loc(0) + 1
  Exit Sub
 ElseIf LocInd(loc(0), loc(1) + 1) = False Then
  newloc(0) = loc(0)
  Exit Sub
 Else
  For i = loc(0) - 2 To 0 Step -1
   If LocInd(i, loc(1) + 1) = False Then
    newloc(0) = i
    Exit Sub
   End If
  Next
  For i = loc(0) + 1 To 10
   If LocInd(i, loc(1) + 1) = False Then
    newloc(0) = i
    Exit Sub
   End If
  Next
 End If
 
 ElseIf loc(0) = 0 And loc(1) <> 5 Then
 
 If LocInd(loc(0), loc(1) + 1) = False Then
  newloc(0) = loc(0)
  Exit Sub
 ElseIf LocInd(loc(0) + 1, loc(1) + 1) = False Then
  newloc(0) = loc(0) + 1
  Exit Sub
 Else
  For i = loc(0) + 2 To 10
   If LocInd(i, loc(1) + 1) = False Then
    newloc(0) = i
    Exit Sub
   End If
  Next
 End If
 
 ElseIf loc(0) = 10 Then
  
 If LocInd(loc(0), loc(1) + 1) = False Then
  newloc(0) = loc(0)
  Exit Sub
 ElseIf LocInd(loc(0) - 1, loc(1) + 1) = False Then
  newloc(0) = loc(0) - 1
  Exit Sub
 Else
  For i = 0 To loc(0) - 1
   If LocInd(i, loc(1) + 1) = False Then
    newloc(0) = i
    Exit Sub
   End If
  Next
 End If
 
 Else
  Err = True
  Exit Sub
 End If
 Err = True
End Sub

Private Sub Att_Change(Index As Integer)
 NodeList(Index).Att = Att(Index).Text
End Sub

Private Sub ExitButton_Click()
Unload Me
End Sub

Private Sub Form_Resize()
ExitButton.Left = Me.Width - ExitButton.Width - 100
NextButton.Left = ExitButton.Left - NextButton.Width - 50
End Sub


Private Sub NextButton_Click()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim childstring As String
Dim sXML As String

Call Translate

'sXML = sXML & "<?xml version=&quot1.0&quot?>"
'sXML = sXML & "<!DOCTYPE PROJECT SYSTEM 'template.dtd'>"
sXML = sXML & "<PROJECT>" & vbCrLf
 
i = 0
Do While (ObjectArray(i) <> "")
childstring = ""
For k = 0 To NodeList(i + 1).ChildCount - 1
    childstring = childstring + "B" + CStr(NodeList(i + 1).Children(k))
    If (k < NodeList(i + 1).ChildCount - 1) Then
    childstring = childstring + " "
    End If
Next
If (NodeList(i + 1).ChildCount > 0) Then childstring = " parent_of='" + childstring + "'"
sXML = sXML + " <OBJECT object_id='" + "B" + CStr(i) + "'" + childstring + " name='" + ObjectArray(i) + "'>" + vbCrLf

'----------------------------------------------------添属性
j = 0
Do
If Not AttributeArray(i, j) = "" Then
sXML = sXML & "  <ATTRIBUTE name='" & AttributeArray(i, j) & "'/>" & vbCrLf
Else
Exit Do
End If
j = j + 1
Loop
'----------------------------------------------------

sXML = sXML & " </OBJECT>" & vbCrLf
i = i + 1
Loop

sXML = sXML & "</PROJECT>"

FormKnowledge.TextShowXML = sXML
FormKnowledge.Show
End Sub

Private Sub Form_Load()
Dim i As Integer
Dim j As Integer
Dim WidthUnit As Integer
Dim HeightUnit As Integer
NodeCount = 0
For i = 0 To 100
    NodeList(i).Name = ""
Next
For i = 0 To 10
 For j = 0 To 5
  LocInd(i, j) = False
 Next
Next
'ScaleWidth = 110
'ScaleHeight = 120
WidthUnit = ScaleWidth / 110
HeightUnit = ScaleHeight / 120
Object(0).Top = 2 * HeightUnit
Object(0).Left = 51 * WidthUnit
Object(0).Height = 8 * HeightUnit
Object(0).Width = 8 * WidthUnit
Att(0).Top = Object(0).Top + Object(0).Height
Att(0).Left = Object(0).Left
Att(0).Height = Object(0).Height
Att(0).Width = Object(0).Width
NodeList(0).Name = "工程"
NodeList(0).Children(0) = 1
NodeList(0).ChildCount = 1
NodeList(0).loc(0) = 5
NodeList(0).loc(1) = 0

Object(1).Top = 22 * HeightUnit
Object(1).Left = 41 * WidthUnit
Object(1).Height = 8 * HeightUnit
Object(1).Width = 8 * WidthUnit
Object(1).Text = "对象"
Att(1).Top = Object(1).Top + Object(1).Height
Att(1).Left = Object(1).Left
Att(1).Height = Object(1).Height
Att(1).Width = Object(1).Width
NodeList(1).ChildCount = 0
NodeList(1).loc(0) = 4
NodeList(1).loc(1) = 1
DevideLine(0).x1 = 0
DevideLine(0).y1 = 20 * HeightUnit
DevideLine(0).x2 = ScaleWidth
DevideLine(0).y2 = 20 * HeightUnit
DevideLine(1).x1 = 0
DevideLine(1).y1 = 40 * HeightUnit
DevideLine(1).x2 = ScaleWidth
DevideLine(1).y2 = 40 * HeightUnit
Line (55 * WidthUnit, 18 * HeightUnit)-(45 * WidthUnit, 22 * HeightUnit)
LineCount = 1 'from zero
NodeCount = 1 'from zero
LocInd(5, 0) = True
LocInd(4, 1) = True
DevideLine(0).Visible = False
DevideLine(1).Visible = False
End Sub

Private Sub mnuNewNode_Click()
 Dim flag As Boolean
 Dim i As Integer
 Dim Err As Boolean
 flag = False 'indicate that there is no element in the next line
 SearchLoc NodeList(CurrentNode).loc(), NodeList(NodeCount + 1).loc(), Err
 If Err = True Then
  MsgBox "很抱歉，超出范围。", vbOKOnly, "注意"
  Exit Sub
 End If
 NodeCount = NodeCount + 1
 NodeList(CurrentNode).ChildCount = NodeList(CurrentNode).ChildCount + 1
 NodeList(CurrentNode).Children(NodeList(CurrentNode).ChildCount - 1) = NodeCount
 Load Object(NodeCount)
 Load Att(NodeCount)
 Object(NodeCount).Visible = True
 Att(NodeCount).Visible = True
 ObjLoc NodeCount, NodeList(NodeCount).loc()
 Link NodeList(CurrentNode).loc(), NodeList(NodeCount).loc()
'i = NodeList(NodeCount).loc(0)
'i = NodeList(NodeCount).loc(1)
 'Object(NodeCount).Top = Att(CurrentNode).Top + Att(CurrentNode).Height + 4
 'Att(NodeCount).Top = Object(NodeCount).Top + Object(NodeCount).Height
 NodeList(NodeCount).ChildCount = 0
 For i = 0 To 10
  If LocInd(i, NodeList(CurrentNode).loc(1)) = True Then
   flag = True
   Exit For
  End If
 Next
 If flag = False Then
  LineCount = LineCount + 1
  Load DevideLine(LineCount)
 End If
'DevideLine(LineCount).x1 = 0
'DevideLine(LineCount).y1 = LineCount * 2 / 11 * ScaleWidth
'DevideLine(LineCount).x2 = ScaleWidth
'DevideLine(LineCount).y2 = LineCount * 2 / 11 * ScaleWidth
End Sub

Private Sub Object_Change(Index As Integer)
 NodeList(Index).Name = Object(Index).Text
End Sub

Private Sub Object_DblClick(Index As Integer)
 CurrentNode = Index
 PopupMenu mnuNodeAction

End Sub

Private Sub Translate()
Dim i As Integer
Dim j As Integer
Dim m_string() As String
i = 0
Do While (NodeList(i).Name <> "")
    ObjectArray(i) = NodeList(i + 1).Name
    m_string = Split(NodeList(i + 1).Att, " ")
    For j = 0 To UBound(m_string)
        AttributeArray(i, j) = m_string(j)
    Next
i = i + 1
Loop
End Sub