VB6 PRO DOCS

中文

English

中文

English

Appearance

ImageCombo Control (VBCCRImageCombo) ​

ImageCombo 控件是一个带有图像的组合框控件，它可以在每个列表项的旁边显示一个图像。这个控件通常与 ImageList 控件配合使用，用于创建更直观的下拉列表。

属性 ​

基本属性 ​

  • Text - 当前选择的项的文本
  • List - 列表项集合
  • ListCount - 列表项数量
  • ListIndex - 当前选中项的索引
  • BackColor - 背景颜色
  • ForeColor - 前景颜色
  • Enabled - 是否启用控件
  • Font - 字体设置
  • Visible - 是否可见

图像相关属性 ​

  • ImageList - 关联的图像列表控件
  • Images - 项目关联的图像集合
  • IndentLevel - 缩进级别
  • ItemData - 项目关联的数值数据
  • SelImage - 选中时的图像索引
  • Image - 默认图像索引

事件 ​

  • Change - 选择改变时触发
  • Click - 点击控件时触发
  • DblClick - 双击控件时触发
  • DropDown - 下拉列表时触发
  • GotFocus - 获得焦点时触发
  • KeyDown - 按下键盘时触发
  • KeyPress - 键盘按键时触发
  • KeyUp - 释放键盘时触发
  • LostFocus - 失去焦点时触发
  • MouseDown - 鼠标按下时触发
  • MouseMove - 鼠标移动时触发
  • MouseUp - 鼠标释放时触发
  • Scroll - 滚动列表时触发
  • CloseUp - 关闭下拉列表时触发

代码示例 ​

基本用法 ​

vb
Private Sub InitImageCombo()
    ' 设置图像列表
    Set ImageCombo1.ImageList = ImageList1
    
    ' 添加项目
    With ImageCombo1
        .AddItem "文档"
        .ListImages(0).Picture = 1  ' 文档图标
        
        .AddItem "图片"
        .ListImages(1).Picture = 2  ' 图片图标
        
        .AddItem "音乐"
        .ListImages(2).Picture = 3  ' 音乐图标
    End With
End Sub

树形菜单实现 ​

vb
Private Type MenuItem
    Text As String
    ImageIndex As Long
    SelImageIndex As Long
    Level As Long
    Tag As String
    SubItems() As Long  ' 子项索引数组
    SubItemCount As Long
    ParentIndex As Long
End Type

Private Type MenuManager
    Items() As MenuItem
    Count As Long
    ImageList As ImageList
End Type

Private Menu As MenuManager

Private Sub InitMenuManager()
    With Menu
        ReDim .Items(1 To 100)
        .Count = 0
        Set .ImageList = ImageList1
    End With
End Sub

Private Function AddMenuItem(ByVal Text As String, _
                           ByVal ImageIndex As Long, _
                           Optional ByVal SelImageIndex As Long = -1, _
                           Optional ByVal Level As Long = 0, _
                           Optional ByVal ParentIndex As Long = 0) As Long
    With Menu
        .Count = .Count + 1
        
        With .Items(.Count)
            .Text = Text
            .ImageIndex = ImageIndex
            .SelImageIndex = IIf(SelImageIndex = -1, ImageIndex, SelImageIndex)
            .Level = Level
            .ParentIndex = ParentIndex
            ReDim .SubItems(1 To 10)
            .SubItemCount = 0
            
            ' 如果有父项，添加到父项的子项列表
            If ParentIndex > 0 Then
                With Menu.Items(ParentIndex)
                    .SubItemCount = .SubItemCount + 1
                    If .SubItemCount > UBound(.SubItems) Then
                        ReDim Preserve .SubItems(1 To .SubItemCount + 10)
                    End If
                    .SubItems(.SubItemCount) = Menu.Count
                End With
            End If
        End With
        
        AddMenuItem = .Count
    End With
End Sub

Private Sub UpdateComboItems()
    With ImageCombo1
        ' 清空列表
        Do While .ListCount > 0
            .RemoveItem 0
        Loop
        
        ' 添加所有项目
        Dim i As Long
        For i = 1 To Menu.Count
            With Menu.Items(i)
                ' 添加项目
                ImageCombo1.AddItem Space$(.Level * 4) & .Text
                ImageCombo1.ListImages(ImageCombo1.ListCount - 1).Picture = .ImageIndex
            End With
        Next i
    End With
End Sub

Private Function FindItemByText(ByVal Text As String, _
                              Optional ByVal ExactMatch As Boolean = True) As Long
    Dim i As Long
    For i = 1 To Menu.Count
        If ExactMatch Then
            If Menu.Items(i).Text = Text Then
                FindItemByText = i
                Exit Function
            End If
        Else
            If InStr(1, Menu.Items(i).Text, Text, vbTextCompare) > 0 Then
                FindItemByText = i
                Exit Function
            End If
        End If
    Next i
    FindItemByText = 0
End Function

Private Sub GetSubItems(ByVal Index As Long, ByRef Results() As Long)
    If Index < 1 Or Index > Menu.Count Then Exit Sub
    
    With Menu.Items(Index)
        If .SubItemCount > 0 Then
            ReDim Results(1 To .SubItemCount)
            Dim i As Long
            For i = 1 To .SubItemCount
                Results(i) = .SubItems(i)
            Next i
        Else
            ReDim Results(0)
        End If
    End With
End Sub

数据绑定 ​

vb
Private Type ItemData
    ID As Long
    Text As String
    ImageIndex As Long
    ExtraData As String
End Type

Private Type DataManager
    Items() As ItemData
    Count As Long
    ImageList As ImageList
End Type

Private Data As DataManager

Private Sub InitDataManager()
    With Data
        ReDim .Items(1 To 100)
        .Count = 0
        Set .ImageList = ImageList1
    End With
End Sub

Private Sub AddDataItem(ByVal ID As Long, _
                       ByVal Text As String, _
                       ByVal ImageIndex As Long, _
                       Optional ByVal ExtraData As String = "")
    With Data
        .Count = .Count + 1
        If .Count > UBound(.Items) Then
            ReDim Preserve .Items(1 To .Count + 100)
        End If
        
        With .Items(.Count)
            .ID = ID
            .Text = Text
            .ImageIndex = ImageIndex
            .ExtraData = ExtraData
        End With
    End With
End Sub

Private Sub BindData()
    With ImageCombo1
        ' 清空列表
        Do While .ListCount > 0
            .RemoveItem 0
        Loop
        
        ' 添加数据项
        Dim i As Long
        For i = 1 To Data.Count
            With Data.Items(i)
                ImageCombo1.AddItem .Text
                ImageCombo1.ListImages(ImageCombo1.ListCount - 1).Picture = .ImageIndex
                ImageCombo1.ItemData(ImageCombo1.ListCount - 1) = .ID
            End With
        Next i
    End With
End Sub

Private Function FindDataById(ByVal ID As Long) As Long
    Dim i As Long
    For i = 1 To Data.Count
        If Data.Items(i).ID = ID Then
            FindDataById = i
            Exit Function
        End If
    Next i
    FindDataById = 0
End Function

Private Sub ImageCombo1_Click()
    ' 获取选中项的数据
    If ImageCombo1.ListIndex >= 0 Then
        Dim ID As Long
        ID = ImageCombo1.ItemData(ImageCombo1.ListIndex)
        
        Dim Index As Long
        Index = FindDataById(ID)
        
        If Index > 0 Then
            With Data.Items(Index)
                Debug.Print "选中项: " & .Text
                Debug.Print "ID: " & .ID
                Debug.Print "额外数据: " & .ExtraData
            End With
        End If
    End If
End Sub

自动完成功能 ​

vb
Private Type AutoComplete
    Enabled As Boolean
    Timer As VBCCRTimer
    LastInput As String
    MatchCase As Boolean
    MinChars As Long
End Type

Private AC As AutoComplete

Private Sub InitAutoComplete()
    With AC
        .Enabled = True
        Set .Timer = Timer1
        .Timer.Interval = 500  ' 500毫秒延迟
        .Timer.Enabled = False
        .LastInput = ""
        .MatchCase = False
        .MinChars = 2
    End With
End Sub

Private Sub ImageCombo1_KeyPress(KeyAscii As Integer)
    If Not AC.Enabled Then Exit Sub
    
    ' 记录输入
    AC.LastInput = AC.LastInput & Chr$(KeyAscii)
    
    ' 重置计时器
    AC.Timer.Enabled = False
    AC.Timer.Enabled = True
End Sub

Private Sub Timer1_Timer()
    AC.Timer.Enabled = False
    
    ' 执行自动完成
    If Len(AC.LastInput) >= AC.MinChars Then
        Dim Found As Boolean
        Found = False
        
        ' 查找匹配项
        Dim i As Long
        For i = 0 To ImageCombo1.ListCount - 1
            Dim ItemText As String
            ItemText = ImageCombo1.List(i)
            
            If AC.MatchCase Then
                If Left$(ItemText, Len(AC.LastInput)) = AC.LastInput Then
                    Found = True
                    Exit For
                End If
            Else
                If Left$(LCase$(ItemText), Len(AC.LastInput)) = LCase$(AC.LastInput) Then
                    Found = True
                    Exit For
                End If
            End If
        Next i
        
        ' 如果找到匹配项，选中它
        If Found Then
            ImageCombo1.ListIndex = i
        End If
    End If
    
    ' 清除输入缓存
    AC.LastInput = ""
End Sub

最佳实践 ​

  1. 错误处理
vb
Private Function SafeAddItem(ByVal Text As String, _
                           ByVal ImageIndex As Long) As Boolean
    On Error GoTo ErrorHandler
    
    With ImageCombo1
        .AddItem Text
        .ListImages(.ListCount - 1).Picture = ImageIndex
    End With
    
    SafeAddItem = True
    Exit Function
    
ErrorHandler:
    Debug.Print "添加项目失败: " & Err.Description
    SafeAddItem = False
End Function
  1. 数据导出导入
vb
Private Sub SaveItemsToFile(ByVal FilePath As String)
    Dim FileNum As Long
    FileNum = FreeFile
    
    Open FilePath For Output As #FileNum
    
    With ImageCombo1
        Dim i As Long
        For i = 0 To .ListCount - 1
            Print #FileNum, .List(i) & "," & _
                          .ListImages(i).Picture & "," & _
                          .ItemData(i)
        Next i
    End With
    
    Close #FileNum
End Sub

Private Sub LoadItemsFromFile(ByVal FilePath As String)
    Dim FileNum As Long
    FileNum = FreeFile
    
    Open FilePath For Input As #FileNum
    
    With ImageCombo1
        ' 清空现有项目
        Do While .ListCount > 0
            .RemoveItem 0
        Loop
        
        ' 读取项目
        Do While Not EOF(FileNum)
            Dim Line As String
            Line Input #FileNum, Line
            
            Dim Parts() As String
            Parts = Split(Line, ",")
            
            If UBound(Parts) >= 2 Then
                .AddItem Parts(0)
                .ListImages(.ListCount - 1).Picture = CLng(Parts(1))
                .ItemData(.ListCount - 1) = CLng(Parts(2))
            End If
        Loop
    End With
    
    Close #FileNum
End Sub
  1. 状态保存
vb
Private Sub SaveImageComboState()
    SaveSetting App.Title, "ImageCombo", "SelectedIndex", CStr(ImageCombo1.ListIndex)
    SaveSetting App.Title, "ImageCombo", "AutoComplete", CStr(AC.Enabled)
End Sub

Private Sub RestoreImageComboState()
    With ImageCombo1
        .ListIndex = CLng(GetSetting(App.Title, "ImageCombo", "SelectedIndex", "-1"))
    End With
    
    AC.Enabled = CBool(GetSetting(App.Title, "ImageCombo", "AutoComplete", "True"))
End Sub

ImageCombo 控件通过在列表项旁边显示图像，提供了更直观的选择界面。通过合理的扩展，可以实现树形菜单、数据绑定和自动完成等功能。上述示例展示了 ImageCombo 控件的多种用法，开发者可以根据具体需求选择合适的实现方式。

VB6及其LOGO版权为微软公司所有

VBMAN 版权所有 © 2019-2025 邓伟