Lotusnut >> Soft >> Visual Basic >> ListView2

Visual Basic 6.0

  • Option Explicit
  • Function dfLvwDB(ByVal ctrl As Variant, ByVal strPath As String) As Integer
  • ' 作  者(Writer) : lotusnut
  • ' 目  的(Aim) : リストビューに strPath内のフォルダー・ファイルを取り込む
  • ' 入  力(Input) : リストビューコントロール・フォルダーパス=Node.Key
  • ' 受け渡し(Delivery): なし
  • ' 戻  値(Return): フォルダー・ファイル数
  • ' 出  力(Output): なし
  • ' 注  釈(Notes): このプロシージャはツリービューコントロール専用です
  • ' 使用方法(Usage): Count = dfLvwDB(Ctrl,path)
  • ' 履  歴(History): Ver 0.0.0 2002/12/12 Original
  • On Error GoTo ErrTrap
  • 'ローカル変数の宣言
  • Dim itm As ListItem
  • Dim cvt As New clsVntTo
  • Dim lngcount As Long
  • Dim lngresult As Long
  • Dim FName As String
  • '引数の検証&変換
  • strPath = cvt.dfVntToTrimStr(strPath)
  • If strPath = "" Then Exit Function
  • If Not TypeOf ctrl Is ListView Then
  • Debug.Print "sfLvwSetColumリストビューコントロールが不正です"& _
  • Err.Description
  • Exit Function
  • End If
  • '***** プロシージャ処理の実行 *****
  • If strPath = "Root" Or strPath = "Mycom" Then
  • Exit Function
  • 'マウスアイコンを砂時計にし再描画を抑止
  • Sceen.MousePointer = vbHourglass
  • lngresult = SendMessage(ctrl.hWnd, _
  • WM_SETREDRAW, 0, ByVal CLng(0))
  • 'リストのクリア
  • trl.ListItems.Clear
  • '最初のディレクトリを取得
  • If Right$(strPath, 1) <> "\" Then
  • strPath = strPath & "\"
  • End If
  • '最初のファイル名を取得
  • FName = Dir(strPath, vbDirectory)
  • Do While FName <> ""
  • If (FName <> ".") And (FName <> "..")
  • Then
  • If (GetAttr(strPath & FName) And vbDirectory)
  • = vbDirectory Then
  • lngcount = lngcount + 1
  • 'オブジェクトの設定
  • Set itm = ctrl.ListItems.Add(, , FName, , "Folder")
  • itm.SubItems(2) = "< D I R >"
  • itm.SubItems(3) = Left(FileDateTime(strPath &
  • FName), 16)
  • If GetAttr(strPath & FName) And vbDirectory
  • Then itm.Ghosted = False
  • End If
  • End If
  • FName = Dir
  • Loop
  • '最初のファイル名を取得
  • FName = Dir(strPath & "*.*")
  • Do While FName <> ""
  • lngcount = lngcount + 1
  • lngsize = Round(FileLen(strPath & FName) / 1024)
  • If lngsize = 0 And FileLen(strPath & FName) <>
  • 0 Then lngsize = 1
  • 'オブジェクトの設定
  • Set itm = ctrl.ListItems.Add(, , FName)
  • itm.SubItems(1) = Format(lngsize, "###,###,##0")
  • & " KB"
  • itm.SubItems(2) = Right(FName, 3) & "ファイル"
  • itm.SubItems(3) = Left(FileDateTime(strPath & FName), 16)
  • If GetAttr(strPath & FName) And vbSystem Then _
  • itm.Ghosted = False
  • FName = Dir
  • Loop
  • 'フォルダー&ファイルの総数を返す
  • dfLvwDB = lngcount
  • 'オブジェクト数を確認
  • If lngcount = 0 Then
  • Set itm = ctrl.ListItems.Add(, , "There is not a file." _
    , , "NoFile")
    End If
  • '表示の復活
    Screen.MousePointer = vbDefault
    lngresult = SendMessage(ctrl.hWnd, _
    WM_SETREDRAW, _
    1, ByVal CLng(0))
    Exit Function
  • 'エラートラップ
    ErrTrap:
    Debug.Print "dfLvwDBプロシージャエラーです : " & Err.Description
    On Error GoTo 0

    End Function

    感想;

     ・・・前回のツリービューの処理ロジックからフォルダー・ファイル情報を取得する第二の方法 Dir関数を使って組み立ててみた。なるほど体感的にも速度が上がっているのは事実である。がフォルダー内のファイル数が1000を越える頃から急に速度が落ちる幹事は否めない。300カウントあたりで、LOOPを抜けて、バックグランドで残りを読むというロジックを考えたがなかなか良いアイディアが浮かばない。やはり一気にそのノード分は全て読み込んで次のユーザー処理を待ったほうが都合が良さそうであるが、速度を何とか速める方法を考えねば・・・
    長い道のりはまだまだ続く・・・・・

メニューTOPへ