none
如何显示在LABEL 里面? RRS feed

  • 问题

  • 这个函数不太好用,因为用的是句柄,所以一定要加LIST,谁能帮我改改?

     

    我以前只是把List1=label  倒可以显示,但是list 用起来会很卡

     

    Dim mlstHwnd$  

    在form.LOAD中加上 mlstHwnd$ = List1.hWnd

     

    Sub SearchDirs(filepath$)

        Dim WFD As WIN32_FIND_DATA, hItem&, hFile&

        Dim fileCount&
        Dim dirCount&, i&
        Dim dirArray$()

        DoEvents

        '查找第一个文件的API
        hItem& = FindFirstFile(filepath$ & "*.*", WFD)

        If hItem& <> INVALID_HANDLE_VALUE Then

            Do
                If (WFD.dwFileAttributes And vbDirectory) Then  '如果搜索范围存在目录

                    If Asc(WFD.cFileName) <> 46 Then

                        If (dirCount& Mod 10) = 0 Then ReDim Preserve dirArray(dirCount& + 10)
                        dirCount& = dirCount& + 1
               
                        dirArray(dirCount&) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)

                    End If

                Else

                    fileCount& = fileCount& + 1

                End If

                '查找下一个文件
            Loop While FindNextFile(hItem&, WFD) '获取下一个子目录
       
            Call FindClose(hItem&)      '关闭FindFirstFile

        End If


        SendMessage mlstHwnd$, WM_SETREDRAW, 0, 0

        hFile& = FindFirstFile(filepath$ & "*.*", WFD)

        If hFile& <> INVALID_HANDLE_VALUE Then

            Do

                DoEvents

                If Not mStopSearch Then Exit Sub

             
                If Asc(WFD.cFileName) <> 46 Then

                    SendMessage mlstHwnd$, LB_ADDSTRING, 0, ByVal filepath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)

                    Label4.Caption = List1.ListCount & " 个"
                    Text2 = filepath$ & WFD.cFileName
                End If

            Loop While FindNextFile(hFile&, WFD) ' 获取下一个文件

            Call FindClose(hFile&)

        End If

        SendMessage mlstHwnd$, WM_VSCROLL, SB_BOTTOM, 0  '自动滚屏


        For i& = 1 To dirCount&

            SearchDirs filepath$ & dirArray(i&) & "\"  '递归搜索

        Next i&

        Erase dirArray()

    End Sub

    2008年11月21日 8:27

答案

全部回复

  • Sub SearchDirs(filepath$)

        Dim WFD As WIN32_FIND_DATA, hItem&, hFile&

        Dim fileCount&
        Dim dirCount&, i&
        Dim dirArray$()

    dim intTotFiels as integer

        DoEvents

        '查找第一个文件的API
        hItem& = FindFirstFile(filepath$ & "*.*", WFD)

        If hItem& <> INVALID_HANDLE_VALUE Then

            Do
                If (WFD.dwFileAttributes And vbDirectory) Then  '如果搜索范围存在目录

                    If Asc(WFD.cFileName) <> 46 Then

                        If (dirCount& Mod 10) = 0 Then ReDim Preserve dirArray(dirCount& + 10)
                        dirCount& = dirCount& + 1
               
                        dirArray(dirCount&) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)

                    End If

                Else

                    fileCount& = fileCount& + 1

                End If

                '查找下一个文件
            Loop While FindNextFile(hItem&, WFD) '获取下一个子目录
       
            Call FindClose(hItem&)      '关闭FindFirstFile

        End If


        hFile& = FindFirstFile(filepath$ & "*.*", WFD)

        If hFile& <> INVALID_HANDLE_VALUE Then

            Do

                DoEvents

                If Not mStopSearch Then Exit Sub

             
                If Asc(WFD.cFileName) <> 46 Then

                    label1.caption=  filepath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)

    intTotFiels =intTotFiels +1

                    Label4.Caption = intTotFiels  & " 个"
                    Text2 = filepath$ & WFD.cFileName
                End If

            Loop While FindNextFile(hFile&, WFD) ' 获取下一个文件

            Call FindClose(hFile&)

        End If


        For i& = 1 To dirCount&

            SearchDirs filepath$ & dirArray(i&) & "\"  '递归搜索

        Next i&

        Erase dirArray()

    End Sub

    2008年11月21日 9:05
    版主
  • 有个BUG 就是每次扫描一个文件夹后 在扫描另外一个  文件计数 就又从1开始了

    2008年11月21日 9:14
  •  

    dim intTotFiels as integer

     

    放到全局

    2008年11月24日 3:47
    版主