listview.frm

VB6程序设计参考手册 -独立源码 VB6程序设计参考手册 -独立源码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form ListView 
   Caption         =   "ListView"
   ClientHeight    =   2580
   ClientLeft      =   3795
   ClientTop       =   2190
   ClientWidth     =   3330
   LinkTopic       =   "Form1"
   ScaleHeight     =   2580
   ScaleWidth      =   3330
   Tag             =   "hello"
   Begin MSComctlLib.ImageList Big_IList 
      Left            =   1680
      Top             =   1920
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "ListView.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "ListView.frx":0452
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "ListView.frx":08A4
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "ListView.frx":127E
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ImageList Small_IList 
      Left            =   120
      Top             =   1920
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "ListView.frx":16D0
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "ListView.frx":1B22
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "ListView.frx":1F74
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "ListView.frx":294E
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ListView Demo_LView 
      Height          =   1695
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   2895
      _ExtentX        =   5106
      _ExtentY        =   2990
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      AllowReorder    =   -1  'True
      HoverSelection  =   -1  'True
      _Version        =   393217
      Icons           =   "Big_IList"
      SmallIcons      =   "Small_IList"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.Menu Menu 
      Caption         =   "菜单"
      Begin VB.Menu LargeIcon_Menu 
         Caption         =   "大图标"
         Checked         =   -1  'True
      End
      Begin VB.Menu SmallIcon_Menu 
         Caption         =   "小图标"
      End
      Begin VB.Menu List_Menu 
         Caption         =   "列表"
      End
      Begin VB.Menu Report_Menu 
         Caption         =   "报表"
      End
   End
End
Attribute VB_Name = "ListView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim FSO As Scripting.FileSystemObject

'  显示右键菜单
Private Sub Demo_LView_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then  '判断是否鼠标右键事件
        PopupMenu Menu      '显示用户自定义菜单
    End If
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Dim LItem As ListItem
    Dim DirN As Folder
    Dim f As File
    
    Menu.Visible = False
    
    '  设定ListView控件大小和位置
    With Demo_LView
        .Top = 50
        .Left = 50
        .Height = Me.ScaleHeight - 100
        .Width = Me.ScaleWidth - 100
    End With
    
    '  设定大小图标属性
    Demo_LView.Icons = Big_IList
    Demo_LView.SmallIcons = Small_IList
    
    '  创建报表视图的ColumnHeader对象
    Demo_LView.ColumnHeaders.Add , , "名称", Demo_LView.Width / 2
    Demo_LView.ColumnHeaders.Add , , "类型", Demo_LView.Width / 2
    Set FSO = New FileSystemObject
    Set DirN = FSO.GetFolder("D:\cafe blue")
    '  添加列表项
    For Each f In DirN.Files
        Set LItem = Demo_LView.ListItems.Add(, , f.ShortName)
        LItem.SubItems(1) = f.Type
        '  为列表项指定大小图标
        LItem.Icon = GetIcon(f)
        LItem.SmallIcon = GetIcon(f)
    Next
End Sub

'  大图标菜单项
Private Sub LargeIcon_Menu_Click()
    LargeIcon_Menu.Checked = True
    SmallIcon_Menu.Checked = False
    Report_Menu.Checked = False
    List_Menu.Checked = False
    
    ' 每个 ListItem 对象由整幅图标和文本标签代表
    Demo_LView.View = lvwIcon
End Sub

'  小图标菜单项
Private Sub SmallIcon_Menu_Click()
     SmallIcon_Menu.Checked = True
     LargeIcon_Menu.Checked = False
     Report_Menu.Checked = False
     List_Menu.Checked = False
     
     ' 每个 ListItem 对象由小图标及其右侧的文本标签代表,项目水平排列
     Demo_LView.View = lvwSmallIcon
End Sub

'  列表菜单项
Private Sub List_Menu_Click()
    List_Menu.Checked = True
    LargeIcon_Menu.Checked = False
    SmallIcon_Menu.Checked = False
    Report_Menu.Checked = False
    
    '  每个 ListItem 对象由小图标及其右侧的文本标签代表,
    '  ListItem 对象及其相关的信息在列中垂直排列
    Demo_LView.View = lvwList
End Sub

'  报表菜单项
Private Sub Report_Menu_Click()
    Report_Menu.Checked = True
    LargeIcon_Menu.Checked = False
    SmallIcon_Menu.Checked = False
    List_Menu.Checked = False
    
    '  报表视图，每个 ListItem 对象显示为小图标和文本标签
    '  可在子项目中提供关于每个 ListItem 对象的附加信息
    '  图标、文本标签和信息显示在列中，其中最左侧一列包含小图标和文本标签
    '  附加列显示每个项目的子项目的文本
    Demo_LView.View = lvwReport
End Sub

'  根据文件类型选择图标
Private Function GetIcon(f As File) As Integer
    Dim ExtName As String
    ExtName = UCase(Right(f.ShortName, 3))
    Select Case ExtName
        Case "TXT", "DOC", "HTM", "PDF"
            GetIcon = 1
        Case "MP3", "WAV", "APE", "MID", "WMA"
            GetIcon = 2
        Case "JPG", "BMP", "GIF", "ICO"
            GetIcon = 3
        Case Else
            GetIcon = 4
    End Select
End Function