form1.frm

这里有很多很实用的VB编程案例,方便大家学习VB.

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("Warning this will really add a Directory to your System. Do you want to continue?", vbYesNo) = vbNo Then Exit Sub

    On Error Resume Next

    MkDir Text1.Text

    If Err Then
        MsgBox "There was an error adding this directory so it will not be added."
        Exit Sub
    End If

    On Error GoTo 0
    Set itmX = ListView1.ListItems.Add(, , Text1.Text)
    itmX.Icon = 1
    itmX.SmallIcon = 1
End Sub


Private Sub Command4_Click()
    Dim itmFound  As ListItem
    Set itmFound = ListView1.FindItem(Text2.Text, lvwText, , lvwPartial)
    If itmFound Is Nothing Then
        MsgBox "No match found"
        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 = "ListView Sample"

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 , , "Name", ListView1.Width / 3
Set clmX = ListView1.ColumnHeaders.Add(, , "Size", ListView1.Width / 3)
Set clmX = ListView1.ColumnHeaders.Add(, , "Date", ListView1.Width / 3)
    
ListView1.BorderStyle = ccFixedSingle
    
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

End Sub


Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)
    ListView1.SortKey = ColumnHeader.Index - 1
End Sub





Private Sub ListView1_DblClick()
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 = "ListView Sample - " & 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