You are here Create BS ListView grouping rows, support unicode and icons

Create BS ListView grouping rows, support unicode and icons

ListView in Microsoft's old activeX suite programmed for VB6, VBA does not support unicode, 64-bit, they have stopped developing. BSAC with BSListView is an alternative solution to support unicode and 64-bit along with many of the latest properties.

This article guides how to program VBA with BSListView control to create ListView displaying unicode, grouping rows, displaying images/icons, unicode strings.

(If you want to see a simpler example of creating BSListView for easier understanding - Lesson 1 see here)

1. Install activex BSAC.ocx

This only needs to be done the first time. If you install Add-in A-Tools will install automatically. If you want to download BSAC separately with sample examples, go here: https://atoolspro.com/products/bsac-bluesofts-activex-controls.html

2. Embed activex BSAC into project

+ In VB6:

- Create Project

- Go to menu Project->Components: find and select BSAC.ocx

(BSAC 32-bit at C:\Windows\SysWow64\)

+ In VBA:

- ALT+F11 (Go to Visual Basic Application)

- Go to menu Insert->Userform

- Go to menu Tools->References...: find and select BSAC.ocx

(BSAC 32-bit: at C:\Windows\SysWow64\

BSAC 64-bit: at C:\Windows\System32\)

See more at: https://atoolspro.com/install-activex-controls-bsac-manually.html

- Right click on Toolbox, select "Additional Controls..." then check the controls used for programming, such as BSImageList, BSListView, BSTreeView, BSListBox, BSComboBox, BSTaskPaneX, BSTooltip,...

3. Create an interface with ListView on Form/Userform

- Drag and drop BSListView into Form/Userform. Adjust the size and position appropriately

- Drag BSButton into the form, set Name: "cmdAdd", Text: "Add"

- Drag BSButton into the form, set Name: "cmdRemove", Text: Delete"

- Drag BSImageList into the form (to save the icon displayed for BSListView).

From the BSImageList control, you should set the ColorDepth property to cd32Bit to get full color images.

Right-click, select Properties, select (Custom) in the Properties window, load the images (icon, jpec, png...) into the control.

Set the Font of the controls to "Tahoma".

4. Program to display ListView with unicode with BSListView control

Open the code window of Form/Userform, paste all the code below into it

'SOURCE CODE BEGIN--------
Option Explicit 
Private Sub UserForm_Initialize() 
   'Setup BSListView
   'Thiet lap ImageList to BSListView
   Set BSListView1.ImageList = BSImageList1 
   BSListView1.View = vsReport 
   BSListView1.RowSelect = True 
   BSListView1.CheckBoxes = True  'Show checkbox
   BSListView1.GroupView = True  'View grouping
   BSListView1.hGroupImageList = BSImageList1.Handle 
   BSListView1.ReadOnly = True  'Prevent item editing
   'Add columns to BSListView
   'Column: Caption, Width, ImageIndex
   ' Caption: use UNC() convert VNI/TCVN3 to unicode
   Dim lc As BSListColumn 
   Set lc = BSListView1.Columns.Add(UNC("Ngµy"), 110, 1) 
   lc.Alignment = taCenter 
   Set lc = BSListView1.Columns.Add(UNC("Tªn hµng"), 170, 2) 
   Set lc = BSListView1.Columns.Add(UNC("Sè lîng"), 90) 
   lc.Alignment = taCenter 
   Set lc = BSListView1.Columns.Add(UNC("§¬n gi¸"), 100) 
   lc.Alignment = taRightJustify 
   Set lc = BSListView1.Columns.Add(UNC("Thµnh tiÒn "), 100, 3) 
   lc.Alignment = taRightJustify 
   'Add Group (BSListGroup)
   Dim lg As BSListGroup 
   Dim li As BSListItem, I As Long 
   BSListView1.Items.BeginUpdate  'High speed
   On Error GoTo lbEndUpdate 
   Set lg = BSListView1.Groups.Add(UNC("§iÖn tö"), UNC("C¸c mÆt hµng nh tivi, m¸y tÝnh, ®iÖn tho¹i"), "dientu", 0) 
   lg.FooterAlign = taRightJustify 
   'Add row (BSListItem)
   Set li = BSListView1.Items.Add(Date, 1) 
   'Add column
   li.SubItems.Add UNC("M¸y tÝnh "), 2 
   li.SubItems.Add 1 
   li.SubItems.Add Format(15000000, "#,##0") 
   li.SubItems.Add Format(15000000, "#,##0") 
   Set li.Group = lg 
   'Add row (BSListItem)
   Set li = BSListView1.Items.Add(Date, 1) 
   'Add column
   li.SubItems.Add UNC("§iÖn tho¹i"), 2 
   li.SubItems.Add 1 
   li.SubItems.Add Format(10000000, "#,##0") 
   li.SubItems.Add Format(10000000, "#,##0") 
   Set li.Group = lg 
   lg.Footer = UNC("Céng: ") & Format(25000000, "#,##0") 
   Set lg = BSListView1.Groups.Add(UNC("Gia dông"), UNC("C¸c thiÕt bÞ dïng cho nÊu níng nh nåi, xoong nåi"), "giadung", 0) 
   lg.FooterAlign = taRightJustify 
   Dim Total As Double 
   For I = 1 To 6 
      'Add row (BSListItem)
      Set li = BSListView1.Items.Add(Date, 1) 
      'Add column
      li.SubItems.Add UNC("Ch¶o níng ") & I, 2 
      li.SubItems.Add 1 
      li.SubItems.Add Format(5000000, "#,##0") 
      li.SubItems.Add Format(5000000, "#,##0") 
      Set li.Group = lg 
      Total = Total + 5000000 
   Next 
   lg.Footer = UNC("Céng: ") & Format(Total, "#,##0") 
lbEndUpdate: 
   BSListView1.Items.EndUpdate 
   If Err <> 0 Then 
      MsgBox Err.Description, vbCritical 
   End If 
End Sub 
'-----------------------------------------------------------------------
'Get item info when selected
Private Sub BSListView1_OnSelectItem(ByVal Item As BSAC.BSListItem, ByVal IsSelected As Boolean) 
   'Get item info when it is selected
   Label1.Caption = IIf(Item.Checked, "Checked", "Uncheck") & " | " & Item.SubItems(0) & " | " & _ 
   Item.SubItems(1) & " | " & Item.SubItems(2) & " | " & Item.SubItems(3) 
End Sub 
'-----------------------------------------------------------------------
'BSAC.BSListView: create ListView with unicode
'Use UNC() convert VNI/TCVN3 to unicode
Private Sub cmdAdd_OnClick() 
   'Add row (BSListItem)
   Dim lg As BSListGroup, li As BSListItem, I As Long 
   If Not BSListView1.Selected Is Nothing Then 
      Set lg = BSListView1.Selected.Group 
   Else 
      Set lg = BSListView1.Groups(0) 
   End If 
   'Add row (BSListItem)
   Set li = BSListView1.Items.Add(Date, 1) 
   'Add column
   li.SubItems.Add UNC("MÆt hµng míi thªm lóc") & Format(Now, "mm:ss"), 2 
   li.SubItems.Add 1 
   li.SubItems.Add Format(20000000, "#,##0") 
   li.SubItems.Add Format(20000000, "#,##0") 
   Set li.Group = lg 
   'Calculate Total of items in group
   UpdateGroupTotal lg 
End Sub 
'-----------------------------------------------------------------------
Private Sub cmdRemove_OnClick() 
   If BSListView1.Selected Is Nothing Then 
      MsgBoxW "Please select an item.", vbCritical 
      Exit Sub 
   End If 
   Dim lg As BSListGroup 
   Set lg = BSListView1.Selected.Group 
   BSListView1.Selected.Delete 
   'Update Total in group
   UpdateGroupTotal lg 
End Sub 
'-----------------------------------------------------------------------
Sub UpdateGroupTotal(ByVal lg As BSListGroup) 
   Dim Total As Double, I& 
   Dim li As BSListItem 
   For I = 0 To BSListView1.Items.Count - 1 
      Set li = BSListView1.Items(I) 
      If li.Group.Key = lg.Key Then 
         Total = Total + Val(li.SubItems(3)) 
      End If 
   Next 
   lg.Footer = UNC("Céng: ") & Format(Total, "#,##0") 
   lg.FooterAlign = taRightJustify 
End Sub 
'SOURCE CODE END--------

If VB6 change the event name "UserForm_Initialize()" to "Form_Load()"

After running you get the screen as shown below:

(*) Note: to use group in BSAC you should update to BSAC v3.1.0.12 or upgrade Add-in A-Tools from this website.

BSAC.ocx is an activex that supports unicode, supports 32-bit, 64-bit with full controls such as BSListView, BSTreeView, BSImageList, BSTaskPane,...

Download SetupBSAC

Author: Nguyễn Duy Tuân

Powered By BLUESOFTS

Query, Share and Manage Excel workbooks on LAN, Internet

Create BS ListView grouping rows, support unicode and icons