frmoptions.frm

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

            Top             =   1200
            Width           =   2175
         End
         Begin VB.CheckBox Check1 
            BackColor       =   &H80000004&
            Caption         =   "  输入文档时自动提示"
            Height          =   495
            Left            =   120
            TabIndex        =   5
            Top             =   720
            Width           =   2175
         End
         Begin VB.Label Label3 
            BackColor       =   &H80000004&
            Caption         =   "分钟"
            Height          =   375
            Left            =   2760
            TabIndex        =   22
            Top             =   2760
            Width           =   615
         End
         Begin VB.Label Label2 
            BackColor       =   &H80000004&
            Caption         =   "两次存盘的时间间隔"
            Height          =   375
            Left            =   120
            TabIndex        =   21
            Top             =   2760
            Width           =   1815
         End
      End
   End
   Begin MSComDlg.CommonDialog DialogOption 
      Left            =   360
      Top             =   4440
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   375
      Left            =   2280
      TabIndex        =   0
      Tag             =   "1065"
      Top             =   4335
      Width           =   1095
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   3480
      TabIndex        =   1
      Tag             =   "1064"
      Top             =   4335
      Width           =   1095
   End
   Begin VB.CommandButton cmdHelp 
      Caption         =   "帮助"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4680
      TabIndex        =   2
      Tag             =   "1063"
      Top             =   4335
      Width           =   1095
   End
End
Attribute VB_Name = "frmOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
    On Error Resume Next
    DialogOption.CancelError = True
    DialogOption.ShowColor
    If Err.Number = cdlCancel Then
        Command1.BackColor = &H8000000F
    Else
    Command1.BackColor = DialogOption.Color
    txtSample.BackColor = DialogOption.Color
    End If
End Sub

Private Sub Command2_Click()
DialogOption.CancelError = False
DialogOption.Flags = cdlCFScreenFonts
DialogOption.FontName = txtFont.Text
DialogOption.FontSize = txtFontSize.Text
DialogOption.ShowFont
txtFont.Text = DialogOption.FontName
txtFontSize.Text = DialogOption.FontSize
txtSample.FontName = DialogOption.FontName
txtSample.FontSize = DialogOption.FontSize
txtSample.FontItalic = DialogOption.FontItalic
txtSample.FontBold = DialogOption.FontBold
txtSample.FontUnderline = DialogOption.FontUnderline
End Sub


Private Sub Command3_Click()
Dim frmdir1 As New frmDir
frmdir1.Show vbModal
txtKBPath.Text = frmdir1.returnpath
End Sub

Private Sub Form_Load()
    txtKBPath.Text = App.path + "\KB"
    bValidate = GetSetting(App.Title, "Settings", "bValidate", bValidate)
    txtFont.Text = GetSetting(App.Title, "Settings", "txtFont", txtFont)
    txtFontSize.Text = GetSetting(App.Title, "Settings", "txtFontSize", txtFontSize)
    txtKBPath.Text = GetSetting(App.Title, "Settings", "txtKBPath", txtKBPath)
    txtSample.FontName = txtFont.FontName
    txtSample.FontSize = txtFontSize.FontSize
    txtSample.Refresh
    Check5.value = IIf(GetSetting(App.Title, "Settings", "bValidate", bValidate), 1, 0)
    Check1.value = IIf(GetSetting(App.Title, "Settings", "bAutoadd", bAutoAdd), 1, 0)
    Check2.value = IIf(GetSetting(App.Title, "Settings", "xpLook", fMainForm.ActiveBar.XPLook), 1, 0)
    Check3.value = IIf(GetSetting(App.Title, "Settings", "bAutoSave", bAutoSave), 1, 0)
    TxtSaveInteval.Text = GetSetting(App.Title, "Settings", "bsaveInteval", TxtSaveInteval.Text)
End Sub

Private Sub CmdCancel_Click()
    Unload Me
End Sub


Private Sub cmdOK_Click()
    Dim i As Integer
    '确定更改
    With fMainForm.rtfsample
        .BackColor = Command1.BackColor
        .Font.Name = txtFont.Text
        .Font.Size = txtFontSize.Text
        .Font.Bold = DialogOption.FontBold
        .Font.Italic = DialogOption.FontItalic
        .Font.Strikethrough = DialogOption.FontStrikethru
        .Font.Underline = DialogOption.FontUnderline
    End With
    ApplytoDoc
    
    '设置验证有效性
    If Check5.value = 0 Then
        bValidate = False
    Else
        bValidate = True
    End If
    
    '设置文档是否有自动添加提示功能
    If Check1.value = 0 Then
        bAutoAdd = False
    Else
        bAutoAdd = True
    End If
    
    '设置程序是否为XP风格
    If Check2.value = 0 Then
        fMainForm.ActiveBar.XPLook = False
    Else
        fMainForm.ActiveBar.XPLook = True
    End If
    
    '设置是否自动存盘
    If Check3.value = 0 Then
        bAutoSave = False
    Else
        bAutoSave = True
    End If
    
    '设置自动存盘的时间差
    If (IsNumeric(TxtSaveInteval.Text)) Then
        i = CInt(TxtSaveInteval.Text)
    If i <= 0 Or i > 30 Then
        MsgBox "请设置存盘间隔时间在（1～30）分钟之间", vbInformation, "Dest3.0"
        Exit Sub
    Else
        m_saveinteval = CInt(TxtSaveInteval.Text)
    End If
    Else
        MsgBox "输入了非法的字符，请输入整数", vbInformation, "Dest3.0"
        Exit Sub
    End If
    SetDocument bAutoSave
    
    '设置知识库路径
    Dim fsoSave As Scripting.FileSystemObject
    Set fsoSave = CreateObject("Scripting.FileSystemObject")
    If fsoSave.FolderExists(txtKBPath.Text) = False Then
        MsgBox "该路径不存在，请检查你的知识库路径！", vbOKOnly + vbInformation, "Dest3.0"
        txtKBPath = App.path + "\KB"
        Exit Sub
    End If
    SaveSetting App.Title, "Settings", "bValidate", bValidate
    SaveSetting App.Title, "Settings", "bAutoadd", Check1.value
    SaveSetting App.Title, "Settings", "bAutoSave", bAutoSave
    SaveSetting App.Title, "Settings", "bsaveInteval", CInt(TxtSaveInteval.Text)
    SaveSetting App.Title, "Settings", "txtKBPath", txtKBPath.Text
    SaveSetting App.Title, "Settings", "txtFont", txtFont.Text
    SaveSetting App.Title, "Settings", "txtFontSize", txtFontSize.Text
    SaveSetting App.Title, "Settings", "xpLook", fMainForm.ActiveBar.XPLook    '卸载
    Unload Me
End Sub


Private Sub ApplytoDoc()
With fMainForm.ActiveForm.rtfText
        .BackColor = Command1.BackColor
        .Font.Name = txtFont.Text
        .Font.Size = txtFontSize.Text
        .Font.Bold = DialogOption.FontBold
        .Font.Italic = DialogOption.FontItalic
        .Font.Strikethrough = DialogOption.FontStrikethru
        .Font.Underline = DialogOption.FontUnderline
    End With
End Sub

Private Sub SetDocument(ByVal bAutoSave As Boolean)
For Each f In Forms
    If (TypeOf f Is frmDocument) Then
        f.AutoSaveTimer.Enabled = bAutoSave
    End If
Next
End Sub