frmmain.frm

利用Visual Basic6.0制作的字符串搜索处理系统!推荐中

' set up the command dialog box to select a log file
dlgOpen.DialogTitle = "打开VB工程文件"
dlgOpen.Flags = cdlOFNCreatePrompt & cdlOFNOverwritePrompt
dlgOpen.CancelError = True
dlgOpen.Filter = "VB文件 (*.VBG;*.VBP)|*.VBG;*.VBP|所有文件 (*.*)|*.*"
If txtFile.Text <> "" Then
    dlgOpen.Filename = txtFile.Text
End If

' display the open dialog
dlgOpen.ShowOpen

' if there were no errors, update the label
If Err = 0 Then
    txtFile.Text = dlgOpen.Filename
    txtOutput.Text = Left$(dlgOpen.Filename, InStrRev(dlgOpen.Filename, "\") - 1)
End If

On Error GoTo 0

End Sub

Private Sub cmdGetFolder_Click()

txtOutput.Text = GetFolder("输出文件夹", Me)

End Sub

Private Sub cmdHelpCompiler_Click()

On Error Resume Next

' set up the command dialog box to select a log file
dlgOpen.DialogTitle = "选择帮助编译器"
dlgOpen.Flags = cdlOFNCreatePrompt & cdlOFNOverwritePrompt
dlgOpen.CancelError = True
dlgOpen.Filter = "EXE 文件 (*.EXE)|*.EXE|所有文件 (*.*)|*.*"
If txtHelpCompiler.Text <> "" Then
    dlgOpen.Filename = txtHelpCompiler.Text
End If

' displace the open dialog
dlgOpen.ShowOpen

' if there were no errors, update the label
If Err = 0 Then
    txtHelpCompiler.Text = dlgOpen.Filename
End If

On Error GoTo 0

End Sub

Private Sub cmdRun_Click()

Dim ctl As Control
Dim cProject As clsProject
Dim cGroup As clsGroup
Dim strError As String

On Error GoTo Handler

If txtFile.Text = "" Then
    MsgBox "您必须选择一个VB工程文件.", vbExclamation, "提示"
    txtFile.SetFocus
    Exit Sub
End If

If txtOutput.Text = "" Then
    MsgBox "必须选择一个本地的目录以输出文件.", vbExclamation, "输出路径错误"
    txtOutput.SetFocus
    Exit Sub
End If

If FileExists(txtFile.Text) = False Then
    MsgBox "指定的VB的工程不存在. 请重新选择一个有效的工程.", vbExclamation, "文件错误"
    txtFile.SetFocus
    Exit Sub
End If

If FileExists(txtOutput.Text & IIf(Right$(txtOutput.Text, 1) = "\", "", "\")) = False Then
    MsgBox "输出路径错误，请重新选择.", vbExclamation, "路径无效"
    txtOutput.SetFocus
    Exit Sub
End If

Screen.MousePointer = vbHourglass

For Each ctl In Me.Controls
    If TypeOf ctl Is CommandButton Then
        ctl.Enabled = False
    End If
    If TypeOf ctl Is TextBox Then
        ctl.Enabled = False
    End If
    If TypeOf ctl Is CheckBox Then
        ctl.Enabled = False
    End If
    If TypeOf ctl Is ListBox Then
        ctl.Enabled = False
    End If
Next
Me.Refresh

If InStr(LCase$(txtFile.Text), ".vbg") > 0 Then
    ' when a group file has been specified
    Set cGroup = New clsGroup
    cGroup.HelpTitle = txtHelpTitle.Text
    If lstOptions.Selected(2) = True Then
        cGroup.FileOutputType = HTMLHelp
    Else
        cGroup.FileOutputType = HTML
    End If
    cGroup.IncludeAPI = lstOptions.Selected(5)
    cGroup.IncludeCounts = lstOptions.Selected(9)
    cGroup.IncludeDeclarations = lstOptions.Selected(3)
    cGroup.IncludeEvents = lstOptions.Selected(6)
    cGroup.IncludeReferences = lstOptions.Selected(8)
    cGroup.IncludeSubs = lstOptions.Selected(7)
    cGroup.IncludeTypes = lstOptions.Selected(4)
    cGroup.IncludeNAVBar = lstOptions.Selected(0)
    cGroup.IncludeAttributes = lstOptions.Selected(10)
    cGroup.IncludeVersionInfo = lstOptions.Selected(11)
    cGroup.IncludeForms = lstInclude.Selected(0)
    cGroup.IncludeClasses = lstInclude.Selected(2)
    cGroup.IncludeDesigners = lstInclude.Selected(5)
    cGroup.IncludeModules = lstInclude.Selected(1)
    cGroup.IncludeRelatedDocs = lstInclude.Selected(7)
    cGroup.IncludeUserControls = lstInclude.Selected(3)
    cGroup.IncludeUserDocuments = lstInclude.Selected(6)
    cGroup.IncludePropertyPages = lstInclude.Selected(4)
    cGroup.OutputStyleSheetFile = lstOptions.Selected(1)
    cGroup.OutputPath = txtOutput.Text
    If Left$(txtSS.Text, 1) <> "[" Then
        cGroup.StyleSheetFile = txtSS.Text
    Else
        cGroup.StyleSheetFile = ""
    End If
    cGroup.ParseGroup txtFile.Text
    cGroup.SaveHTML
    Set cGroup = Nothing
Else
    ' when a project file has been specified
    Set cProject = New clsProject
    cProject.HelpTitle = txtHelpTitle.Text
    If lstOptions.Selected(2) = True Then
        cProject.FileOutputType = HTMLHelp
    Else
        cProject.FileOutputType = HTML
    End If
    cProject.IncludeAPI = lstOptions.Selected(5)
    cProject.IncludeCounts = lstOptions.Selected(9)
    cProject.IncludeDeclarations = lstOptions.Selected(3)
    cProject.IncludeEvents = lstOptions.Selected(6)
    cProject.IncludeReferences = lstOptions.Selected(8)
    cProject.IncludeSubs = lstOptions.Selected(7)
    cProject.IncludeTypes = lstOptions.Selected(4)
    cProject.IncludeNAVBar = lstOptions.Selected(0)
    cProject.IncludeAttributes = lstOptions.Selected(10)
    cProject.IncludeVersionInfo = lstOptions.Selected(11)
    cProject.OutputStyleSheetFile = lstOptions.Selected(1)
    cProject.IncludeForms = lstInclude.Selected(0)
    cProject.IncludeClasses = lstInclude.Selected(2)
    cProject.IncludeDesigners = lstInclude.Selected(5)
    cProject.IncludeModules = lstInclude.Selected(1)
    cProject.IncludeRelatedDocs = lstInclude.Selected(7)
    cProject.IncludeUserControls = lstInclude.Selected(3)
    cProject.IncludeUserDocuments = lstInclude.Selected(6)
    cProject.IncludePropertyPages = lstInclude.Selected(4)
    cProject.OutputPath = txtOutput.Text
    If Left$(txtSS.Text, 1) <> "[" Then
        cProject.StyleSheetFile = txtSS.Text
    Else
        cProject.StyleSheetFile = ""
    End If
    cProject.ParseVBPFile txtFile.Text
    cProject.SaveHTML
    Set cProject = Nothing
End If

For Each ctl In Me.Controls
    If TypeOf ctl Is CommandButton Then
        ctl.Enabled = True
        ' exceptions
        If ctl.Name = "cmdHelpCompiler" And lstOptions.Selected(2) = False Then
            ctl.Enabled = False
        End If
        If ctl.Name = "cmdSS" And lstOptions.Selected(1) = False Then
            ctl.Enabled = False
        End If
    End If
    If TypeOf ctl Is TextBox Then
        ctl.Enabled = True
        ' exceptions
        If ctl.Name = "txtHelpCompiler" And lstOptions.Selected(2) = False Then
            ctl.Enabled = False
        End If
        If ctl.Name = "txtHelpTitle" And lstOptions.Selected(2) = False Then
            ctl.Enabled = False
        End If
        If ctl.Name = "txtSS" And lstOptions.Selected(1) = False Then
            ctl.Enabled = False
        End If
    End If
    If TypeOf ctl Is CheckBox Then
        ctl.Enabled = True
    End If
    If TypeOf ctl Is ListBox Then
        ctl.Enabled = True
    End If
Next
Me.Refresh

Screen.MousePointer = vbDefault

' compile a HTML help file
If lstOptions.Selected(2) = True And txtHelpCompiler.Text <> "" Then
    DoEvents
    CompileHTMLHelp txtOutput.Text & IIf(Right$(txtOutput.Text, 1) <> "\", "\", "") & ExtractName(txtFile.Text) & ".HHP", txtHelpCompiler.Text
End If

MsgBox "报告生成完毕!", vbInformation, "完毕"

Exit Sub

Handler:
strError = "未知错误." & vbCrLf & Err.Number & ": " & Err.Description
MsgBox strError, vbExclamation, "错误"

End Sub

Private Sub cmdSS_Click()

On Error Resume Next

' set up the command dialog box to select a log file
dlgOpen.DialogTitle = "选择样式表文件"
dlgOpen.Flags = cdlOFNCreatePrompt & cdlOFNOverwritePrompt
dlgOpen.CancelError = True
dlgOpen.Filter = "样式表文件 (*.CSS)|*.CSS|所有文件 (*.*)|*.*"
If Left$(txtSS.Text, 1) <> "[" Then
    dlgOpen.Filename = txtSS.Text
End If

' displace the open dialog
dlgOpen.ShowOpen

' if there were no errors, update the label
If Err = 0 Then
    txtSS.Text = dlgOpen.Filename
End If

On Error GoTo 0

End Sub

Private Sub Form_Load()

Dim reg As New clsRegistry
Dim strPath As String, i As Long

lstOptions.AddItem "目录导航格式"
lstOptions.AddItem "创建样式表文件"
lstOptions.AddItem "创建HTML帮助文件"
lstOptions.AddItem "输出一般声明"
lstOptions.AddItem "输出类型和枚举定义"
lstOptions.AddItem "输出API声明"
lstOptions.AddItem "输出用户控件事件声明"
lstOptions.AddItem "输出过程/函数/属性"
lstOptions.AddItem "输出控件和参数信息"
lstOptions.AddItem "输出代码/注释信息行数"
lstOptions.AddItem "输出程序属性(哪里定义)"
lstOptions.AddItem "输出工程版本信息"

For i = 0 To lstOptions.ListCount - 1
    If i <> 2 Then
        lstOptions.Selected(i) = True
    End If
Next i
lstOptions.ListIndex = -1

lstInclude.AddItem "窗体文件"
lstInclude.AddItem "模块文件"
lstInclude.AddItem "类模块文件"
lstInclude.AddItem "用户控件"
lstInclude.AddItem "属性页"
lstInclude.AddItem "报表设计"
lstInclude.AddItem "用户文档"
lstInclude.AddItem "其它关联文档"

For i = 0 To lstInclude.ListCount - 1
    lstInclude.Selected(i) = True
Next i
lstInclude.ListIndex = -1

reg.ClassKey = HKEY_CURRENT_USER
reg.SectionKey = "Software\Microsoft\HTML Help Workshop"

' find out if the HTML Help Workshop has been installed
reg.ValueKey = "InstallDir"

strPath = Trim$(reg.Value)

If strPath = "" Then
    fraHelp.Visible = False
    lblInfo(4).Visible = False
Else
    txtHelpCompiler.Text = strPath & IIf(Right$(strPath, 1) = "\", "", "\") & "HHC.EXE"
End If

Set reg = Nothing

End Sub

Private Sub lstOptions_ItemCheck(Item As Integer)

Dim obj As Control

Select Case Item
Case 0
    If lstOptions.Selected(2) = True And lstOptions.Selected(0) = True Then
        lstOptions.Selected(2) = False
    End If
Case 1
    txtSS.Enabled = lstOptions.Selected(1)
    cmdSS.Enabled = lstOptions.Selected(1)
Case 2
    If fraHelp.Visible = False And lstOptions.Selected(2) = True Then
        lstOptions.Selected(2) = False
    End If
    If lstOptions.Selected(2) = True And lstOptions.Selected(0) = True Then
        lstOptions.Selected(0) = False
    End If
Case 3
    If lstOptions.Selected(3) = False Then
        lstOptions.Selected(4) = False
    End If
Case 4
    If lstOptions.Selected(3) = False And lstOptions.Selected(4) = True Then
        lstOptions.Selected(3) = True
    End If
End Select

On Error Resume Next
For Each obj In Me.Controls
    If obj.Name <> "dlgOpen" Then
        If obj.Container.Name = "fraHelp" Then
            obj.Enabled = lstOptions.Selected(2)
        End If
    End If
Next
On Error GoTo 0

End Sub