GFFastList/GFFastListctl.ctl

VERSION 5.00
Begin VB.UserControl GFFastListctl 
   ClientHeight    =   3915
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6975
   ScaleHeight     =   3915
   ScaleWidth      =   6975
   Begin VB.PictureBox FLPicture 
      Height          =   3675
      Left            =   0
      ScaleHeight     =   3615
      ScaleWidth      =   6675
      TabIndex        =   0
      Top             =   0
      Width           =   6735
   End
   Begin VB.VScrollBar FLVScroll 
      Height          =   3675
      Left            =   6708
      TabIndex        =   1
      Top             =   0
      Width           =   273
   End
   Begin VB.HScrollBar FLHScroll 
      Height          =   255
      Left            =   0
      TabIndex        =   2
      Top             =   3660
      Width           =   6735
   End
End
Attribute VB_Name = "GFFastListctl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'(c)2002, 2003 by Louis.
#Const ColorSupportEnabledFlag = False
'
'NOTE: the GFFastList is used to list a high amount of items
'as fast as possible. Marking any item(s) is not possible.
'The largest number of items (lines) is 32766 * FLStructVar.ScrollStep.
'The list does support the following methods of the original ListBox:
'‑Add (without Index)
'‑Remove
'‑ICS_Clear
'‑List (Property Get and Let)
'‑ListCount (Property Get)
'
'NOTE: this module is not completely finished yet.
'Why this list is faster than the usual ListBox (already done):
'‑WM_SETREDRAW is processed (call Redraw_[Dis/En]able)
'‑List() = [...] redraws changed line only
'‑list is not scrolled when items are added
'not done yet:
'‑don't redraw any changed lines, also if cleared and reloaded
'‑don't calculate more than necessary (only calculation if items added/removed).
'‑don't update scroll bars if not necessary
'
'FLStruct ‑ general information about the FastList
Private Type FLStruct
    FLPictureBox As PictureBox
    FLHScrollBar As HScrollBar
    FLVScrollBar As VScrollBar
    RedrawEnabledFlag As Boolean
    FontWidth As Single
    FontHeight As Single
    ScrollXPos As Long 'pixel position
    ScrollYPos As Long 'pixel position
    ScrollLine As Long 'line Index
    ScrollStep As Long 'how many lines are scrolled at once, default: 1
End Type
Dim FLStructVar As FLStruct
'other
Dim ItemNumber As Long 'current number of 'ListItems'
Dim ItemArray() As String 'contains 'ListItems'
#If ColorSupportEnabledFlag = True Then
    Dim ItemColorArray() As GFIndexColLight 'contains color of letters of list items
#End If
Dim ColorModeEnabledFlag As Boolean 'if enabled, then Redraw will always jump to RedrawColor

Private Sub UserControl_Initialize()
    'on error resume next
    Set FLStructVar.FLPictureBox = FLPicture
    Set FLStructVar.FLHScrollBar = FLHScroll
    Set FLStructVar.FLVScrollBar = FLVScroll
End Sub

Private Sub UserControl_Resize()
    'on error resume next
    FLPicture.Height = MAX(UserControl.Height ‑ FLHScroll.Height, 25 * Screen.TwipsPerPixelY)
    FLPicture.Width = MAX(UserControl.Width ‑ FLHScroll.Height, 25 * Screen.TwipsPerPixelX)
    FLHScroll.Top = UserControl.Height ‑ FLHScroll.Height
    FLHScroll.Width = FLPicture.Width
    FLVScroll.Height = FLPicture.Height
    FLVScroll.Left = UserControl.Width ‑ FLVScroll.Width
End Sub

Private Sub FLHScroll_Change()
    'on error resume next
    Call ScrollBarChanged
End Sub

Private Sub FLHScroll_Scroll()
    'on error resume next
    Call ScrollBarChanged
End Sub

Private Sub FLVScroll_Change()
    'on error resume next
    Call ScrollBarChanged
End Sub

Private Sub FLVScroll_Scroll()
    'on error resume next
    Call ScrollBarChanged
End Sub

'***METHODS***

Private Sub ScrollBarChanged()
    'on error resume next 'call whenever a Change or Scroll event of one of the both scroll bars appears
    FLStructVar.ScrollXPos = FLStructVar.FLHScrollBar.Value
    FLStructVar.ScrollYPos = FLStructVar.FLVScrollBar.Value * FLStructVar.ScrollStep
    Call Redraw
End Sub

Public Sub Initialize(Optional ByRef FontName As String = "Fixedsys", Optional ByVal FontSize As Single = 10, Optional ByVal FontBoldFlag As Boolean = False, Optional ByVal FontItalicFlag As Boolean = False, Optional ByVal FontUnderlineFlag As Boolean = False, Optional ByVal FontStrikeThroughFlag As Boolean = False, Optional ByRef ScrollStep As Long = 1)
    'on error resume next 'can be called several times (to change font)
    FLStructVar.FLPictureBox.AutoRedraw = True
    FLStructVar.FLPictureBox.Font.Name = FontName
    FLStructVar.FLPictureBox.Font.Size = FontSize
    FLStructVar.FLPictureBox.Font.Bold = FontBoldFlag
    FLStructVar.FLPictureBox.Font.Italic = FontItalicFlag
    FLStructVar.FLPictureBox.Font.Underline = FontUnderlineFlag
    FLStructVar.FLPictureBox.Font.Strikethrough = FontStrikeThroughFlag
    FLStructVar.RedrawEnabledFlag = True 'preset
    FLStructVar.FontWidth = FLStructVar.FLPictureBox.TextWidth("a")
    FLStructVar.FontHeight = FLStructVar.FLPictureBox.TextHeight("a")
    FLStructVar.ScrollXPos = 0& 'preset
    FLStructVar.ScrollYPos = 0& 'preset
    FLStructVar.ScrollStep = ScrollStep
End Sub

Public Sub Clear()
    'on error resume next
    ItemNumber = 0& 'reset
    'ReDim ItemArray(1 To 1) As String 'no (faster without ReDim())
    'NOTE: do not verify the scroll pos or it will be reset to 0 (then no retaining of scroll pos possible).
    Call UpdateScrollBars
    Call Redraw
End Sub

Public Sub Add(ByVal AddItem As String)
    'on error resume next
    '
    'NOTE: even if only 1 item is added the calling procedure should use
    'Redraw_Disable before clearing and Redraw_Enable when finished
    'adding as when enabling redrawing the y scroll pos is verified.
    '
    'verify
    If (ItemNumber > (32766& * FLStructVar.ScrollStep)) Then
        '
        'NOTE: checking is ONLY necessary as the scroll bar does not
        'support more than 32767 scroll steps, the code can handle over
        '32767 lines. To be able to add more than 32767 lines it is
        'possible to make the v scroll bar scroll more than one line,
        'if e.g. the scroll step is 2 then 32766 * 2 lines can be added
        '(we use 32766 instead of 32767 to avoid an overflow error when
        'leaving a For‑loop).
        '
        Debug.Print "internal error in Add() (GFFastList): overflow !"
        Exit Sub
    End If
    'begin
    ItemNumber = ItemNumber + 1&
    If ((ItemNumber ‑ 1&) Mod 128&) = 0& Then
        ReDim Preserve ItemArray(1 To (ItemNumber + 127&)) As String
    End If
    ItemArray(ItemNumber) = AddItem
    Call UpdateScrollBars
    Call Redraw
    Exit Sub
End Sub

#If ColorSupportEnabledFlag = True Then
Public Sub AddColor(ByVal AddItem As StringByRef AddColorIndexCol As GFIndexColLight)
    'on error resume next
    '
    'NOTE: even if only 1 item is added the calling procedure should use
    'Redraw_Disable before clearing and Redraw_Enable when finished
    'adding as when enabling redrawing the y scroll pos is verified.
    '
    'verify
    If (ItemNumber > (32766& * FLStructVar.ScrollStep)) Then
        '
        'NOTE: checking is ONLY necessary as the scroll bar does not
        'support more than 32767 scroll steps, the code can handle over
        '32767 lines. To be able to add more than 32767 lines it is
        'possible to make the v scroll bar scroll more than one line,
        'if e.g. the scroll step is 2 then 32766 * 2 lines can be added
        '(we use 32766 instead of 32767 to avoid an overflow error when
        'leaving a For‑loop).
        '
        Debug.Print "internal error in AddColor() (GFFastList): overflow !"
        Exit Sub
    End If
    'begin
    ItemNumber = ItemNumber + 1&
    If ((ItemNumber ‑ 1&) Mod 128&) = 0& Then
        ReDim Preserve ItemArray(1 To (ItemNumber + 127&)) As String
    End If
    ItemArray(ItemNumber) = AddItem
    '
    If ((ItemNumber ‑ 1&) Mod 128&) = 0& Then
        ReDim Preserve ItemColorArray(1 To (ItemNumber + 127&)) As GFIndexColLight
    End If
    Set ItemColorArray(ItemNumber) = AddColorIndexCol
    '
    Call UpdateScrollBars
    Call Redraw
    Exit Sub
End Sub
#End If

Public Sub Remove(ByVal RemoveItemIndex As Long)
    'on error resume next
    Dim ItemFor As Long
    'begin
    For ItemFor = RemoveItemIndex To ItemNumber
        If Not (ItemFor = ItemNumber) Then
            ItemArray(ItemFor) = ItemArray(ItemFor + 1&)
        Else
            ItemNumber = ItemNumber ‑ 1&
            ItemFor = ItemNumber
            If ItemFor < 1& Then ItemFor = 1&
            If ((ItemFor ‑ 1&) Mod 128&) = 0& Then 'save CPU time
                ReDim Preserve ItemArray(1 To (ItemFor + 127&)) As String
            End If
            Exit For 'important
        End If
    Next ItemFor
    Call VerifyScrollPos
    Call UpdateScrollBars
    Call Redraw(RemoveItemIndex, ‑1&)
End Sub

Public Function IsItemVisible(ByVal ItemIndex As Long) As Boolean
    'on error resume next
    IsItemVisible = ((ItemIndex <= VisibleItem_StartIndex) And (ItemIndex <= VisibleItem_EndIndex))
End Function

Public Sub Redraw_Disable()
    'on error resume next
    FLStructVar.RedrawEnabledFlag = False
End Sub

Public Sub Redraw_Enable()
    'on error resume next
    FLStructVar.RedrawEnabledFlag = True
    Call VerifyScrollPos
    Call UpdateScrollBars
    Call Redraw
End Sub

Public Sub Redraw(Optional ByVal RedrawStartLine As Long = ‑1&, Optional ByVal RedrawEndLine As Long = ‑1&)
    'on error resume next
    Dim FirstVisibleLine As Long
    Dim LineStartIndex As Long
    Dim LineEndIndex As Long
    Dim LineHeight As Single
    Dim LineLoop As Long
    'verify
    If FLStructVar.RedrawEnabledFlag = False Then Exit Sub
    If (ColorModeEnabledFlag) Then
        #If ColorSupportEnabledFlag = True Then
            Call RedrawColor(RedrawStartLine, RedrawEndLine)
        #Else
            MsgBox "internal error in Redraw: color support disabled !", vbOKOnly + vbExclamation
        #End If
        Exit Sub
    End If
    'preset
    If RedrawStartLine = ‑1& Then LineStartIndex = Me.VisibleLine_StartIndex Else LineStartIndex = RedrawStartLine
    If RedrawEndLine = ‑1& Then LineEndIndex = Me.VisibleLine_EndIndex Else LineEndIndex = RedrawEndLine
    FirstVisibleLine = Me.VisibleItem_StartIndex 'needn't to be equal to LineStartIndex
    LineHeight = Me.LineHeight
    'begin
    For LineLoop = LineStartIndex To LineEndIndex
        If FLStructVar.FLPictureBox.ScaleMode = vbTwips Then
            'erase current line
            FLStructVar.FLPictureBox.Line (0!, ((LineLoop ‑ FirstVisibleLine) * LineHeight) * Screen.TwipsPerPixelY)‑((VisibleWidth ‑ 1!) * Screen.TwipsPerPixelX, (((LineLoop ‑ FirstVisibleLine) + 1&) * LineHeight) * Screen.TwipsPerPixelY), FLStructVar.FLPictureBox.BackColor, BF
            'print text
            FLStructVar.FLPictureBox.CurrentX = ‑FLStructVar.ScrollXPos * Screen.TwipsPerPixelX
            FLStructVar.FLPictureBox.CurrentY = (LineLoop ‑ FirstVisibleLine) * Me.LineHeight * Screen.TwipsPerPixelY
        Else
            'erase current line
            FLStructVar.FLPictureBox.Line (0!, (LineLoop ‑ FirstVisibleLine) * LineHeight)‑(VisibleWidth ‑ 1!, ((LineLoop ‑ FirstVisibleLine) + 1&) * LineHeight), FLStructVar.FLPictureBox.BackColor, BF
            'print text
            FLStructVar.FLPictureBox.CurrentX = ‑FLStructVar.ScrollXPos
            FLStructVar.FLPictureBox.CurrentY = (LineLoop ‑ FirstVisibleLine) * Me.LineHeight
        End If
        If LineLoop <= ItemNumber Then
            FLStructVar.FLPictureBox.Print ItemArray(LineLoop)
        Else
            'do nothing (line does not exist (anymore))
        End If
    Next LineLoop
    FLStructVar.FLPictureBox.Refresh 'important (if in a loop)
    Exit Sub
End Sub

#If ColorSupportEnabledFlag = True Then
Public Sub RedrawColor(Optional ByVal RedrawStartLine As Long = ‑1&, Optional ByVal RedrawEndLine As Long = ‑1&)
    'on error resume next
    Dim FirstVisibleLine As Long
    Dim LineStartIndex As Long
    Dim LineEndIndex As Long
    Dim LineHeight As Single
    Dim LineLoop As Long
    Dim CharColorOld As Long
    Dim CharColorChangePos As Long
    Dim CharFor As Long
    'verify
    If FLStructVar.RedrawEnabledFlag = False Then Exit Sub
    'preset
    If RedrawStartLine = ‑1& Then LineStartIndex = Me.VisibleLine_StartIndex Else LineStartIndex = RedrawStartLine
    If RedrawEndLine = ‑1& Then LineEndIndex = Me.VisibleLine_EndIndex Else LineEndIndex = RedrawEndLine
    FirstVisibleLine = Me.VisibleItem_StartIndex 'needn't to be equal to LineStartIndex
    LineHeight = Me.LineHeight
    'begin
    For LineLoop = LineStartIndex To LineEndIndex
        If FLStructVar.FLPictureBox.ScaleMode = vbTwips Then
            'erase current line
            FLStructVar.FLPictureBox.Line (0!, ((LineLoop ‑ FirstVisibleLine) * LineHeight) * Screen.TwipsPerPixelY)‑((VisibleWidth ‑ 1!) * Screen.TwipsPerPixelX, (((LineLoop ‑ FirstVisibleLine) + 1&) * LineHeight) * Screen.TwipsPerPixelY), FLStructVar.FLPictureBox.BackColor, BF
            'print text
            FLStructVar.FLPictureBox.CurrentX = ‑FLStructVar.ScrollXPos * Screen.TwipsPerPixelX
            FLStructVar.FLPictureBox.CurrentY = (LineLoop ‑ FirstVisibleLine) * Me.LineHeight * Screen.TwipsPerPixelY
        Else
            'erase current line
            FLStructVar.FLPictureBox.Line (0!, (LineLoop ‑ FirstVisibleLine) * LineHeight)‑(VisibleWidth ‑ 1!, ((LineLoop ‑ FirstVisibleLine) + 1&) * LineHeight), FLStructVar.FLPictureBox.BackColor, BF
            'print text
            FLStructVar.FLPictureBox.CurrentX = ‑FLStructVar.ScrollXPos
            FLStructVar.FLPictureBox.CurrentY = (LineLoop ‑ FirstVisibleLine) * Me.LineHeight
        End If
        If LineLoop <= ItemNumber Then
            If (ItemColorArray(LineLoop).IndexNumber) Then
                CharColorOld = ItemColorArray(LineLoop).IndexArray(1&)
            End If
            CharColorChangePos = 1& 'preset
            For CharFor = 2& To ItemColorArray(LineLoop).IndexNumber 'must have exactly the same item count than the string item chars
                If Not (ItemColorArray(LineLoop).IndexArray(CharFor) = CharColorOld) Then
                    FLStructVar.FLPictureBox.ForeColor = ItemColorArray(LineLoop).IndexArray(CharFor ‑ 1&)
                    FLStructVar.FLPictureBox.Print Mid$(ItemArray(LineLoop), CharColorChangePos, (CharFor ‑ 1&) ‑ CharColorChangePos + 1&);
                    CharColorOld = ItemColorArray(LineLoop).IndexArray(CharFor)
                    CharColorChangePos = CharFor
                End If
            Next CharFor
            CharFor = ItemColorArray(LineLoop).IndexNumber
            If (CharFor) Then
                FLStructVar.FLPictureBox.ForeColor = ItemColorArray(LineLoop).IndexArray(CharFor)
                FLStructVar.FLPictureBox.Print Mid$(ItemArray(LineLoop), CharColorChangePos, (CharFor) ‑ CharColorChangePos + 1&);
            End If
        Else
            'do nothing (line does not exist (anymore))
        End If
    Next LineLoop
    FLStructVar.FLPictureBox.Refresh 'important (if in a loop)
    Exit Sub
End Sub
#End If

Public Sub ScrollToBottom()
    'on error resume next
    FLStructVar.ScrollYPos = (ItemNumber ‑ Me.VisibleLines) + (FLStructVar.ScrollStep ‑ 1&)
End Sub

Private Sub VerifyScrollPos()
    'on error resume next
    'verify
    If FLStructVar.RedrawEnabledFlag = False Then Exit Sub 'avoid resetting scroll pos when reloading
    'begin
    '
    'NOTE: this sub verifies the scroll position is valid so that newly added items
    'are visible when removing one line or clearing the list.
    '
    If FLStructVar.ScrollXPos > (Me.VisibleLine_WidthMax ‑ Me.VisibleWidth) Then FLStructVar.ScrollXPos = (Me.VisibleLine_WidthMax ‑ Me.VisibleWidth)
    If FLStructVar.ScrollXPos < 0& Then FLStructVar.ScrollXPos = 0& 'can happen
    '
    'NOTE: the y pos has the format lines.
    If FLStructVar.ScrollYPos > (ItemNumber + (FLStructVar.ScrollStep ‑ 1&) ‑ Me.VisibleLines) Then FLStructVar.ScrollYPos = (ItemNumber ‑ Me.VisibleLines) + (FLStructVar.ScrollStep ‑ 1&)
    If FLStructVar.ScrollYPos < 0& Then FLStructVar.ScrollYPos = 0& 'can happen (see above)
End Sub

Private Sub UpdateScrollBars() 'code copied from Decrypt for NN99, IDMsys
    'on error resume next
    Dim VisibleWidth As Single
    Dim VisibleHeight As Single
    'preset
    VisibleWidth = Me.VisibleWidth
    VisibleHeight = Me.VisibleHeight
    'verify
    If FLStructVar.RedrawEnabledFlag = False Then Exit Sub
    'begin
    With FLStructVar.FLHScrollBar
        If (Me.VisibleLine_WidthMax ‑ VisibleWidth) > 0! Then
            .MIN = 0 'zero (say what)
            'NOTE: the .Max value is: [max value] ‑ [visible value].
            .MAX = MIN(Me.VisibleLine_WidthMax ‑ VisibleWidth, 32767&)
            .TabStop = False 'avoid blinking slider (looks ugly)
            .Enabled = True
            .LargeChange = VisibleWidth
            .SmallChange = 1
            .Value = FLStructVar.ScrollXPos
        Else
            '.Min = 0 'no (updating, flickering)
            '.Max = 0
            '.TabStop = False
            .Enabled = False
            '.TabStop = False 'avoid blinking slider (looks ugly)
            '.LargeChange = 1
            '.SmallChange = 1
            '.Value = 0
        End If
    End With
    With FLStructVar.FLVScrollBar
        If ((ItemNumber * Me.LineHeight) ‑ VisibleHeight) > 0! Then
            'NOTE: the scroll bar's 'scale mode' is line numbers
            .MIN = 0
            .MAX = MIN(‑Int(‑CSng(ItemNumber ‑ Me.VisibleLines) * (1! / CSng(FLStructVar.ScrollStep))), 32767&) 'not more than 32767 scroll steps possible
            .TabStop = False 'avoid blinking slider (looks ugly)
            .Enabled = True
            .LargeChange = Me.VisibleLines
            .SmallChange = 1
            .Value = (FLStructVar.ScrollYPos / FLStructVar.ScrollStep)
            '
            'NOTE: there can be a 'gap' (empty lines) at the end of the list with size
            '(FLStructVar.ScrollStep ‑ 1), but this is by design and no error.
            '
        Else
            '.Min = 0
            '.Max = 0
            '.TabStop = False
            .Enabled = False
            '.TabStop = False 'avoid blinking slider (looks ugly)
            '.LargeChange = 1
            '.SmallChange = 1
            '.Value = 0
        End If
    End With
    'display changes
    FLStructVar.FLHScrollBar.Refresh
    FLStructVar.FLVScrollBar.Refresh
End Sub

'***END OF METHODS***
'***PROPERTIES***

Public Property Let ForeColor(ByVal ForeColor As Long)
    'on error resume next
    FLPicture.ForeColor = ForeColor
End Property

Public Property Set ForeColor() As Long
    'on error resume next
    ForeColor = FLPicture.ForeColor
End Property

Public Property Let BackColor(ByVal BackColor As Long)
    'on error resume next
    FLPicture.BackColor = BackColor
    Call Redraw 'necessary as a VB picture box clears its content when back color is changed
End Property

Public Property Set BackColor() As Long
    'on error resume next
    BackColor = FLPicture.BackColor
End Property

Public Property Let ColorMode(ByVal EnabledFlag As Boolean)
    'on error resume next
    ColorModeEnabledFlag = EnabledFlag
End Property

Public Property Set ColorMode() As Boolean
    'on error resume next
    ColorMode = ColorModeEnabledFlag
End Property

Public Property Set FontWidth() As Single
    'on error resume next
    FontWidth = FLStructVar.FontWidth
End Property

Public Property Set FontHeight() As Single
    'on error resume next
    FontHeight = FLStructVar.FontHeight
End Property

Public Property Set VisibleWidth() As Single
    'on error resume next
    If FLStructVar.FLPictureBox.ScaleMode = vbTwips Then
        VisibleWidth = FLStructVar.FLPictureBox.ScaleWidth / Screen.TwipsPerPixelX
    Else 'vbPixels only
        VisibleWidth = FLStructVar.FLPictureBox.ScaleWidth
    End If
End Property

Public Property Set VisibleHeight() As Single
    'on error resume next
    If FLStructVar.FLPictureBox.ScaleMode = vbTwips Then
        VisibleHeight = (Int(FLStructVar.FLPictureBox.ScaleHeight / (Me.LineHeight * Screen.TwipsPerPixelY)) * (Me.LineHeight * Screen.TwipsPerPixelY)) / Screen.TwipsPerPixelY
    Else 'vbPixels only
        VisibleHeight = (Int(FLStructVar.FLPictureBox.ScaleHeight / (Me.LineHeight)) * (Me.LineHeight))
    End If
End Property

Public Property Set VisibleItem_StartIndex() As Long
    'on error resume next
    VisibleItem_StartIndex = CLng(FLStructVar.ScrollYPos) + 1&
End Property
    
Public Property Set VisibleItem_EndIndex() As Long
    'on error resume next
    VisibleItem_EndIndex = Me.VisibleItem_StartIndex + Me.VisibleLines ‑ 1&
End Property

Public Property Set VisibleLine_StartIndex() As Long
    'on error resume next
    VisibleLine_StartIndex = Me.VisibleItem_StartIndex
End Property

Public Property Set VisibleLine_EndIndex() As Long
    'on error resume next
    VisibleLine_EndIndex = Me.VisibleItem_EndIndex
End Property

Public Property Set VisibleLines() As Long
    'on error resume next
    VisibleLines = CLng(Me.VisibleHeight / Me.LineHeight)
End Property

Public Property Set VisibleLine_WidthMax() As Long
    'on error resume next 'returns the width in pixels of the widthest visible line
    Dim LineWidthMax As Single
    Dim Temp As Long
    'begin
    For Temp = 1 To ItemNumber 'Me.VisibleLine_StartIndex To Me.VisibleItem_EndIndex
        '
        'NOTE: as this function is mainly used to size the scroll bars we return
        'the largest line of all as then the scroll bar behaviour is that of the
        'real ListBox.
        '
        If CSng(Len(ItemArray(Temp))) * FLStructVar.FontWidth > LineWidthMax Then
           LineWidthMax = CSng(Len(ItemArray(Temp))) * FLStructVar.FontWidth
        End If
    Next Temp
    VisibleLine_WidthMax = LineWidthMax / Screen.TwipsPerPixelX
End Property

Public Property Set LineHeight() As Single
    'on error resume next
    LineHeight = (Me.FontHeight / Screen.TwipsPerPixelX) + 2!
End Property

Public Property Set ListCount()
    'on error resume next
    ListCount = ItemNumber
End Property

Public Property Set List(ByVal Index As Long) As String
    'on error resume next
    Index = Index + 1& '0 to 1 based
    If Not ((Index < 1&) Or (Index > ItemNumber)) Then 'verify
        List = ItemArray(Index)
    Else
        Debug.Print "internal error in GFFastListmod.List() [Property Get]: passed value invalid !"
        List = "" 'error
    End If
End Property

Public Property Let List(ByVal Index As LongByVal ItemNew As String)
    'on error resume next
    Index = Index + 1& '0 to 1 based
    If Not ((Index < 1&) Or (Index > ItemNumber)) Then 'verify
        ItemArray(Index) = ItemNew
        Call UpdateScrollBars 'display changes
        Call Redraw(Index, Index) 'display changes
    Else
        Debug.Print "internal error in GFFastListmod.List() [Property Let]: passed value invalid !"
        'do nothing (error)
    End If
End Property

'***END OF PROPERTIES***
'***OTHER***

Private Function MIN(ByVal Value1 As LongByVal Value2 As Long) As Long
    'on error resume next
    If Value1 > Value2 Then
        MIN = Value2
    Else
        MIN = Value1
    End If
End Function

Private Function MAX(ByVal Value1 As LongByVal Value2 As Long) As Long
    'on error resume next
    If Value1 < Value2 Then
        MAX = Value2
    Else
        MAX = Value1
    End If
End Function



[END OF FILE]