Click here to Skip to main content
15,886,565 members
Articles / Web Development / HTML

ExCB - Extended Multi Column ComboBox

Rate me:
Please Sign up or sign in to vote.
4.77/5 (31 votes)
21 Mar 2016CPOL6 min read 77.3K   3.6K   43  
Presenting an easy-to-use, flexible, filterable ComboBox, managing various data types (including images), also sortable, resizable and reordable columns
Option Compare Text

#Region "Imports"

Imports System
Imports System.Math
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Imports System.Drawing.Text
Imports System.Windows.Forms
Imports System.Windows.Forms.Design
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Imports System.Reflection
Imports System.ComponentModel.Design.Serialization
Imports System.Globalization

#End Region

#Region "Class ExCB"

Public Class ExCB
    Inherits UserControl

#Region "Enums"

    Public Enum DataType
        _Text       ' String
        _Date       ' Date[Time]
        _Numeric
        _LogicTxt   ' Boolean, Text checkbox
        _LogicImg   ' Boolean, Image checkbox
        _Image
    End Enum

    Public Enum SizeMode
        _Stretch    ' Only Stretch &
        _Zoom       ' Zoom are allowed
    End Enum

#End Region

#Region "Variables"

    Private Const _VSArea As Integer = 21           ' Vertical Scroll area
    Friend _ColAttr() As _cAttr                     ' Column's Attributes & Fields
    Private _ListRowHeight As Integer               ' Effective ListView row height
    Private IL As New ImageList                     ' Controls ListView row height
    Private IL813 As New ImageList                  ' ImageList for sort arrows
    Private Img_No As Image = My.Resources.cbNo     ' Original CheckBox (Unchecked)
    Private Img_Yes As Image = My.Resources.cbYes   ' Original CheckBox (Checked)
    Private _TxtHeight As Integer = 20              ' TextBox height
    Private _LblBoxH As Integer = 32                ' Label1 (counter) + TextBox1 heights
    Private _1stCol As Boolean = True               ' Flags first Column
    Private _1stRow As Boolean = True               ' Flags first Row
    Private _SelRow As Integer = -1                 ' Index of the currently selected item (row)
    Private _NCols As Integer = 0                   ' Number of columns
    Private _NCImg As Integer = 0                   ' Number of Columns with Image
    Private _ColsX As Integer = 0                   ' Columns X value
    Private _MaxSiz As Integer = _VSArea            ' Control's Max size (including vertical scroll area)
    Private _iRows As Integer = -1                  ' Last Row index (Number of Rows - 1)
    Private _NSRows As Integer = 0                  ' Number of Selected Rows
    Private _SRows() As Integer                     ' List of Selected Rows
    Private _NDRows As Integer = 0                  ' Number of Displayed Rows
    Private _EC_Tmp(,) As _ECT                      ' Temporary EmbeddedControls
    Private _TCImg() As Integer                     ' Temporary image Column List
    Private _TxtBk As String                        ' Previously typed Text
    Private _TBtyped As Boolean = False             ' Has text been typed?
    Private _MB_Right As Boolean = False            ' Right Mouse Button clicked?
    Private _Wrk As Boolean = False                 ' Used for bypassing some procedures

#End Region

#Region "Properties"

    Private _BStyle As BorderStyle = Windows.Forms.BorderStyle.Fixed3D
    <Category("_ExCB specifics")> _
    <Description("Location of the built-in Row counter")> _
    Public Overloads Property BorderStyle() As BorderStyle
        Get
            Return _BStyle
        End Get
        Set(ByVal value As BorderStyle)
            _BStyle = value
            _CalcSize()
        End Set
    End Property

    <Category("_ExCB specifics")> _
    <Description("The font used to display text in the TextBox and List portions of the ExCB")> _
    Public Overrides Property Font() As Font
        Get
            Return MyBase.Font
        End Get
        Set(ByVal Value As Font)
            MyBase.Font = Value
            Label1.Font = Value
            TextBox1.Font = Value
            MyLV1.Font = Value
            _CalcSize()
        End Set
    End Property

    Public Enum _CounterLoc
        None = 0
        TopLeft = 1
        BottomLeft = 2
        TopRight = 3
        BottomRight = 4
    End Enum

    Private _CtLoc As _CounterLoc = _CounterLoc.TopRight  '  see CounterLoc Enum (above)
    <Category("_ExCB specifics")> _
    <Description("Location of the built-in Row counter")> _
    Public Property CounterLoc() As _CounterLoc
        Get
            Return _CtLoc
        End Get
        Set(ByVal value As _CounterLoc)
            _CtLoc = value
            _CalcSize()
        End Set
    End Property

    Private _MinWidth As Integer = 87                ' Min width of control (TextBox width)
    <Category("_ExCB specifics")> _
    <Description("Minimum width of the control (TextBox + Button)")> _
    Public Property MinimumWidth() As Integer
        Get
            Return _MinWidth
        End Get
        Set(ByVal value As Integer)
            _MinWidth = If(value < 37, 37, value)
            Me.Width = value
            _CalcSize()
        End Set
    End Property

    Private _MaxDsp As Integer = 8                 ' Max Items to display in List
    <Category("_ExCB specifics")> _
    <Description("Maximum number of rows to display in the drop-down list")> _
    Public Property MaxRowsDisp() As Integer
        Get
            Return _MaxDsp
        End Get
        Set(ByVal value As Integer)
            _MaxDsp = value
        End Set
    End Property

    Dim _RdOnly As Boolean = False                  ' Read Only?
    ' If False, ignores 
    <Category("_ExCB specifics")> _
    <Description("Controls whether the ExCB can be dropped-down/changed")> _
    Public Property Read_Only() As Boolean
        Get
            Return _RdOnly
        End Get
        Set(ByVal value As Boolean)
            _RdOnly = value
            Button1.Visible = Not (_RdOnly)
            TextBox1.ReadOnly = _RdOnly
            MyLV1.Enabled = Not (_RdOnly)
            If _RdOnly Then
                TextBox1.BorderStyle = Windows.Forms.BorderStyle.FixedSingle
            Else
                TextBox1.BorderStyle = Windows.Forms.BorderStyle.Fixed3D
            End If
        End Set
    End Property

    <Category("_ExCB specifics")> _
    <Description("Displays grid lines in the list portion of the control")> _
    Public Property GridLines() As Boolean
        Get
            Return MyLV1.GridLines
        End Get
        Set(ByVal value As Boolean)
            MyLV1.GridLines = value
        End Set
    End Property

    Private _Filter As Boolean = False                  ' Filterable?
    <Category("_ExCB specifics")> _
    <Description("Can the list be filtered?")> _
    Public Property Filterable() As Boolean
        Get
            Return _Filter
        End Get
        Set(ByVal value As Boolean)
            _Filter = value
        End Set
    End Property

    Private _G_Resiz As Boolean = False                ' Resizable ?
    <Category("_ExCB specifics")> _
    <Description("Can the list columns be resized?")> _
    Public Property Resizable() As Boolean
        Get
            Return _G_Resiz
        End Get
        Set(ByVal value As Boolean)
            _G_Resiz = value
        End Set
    End Property

    Private _G_Reord As Boolean = False                ' Reordable ?
    <Category("_ExCB specifics")> _
    <Description("Can the list columns be reordered?")> _
    Public Property Reordable() As Boolean
        Get
            Return _G_Reord
        End Get
        Set(ByVal value As Boolean)
            _G_Reord = value
        End Set
    End Property

    Private _G_Sortab As Boolean = True                ' Sortable ?
    <Category("_ExCB specifics")> _
    <Description("Can the list be sorted by columns?")> _
    Public Property Sortable() As Boolean
        Get
            Return _G_Sortab
        End Get
        Set(ByVal value As Boolean)
            _G_Sortab = value
        End Set
    End Property

    Private _DispCol As Integer = 0                   ' Index of Column to Display 
    <Category("_ExCB specifics")> _
    <Description("Index of the column whose values are to be shown in the textbox")> _
    Public Property DisplayColumn() As Integer
        Get
            Return _DispCol
        End Get
        Set(ByVal value As Integer)
            _DispCol = value
        End Set
    End Property

    <System.ComponentModel.Browsable(False)> _
    Public ReadOnly Property Count() As Integer
        Get
            Return _iRows + 1
        End Get
    End Property

    <System.ComponentModel.Browsable(False)> _
    Public Property SelectedIndex() As Integer
        Get
            Return _SelRow
        End Get
        Set(ByVal value As Integer)
            If value < 0 OrElse value > _iRows Then
                MyLV1.SelectedItems.Clear()
                _SelRow = -1
                _Wrk = True
                TextBox1.Text = ""
                _Wrk = False
            Else
                MyLV1.Items(value).Selected = True
            End If
        End Set
    End Property

    <System.ComponentModel.Browsable(False)> _
    Public Overrides Property Text() As String
        Get
            Return TextBox1.Text
        End Get
        Set(ByVal value As String)
            _Wrk = True
            Dim iFound As Integer = RowSelect(_DispCol, value)
            If iFound = Nothing Then
                MyLV1.SelectedItems.Clear()
            Else
                MyLV1.Items(iFound).Selected = True
            End If
            _Wrk = False
        End Set
    End Property

    <System.ComponentModel.Browsable(False)> _
    ReadOnly Property Columns() As ListView.ColumnHeaderCollection      'Columns in the Listview
        Get
            Return MyLV1.Columns
        End Get
    End Property

    <System.ComponentModel.Browsable(False)> _
    ReadOnly Property Items() As ListView.ListViewItemCollection        'Items in the listview
        Get
            Return MyLV1.Items
        End Get
    End Property

    <DefaultValueAttribute(GetType(System.Drawing.Color), "Transparent")> _
    Public Overrides Property BackColor() As System.Drawing.Color
        Get
            Return MyBase.BackColor
        End Get
        Set(ByVal Value As System.Drawing.Color)
            MyBase.BackColor = Value
        End Set
    End Property

#End Region

#Region "Expandable properties"

    Private Sizes_ As New Sz_
    <TypeConverter(GetType(Sz_Conv))> _
    <Category("_ExCB specifics")> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Content)> _
    <Description("ExCB default sizes")> _
    Public Property Sizes() As Sz_
        Get
            Return Sizes_
        End Get
        Set(ByVal value As Sz_)
            Sizes_ = value
            _CalcSize()
        End Set
    End Property

    Private Colors_ As Co_ = New Co_
    <TypeConverter(GetType(Co_Conv))> _
    <Category("_ExCB specifics")> _
    <DesignerSerializationVisibility(DesignerSerializationVisibility.Content)> _
    <Description("ExCB default colors")> _
    <RefreshProperties(RefreshProperties.Repaint)> _
    Public Property Colors() As Co_
        Get
            Return Colors_
        End Get
        Set(ByVal value As Co_)
            Colors_ = value
            TextBox1.BackColor = Colors_.TBoxBackColor
            TextBox1.ForeColor = Colors_.TBoxForeColor
        End Set
    End Property

#End Region

#Region "Public Event"

    Public Event ItemSelected(ByVal ItemArray As Array, ByVal Index As Integer)
    Public Event DropDownChanged(IsDroppedDown As Boolean)

#End Region

#Region "Public Methods"

    Public Sub Clear(Optional ByVal AlsoColumns As Boolean = False)
        _HideLV()                   ' Hide ListView
        MyLV1.ECClear()             ' Clear Embedded Controls
        MyLV1.Items.Clear()         ' Clear Items
        MyLV1._ItmStr = Nothing     ' Clear added rows
        _SRows = Nothing
        _NSRows = 0
        _NDRows = 0
        _iRows = -1
        _SelRow = -1
        _1stRow = True
        _ListRowHeight = Sizes.ListRow_Height
        _Wrk = True
        TextBox1.Text = ""
        _Wrk = False
        Label1.Text = "0"
        If AlsoColumns Then
            MyLV1.Columns.Clear()   ' Clear Columns
            _ColAttr = Nothing      ' Clear Column definitions
            _NCols = 0
            _ColsX = 0
            _1stCol = True
            _MaxSiz = _VSArea
        End If
    End Sub

    Public Sub AddColumn(ByVal HeaderText As String, Optional ByVal Width As Integer = 80, _
                         Optional ByVal Align As HorizontalAlignment = HorizontalAlignment.Left, _
                         Optional ByVal DataType As DataType = DataType._Text, _
                         Optional ByVal Format As String = Nothing, _
                         Optional ByVal ForeColor As Integer = Nothing, _
                         Optional ByVal BackColor As Integer = Nothing, _
                         Optional ByVal ImgWidth As Integer = Nothing, _
                         Optional ByVal ImgHeight As Integer = Nothing, _
                         Optional ByVal SizeMode As SizeMode = SizeMode._Stretch, _
                         Optional ByVal Resizable As Boolean = True, _
                         Optional ByVal Reordable As Boolean = True, _
                         Optional ByVal Sortable As Boolean = True, _
                         Optional ByVal ArrowOnRight As Boolean = False)

        ' In VS2008, Colors are passed as "Integer", not as "Color", because
        ' "Optional parameters cannot have structure types"

        MyLV1.Columns.Add(HeaderText, Width, Align)
        If _NCols = 0 Then
            ReDim _ColAttr(0)
        Else
            ReDim Preserve _ColAttr(_NCols)
        End If
        _ColAttr(_NCols)._Type = DataType
        _ColAttr(_NCols)._Format = Format
        _ColAttr(_NCols)._Align = Align
        _ColAttr(_NCols)._X = _ColsX
        _ColAttr(_NCols)._Width = Width
        _ColAttr(_NCols).Resizable = Resizable
        _ColAttr(_NCols).Reordable = Reordable
        _ColAttr(_NCols).Sortable = Sortable
        _ColAttr(_NCols)._ArrowOnRight = ArrowOnRight

        ' Column BackColor and ForeColor
        If BackColor = Nothing Then
            _ColAttr(_NCols)._BackColor = MyLV1.BackColor
        Else
            _ColAttr(_NCols)._BackColor = Color.FromArgb(BackColor)
        End If
        If ForeColor = Nothing Then
            _ColAttr(_NCols)._ForeColor = Colors_.ListForeColor
        Else
            _ColAttr(_NCols)._ForeColor = Color.FromArgb(ForeColor)
        End If

        If _ColAttr(_NCols)._Type > 3 Then      ' Booleans with image or Image
            ReDim Preserve _TCImg(_NCImg)
            _TCImg(_NCImg) = _NCols
            _NCImg += 1                         ' Column with image
            If _ColAttr(_NCols)._Type = 4 Then  ' Booleans with image
                ' Prepare Column "checkboxes" with selected ForeColor
                _ColAttr(_NCols)._cbNo = ChgColor(Img_No, _ColAttr(_NCols)._ForeColor)
                _ColAttr(_NCols)._cbYes = ChgColor(Img_Yes, _ColAttr(_NCols)._ForeColor)
            End If
            _ColAttr(_NCols)._ForeColor = _ColAttr(_NCols)._BackColor
            If ImgWidth = Nothing Then
                If _ColAttr(_NCols)._Type = DataType._Image Then
                    _ColAttr(_NCols)._ImgWidth = Sizes_.Image_Width
                Else
                    _ColAttr(_NCols)._ImgWidth = Sizes_.YesNo_Height
                End If
            Else
                _ColAttr(_NCols)._ImgWidth = ImgWidth
            End If
            If ImgHeight = Nothing Then
                If _ColAttr(_NCols)._Type = DataType._Image Then
                    _ColAttr(_NCols)._ImgHeight = Sizes_.Image_Height
                Else
                    _ColAttr(_NCols)._ImgHeight = Sizes_.YesNo_Height
                End If
            Else
                _ColAttr(_NCols)._ImgHeight = ImgHeight
            End If
            If _ColAttr(_NCols)._Type = 5 Then      ' Image
                _ColAttr(_NCols)._SizeMode = SizeMode
                ' SizeMode Zoom not allowed in checkboxes (YesNo)
            End If
        End If

        If ImgHeight + 2 > _ListRowHeight Then
            ' Adjust ListView Row Height
            _ListRowHeight = Math.Max(Math.Max(ImgHeight + 2, Sizes.ListRow_Height), _ListRowHeight)
            IL.ImageSize = New Size(1, _ListRowHeight)
        End If

        _NCols += 1
        _ColsX += Width
        _MaxSiz += Width
    End Sub

    Public Sub AddRow(ByVal ItemArray As Object())
        If _1stRow Then
            ' Only first row
            MyLV1._ColsAttr(_ColAttr)
            _CalcSize()
            _1stRow = False
        End If
        Dim IA_Txt(_NCols - 1) As String        ' Initialize String Array
        For C As Integer = 0 To _NCols - 1      ' Every Column
            Dim CA As _cAttr = _ColAttr(C)
            If CA._Type = DataType._Image Then  ' Image DataType
                ' An Image is always created
                Dim _imgIndex As Integer = If(MyLV1._Images Is Nothing, 0, MyLV1._Images.Length)
                ReDim Preserve MyLV1._Images(_imgIndex)
                If TypeOf (ItemArray(C)) Is Image Then  ' Image sent?
                    MyLV1._Images(_imgIndex) = ItemArray(C)
                ElseIf TypeOf (ItemArray(C)) Is String Then
                    Dim Path As String = ItemArray(C)
                    If Path > "" Then                   ' Path supplied?
                        Try             ' Try to get Image from File
                            MyLV1._Images(_imgIndex) = Image.FromFile(Path)
                        Catch           ' Bad Path or image error
                            MyLV1._Images(_imgIndex) = Nothing
                        End Try
                    Else                ' Path not supplied
                        MyLV1._Images(_imgIndex) = Nothing
                    End If
                Else                    ' Bad data type
                    MyLV1._Images(_imgIndex) = Nothing
                End If
                IA_Txt(C) = _imgIndex
            Else                                ' All other DataTypes
                IA_Txt(C) = CType(ItemArray(C), String)
                If CA._Type < 3 Then
                    If CA._Format IsNot Nothing Then    ' Formatted data?
                        Try
                            If CA._Type = DataType._Date Then
                                IA_Txt(C) = Format(CDate(IA_Txt(C)), CA._Format)
                            ElseIf CA._Type = DataType._Numeric Then
                                IA_Txt(C) = Format(CDbl(IA_Txt(C)), CA._Format)
                            Else
                                IA_Txt(C) = Format(IA_Txt(C), CA._Format)
                            End If
                        Catch ex As Exception
                            If (MsgBox("Column Index: " & C.ToString & vbCr & _
                                   "Row Index: " & (_iRows + 1).ToString & vbCr & _
                                   "SubItem: " & IA_Txt(C).ToString & vbCr & vbCr & _
                                   ex.Message, MsgBoxStyle.OkCancel, "Data conversion error")) = MsgBoxResult.Cancel Then
                                Me.ParentForm.Close()
                            End If
                        End Try
                    End If
                End If
            End If
        Next
        _iRows += 1
        ReDim Preserve MyLV1._ItmStr(_iRows)
        MyLV1._ItmStr(_iRows) = IA_Txt
        _SelectRow(_iRows)
    End Sub

    Public Function RowSelect(ByVal ColIndex As Integer, ByVal Value As Object, Optional ByVal GetItem As Integer = -1)
        ' ColIndex: Column Index to search
        ' Value: value (string, number, boolean) to search
        ' GetItem: Column Index of item to return [of Row where Value(ColIndex) is found]

        If MyLV1.Columns.Count > 0 Then
            Dim _Found As Integer = -1
            If MyLV1._ItmStr.Length > MyLV1.Items.Count Then
                ' Not all Items selected?
                _SelectAllRows()
                _DisplayRows()
            End If
            For iCtr As Integer = 0 To _iRows   ' Search specific (ColIndex) element
                If MyLV1.Items(iCtr).SubItems(ColIndex).Text = If(_ColAttr(ColIndex)._Type = 3 _
                                OrElse _ColAttr(ColIndex)._Type = 4, _Bool2Char(Value), Value) Then
                    _Found = iCtr
                    Exit For
                End If
            Next
            If _Found >= 0 Then             ' ITEM FOUND
                _SelRow = _Found
                _Wrk = True
                TextBox1.Text = MyLV1.Items(_Found).SubItems(DisplayColumn).Text
                _Wrk = False
                MyLV1.Items(_Found).Selected = True
                MyLV1.Select()
                If GetItem >= 0 Then    ' Item required
                    Return IIf(_ColAttr(GetItem)._Type = 3 OrElse _ColAttr(GetItem)._Type = 4, _
                              _Char2Bool(MyLV1.Items(_Found).SubItems(GetItem).Text), _
                              MyLV1.Items(_Found).SubItems(GetItem).Text)
                End If
                Return _Found   ' Return Found Index
            Else                            ' ITEM NOT FOUND
                SelectedIndex = -1
                _Wrk = True
                TextBox1.Text = ""
                MyLV1.SelectedItems.Clear()
                _Wrk = False
                MyLV1_ItemSelectionChanged(Nothing, Nothing)    ' For firing the event
            End If
        End If
        Return Nothing  ' If no Columns or Item not found
    End Function

    Public Function GetImage(ImageIndex As Integer) As Image
        Dim Img As Image = Nothing
        If ImageIndex >= 0 Then
            If MyLV1._Images.Length > 0 And MyLV1._Images.Length > ImageIndex Then
                Img = MyLV1._Images(ImageIndex)
            End If
        End If
        Return Img
    End Function

    Public Function ARGB(ByVal C As Color) As Integer
        Return C.ToArgb
    End Function

#End Region

#Region "Sub New"

    Public Sub New()
        ' This call is required by the Windows Form Designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.

        Me.SetStyle(ControlStyles.SupportsTransparentBackColor, True)
        Me.BackColor = Color.Transparent

        ' The 2 lines above are suggested by Microsoft to give Controls
        ' a Transparent BackColor:
        ' http://msdn.microsoft.com/en-us/library/wk5b13s4(v=vs.85).aspx
        ' Unfortunatelly, it seems do not work...

        _BStyle = Windows.Forms.BorderStyle.Fixed3D

        IL813.ImageSize = New Size(8, 13)
        IL813.Images.Add(My.Resources.SortA)
        IL813.Images.Add(My.Resources.SortD)
    End Sub

#End Region

#Region "ListView code"

    Private Sub MyLV1_ItemSelectionChanged(ByVal sender As Object, ByVal e As System.Windows.Forms.ListViewItemSelectionChangedEventArgs) Handles MyLV1.ItemSelectionChanged
        If _Wrk = False Then
            Dim _iCC = _NCols - 1
            Dim _Itms(_iCC)
            If e IsNot Nothing Then
                Try
                    _SelRow = e.ItemIndex
                    _HideLV()
                    For iCtr As Integer = 0 To _iCC
                        If _ColAttr(iCtr)._Type = DataType._LogicTxt OrElse _ColAttr(iCtr)._Type = DataType._LogicImg Then
                            _Itms(iCtr) = _Char2Bool(MyLV1.Items(_SelRow).SubItems(iCtr).Text)
                        Else
                            _Itms(iCtr) = MyLV1.Items(_SelRow).SubItems(iCtr).Text
                        End If
                    Next
                    _Wrk = True
                    TextBox1.Text = _Itms(DisplayColumn)
                    _Wrk = False
                    'RaiseEvent ItemSelected(_Itms, _SelRow)
                Catch ex As Exception
                    MsgBox(ex.Message, , "ItemSelectionChanged")
                End Try
            End If
            RaiseEvent ItemSelected(_Itms, _SelRow)
        End If
    End Sub

    Private Sub ClearArrow()
        For iCtr As Integer = 0 To _NCols - 1
            If _ColAttr(iCtr)._Sort > 0 Then     ' Previous sorted column
                _ColAttr(iCtr)._Sort = 0
                SetItem(_ColAttr(iCtr)._Align, iCtr)    ' Send message HDM_SETITEM
                MyLV1.Invalidate(True)
                Exit For
            End If
        Next
    End Sub

    Private Sub MyLV1_ColumnClick(ByVal sender As Object, ByVal e As System.Windows.Forms.ColumnClickEventArgs) Handles MyLV1.ColumnClick
        If _G_Sortab Then
            If _ColAttr(e.Column).Sortable Then
                ' First, clear arrow of previous sorted column (if any)
                For iCtr As Integer = 0 To _NCols - 1
                    If iCtr <> e.Column Then
                        If _ColAttr(iCtr)._Sort > 0 Then     ' Previous sorted column
                            _ColAttr(iCtr)._Sort = 0
                            SetItem(_ColAttr(iCtr)._Align, iCtr)    ' Send message HDM_SETITEM
                            MyLV1.Invalidate(True)
                        End If
                    End If
                Next
                ' Next, draw arrow and sort data
                For iCtr As Integer = 0 To _NCols - 1
                    If iCtr = e.Column Then     ' Clicked column
                        If _ColAttr(iCtr)._Sort = 1 Then
                            _ColAttr(iCtr)._Sort = 2         ' If Ascending, -> Descending
                        Else
                            _ColAttr(iCtr)._Sort = 1         ' If Descending or None, -> Ascending
                        End If
                        SetItem(_ColAttr(iCtr)._Align, iCtr)        ' Send message HDM_SETITEM
                        MyLV1.ListViewItemSorter = New SortLV(e.Column, _ColAttr(iCtr)._Type, _ColAttr(iCtr)._Sort)
                    End If
                Next
            End If
        End If
    End Sub

    Private Sub SetItem(ByVal HA As HorizontalAlignment, ByVal Index As Integer)
        ' Send message HDM_SETITEM
        Dim HDI As New HDITEM
        HDI.mask = Defs.HDI_FORMAT
        HDI.fmt = HDF_OWNERDRAW Or HA
        Defs.SendMessage(MyLV1.Handle, HDM_SETITEM, Index, HDI)
    End Sub

    Private Sub MyLV1_DrawColumnHeader(ByVal sender As Object, ByVal e As DrawListViewColumnHeaderEventArgs) Handles MyLV1.DrawColumnHeader
        If _Wrk = False Then
            ' Draw Graphics
            e.DrawDefault = False
            e.Graphics.FillRectangle(New SolidBrush(Colors_.HeadBackColor), e.Bounds)
            Dim _Bnds As Rectangle = e.Bounds
            _Bnds.Width -= 1
            _Bnds.Height -= 2
            e.Graphics.DrawRectangle(SystemPens.ControlDarkDark, _Bnds)
            _Bnds.Width -= 1
            _Bnds.Height -= 1
            e.Graphics.DrawLine(SystemPens.ControlLightLight, _Bnds.X, _Bnds.Y, _Bnds.Right, _Bnds.Y)
            e.Graphics.DrawLine(SystemPens.ControlLightLight, _Bnds.X, _Bnds.Y, _Bnds.X, _Bnds.Bottom)
            e.Graphics.DrawLine(SystemPens.ControlDark, (_Bnds.X + 1), _Bnds.Bottom, _Bnds.Right, _Bnds.Bottom)
            e.Graphics.DrawLine(SystemPens.ControlDark, _Bnds.Right, (_Bnds.Y + 1), _Bnds.Right, _Bnds.Bottom)

            If e.ColumnIndex = _NCols - 1 Then  ' If last column
                ' Paint the area from last column to the end of the header
                Dim r1 As New Rectangle(e.Bounds.Right, e.Bounds.Top, Me.Width - e.Bounds.Right, e.Bounds.Height)
                e.Graphics.FillRectangle(New SolidBrush(Colors_.HeadBackColor), r1)
            End If

            ' Draw Text
            Dim _Flags As TextFormatFlags = e.Header.TextAlign Or TextFormatFlags.VerticalCenter
            If _Flags > 4 Then
                _Flags = (_Flags Xor 3)
            End If
            Dim _Txt As String = e.Header.Text
            Dim _Size As Size = TextRenderer.MeasureText(" ", e.Font)
            Dim _TxW As Integer = _Size.Width
            _Bnds = Rectangle.Inflate(e.Bounds, -_TxW, 0)
            TextRenderer.DrawText(e.Graphics, _Txt, e.Font, _Bnds, Colors_.HeadForeColor, _Flags)

            ' Draw Sort arrow ?
            If _ColAttr(e.ColumnIndex).Sortable Then
                If _ColAttr(e.ColumnIndex)._Sort > 0 Then
                    ' Yes, draw Sort Arrow - Left or Right aligned, Height centered
                    e.Graphics.DrawImage(IL813.Images(_ColAttr(e.ColumnIndex)._Sort - 1), e.Bounds.X + (_TxW - 8) \ 2 + _
                                            If(_ColAttr(e.ColumnIndex)._ArrowOnRight, _Bnds.Width + _TxW - 3, 2), _
                                            e.Bounds.Y + (e.Bounds.Height - 13) \ 2, 8, 13)
                End If
            End If

            If _1stCol Then    ' First time Column 0 is drawn
                Sizes_.ListRow_Height = Math.Max(Sizes_.ListRow_Height, _Size.Height)
                _ListRowHeight = Math.Max(Sizes_.ListRow_Height, _ListRowHeight)    ' Set effective ListView Row Height
                _1stCol = False
            End If
        End If
    End Sub

    Private Sub MyLV1_DrawSubItem(ByVal sender As Object, ByVal e As DrawListViewSubItemEventArgs) Handles MyLV1.DrawSubItem
        e.DrawDefault = True
    End Sub

    Private Sub MyLV1_ColumnWidthChanging(ByVal sender As Object, ByVal e As System.Windows.Forms.ColumnWidthChangingEventArgs) Handles MyLV1.ColumnWidthChanging
        If Not (_G_Resiz And _ColAttr(e.ColumnIndex).Resizable) Then
            e.Cancel = True
            e.NewWidth = _ColAttr(e.ColumnIndex)._Width
        End If
    End Sub

    Private Sub MyLV1_ColumnReordered(ByVal sender As Object, ByVal e As System.Windows.Forms.ColumnReorderedEventArgs) Handles MyLV1.ColumnReordered
        Dim iCol As Integer
        For iCtr As Integer = 0 To _NCols - 1
            If Me.Columns(iCtr).DisplayIndex = e.OldDisplayIndex Then
                iCol = iCtr
                Exit For
            End If
        Next
        If Not (_G_Resiz And _ColAttr(iCol).Reordable) Then
            e.Cancel = True
        End If
    End Sub

#End Region

#Region "TextBox & Button code"

    Private Sub TextBox1_Click(sender As Object, e As EventArgs) Handles TextBox1.Click
        If _Filter = False Then
            Button1_MouseDown(Nothing, Nothing)
        End If
    End Sub

    Private Sub TextBox1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles TextBox1.KeyPress
        If _Filter Then
            If e.KeyChar = ChrW(Keys.Return) Then
                _MB_Right = False
                Button1_MouseDown(Nothing, Nothing)
            End If
        Else
            e.KeyChar = Nothing
        End If
    End Sub

    Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged
        If _Wrk = False Then
            ' Select Rows matching specified Text
            Label1.Text = "0"
            _NSRows = 0
            _SRows = Nothing
            Dim IA() As String
            For iR = 0 To _iRows
                IA = MyLV1._ItmStr(iR)
                For iC As Integer = 0 To _NCols - 1
                    If Strings.InStr(IA(iC), Text, CompareMethod.Text) > 0 Then
                        _SelectRow(iR)
                        Exit For
                    End If
                Next
            Next
            _TBtyped = True
        End If
    End Sub

    Private Sub Button1_MouseDown(sender As Object, e As MouseEventArgs) Handles Button1.MouseDown
        If MyLV1.Visible Then
            ' Hide ListView
            _HideLV()
        Else
            ' Witch Mouse Button was pressed?
            If e Is Nothing Then        ' No Mouse clicked, comes from 
                _MB_Right = False       ' a <Return> in TextBox1 (or Click, if not Filterable)
            Else
                _MB_Right = (e.Button = Windows.Forms.MouseButtons.Right)
            End If
            _Wrk = True
            If _TBtyped Then
                _DisplayRows()
                If TextBox1.Text <> _TxtBk Then
                    _TxtBk = TextBox1.Text
                End If
                _TBtyped = False
            Else
                If TextBox1.Text = "" OrElse _MB_Right Then
                    ' Select all rows
                    TextBox1.Text = ""
                    If (_iRows + 1) <> _NDRows Then
                        _SelectAllRows()
                        _DisplayRows()
                    End If
                End If
            End If
            ' Show ListView
            Label1.Text = MyLV1.Items.Count.ToString
            Me.Width = Math.Max(_MaxSiz, _MinWidth)
            MyLV1.Visible = True
            ' Rows to show (Smaller of Max Items to display / Item count + 1
            Dim MX As Integer = Math.Min(_MaxDsp, MyLV1.Items.Count + 1)
            ' Compute ListView Height (Header + Rows)
            Dim LX As Integer = Sizes_.ListHeader_Height + 1 + MX * (_ListRowHeight + 1)
            Me.Height = _LblBoxH + LX
            MyLV1.Height = LX
            RaiseEvent DropDownChanged(True)
            _Wrk = False
        End If
    End Sub

#End Region

#Region "Fade in / Fade out"

    Private Sub TextBox1_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox1.MouseEnter
        Fade(Button1, True)
    End Sub

    Private Sub TextBox1_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox1.MouseLeave
        Fade(Button1, False)
    End Sub

    Private Sub Button1_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.MouseEnter
        Fade(CType(sender, Control), True)
    End Sub

    Private Sub Button1_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.MouseLeave
        Fade(CType(sender, Control), False)
    End Sub

    Private Sub Fade(ByVal Ctrl As Control, ByVal Hovering As Boolean)
        ' Thanks to Burton Johnson (ballisticnylon@msn.com)
        ' GlowButtons - April 12, 2003 
        ' You can view the original code at:
        ' http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=1129&lngWId=10

        ' I made some modifications, because in some versions of Windows, the original values
        ' [SystemColors.ActiveCaption (0,84,227)] does not work, a runtime error occurs
        ' Therefore, Windows 8 color values for ActiveCaption (153,180,209) are used 

        Dim Sb_R, Sb_G, Sb_B As Int16 '           <--- RGB values for the starting backcolor
        Dim Sf_R, Sf_G, Sf_B As Int16 '           <--- RGB values for the starting forecolor
        Dim Eb_R, Eb_G, Eb_B As Int16 '           <--- RGB values for the ending backcolor
        Dim Ef_R, Ef_G, Ef_B As Int16 '           <--- RGB values for the ending forecolor
        Select Case Hovering  ' True for MouseEnter, False for MouseLeave
            Case True
                Sb_R = 255      ' Assign the variables the 
                Sb_G = 255      ' appropriate values based
                Sb_B = 255      ' on system-defined colors
                '               ' for control and control text
                Sf_R = 255
                Sf_G = 255
                Sf_B = 255

                Eb_R = 153      ' Assign the variables the
                Eb_G = 180      ' appropriate values based
                Eb_B = 209      ' on system-defined colors
                '               ' for the title bar and the
                Ef_R = 0        ' title bar's text.
                Ef_G = 0
                Ef_B = 0
            Case False
                Sb_R = 153      ' Assign the variables the
                Sb_G = 180      ' appropriate values based
                Sb_B = 209      ' on system-defined colors
                '               ' for the title bar and the
                Sf_R = 0        ' title bar's text.
                Sf_G = 0
                Sf_B = 0

                Eb_R = 255      ' Assign the variables the 
                Eb_G = 255      ' appropriate values based
                Eb_B = 255      ' on system-defined colors
                '               ' for control and control
                Ef_R = 255      ' text.
                Ef_G = 255
                Ef_B = 255
        End Select
        Dim b_RIncrement As Int16 = Round(((Eb_R - Sb_R) / 16), 0)      ' Find the increments that
        Dim b_GIncrement As Int16 = Round(((Eb_G - Sb_G) / 16), 0)      ' the RGB values will take;
        Dim b_BIncrement As Int16 = Round(((Eb_B - Sb_B) / 16), 0)      ' 1/16th of the difference
        '                                                               ' between the start and end
        Dim f_RIncrement As Int16 = Round(((Ef_R - Sf_R) / 16), 0)      ' values, rounded to the 
        Dim f_GIncrement As Int16 = Round(((Ef_G - Sf_G) / 16), 0)      ' nearest integer.
        Dim f_BIncrement As Int16 = Round(((Ef_B - Sf_B) / 16), 0)
        Dim bR As Int16 = Sb_R ' \
        Dim bG As Int16 = Sb_G '  }--  the RGB values for the backcolor as it changes.
        Dim bB As Int16 = Sb_B ' /
        Dim fR As Int16 = Sf_R ' \
        Dim fG As Int16 = Sf_G '  }--  the RGB values for the forecolor as it changes.
        Dim fB As Int16 = Sf_B ' /
        Dim count As Int16
        For count = 0 To 14
            bR += b_RIncrement          ' Add the appropriate increments to the 
            bG += b_GIncrement          ' RGB values.  The result is a nifty
            bB += b_BIncrement          ' "cross-fade" effect.
            fR += f_RIncrement
            fG += f_GIncrement
            fB += f_BIncrement

            Ctrl.BackColor = Color.FromArgb(bR, bG, bB)   ' Repaint the button using the
            Ctrl.ForeColor = Color.FromArgb(fR, fG, fB)   ' current RGB values, and refresh
            Ctrl.Refresh()                                ' the button.

            Threading.Thread.Sleep(30 - (count * 2))      ' Wait a certain number of milliseconds,
            '                                             ' which is a factor of the current count.
            '                                             ' I tweaked these numbers to get a decent
            '                                             ' effect; feel free to adjust these 
            '                                             ' numbers to achieve an effect you like.
        Next
        Select Case Hovering
            Case True
                Ctrl.BackColor = Color.FromArgb(153, 180, 209)  ' Finish the effect by painting 
                Ctrl.ForeColor = Color.Black                    ' the control with it's final
            Case False                                          ' look, depending on whether
                Ctrl.BackColor = Color.White                    ' we're fading in or out.
                Ctrl.ForeColor = Color.White
        End Select
    End Sub

#End Region

#Region "Component Load & Resize"

    Private Sub ExCB_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
        Me.Height = _LblBoxH
        MyLV1.Visible = False
        MyLV1.Font = Me.Font
        MyLV1.BackColor = Colors_.ListBackColor
        MyLV1.ForeColor = Colors_.ListForeColor
        Label1.Font = Me.Font
        TextBox1.BorderStyle = _BStyle
        TextBox1.Font = Me.Font
        TextBox1.BackColor = Colors_.TBoxBackColor
        TextBox1.ForeColor = Colors_.TBoxForeColor
        MyLV1._HeaderHeight = Sizes_.ListHeader_Height
        MyLV1.HeadBackColor = Colors_.HeadBackColor
        MyLV1.HeadForeColor = Colors_.HeadForeColor
        MyLV1.SmallImageList = IL
        _ListRowHeight = Sizes_.ListRow_Height
        IL.ImageSize = New Size(1, _ListRowHeight)
        MyLV1.Sortable = _G_Sortab
    End Sub

    Private Sub ExCB_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
        If Me.DesignMode Then
            If Me.Width < 37 Then       ' Minimum width
                Me.Width = 37
            End If
            _MinWidth = Me.Width
            TextBox1.Width = _MinWidth
            Label1.Width = _MinWidth - _TxtHeight
            Button1.Left = _MinWidth - _TxtHeight
            _CalcSize()
        End If
    End Sub

#End Region

#Region "Private Subs & Functions"

    Private Sub _SelectRow(Row As Integer)
        ReDim Preserve _SRows(_NSRows)
        _SRows(_NSRows) = Row
        _NSRows += 1
        Label1.Text = _NSRows.ToString
        _HideLV()
        MyLV1.ListViewItemSorter = Nothing
    End Sub

    Private Sub _SelectAllRows()
        ReDim _SRows(_iRows)
        For iR As Integer = 0 To _iRows
            _SRows(iR) = iR
        Next
        _NSRows = _iRows + 1
        Label1.Text = _NSRows.ToString
    End Sub

    Private Sub _DisplayRows()
        ClearArrow()
        MyLV1.ECClear()         ' Clear Embedded Controls
        MyLV1.Items.Clear()     ' Clear Items
        _NDRows = 0             ' Number of Displayed Rows
        If _NSRows > 0 Then     ' Any Row(s) selected?
            ' 
            If _NCImg > 0 Then
                ReDim Preserve _EC_Tmp(_NCImg - 1, _NSRows - 1)
            End If
            ' Phase 1 - Add all selected rows
            For iR As Integer = 0 To _NSRows - 1
                AddSelRow(_SRows(iR), iR)
            Next
            ' Phase 2 - Add all Embedded Controls
            If _NCImg > 0 Then
                For iR As Integer = 0 To _NSRows - 1
                    For iC As Integer = 0 To _NCImg - 1
                        With _EC_Tmp(iC, iR)
                            MyLV1._AddEmbeddedControl(.Row, .Col, .Img, .Width, .Height, .SzMod)
                        End With
                    Next
                Next
            End If
        End If
    End Sub

    Private Function i_Of_C(C As Integer) As Integer
        ' Index of "image" Column
        Dim i As Integer
        For i = 0 To _NCImg - 1
            If _TCImg(i) = C Then
                Exit For
            End If
        Next
        Return i
    End Function

    Private Sub AddSelRow(FxdRow As Integer, SelRow As Integer)
        Dim Itm As ListViewItem = New ListViewItem(MyLV1._ItmStr(FxdRow))
        Itm.UseItemStyleForSubItems = False

        ' Text (all types). Booleans are stored as Chr(254) for True, Chr(168) for False    NEW
        For C As Integer = 0 To _NCols - 1
            If _ColAttr(C)._Type = DataType._LogicTxt OrElse _ColAttr(C)._Type = DataType._LogicImg Then
                If _ColAttr(C)._Type = DataType._LogicTxt Then
                    Itm.SubItems(C).Font = New System.Drawing.Font("Wingdings", Sizes_.YesNo_Height, FontStyle.Regular)
                End If
                Itm.SubItems(C).Text = _Bool2Char(CBool(Itm.SubItems(C).Text))
            End If
            Itm.SubItems(C).BackColor = _ColAttr(C)._BackColor
            Itm.SubItems(C).ForeColor = If(_ColAttr(C)._Type > 3, _ColAttr(C)._BackColor, _ColAttr(C)._ForeColor)
        Next
        MyLV1.Items.Add(Itm)

        ' Boolean & Image types - creates Embedded Control
        For C As Integer = 0 To _NCols - 1
            _Wrk = True
            If _ColAttr(C)._Type = DataType._LogicImg Then
                ' Creates temporary Embedded Control definitions for (image) checkbox
                Dim iC As Integer = i_Of_C(C)
                With _EC_Tmp(iC, SelRow)
                    .Row = SelRow
                    .Col = C
                    .Img = If(_Char2Bool(Itm.SubItems(C).Text), _ColAttr(C)._cbYes, _ColAttr(C)._cbNo)
                    .Width = _ColAttr(C)._ImgWidth
                    .Height = _ColAttr(C)._ImgHeight
                    .SzMod = SizeMode._Stretch
                End With
            ElseIf _ColAttr(C)._Type = DataType._Image Then
                ' Creates temporary Embedded Control definitions for (true) image
                Dim iC As Integer = i_Of_C(C)
                With _EC_Tmp(iC, SelRow)
                    .Row = SelRow
                    .Col = C
                    .Img = MyLV1._Images(Val(Itm.SubItems(C).Text))
                    .Width = _ColAttr(C)._ImgWidth
                    .Height = _ColAttr(C)._ImgHeight
                    .SzMod = _ColAttr(C)._SizeMode
                End With
            End If
            _Wrk = False
        Next
        _NDRows += 1
        _SelRow = -1
    End Sub

    Private Sub _HideLV()
        ' Hide ListView
        MyLV1.Visible = False
        Me.Height = _LblBoxH
        Me.Width = _MinWidth
        RaiseEvent DropDownChanged(False)
    End Sub

    Private Function ChgColor(ByVal pbFrom As Image, ByVal ColorTo As Color) As Image
        Dim iTo As Image = Nothing
        If ColorTo <> Color.Black Then
            Dim CM As New ColorMap
            CM.OldColor = Color.Black
            CM.NewColor = ColorTo
            Dim RemapTab() As ColorMap = {CM}
            Dim iAttr As New ImageAttributes
            iAttr.SetRemapTable(RemapTab, ColorAdjustType.Bitmap)
            Dim iFrom As Bitmap = pbFrom.Clone
            iTo = New Bitmap(iFrom.Width, iFrom.Height)
            Dim G As Graphics = Graphics.FromImage(iTo)
            Dim rect As Rectangle = Rectangle.Round(iTo.GetBounds(GraphicsUnit.Pixel))
            G.DrawImage(iFrom, rect, 0, 0, iTo.Width, iTo.Height, GraphicsUnit.Pixel, iAttr)
            G.Dispose()
            iFrom.Dispose()
            iAttr.Dispose()
        End If
        Return iTo
    End Function

    Private Sub _CalcSize()
        ' Calculates all component & subcomponent sizes & locations
        Dim tbN As New TextBox                  ' TextBox without BorderStyle
        tbN.Font = Me.Font
        tbN.BorderStyle = Windows.Forms.BorderStyle.None
        Dim tbF As New TextBox                  ' TextBox with BorderStyle
        tbF.Font = Me.Font
        tbF.BorderStyle = Windows.Forms.BorderStyle.FixedSingle
        Dim xHbsNone As Integer = tbN.Height    ' Height without BorderStyle
        Dim xHbsFixed As Integer = tbF.Height   ' Height with BorderStyle
        Dim LblH As Integer = xHbsFixed - 7
        TextBox1.BorderStyle = _BStyle
        TextBox1.Width = _MinWidth
        Label1.Height = LblH
        Dim xH_OK As Integer = If(_BStyle = 0, xHbsNone, xHbsFixed)
        Label1.Visible = (_CtLoc > 0)
        If (_CtLoc And 1) > 0 Then              ' Top Left/Right
            Label1.Top = 0
            TextBox1.Top = LblH
        Else                                    ' Bottom Left/Right
            TextBox1.Top = 0
            Label1.Top = xH_OK
        End If
        Label1.TextAlign = If(_CtLoc > 2, ContentAlignment.MiddleRight, ContentAlignment.MiddleLeft)
        _LblBoxH = xH_OK + LblH
        MyLV1.Top = _LblBoxH - 1 - If((_CtLoc And 1) = 0, LblH, 0)
        Me.Height = _LblBoxH
        Button1.Top = TextBox1.Top + 1
        Button1.Width = xH_OK
        Button1.Height = xH_OK - 1
        Button1.Left = Me.Width - xH_OK
        Label1.Width = Button1.Left
        Dim _TxH As Integer = TextRenderer.MeasureText(" ", Me.Font).Height
        _ListRowHeight = Math.Max(Math.Max(_TxH, Sizes.ListRow_Height), _ListRowHeight)
        MyLV1._HeaderHeight = Math.Max(Sizes.ListHeader_Height, _TxH + 4)
        tbN.Dispose()
        tbF.Dispose()
    End Sub

    Private Function _Bool2Char(ByVal VarBool As Boolean) As String
        Return If(VarBool, Chr(254), Chr(168))
    End Function

    Private Function _Char2Bool(ByVal VarChar As String) As Boolean
        Return If(VarChar = Chr(254), True, False)
    End Function

#End Region

End Class   ' ExCB

#End Region

#Region "Class Sz_"

<TypeConverter(GetType(Sz_Conv))> _
Public Class Sz_

    Public Sub New()
    End Sub

    Public Sub New(ByVal IH As Integer, ByVal IW As Integer, ByVal HH As Integer, ByVal Ro As Integer, ByVal CB As Integer)
        Me.Image_Height = IH
        Me.Image_Width = IW
        Me.ListHeader_Height = HH
        Me.ListRow_Height = Ro
        Me.YesNo_Height = CB
    End Sub

    Private _ImgH As Integer = 13
    <Category("_ExCB specifics")> _
    <Description("The Height of the Images in pixels")> _
    Public Property Image_Height() As Integer
        Get
            Return _ImgH
        End Get
        Set(ByVal value As Integer)
            _ImgH = value
        End Set
    End Property

    Private _ImgW As Integer = 13
    <Category("_ExCB specifics")> _
    <Description("The Width of the Images in pixels")> _
    Public Property Image_Width() As Integer
        Get
            Return _ImgW
        End Get
        Set(ByVal value As Integer)
            _ImgW = value
        End Set
    End Property

    Private _HeadH As Integer = 20
    <Category("_ExCB specifics")> _
    <Description("The Height of the List Header in pixels")> _
    Public Property ListHeader_Height() As Integer
        Get
            Return _HeadH
        End Get
        Set(ByVal value As Integer)
            If value < 20 Then
                Throw New ArgumentOutOfRangeException("ListHeader_Height", "Value must be greather than 19")
            Else
                _HeadH = value
            End If
        End Set
    End Property

    Private _RowH As Integer = 16
    <Category("_ExCB specifics")> _
    <Description("The Height of the List Rows in pixels")> _
    Public Property ListRow_Height() As Integer
        Get
            Return _RowH
        End Get
        Set(ByVal value As Integer)
            If value < 16 Then
                Throw New ArgumentOutOfRangeException("ListRow_Height", "Value must be greather than 15")
            Else
                _RowH = value
            End If
        End Set
    End Property

    Private _YN_H As Integer = 13
    <Category("_ExCB specifics")> _
    <Description("The Height of the 'CheckBoxes' in pixels")> _
    Public Property YesNo_Height() As Integer
        Get
            Return _YN_H
        End Get
        Set(ByVal value As Integer)
            _YN_H = value
        End Set
    End Property

    Public Overrides Function ToString() As String
        Return String.Format("{0}; {1}; {2}; {3}; {4}", Me._ImgH, Me._ImgW, Me._HeadH, Me._RowH, Me._YN_H)
    End Function

End Class

#End Region

#Region "Class Sz_Conv"

Friend Class Sz_Conv
    Inherits ExpandableObjectConverter

    Public Overrides Function GetCreateInstanceSupported(ByVal context As ITypeDescriptorContext) As Boolean
        Return True
    End Function

    Public Overrides Function CreateInstance(ByVal context As ITypeDescriptorContext, _
                                             ByVal propertyValues As IDictionary) As Object
        Dim _Szs As New Sz_
        With _Szs
            Integer.TryParse(propertyValues("Image_Height"), .Image_Height)
            Integer.TryParse(propertyValues("Image_Width"), .Image_Width)
            Integer.TryParse(propertyValues("ListHeader_Height"), .ListHeader_Height)
            Integer.TryParse(propertyValues("ListRow_Height"), .ListRow_Height)
            Integer.TryParse(propertyValues("YesNo_Height"), .YesNo_Height)
        End With
        Return _Szs
    End Function

    Public Overloads Overrides Function CanConvertFrom(ByVal context As ITypeDescriptorContext, _
                                                       ByVal sourceType As Type) As Boolean
        If (sourceType Is GetType(String)) Then
            Return True
        End If
        Return MyBase.CanConvertFrom(context, sourceType)
    End Function

    Public Overloads Overrides Function ConvertFrom(ByVal context As ITypeDescriptorContext, _
                                                    ByVal culture As CultureInfo, _
                                                    ByVal value As Object) As Object
        If (TypeOf value Is String) Then
            Try
                Dim Sz_Items() As Integer = Array.ConvertAll(value.ToString.Split("; "), Function(s) CInt(s))
                Dim _Szs As New Sz_
                _Szs.Image_Height = Sz_Items(0)
                _Szs.Image_Width = Sz_Items(1)
                _Szs.ListHeader_Height = Sz_Items(2)
                _Szs.ListRow_Height = Sz_Items(3)
                _Szs.YesNo_Height = Sz_Items(4)
                Return _Szs
            Catch
                Throw New ArgumentException("Cannot convert '" & CStr(value) & "' to type Integer")
            End Try
        End If
        Return MyBase.ConvertFrom(context, culture, value)
    End Function

    Public Overloads Overrides Function ConvertTo(ByVal context As ITypeDescriptorContext, _
                                                  ByVal culture As CultureInfo, _
                                                  ByVal value As Object, _
                                                  ByVal destinationType As Type) As Object
        If destinationType Is GetType(String) _
            AndAlso TypeOf value Is Sz_ Then
            Dim _Szs As Sz_ = DirectCast(value, Sz_)
            Return String.Format("{0}; {1}; {2}; {3}; {4}", _
                _Szs.Image_Height, _Szs.Image_Width, _Szs.ListHeader_Height, _Szs.ListRow_Height, _Szs.YesNo_Height)
        ElseIf destinationType Is GetType(InstanceDescriptor) _
            AndAlso TypeOf value Is Sz_ Then
            Dim CI As ConstructorInfo = GetType(Sz_).GetConstructor(New Type() _
                    {GetType(Integer), GetType(Integer), GetType(Integer)})
            Dim _Szs As Sz_ = DirectCast(value, Sz_)
            Dim Args As New List(Of Integer)(New Integer() _
                    {_Szs.Image_Height, _Szs.Image_Width, _Szs.ListHeader_Height, _Szs.ListRow_Height, _Szs.YesNo_Height})
            Return New InstanceDescriptor(CI, Args)
        End If
        Return MyBase.ConvertTo(context, culture, value, destinationType)
    End Function

End Class

#End Region

#Region "Class Co_"

<TypeConverter(GetType(Co_Conv))> _
Public Class Co_

    Public Sub New()
    End Sub

    Public Sub New(ByVal HBC As Color, ByVal HFC As Color, ByVal LBC As Color, ByVal LFC As Color, ByVal BBC As Color, ByVal BFC As Color)
        Me.HeadBackColor = HBC
        Me.HeadForeColor = HFC
        Me.ListBackColor = LBC
        Me.ListForeColor = LFC
        Me.TBoxBackColor = BBC
        Me.TBoxForeColor = BFC
    End Sub

    Public Sub New(ByVal HBC As String, ByVal HFC As String, ByVal LBC As String, ByVal LFC As String, ByVal BBC As String, ByVal BFC As String)
        Me.HeadBackColor = Color.FromName(HBC)
        Me.HeadForeColor = Color.FromName(HFC)
        Me.ListBackColor = Color.FromName(LBC)
        Me.ListForeColor = Color.FromName(LFC)
        Me.TBoxBackColor = Color.FromName(BBC)
        Me.TBoxForeColor = Color.FromName(BFC)
    End Sub

    Private _HeadBC As Color = Color.Bisque
    <Category("_ExCB specifics")> _
    <Description("List Header BackColor")> _
    Public Property HeadBackColor() As Color
        Get
            Return _HeadBC
        End Get
        Set(ByVal value As Color)
            _HeadBC = value
        End Set
    End Property

    Private _HeadFC As Color = Color.Black
    <Category("_ExCB specifics")> _
    <Description("List Header ForeColor")> _
    Public Property HeadForeColor() As Color
        Get
            Return _HeadFC
        End Get
        Set(ByVal value As Color)
            _HeadFC = value
        End Set
    End Property

    Private _ListBC As Color = System.Drawing.SystemColors.Window
    <Category("_ExCB specifics")> _
    <Description("List Rows BackColor")> _
    Public Property ListBackColor() As Color
        Get
            Return _ListBC
        End Get
        Set(ByVal value As Color)
            _ListBC = value
        End Set
    End Property

    Private _ListFC As Color = System.Drawing.SystemColors.WindowText
    <Category("_ExCB specifics")> _
    <Description("List Rows ForeColor")> _
    Public Property ListForeColor() As Color
        Get
            Return _ListFC
        End Get
        Set(ByVal value As Color)
            _ListFC = value
        End Set
    End Property

    Private TBoxBC As Color = System.Drawing.SystemColors.Window
    <Category("_ExCB specifics")> _
    <Description("TextBox BackColor")> _
    Public Property TBoxBackColor() As Color
        Get
            Return TBoxBC
        End Get
        Set(ByVal value As Color)
            TBoxBC = value
        End Set
    End Property

    Private TBoxFC As Color = System.Drawing.SystemColors.WindowText
    <Category("_ExCB specifics")> _
    <Description("TextBox ForeColor")> _
    Public Property TBoxForeColor() As Color
        Get
            Return TBoxFC
        End Get
        Set(ByVal value As Color)
            TBoxFC = value
        End Set
    End Property

End Class

#End Region

#Region "Class Co_Conv"

Friend Class Co_Conv
    Inherits ExpandableObjectConverter

    Public Overrides Function GetCreateInstanceSupported(ByVal context As ITypeDescriptorContext) As Boolean
        Return True
    End Function

    Public Overrides Function CreateInstance(ByVal context As ITypeDescriptorContext, _
                                             ByVal propertyValues As IDictionary) As Object
        Dim _Clrs As New Co_
        With _Clrs
            .HeadBackColor = CType(propertyValues("HeadBackColor"), Color)
            .HeadForeColor = CType(propertyValues("HeadForeColor"), Color)
            .ListBackColor = CType(propertyValues("ListBackColor"), Color)
            .ListForeColor = CType(propertyValues("ListForeColor"), Color)
            .TBoxBackColor = CType(propertyValues("TBoxBackColor"), Color)
            .TBoxForeColor = CType(propertyValues("TBoxForeColor"), Color)
        End With
        Return _Clrs
    End Function

    Public Overloads Overrides Function CanConvertFrom(ByVal context As ITypeDescriptorContext, _
                                                       ByVal sourceType As Type) As Boolean
        If (sourceType Is GetType(String)) Then
            Return True
        End If
        Return MyBase.CanConvertFrom(context, sourceType)
    End Function

    Public Overloads Overrides Function ConvertFrom(ByVal context As ITypeDescriptorContext, _
                                                    ByVal culture As CultureInfo, _
                                                    ByVal value As Object) As Object
        If TypeOf value Is String Then
            Try
                Dim s As String = CType(value, String)
                Dim xColor(4) As String
                xColor = Split(s, ",")
                If Not IsNothing(xColor) Then
                    If IsNothing(xColor(0)) Then xColor(0) = "Bisque"
                    If IsNothing(xColor(1)) Then xColor(1) = "Black"
                    If IsNothing(xColor(2)) Then xColor(2) = "Window"
                    If IsNothing(xColor(3)) Then xColor(3) = "WindowText"
                    If IsNothing(xColor(4)) Then xColor(4) = "Window"
                    If IsNothing(xColor(5)) Then xColor(5) = "WindowText"
                    Return New Co_(Color.FromName(xColor(0).Trim), _
                                    Color.FromName(xColor(1).Trim), _
                                    Color.FromName(xColor(2).Trim), _
                                    Color.FromName(xColor(3).Trim), _
                                    Color.FromName(xColor(4).Trim), _
                                    Color.FromName(xColor(5).Trim))
                End If
            Catch ex As Exception
                Throw New ArgumentException("Can not convert '" & CStr(value) & "' to type Color")
            End Try
        End If
        Return MyBase.ConvertFrom(context, culture, value)
    End Function

    Public Overloads Overrides Function ConvertTo(ByVal context As ITypeDescriptorContext, _
                                                  ByVal culture As CultureInfo, _
                                                  ByVal value As Object, _
                                                  ByVal destinationType As Type) As Object
        If (destinationType Is GetType(System.String) AndAlso TypeOf value Is Co_) Then
            Dim Colors_ As Co_ = CType(value, Co_)
            Return String.Format("{0}, {1}, {2}, {3}, {4}, {5}", _
                    Colors_.HeadBackColor.Name, _
                    Colors_.HeadForeColor.Name, _
                    Colors_.ListBackColor.Name, _
                    Colors_.ListForeColor.Name, _
                    Colors_.TBoxBackColor.Name, _
                    Colors_.TBoxForeColor.Name)
        End If
        Return MyBase.ConvertTo(context, culture, value, destinationType)
    End Function

End Class

#End Region

#Region "Class SortLV"

' Implements the manual sorting of items by columns (ascending/descending)
' Type (of data): 0=Text(String), 1=Date[Time], 2=Numeric

' Usage:    Private Sub MyLV1_ColumnClick(ByVal sender As Object, ByVal e As System.Windows.Forms.ColumnClickEventArgs) Handles MyLV1.ColumnClick
' Usage:    MyLV1.ListViewItemSorter = New SortLV.LVEx_ColumnSort(Column, DataType, NewOrder)

' Example:  MyLV1.ListViewItemSorter = New SortLV(e.Column, _ColAttr(iCtr)._Type, _ColAttr(iCtr)._Sort)

Class SortLV
    Implements IComparer

    Private _Column As Integer
    Private _Type As Integer
    Private _Order As Integer

    Public Sub New()
        _Column = 0
    End Sub

    Public Sub New(ByVal Column As Integer, ByVal Type As Integer, ByVal Order As Integer)
        _Column = Column
        _Type = Type
        _Order = Order
    End Sub

    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer _
        Implements System.Collections.IComparer.Compare
        Dim vX As Object
        Dim vY As Object
        ' If DataType = Text or if some convertion fails...
        vX = CStr(CType(x, ListViewItem).SubItems(_Column).Text)
        vY = CStr(CType(y, ListViewItem).SubItems(_Column).Text)
        If _Type = 2 Then       ' DataType is Numeric
            Try
                vX = CDbl(CType(x, ListViewItem).SubItems(_Column).Text)
                vY = CDbl(CType(y, ListViewItem).SubItems(_Column).Text)
            Catch
            End Try
        ElseIf _Type = 1 Then   ' DataType is Date[Time]
            Try
                vX = CDate(CType(x, ListViewItem).SubItems(_Column).Text).ToOADate
                vY = CDate(CType(y, ListViewItem).SubItems(_Column).Text).ToOADate
            Catch
            End Try
        End If
        If _Order = 1 Then      ' Ascending
            Select Case True
                Case vX < vY : Return -1
                Case vX = vY : Return 0
                Case vX > vY : Return 1
            End Select
        Else                    ' Descending
            Select Case True
                Case vX < vY : Return 1
                Case vX = vY : Return 0
                Case vX > vY : Return -1
            End Select
        End If
    End Function

End Class

#End Region

#Region "Class MyLV"

Partial Public Class MyLV
    Inherits ListView

#Region "Variables"

    Public _ItmStr() As Array           ' Original added Rows
    Friend Sortable As Boolean = True   ' Global
    Private IL813 As New ImageList      ' For Ascending & Descending Sort Arrows
    Private _CAtt() As _cAttr           ' Column attributes
    Private Header As HeaderControl     ' SubClassed HeaderControl

#End Region

#Region "Properties"

    Private _HeadHeight As Integer = 20
    Public WriteOnly Property _HeaderHeight() As Integer
        Set(ByVal value As Integer)
            _HeadHeight = value
        End Set
    End Property

    Private _HeadBC As Color = Me.BackColor
    Public WriteOnly Property HeadBackColor() As Color
        Set(ByVal value As Color)
            _HeadBC = value
        End Set
    End Property

    Private _HeadFC As Color = Me.ForeColor
    Public WriteOnly Property HeadForeColor() As Color
        Set(ByVal value As Color)
            _HeadFC = value
        End Set
    End Property

#End Region

#Region "Sub New"

    Public Sub New()
        Me.View = Windows.Forms.View.Details
        Me.GridLines = True
        Me.BorderStyle = Windows.Forms.BorderStyle.FixedSingle
        Me.MultiSelect = False
        Me.FullRowSelect = True
    End Sub

#End Region

#Region "Overrides"

    Protected Overrides Sub OnHandleCreated(ByVal e As EventArgs)
        'Create a new HeaderControl object
        Header = New HeaderControl(Me)
        MyBase.OnHandleCreated(e)
    End Sub

    Protected Overrides Sub WndProc(ByRef m As Message)
        If m.Msg = WM_PAINT Then
            For Each EC As _EC In _EmbeddedControls
                Dim Col As Integer = EC.Col

                ' Because Columns can be reordered...
                Dim dCol As Integer = Me.Columns(Col).DisplayIndex
                Dim VarX As Integer = 0
                If dCol > 0 Then
                    For Each C As ColumnHeader In Me.Columns
                        If C.DisplayIndex < dCol Then
                            VarX += C.Width
                        End If
                    Next
                End If

                Dim ColW As Integer = Me.Columns(Col).Width
                Dim ImgW As Integer = _CAtt(Col)._ImgWidth
                Dim _iBnds As Rectangle = EC.Item.GetBounds(ItemBoundsPortion.Entire)
                ' Columns can be resized...
                Dim X As Integer
                If ColW + 3 <= ImgW Then
                    ImgW = ColW - 3
                End If
                Select Case _CAtt(Col)._Align
                    Case HorizontalAlignment.Left
                        X = VarX + 2
                    Case HorizontalAlignment.Center
                        X = VarX + (ColW - ImgW) \ 2
                    Case HorizontalAlignment.Right
                        X = VarX + ColW - ImgW - 1
                End Select
                Dim SIR = New Rectangle(X, _iBnds.Top, ImgW, _iBnds.Height)
                SIR.Offset(0, (SIR.Height - EC.Control.Height) \ 2)
                SIR.Height = EC.Control.Height
                EC.Control.Bounds = SIR
            Next
        End If
        MyBase.WndProc(m)
    End Sub

#End Region

#Region "Embedded Controls"

    Public _EmbeddedControls As New ArrayList()     ' Effective Embedded Controls
    Public _Images() As Image                       ' Original added Images

    Public Sub _ColsAttr(ByVal ColAttrib As Object)
        _CAtt = ColAttrib
    End Sub

    Public Sub _AddEmbeddedControl(ByVal Row As Integer, ByVal Col As Integer, ByVal Img As Image, _
                                    ByVal Width As Integer, ByVal Height As Integer, ByVal SzMod As ExCB.SizeMode)
        Dim xPB As New PictureBox           ' All images are shown as PictureBox
        xPB.Image = Img
        xPB.SizeMode = If(SzMod = ExCB.SizeMode._Zoom, PictureBoxSizeMode.Zoom, PictureBoxSizeMode.StretchImage)
        xPB.Width = Width
        xPB.Height = Height
        xPB.Tag = _EmbeddedControls.Count   ' For use in _embeddedControl_Click.
        Dim EC As _EC
        EC.Control = xPB
        EC.Col = Col
        EC.Row = Row
        EC.Item = Items(Row)
        _EmbeddedControls.Add(EC)   ' Add Embedded Control & EventHandler (Click event)
        AddHandler xPB.Click, New EventHandler(AddressOf _embeddedControl_Click)
        Me.Controls.Add(xPB)
    End Sub

    Public Sub ECClear()
        For iE = _EmbeddedControls.Count - 1 To 0 Step -1
            Dim xPB As PictureBox = _EmbeddedControls(iE).Control
            RemoveHandler xPB.Click, New EventHandler(AddressOf _embeddedControl_Click)
        Next
        _EmbeddedControls.Clear()
        Me.Controls.Clear()
    End Sub

    Private Sub _embeddedControl_Click(ByVal sender As Object, ByVal e As System.EventArgs)
        ' When a control is clicked the Item holding it is selected
        Me.SelectedItems.Clear()
        Me.Items(_EmbeddedControls(Val(sender.Tag)).Item.Index).Selected = True
    End Sub

#End Region

#Region "Class HeaderControl"

    Friend Class HeaderControl
        Inherits NativeWindow

        Private LV As MyLV

        Public Sub New(ByVal L As MyLV)
            Me.LV = L
            Me.AssignHandle(Defs.SendMessage(LV.Handle, Defs.LVM_GETHEADER, IntPtr.Zero, IntPtr.Zero))
        End Sub

        Protected Overrides Sub WndProc(ByRef m As Message)
            If m.Msg = HDM_LAYOUT Then
                ' Get LParam (as HDLAYOUT) from Message
                Dim LParam As HDLAYOUT = DirectCast(m.GetLParam(GetType(HDLAYOUT)), HDLAYOUT)
                ' Get RECT from LParam.prc field
                Dim Rect As RECT = DirectCast(Marshal.PtrToStructure(LParam.prc, GetType(RECT)), RECT)
                ' Get WINDOWPOS from LParam.pwpos field
                Dim wPos As WINDOWPOS = DirectCast(Marshal.PtrToStructure(LParam.pwpos, GetType(WINDOWPOS)), WINDOWPOS)
                ' Apply changes to the Header
                wPos.hWnd = Me.Handle
                wPos.hWndInsertAfter = IntPtr.Zero
                wPos.flags = SWP_FRAMECHANGED
                wPos.x = Rect.Left
                wPos.y = Rect.Top
                wPos.cx = (Rect.Right - Rect.Left)
                wPos.cy = LV._HeadHeight                ' Header Height is changed here
                Rect.Top = wPos.cy - 1
                Marshal.StructureToPtr(Rect, LParam.prc, False)
                Marshal.StructureToPtr(wPos, LParam.pwpos, False)
                Exit Sub
            Else
                MyBase.WndProc(m)
            End If
        End Sub

    End Class   ' HeaderControl

#End Region

End Class   ' MyLV

#End Region

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Retired
Portugal Portugal
Working on computers since Mar,6 1969
Languages: RPN, Fortran, COBOL, Univac 1100 Meta-assembler, Basic, Z80 Assembly, 8086 Assembly, IBM Assembler (360/370, 38xx, 43xx), Clipper, ANSI C, SQL, Visual Basic, VBA, VB.NET
Lately, some HTML, JavaScript, C#
Actually retired, but still developing (for pleasure).

Comments and Discussions