frmmain.frm

大量优秀的vb编程

      Top             =   60
      Width           =   1200
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private mPlayAvi As Boolean

' 关于

' 显示浏览文件夹
Private Sub cmdBrowse_Click()
    Dim nPath$
    
    nPath$ = FPath$(Me.hWnd, "选定开始进行搜索的文件夹。")
    
    cmdFind.SetFocus
    
    If Len(nPath) = 0 Then Exit Sub
    
    icboDirs.Text = nPath$
End Sub

' 清除列表的内容
Private Sub cmdClear_Click()
    Screen.MousePointer = vbHourglass
    sbarMain.Panels(1).Text = "正在清除查找结果..."
    Set lvwList.SmallIcons = Nothing
    imgList.ListImages.Clear
    lvwList.ListItems.Clear
    sbarMain.Panels(1).Text = ""
    Screen.MousePointer = vbDefault
End Sub

Private Sub Form_Load()
    Show
   
    Call GetAllDrives(Me.icboDirs)
    
    If Dir(App.path & "\findfile.avi") = "" Then
        mPlayAvi = False
    Else
        ' 打开查找动画
        aniFindFile.Open App.path & "\findfile.avi"
        
        mPlayAvi = True
    End If
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    
    If Me.Width < 7200 Then Me.Width = 7200
    If Me.Height < 4800 Then Me.Height = 4800
    
    cmdFind.Left = Me.ScaleWidth - cmdFind.Width - 100
    cmdClear.Left = cmdFind.Left
    cmdExit.Left = cmdFind.Left
    aniFindFile.Left = cmdFind.Left
    
    fam.Width = cmdFind.Left - 250
    
    cboSearch.Width = fam.Width - 1200
    icboDirs.Width = cboSearch.Width
    
    cmdBrowse.Left = cboSearch.Left + cboSearch.Width - cmdBrowse.Width
    
    lvwList.Width = Me.ScaleWidth
    lvwList.Height = Me.ScaleHeight - 2700
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    mPlayAvi = False
    End
End Sub

' 对列表进行排序
Private Sub lvwList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    lvwList.SortKey = ColumnHeader.index - 1
    ' 设置 Sorted 为真对列表进行升序排序。
    lvwList.SortOrder = lvwAscending
    lvwList.Sorted = True
End Sub

' 双击文件，以 Windows 默认的关联程序打开该文件
' 若文件没有默认的关联程序则无法打开该文件
Private Sub lvwList_DblClick()
    Dim strOpenFile As String
        
    On Error GoTo Err:
    
    strOpenFile = lvwList.SelectedItem.ListSubItems(1).Text & _
        lvwList.SelectedItem.Text
                                
    ShellExecute 0&, vbNullString, strOpenFile$, _
        vbNullString, vbNullString, vbNormalFocus
Err:
End Sub

' 查找
Private Sub cmdFind_Click()
    If Trim(cboSearch.Text) = "" Then Exit Sub
    If Trim(icboDirs.Text) = "" Then Exit Sub
    
    ' 将当前搜索的文件添加到列表下。
    cboSearch.AddItem cboSearch.Text
    '
    Screen.MousePointer = vbHourglass
    Me.Enabled = False
    ' 播放查找动画
    If mPlayAvi Then aniFindFile.Play
    '
    cmdFind.Enabled = False
    cmdClear.Enabled = False
    cmdBrowse.Enabled = False
    cmdExit.Enabled = False
    lvwList.Sorted = False
    '
    Caption = "查找文件:" & cboSearch.Text & "..."
    sbarMain.Panels(1).Text = "开始查找文件:" & cboSearch.Text & "..."
    
    ' 清除以前查找的结果
    Set lvwList.SmallIcons = Nothing
    imgList.ListImages.Clear
    lvwList.ListItems.Clear

    If chkSubs Then
        ' 单一目录的查找
        SearchSubDirs
    Else
        ' 包含子目录的查找
        SearchCurDirOnly
    End If
        
    ' 停止播放查找动画
    If mPlayAvi Then aniFindFile.Stop
    
    '
    cmdFind.Enabled = True
    cmdBrowse.Enabled = True
    cmdClear.Enabled = True
    cmdExit.Enabled = True
    Me.Enabled = True
    Screen.MousePointer = vbDefault
End Sub

' 搜索单一目录下的文件
Private Sub SearchCurDirOnly()
    Dim dblStart&, i&, nItem As ListItem
    Dim colFiles As New Collection
    
    dblStart = Timer
    
    ' 查找文件
    FindFilesInSingleDir icboDirs.Text, _
        cboSearch.Text, colFiles
    
    sbarMain.Panels(1).Text = "正在将查找到的文件信息添加到列表中..."
    
    ' 将查找的结果添加到显示列表中
    Call LoadCollectionInList(colFiles)
    
    sbarMain.Panels(1).Text = CStr(colFiles.Count) & _
        "个文件被找到，使用" & _
        Format(Timer - dblStart, "Fixed") & "秒。"
End Sub

' 搜索包含子目录下的文件
Private Sub SearchSubDirs()
    Dim dblStart As Long
    Dim colFiles As New Collection
    Dim colDirs As New Collection
    Dim intDirsFound As Integer
    Dim vntItem As Variant
    
    colDirs.Add icboDirs.Text
    
    ' 查找文件
    If Trim(cboSearch.Text) = "*.*" Then
        dblStart = Timer
        intDirsFound = FindAllFiles(icboDirs.Text, "*.*", colFiles, _
            colDirs, , True)
    Else
        intDirsFound = FindAllFiles(icboDirs.Text, "*.*", , colDirs, True)
        
        dblStart = Timer
        
        For Each vntItem In colDirs
            sbarMain.Panels(1).Text = "搜索目录:" & vntItem
            FindAllFiles CStr(vntItem), cboSearch.Text, colFiles
        Next vntItem
    End If
    
    sbarMain.Panels(1).Text = "正在将查找到的文件信息添加到列表中..."
    
    ' 将查找的结果添加到显示列表中
    Call LoadCollectionInList(colFiles)
    
    sbarMain.Panels(1).Text = CStr(colFiles.Count) _
        & "个文件被找到，查找" _
        & Str(intDirsFound) & "个目录，使用" _
        & Format(Timer - dblStart, "Fixed") _
        & "秒。"
End Sub

Private Sub LoadCollectionInList(colFiles As Collection)
    Dim i&, nFile As filAttribute
    Dim nItem As ListItem, nImage As ListImage
    
    If chkLoadIcon Then
        ' 设置缺省时的图标
        Set nImage = imgList.ListImages.Add(, "Default", imgDir.ListImages("default").Picture)
        Set nImage = imgList.ListImages.Add(, "IcoEXE", imgDir.ListImages("exe").Picture)
        Set nImage = imgList.ListImages.Add(, "IcoICO", imgDir.ListImages("ico").Picture)
        Set nImage = imgList.ListImages.Add(, "IcoANI", imgDir.ListImages("ani").Picture)
        Set nImage = imgList.ListImages.Add(, "IcoCUR", imgDir.ListImages("cur").Picture)
        Set nImage = imgList.ListImages.Add(, "IcoLNK", imgDir.ListImages("lnk").Picture)
        Set lvwList.SmallIcons = imgList
        
        For i& = 1 To colFiles.Count
            nFile = GetFileAttrib(colFiles.Item(i&))

            ' 若文件类型为 Exe,Ico,Cur,Ani，则获取每个文件的默认图标
            ' 其他类型的文件，只为每一种类型加载一个默认的图标
            ' 但最多允许加载150种图标，否则将耗用太多的系统资源
            
            If imgList.ListImages.Count >= 150 Then GoTo AddListItems:
            If (nFile.filSuffix = "EXE") Or (nFile.filSuffix = "ICO") Or _
               (nFile.filSuffix = "CUR") Or (nFile.filSuffix = "ANI") Or _
               (nFile.filSuffix = "LNK") Then GoTo AddListItems:
            On Error Resume Next
            ' 为Exe,Ico,Cur,Ani以外的每种文件类型添加默认的图标
            ' 其图标含有唯一的关键字，防止重复加载
            Set nImage = imgList.ListImages.Add(, "Ico" & nFile.filSuffix, _
                            GetIcon(colFiles.Item(i&), SHGFI_SMALLICON))
            On Error GoTo 0: Err.Clear
AddListItems:
            On Error Resume Next
            ' 将文件名添加到显示列表中，使用从文件中提取的图标
            Set nItem = lvwList.ListItems.Add(, , _
                        nFile.filName, , "Ico" & nFile.filSuffix)
            
            If Err.Number Then
                ' 将文件名添加到显示列表中，使用缺省图标
                Set nItem = lvwList.ListItems.Add(, , _
                            nFile.filName, , "Default")
            End If
            On Error GoTo 0: Err.Clear
            
            ' 添加文件其他信息
            nItem.ListSubItems.Add , , nFile.filDir                 ' 文件目录
            nItem.ListSubItems.Add , , nFile.filLen                 ' 文件大小
            nItem.ListSubItems.Add , , nFile.filSuffix              ' 文件后缀
            nItem.ListSubItems.Add , , nFile.filDate                ' 文件修改时间
        Next i&: i& = 0
    Else
        ' 不从文件中获取其默认的图标
        ' 此方法十分节约系统资源
        For i& = 1 To colFiles.Count
            ' 获取文件信息
            nFile = GetFileAttrib(colFiles.Item(i&))
            
            ' 将文件添加到显示列表中
            Set nItem = lvwList.ListItems.Add(, , nFile.filName)    ' 文件名
            nItem.ListSubItems.Add , , nFile.filDir                 ' 文件目录
            nItem.ListSubItems.Add , , nFile.filLen                 ' 文件大小
            nItem.ListSubItems.Add , , nFile.filSuffix              ' 文件后缀
            nItem.ListSubItems.Add , , nFile.filDate                ' 文件修改时间
        Next i&: i& = 0
    End If
    
    Set nItem = Nothing
    Set nImage = Nothing
    
    Debug.Print "Load " & imgList.ListImages.Count & " ImageItems"
    Debug.Print "Load " & lvwList.ListItems.Count & " ListItems"
End Sub