frmmain.frm

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

For i = 2 To frmtree.prjTreeView.Nodes.count
    Write #1, frmtree.prjTreeView.Nodes(i).Text
Next
Close #1   ' Close file
MsgBox "工程已保存", vbInformation, "Dest3.0"
End If
End Sub

'*************************************
'       '以下为文本框中的编辑功能
'*************************************
Private Sub mnuEditDelete_Click()
    ActiveForm.rtfText.SelText = vbNullString
End Sub

Private Sub mnuEditFind_Click()
If (Not ActiveForm Is Nothing) Then
    If TypeOf ActiveForm Is IMDIDocument Then
    frmFind.Show
    End If
End If
End Sub

Private Sub mnuEditFindNext_Click()
    frmFind.cmdFindNext_Click
End Sub

'*************************************
'       '结束推理
'*************************************
Private Sub mnuEndReason_Click()
frmOutput.LVoutput.ListItems.Clear
If Not ActiveForm Is Nothing Then
    Me.ActiveForm.WindowState = Normal
End If
End Sub

'*************************************
'       '导出当前工程中选定的文档
'*************************************

Private Sub mnuExportKnowledge_Click()
If frmtree.prjTreeView.SelectedItem.Index > 1 Then
FileCopy Prj_Location + frmtree.prjTreeView.SelectedItem.Text, App.path + "\KB\" + frmtree.prjTreeView.SelectedItem.Text
MsgBox "保存完毕", vbYesNo + vbInformation, "Dest3.0"
End If
End Sub

'*************************************
'       '编译当前工程中选定的文档
'*************************************

Public Sub mnuFileCompile_Click()
Dim item As ListItem
If Not ActiveForm Is Nothing Then
    If TypeOf ActiveForm Is IMDIDocument Then
        oDoc.async = False
        fMainForm.DocValidity
        oDoc.loadXML (ActiveForm.rtfText.Text)
        currentXml = ActiveForm.Tag
        If oDoc.parseError.errorCode = 0 Then
            bLoaded = True
            frmtree.TreeView
            frmtree.SSTab1.Tab = 1
        Else
            bLoaded = False
            Set item = FormDebug.LvDebug.ListItems.Add(, , ActiveForm.Tag)
            item.SubItems(1) = oDoc.parseError.Line
            item.SubItems(2) = oDoc.parseError.srcText
            item.SubItems(3) = oDoc.parseError.Reason
        End If
    End If
End If
End Sub

Private Sub mnuFileExit_Click()
Unload Me
End Sub

Private Sub mnuFileValidate_Click()
Dim i As Integer
Dim item As ListItem
oDoc.async = False
DocValidity
For i = 0 To UBound(frmD())
    frmD(i).Visible = False
    If (frmD(i).Caption = frmtree.prjTreeView.SelectedItem.Tag) Then
    frmD(i).Visible = True
    oDoc.loadXML frmD(i).rtfText.Text
    If oDoc.parseError.errorCode = 0 Then
        bLoaded = True
        frmtree.TreeView
    Else
        FormDebug.Show
        Set item = FormDebug.LvDebug.ListItems.Add(, , ActiveForm.Tag)
        item.SubItems(1) = oDoc.parseError.Line
        item.SubItems(2) = oDoc.parseError.srcText
        item.SubItems(3) = oDoc.parseError.Reason
    End If
    Exit For
    End If
Next

End Sub

Private Sub mnuInsertDTD_Click()
FormInsertDTD.Show
End Sub

Private Sub mnuInsertSome_Click()
'MsgBox "待添加插入功能", vbYes + vbInformation, "Dest3.0"
End Sub

Private Sub mnuknowinput_Click()
FormCG.Show
End Sub

Private Sub mnuLearn_Click()
    frmLearning.Show vbModal
End Sub

'*************************************
'    在网页浏览器中显示当前的XML文档
'*************************************

Private Sub mnuNetPageShow_Click()
Dim frmB As New frmBrowser
If Not ActiveForm Is Nothing Then
If Right(fMainForm.ActiveForm.Caption, 3) = "xml" Then
    frmB.StartingAddress = fMainForm.ActiveForm.Caption
    frmB.Show
End If
If fMainForm.ActiveForm.Caption = "Dest Project" Then
    If frmtree.prjTreeView.Nodes.count > 2 Then
        frmB.StartingAddress = frmtree.prjTreeView.SelectedItem.Tag
    End If
    frmB.Show
End If
End If
End Sub

Private Sub mnuTechnicalSupport_Click()
ShellExecute 0&, "Open", "http://www.hust.edu.cn", "", App.path, 1
End Sub

Private Sub mnuViewOutput_Click()
Me.mnuViewOutput.checked = Not Me.mnuViewOutput.checked
If Me.mnuViewOutput.checked = True Then
    frmOutput.Visible = True
    frmOutput.SetFocus
Else
    frmOutput.Visible = False
End If
End Sub

Private Sub mnuProjectSave_Click()
If (sPrj <> "") Then _
SaveProjectFile (sPrj)
End Sub

'*************************************
'       '另行保存当前编辑的工程
'*************************************

Private Sub mnuProjectSaveas_Click()
On Error GoTo errhand
    Dim sFile As String
    Dim strFilename  As String
    Dim fsoSave As Scripting.FileSystemObject
    Dim nSaveQuery As Integer

    If ActiveForm Is Nothing Then Exit Sub
    With dlgCommonDialog
        .Flags = cdlOFNNverwritePrompt
        .filename = ActiveForm.Caption
        .DialogTitle = "工程另存为"
        .CancelError = False
        'ToDo: set the flags and attributes of the common dialog control
        .Filter = "Project Files (*.prj)|*.prj|All Files (*.*)|*.*"
        .ShowSave
        If Len(.filename) = 0 Then
            Exit Sub
        End If
        sFile = .filename
        newPrjLoc = Left(sFile, Len(sFile) - Len(.FileTitle))
    End With
    
    Set fsoSave = CreateObject("Scripting.FileSystemObject")
    If (Len(sFile) > 0) Then
            If fsoSave.FileExists(sFile) Then
                nSaveQuery = MsgBox("工程" + dlgCommonDialog.filename + "已存在，覆盖吗？", vbYesNo + vbInformation, "Dest3.0")
                Select Case nSaveQuery
                    Case vbYes
                        ' GO overwrite and quite
                        SaveProjectFile (sFile)
                    Case vbNo
                        Call mnuProjectSaveas_Click
                        ' Redisplay the Save dialog
                    Case vbCancel
                        Exit Sub
                End Select
            Else
                SaveProjectFile (sFile)
            End If
    End If
    
For i = 2 To frmtree.prjTreeView.Nodes.count
    FileCopy Prj_Location + frmtree.prjTreeView.Nodes(i).Text, newPrjLoc + frmtree.prjTreeView.Nodes(i).Text
Next
FileCopy Prj_Location + "template.dtd", newPrjLoc + "template.dtd"

errhand:
    If (Err.Number <> 0) And (Err.Number <> cdlCancel) Then
       MsgBox "Error: " & Err.Description, vbExclamation, "Error saving  file"
    End If
    Set fsoSave = Nothing
End Sub

'*************************************
'       '对当前文档进行正向推理
'*************************************

Private Sub mnuReason_Click()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim row As Integer
Dim frmFlex As New FormResult
Call ClearReasonData

If bLoaded = True Then
    Method ("start_design")

For i = 0 To clk
frmFlex.MSFlexGrid1.TextMatrix(0, i * 5 + 1) = "任务" + CStr(i + 1)
For j = 0 To 100
    If resultqueue(i, j, 4) <> "" Then
       frmFlex.MSFlexGrid1.TextMatrix(j + 1, i * 5 + 1) = resultqueue(i, j, 0)
       frmFlex.MSFlexGrid1.TextMatrix(j + 1, i * 5 + 2) = resultqueue(i, j, 1)
       frmFlex.MSFlexGrid1.TextMatrix(j + 1, i * 5 + 3) = resultqueue(i, j, 2)
       frmFlex.MSFlexGrid1.TextMatrix(j + 1, i * 5 + 4) = resultqueue(i, j, 3)
       Rmax = j + 1
       Cmax = i * 5 + 4
    End If
Next
Next
clk = clk + 1
frmFlex.MSFlexGrid1.Refresh
frmFlex.Show vbModal
End If
End Sub

Private Sub ClearReasonData()
Dim i As Integer
For i = 0 To 100
    For j = 0 To 4
    savequeue(i, j) = ""
    Next
Next
RecordIndex = 0
Reverse_Reason_flag = 0
res = 0
user_information_code = 1
frmOutput.LVoutput.ListItems.Clear

End Sub
'*************************************
'       '移除当前的工程
'*************************************

Private Sub mnuRemovePrj_Click()
frmtree.prjTreeView.Nodes.Clear
frmtree.tvwNodeTree.Nodes.Clear
For i = 0 To max
    sXML(i) = ""
Next
oDoc.loadXML "<Project/>"
Screen.MousePointer = vbHourglass
UnloadAllDocs
delay 4000
Screen.MousePointer = vbDefault
bExistProj = False
For i = 0 To 99
    For j = 0 To 99
        For k = 0 To 4
            resultqueue(i, j, k) = ""
        Next
    Next
Next
clk = 0
End Sub

'*************************************
'       '对当前文档进行反向推理
'*************************************

Private Sub mnuReverseReason_Click()
free_trails
Reverse_Reason_flag = 1
frmOutput.Show
Reverse_Method ("start_design")
End Sub


Private Sub ViewProjectBar()
    ActiveBar.Bands(DOCKABLEBANDPREFIXNAME & frmtree.Name).Visible = Not ActiveBar.Bands(DOCKABLEBANDPREFIXNAME & frmtree.Name).Visible
    ActiveBar.RecalcLayout
End Sub

Private Sub ViewReasonBar()
    ActiveBar.Bands(DOCKABLEBANDPREFIXNAME + frmOutput.Name).Visible = Not ActiveBar.Bands(DOCKABLEBANDPREFIXNAME + frmOutput.Name).Visible
    ActiveBar.RecalcLayout
End Sub

Private Sub ViewCompileBar()
    ActiveBar.Bands(DOCKABLEBANDPREFIXNAME + FormDebug.Name).Visible = Not ActiveBar.Bands(DOCKABLEBANDPREFIXNAME + FormDebug.Name).Visible
    ActiveBar.RecalcLayout
End Sub

Private Sub ViewStatusBar()
    ActiveBar.Bands("Status Bar").Visible = Not ActiveBar.Bands("Status Bar").Visible
    ActiveBar.RecalcLayout
End Sub

Private Sub ViewToolBar()
    ActiveBar.Bands("tbFormat").Visible = Not ActiveBar.Bands("tbFormat").Visible
    ActiveBar.RecalcLayout
End Sub

'*************************************
'       '新建工程
'*************************************

Public Sub mnuNewProject_Click()
Dim i As Integer
If (bExistProj = True) Then _
    mnuRemovePrj_Click
iDoc = 0
FormNewPrj.Show vbModal
If FormNewPrj.bNewprj = True Then
If (sPrj = "") Then Exit Sub
i = 0
Open sPrj For Input As #1   ' Open file.
Do While Not EOF(1)   ' Loop until end of file.
   i = i + 1
   Line Input #1, sXML(i)   ' Read line into variable.
   'Debug.Print sXML(i)   ' Print to the Immediate window.
Loop
Close #1   ' Close file.
FileNum = i

For i = 1 To FileNum
    sXML(i) = Left(sXML(i), Len(sXML(i)) - 1)
    sXML(i) = Right(sXML(i), Len(sXML(i)) - 1)
Next i
    
If FileNum >= 1 Then
    Build_PrjTree
End If

End If
End Sub

'*************************************
'       '打开工程
'*************************************

Public Sub mnuOpenProject_Click()
On Error GoTo errhand
Dim i As Integer
If (bExistProj = True) Then _
    mnuRemovePrj_Click
iDoc = 0
With dlgCommonDialog
    .Flags = cdlOFNNoValidate
    .InitDir = App.path
    .DialogTitle = "打开工程"
    .CancelError = False
    'ToDo: set the flags and attributes of the common dialog control
    .Filter = "Project Files (*.prj)|*.prj|All Files (*.*)|*.*"
    .ShowOpen
    If Len(.filename) = 0 Then _
    Exit Sub
    sPrj = .filename
    Prj_Name = .FileTitle                                '工程名
    Prj_Location = Left(sPrj, Len(sPrj) - Len(Prj_Name)) '工程路径
End With
    i = 0
    Open sPrj For Input As #1   ' Open file.
    Do While Not EOF(1)   ' Loop until end of file.
       i = i + 1
       Line Input #1, sXML(i)   ' Read line into variable.
       If sXML(i) = "" Then     ' 读到空白行，就减一
            i = i - 1
            Exit Do
       End If
      'Debug.Print sXml(i)   ' Print to the Immediate window.
    Loop
    Close #1   ' Close file.
    FileNum = i
    For i = 1 To FileNum
    sXML(i) = Left(sXML(i), Len(sXML(i)) - 1)
    sXML(i) = Right(sXML(i), Len(sXML(i)) - 1)
    Next
    Build_PrjTree    '建立工程的树形显示
    
errhand:
    If (Err.Number <> 0) And (Err.Number <> cdlCancel) Then
       MsgBox "Error: " & Err.Description, vbExclamation, "Error Open file!"
    End If
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()