Lotusnut >> Soft >> Visual Basic >> ListView2

Visual Basic 6.0

■　No.4　リストビューコントロールへの表示を考える。その2

  • 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を抜けて、バックグランドで残りを読むというロジックを考えたがなかなか良いアイディアが浮かばない。やはり一気にそのノード分は全て読み込んで次のユーザー処理を待ったほうが都合が良さそうであるが、速度を何とか速める方法を考えねば・・・
    長い道のりはまだまだ続く・・・・・

メニューＴＯＰへ