Skip to content

Instantly share code, notes, and snippets.

@Profex13

Profex13/gist:898ff692a231388e150c38e31ccf3ac1

Created November 2, 2018 22:18
Download ZIP

Revisions

  1. Profex13 created this gist Nov 2, 2018.
    168 changes: 168 additions & 0 deletions gistfile1.txt
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,168 @@
    '@Folder("View.Model")
    Option Explicit

    Private Const MODULE_NAME As String = "ListModel"

    Private Type TListModel
    Data() As Variant
    Selected() As Boolean
    Columns As Integer
    Count As Integer
    Index As Integer
    End Type

    Private this As TListModel

    Private Sub Class_Initialize()
    this.Columns = 1
    this.Index = -1
    End Sub

    Public Sub Clear()
    With this
    Erase .Data
    Erase .Selected
    .Count = 0
    'Columns = 0
    .Index = -1
    End With
    End Sub

    Public Sub AddItem(Optional Item As Variant, Optional Index As Integer = -1)
    Dim r As Integer, C As Integer
    With this
    If Index < -1 Or Index > .Count Then
    Err.Raise 5, , "Invalid argument."
    Else
    ReDim Preserve .Data(.Columns - 1, .Count)
    ReDim Preserve .Selected(.Count)
    If Index >= 0 Then
    ' Move all the data after the Index row, up one row.
    For r = .Count To Index + 1 Step -1
    For C = 0 To .Columns - 1
    .Data(C, r) = .Data(C, r - 1)
    Next
    .Selected(r) = .Selected(r - 1)
    Next
    ' Clear all the data in the Index row
    For C = 0 To .Columns - 1
    Set .Data(C, Index) = Nothing
    Next
    .Selected(Index) = False
    Else ' Set the Index to the next row
    Index = .Count
    End If
    If Not IsMissing(Item) Then .Data(0, Index) = Item
    .Count = .Count + 1
    End If
    End With
    End Sub

    Public Sub RemoveItem(Index As Integer)
    Dim r As Integer, C As Integer
    With this
    If Index < 0 Or Index >= .Count Then
    Err.Raise 5, , "Invalid argument."
    Else
    ' Move all the data after the Index row, up one row.
    For r = Index + 1 To .Count - 1
    For C = 0 To .Columns - 1
    .Data(C, r - 1) = .Data(C, r)
    Next
    .Selected(r - 1) = .Selected(r)
    Next
    .Count = .Count - 1
    ReDim Preserve .Data(.Columns - 1, .Count - 1)
    ReDim Preserve .Selected(.Count - 1)
    End If
    End With
    End Sub

    Public Property Get List(Row As Integer, Optional Column As Integer = 0) As Variant
    With this
    If Row < 0 Or Row >= .Count Then
    Err.Raise 381, , "Could not get the List property. Invalid property-array row index."
    ElseIf Column < 0 Or Column >= .Columns Then
    Err.Raise 381, , "Could not get the List property. Invalid property-array column index."
    Else
    List = .Data(Column, Row)
    End If
    End With
    End Property

    Public Property Let List(Row As Integer, Column As Integer, Value As Variant)
    With this
    If Row < 0 Or Row >= .Count Then
    Err.Raise 381, , "Could not get the List property. Invalid property-array row index."
    ElseIf Column < 0 Or Column >= .Columns Then
    Err.Raise 381, , "Could not get the List property. Invalid property-array column index."
    Else
    .Data(Column, Row) = Value
    End If
    End With
    End Property

    Public Property Get Selected(Index As Integer) As Boolean
    With this
    If Index < 0 Or Index >= .Count Then
    Err.Raise 381, , "Could not get the List property. Invalid property-array index."
    Else
    Selected = .Selected(Index)
    End If
    End With
    End Property

    Public Property Let Selected(Index As Integer, Value As Boolean)
    With this
    If Index < 0 Or Index >= .Count Then
    Err.Raise 381, , "Could not get the List property. Invalid property-array index."
    Else
    .Selected(Index) = Value
    End If
    End With
    End Property

    Public Property Get ListCount() As Integer
    ListCount = this.Count
    End Property

    Public Property Get ListIndex() As Integer
    ListIndex = this.Index
    End Property

    Public Property Let ListIndex(Value As Integer)
    With this
    If Value < -1 Or Value >= .Count Then
    Err.Raise 5, , "Invalid argument."
    Else
    .Index = Value
    End If
    End With
    End Property

    Public Property Get ColumnCount() As Integer
    ColumnCount = this.Columns
    End Property

    Public Property Let ColumnCount(Value As Integer)
    Dim NewData() As Variant
    Dim r As Integer, C As Integer
    With this
    If Value <= 0 Then
    Err.Raise 5, , "Invalid argument."
    Else
    If .Count > 0 And .Columns <> Value Then
    ' If the columns change, we can't redim the array, we need to create a new Data array
    ReDim NewData(Value - 1, .Count - 1)
    For r = 0 To .Count - 1
    For C = 0 To Value - 1
    NewData(C, r) = .Data(C, r)
    Next
    Next
    .Data = NewData
    Erase NewData
    End If
    .Columns = Value
    End If
    End With
    End Property