Lập trình VBA tạo danh sách ảnh trên ListView bằng control BSListView và BSImageList trong BSAC

[Nguyễn Duy Tuân]

Đã có những ví dụ về việc ứng dụng BSImageList để hiển thị ảnh trong các ví dụ tôi làm trước đây cho BSTreeView, BSListBox, BSComBoBox, tạo hình chuyển động,... Hôm nay xin chia sẻ phương pháp tạo danh sách ảnh hiển thị trong ListView bằng control BSListView với BSIMageList trong BSAC activeX controls.

Download source code: https://drive.google.com/file/d/1LAbWVPS6WZbr95vUPoIs1aypSkfsAP2f/view?usp=sharing

Option Explicit
'Author: Nguyen Duy Tuan - http://bluesofts.net
'Facebook: https://www.facebook.com/groups/hocexcel

Private Sub BSButton1_OnClick()
    Unload Me
End Sub

Private Sub BSComboBox1_OnSelect()
    BSListView1.View = BSComboBox1.ItemIndex
    If BSListView1.View = vsReport Then
        BSListView1.AutoColumns
    End If
End Sub
'When move task pane
Private Sub BSTaskPaneX1_OnDockChange(ByVal DockPosition As BSAC.TBSDockPosition)
    If DockPosition = dpBottom Or DockPosition = dpTop Then
        BSComboBox1.ItemIndex = vsList
    ElseIf DockPosition = dpLeft Or DockPosition = dpRight Then
        BSComboBox1.ItemIndex = vsSmallIcon
    Else
        BSComboBox1.ItemIndex = vsIcon
    End If
    BSComboBox1_OnSelect 'Update BSListView
End Sub

Private Sub UserForm_Initialize()
    Dim fso As New FileSystemObject
    Dim fo As Folder, fi As File
    Dim li As BSListItem, idx As Long
   
    BSComboBox1.Items.Add "Icon"
    BSComboBox1.Items.Add "SmallIcon"
    BSComboBox1.Items.Add "List"
    BSComboBox1.Items.Add "Report"
    BSComboBox1.ItemIndex = 2 'List
   
    BSImageList1.SetSize 236, 234 'Large
    BSImageList2.SetSize 32, 32 'Small
   
    BSListView1.Columns.Add "File name"
    BSListView1.Columns.Add "Type"
    BSListView1.Columns.Add "Size"
    BSListView1.Columns.Add "Date Created"
   
    Set fo = fso.GetFolder(ThisWorkbook.Path & "\Pics")
    For Each fi In fo.Files
        idx = BSImageList1.ListImages.Add(fo.Path & "\" & fi.Name, fi.Name)
        Call BSImageList2.ListImages.Add(fo.Path & "\" & fi.Name, fi.Name)
        Set li = BSListView1.Items.Add(fi.Name, idx)
        li.SubItems.Add fi.Type
        li.SubItems.Add fi.Size
        li.SubItems.Add fi.DateCreated
    Next
   
    BSListView1.ShowColumnHeaders = True
    BSListView1.RowSelect = True
    BSListView1.ReadOnly = True
    Set BSListView1.ImageList = BSImageList1
    'BSListView1.hSmallImageList = BSImageList2.hImageList
   
    BSListView1.View = vsList
    BSListView1.AutoColumns
   
    'Must set: Userform.ShowModal = False
    BSTaskPaneX1.Caption = "View Picture"
    BSTaskPaneX1.DockPosition = dpTop
    BSTaskPaneX1.AllowHide = False
    BSTaskPaneX1.Create Me
End Sub

Private Sub UserForm_Resize()
    On Error Resume Next
    BSListView1.Width = Width - BSListView1.Left
    BSListView1.Height = Height - BSListView1.Top
    Frame1.Left = BSListView1.Width - Frame1.Width
End Sub

Private Sub UserForm_Terminate()
    'Free memory
    BSImageList1.ListImages.Clear
    BSImageList2.ListImages.Clear
End Sub