listview.frm

vb精彩编程希望大家有用

         NumListImages   =   3
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "listview.frx":05EF
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "listview.frx":0909
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "listview.frx":0C23
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim xpos As Long, ypos As Long
Private Sub Check1_Click()
    '自动换行
    If Check1.Value Then
        ListView1.LabelWrap = True
    Else
        ListView1.LabelWrap = False
    End If
End Sub
Private Sub Check2_Click()
    '隐藏列标题
    If Check2.Value Then
        ListView1.HideColumnHeaders = True
    Else
        ListView1.HideColumnHeaders = False
    End If
End Sub
Private Sub Check3_Click()
    '隐藏选择
    If Check3.Value Then
        ListView1.HideSelection = True
    Else
        ListView1.HideSelection = False
    End If
End Sub
Private Sub Check4_Click()
    '标签编辑(自动/手动)
    If Check4.Value Then
        ListView1.LabelEdit = lvwAutomatic
    Else
        ListView1.LabelEdit = lvwManual
    End If
End Sub
Private Sub Combo1_Click()
    '图标显示方式
    Select Case Combo1.ListIndex
    Case 0:
        ListView1.View = lvwIcon
    Case 1:
        ListView1.View = lvwSmallIcon
    Case 2:
        ListView1.View = lvwList
    Case 3:
        ListView1.View = lvwReport
    End Select
End Sub
Private Sub Combo2_Click()
    '图标排列方式
    Select Case Combo2.ListIndex
    Case 0:
        ListView1.Arrange = 0
    Case 1:
        ListView1.Arrange = lvwAutoLeft
    Case 2:
        ListView1.Arrange = lvwAutoTop
    End Select
End Sub
Private Sub Command1_Click()
    '添加列标题
    ListView1.ColumnHeaders.Add , , Text3.Text
End Sub
Private Sub Command2_Click()
    '删除最后一列
    ListView1.ColumnHeaders.Remove ListView1.ColumnHeaders.Count
End Sub
Private Sub Command3_Click()
    '建立目录
    Dim itmX As ListItem
    Dim reply As Integer
    If MsgBox("该操作将在你的系统上建立一个目录，是否继续?", vbYesNo) = vbNo Then Exit Sub
    On Error Resume Next
    MkDir Text1.Text
    If Err Then
        MsgBox "操作出错，目录未建立！"
        Exit Sub
    End If
    On Error GoTo 0
    Set itmX = ListView1.ListItems.Add(, , Text1.Text)
    itmX.Icon = 1           ' 从ImageList1取得大图标
    itmX.SmallIcon = 1      ' 从ImageList2取得小图标
End Sub
Private Sub Command4_Click()
    '在列表中查找
    Dim itmFound  As ListItem
    Set itmFound = ListView1.FindItem(Text2.Text, lvwText, , lvwPartial)
    If itmFound Is Nothing Then
        MsgBox "没找到指定项!"
        Exit Sub
    Else
        itmFound.EnsureVisible ' 滚动到该项
        itmFound.Selected = True ' 选择该项
        ListView1.SetFocus
    End If
End Sub
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Load()
    Dim NameOfFile As String
    Dim clmX As ColumnHeader
    Dim itmX As ListItem
    Dim Counter As Long
    Dim dname As String
    Dim TempDname As String
    Dim counter2 As Integer
    Dim CurrentDir As String
    App.Title = "资源管理器"
    Me.Width = 640 * Screen.TwipsPerPixelX
    Me.Height = 480 * Screen.TwipsPerPixelY
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) / 2
    Combo1.ListIndex = 0
    Combo2.ListIndex = 0
    ListView1.ColumnHeaders.Add , , "名称", ListView1.Width / 3
    Set clmX = ListView1.ColumnHeaders.Add(, , "大小", ListView1.Width / 3)
    Set clmX = ListView1.ColumnHeaders.Add(, , "日期", ListView1.Width / 3)
    ListView1.BorderStyle = ccFixedSingle
    '设置ListView1的大图标从ImageList1中获取，小图标从ImageList2中获取
    ListView1.Icons = ImageList1
    ListView1.SmallIcons = ImageList2
    ChDrive Drive1.Drive
    Dir1.Path = CurDir
    Dim Fname As String
    If Right(Dir1.Path, 1) <> "\" Then
        CurrentDir = Dir1.Path & "\"
        dname = ".."
        Set itmX = ListView1.ListItems.Add(, , dname)
        itmX.SubItems(1) = ""
        itmX.Icon = 3
        itmX.SmallIcon = 3
        itmX.SubItems(2) = ""
    Else
        CurrentDir = Dir1.Path
    End If
    For Counter = 0 To File1.ListCount - 1
        Fname = File1.List(Counter)
        Set itmX = ListView1.ListItems.Add(, , Fname)
        itmX.SubItems(1) = CStr(FileLen(CurrentDir & Fname))
        itmX.Icon = 2
        itmX.SmallIcon = 2
        itmX.SubItems(2) = FileDateTime(CurrentDir & Fname)
    Next Counter
    For Counter = 0 To Dir1.ListCount - 1
        dname = Dir1.List(Counter)
        For counter2 = Len(dname) To 1 Step -1
            If Mid$(dname, counter2, 1) = "\" Then
                TempDname = Right(dname, Len(dname) - counter2)
                Exit For
            End If
        Next counter2
        Set itmX = ListView1.ListItems.Add(, , TempDname)
        itmX.SubItems(1) = ""
        itmX.Icon = 1
        itmX.SmallIcon = 1
        itmX.SubItems(2) = FileDateTime(dname)
    Next Counter
    ListView1.View = lvwIcon   '默认用大图标显示
    ListView1.Arrange = 0      '不排列
    ListView1.LabelWrap = False   '名称不换行
    ListView1.Sorted = True       '排序
    Form1.Caption = "资源管理器 - " & Dir1.Path
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)
    '单击列标题时，按其排序
    ListView1.SortKey = ColumnHeader.Index - 1
End Sub
Private Sub ListView1_DblClick()
    '当在ListView中双击时，如果是目录则打开该目录
    Dim Counter As Long
    Dim itmX As ListItem
    Dim NameOfFile As String
    Dim dname As String
    Dim TempDname As String
    Dim counter2 As Integer
    Dim Item As ListItem
    Dim CurrentDir As String
    If ListView1.HitTest(xpos, ypos) Is Nothing Then
        Exit Sub
    Else
        Set Item = ListView1.HitTest(xpos, ypos)
    End If
    If Right(Dir1.Path, 1) <> "\" Then
        CurrentDir = Dir1.Path & "\"
    Else
        CurrentDir = Dir1.Path
    End If
    '双击项不是目录，则返回
    If (GetAttr(CurrentDir & Item) And vbDirectory) <= 0 Then Exit Sub
    ListView1.ListItems.Clear  '清除原内容
    ChDir Item
    Dir1.Path = CurDir
    Dim Fname As String
    If Right(Dir1.Path, 1) <> "\" Then
        CurrentDir = Dir1.Path & "\"
        dname = ".."
        Set itmX = ListView1.ListItems.Add(, , dname)
        itmX.SubItems(1) = ""
        itmX.Icon = 3
        itmX.SmallIcon = 3
        itmX.SubItems(2) = ""
    Else
        CurrentDir = Dir1.Path
    End If
    For Counter = 0 To File1.ListCount - 1
        Fname = File1.List(Counter)
        Set itmX = ListView1.ListItems.Add(, , Fname)
        itmX.SubItems(1) = CStr(FileLen(CurrentDir & Fname))
        itmX.Icon = 2
        itmX.SmallIcon = 2
        itmX.SubItems(2) = FileDateTime(CurrentDir & Fname)
    Next Counter
    For Counter = 0 To Dir1.ListCount - 1
        dname = Dir1.List(Counter)
        For counter2 = Len(dname) To 1 Step -1
            If Mid$(dname, counter2, 1) = "\" Then
                TempDname = Right(dname, Len(dname) - counter2)
                Exit For
            End If
        Next counter2
        Set itmX = ListView1.ListItems.Add(, , TempDname)
        itmX.SubItems(1) = ""
        itmX.Icon = 1
        itmX.SmallIcon = 1
        itmX.SubItems(2) = FileDateTime(dname)
    Next Counter
    Form1.Caption = "资源管理器 - " & CurrentDir
End Sub
Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    xpos = x
    ypos = y
End Sub
Private Sub mabout_Click()
    Form2.Show 1
End Sub
Private Sub mexit_Click()
    Unload Form1
    End
End Sub