VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "IconList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const DT_LEFT = &H0
Private Const DT_NOPREFIX = &H800

Private Type Colum
  Caption As String
  Width As Integer
  Down As Boolean
  NoScrollRef As Boolean
End Type

Private ConnType As Integer
Private TextH As Integer
Private Obj As PictureBox
Private ScrL As Object
Private BorderStyle As Integer
Private InstOK As Boolean
Private ListIco() As String
Private ListIcoCount As Long
Private LIndex As Integer
Private LastLIndex As Integer
Private ColumCount As Integer
Private lTop As Integer
Private Colums() As Colum
Private IconSize As Integer
Private LastX As Long
Private LastY As Long
Private NScrollRefr As Boolean
Private SuchStr As String
Private SuchTo As Long
Private RangIco As Boolean
Private AutoRef As Boolean
Private RevSort As Boolean
Private ColumResX As Long
Private ColumResPos As Long
Private ScW As Integer

Public cvPrefix As String
Public cvPrefixSign As String
Public CSortIndex As Integer
Public ScrollState As Long

Public ColorGrayText As Long
Public ColorButtonShadow As Long
Public ColorHighlight3D As Long
Public ColorBackColor As Long
Public ColorButtonText As Long

Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event Click()
Event DblClick()
Event Change()

Public Sub EnableRef()
  AutoRef = True
End Sub

Public Sub DisableRef()
  AutoRef = False
End Sub

Public Sub AddColum(Caption As String, Optional Width As Integer = -1, Optional NoScrRef As Boolean)
  ReDim Preserve Colums(ColumCount)
  If ListIcoCount > 0 Then
    ReDim ListIco(-2 To ColumCount, ListIcoCount - 1)
  Else
    ReDim ListIco(-2 To ColumCount, 0)
  End If
  Colums(ColumCount).Caption = Caption
  Colums(ColumCount).Width = Width
  Colums(ColumCount).NoScrollRef = NoScrRef
  ColumCount = ColumCount + 1
  Resize
End Sub

Public Sub SetColum(Cindex As Integer, Caption As String, Optional Width As Integer = -1)
  Colums(Cindex).Caption = Caption
  Colums(Cindex).Width = Width
  If Colums(0).Caption = "" Then lTop = 0 Else lTop = Obj.TextHeight("l") + 5
  Refresh
End Sub

Public Sub RemColum(Cindex As Integer)
  ColumCount = ColumCount - 1
  If ColumCount < 1 Then Exit Sub
  ReDim Preserve Colums(ColumCount - 1)
  ReDim Preserve ListIco(-2 To ColumCount - 1, ListIcoCount - 1)
  Resize
End Sub

Public Property Let ListIndex(TempVal As Integer)
  LIndex = TempVal
  Refresh
End Property

Public Property Get ListIndex() As Integer
  ListIndex = LIndex
End Property

Public Function GetListText(ListIndex As Integer, ColumIndex As Integer) As String
  If ListIndex <= UBound(ListIco, 2) And ListIndex >= LBound(ListIco, 2) And _
  ColumIndex <= UBound(ListIco, 1) And ColumIndex >= LBound(ListIco, 1) Then
    GetListText = ListIco(ColumIndex, ListIndex)
  End If
End Function

Public Sub SetListText(ListIndex As Integer, ColumIndex As Integer, Text As String, Optional NoRefr As Boolean)
  ListIco(ColumIndex, ListIndex) = Text
  If NoRefr = False Then Refresh
End Sub

Public Sub SetListTextColor(ListIndex As Integer, TextColor As Long, Optional NoRefr As Boolean)
  If ListIndex > UBound(ListIco, 2) Or ListIndex < 0 Then Exit Sub
  If TextColor = -1 Then
    ListIco(-2, ListIndex) = ""
  Else
    ListIco(-2, ListIndex) = CStr(TextColor)
  End If
  If NoRefr = False Then Refresh
End Sub

Public Sub Inst(PictureBox As PictureBox, ScrollBar As Object, Optional WinBorderStyle As Integer, Optional Icon_Size As Integer, Optional RankIcons As Boolean, Optional CType As Integer)
  Set Obj = PictureBox
  Set ScrL = ScrollBar
  
  'PictureBox.FontSize = 32
  
  Obj.AutoRedraw = False
  Obj.ScaleMode = 3
  RevSort = True
  ConnType = CType
  IconSize = Icon_Size
  BorderStyle = WinBorderStyle
  If BorderStyle > 0 Then
    Obj.BorderStyle = 0
  Else
    Obj.BorderStyle = 1
  End If
  ScrL.LargeChange = 10
  ScrL.TabStop = False
  
  ReDim ListIco(-2 To 0, 0)
  ReDim Colums(0)
  ColumCount = 1
  
  RangIco = RankIcons
  InstOK = True
  Refresh
End Sub

Public Sub Refresh(Optional X As Single = -1, Optional Y As Single = -1, Optional Button As Integer = 0, Optional Scroll As Boolean, Optional Mode As Integer)
  Dim I As Long
  Dim I2 As Integer
  Dim I3 As Single
  Dim DAT As String
  Dim outChr As Integer
  Dim IndCound As Integer
  Dim Oanf As Integer
  Dim Lanf As Integer
  Dim BasicFColor As Long
  Dim TRealH As Integer
  Dim cXPos As Long
  Dim cYPos As Long
  Dim baColor As Long
  Dim rectColumn As RECT
  Dim IsStyleSel As Boolean
  Dim SignChar As String
  
  If AutoRef = False Then Exit Sub
    
  BasicFColor = Obj.ForeColor
  TextH = Obj.TextHeight("l")
  TRealH = TextH
  If TextH < IconSize Then TextH = IconSize + 1
  TRealH = (TextH - TRealH) / 2
  If TRealH < 0 Then TRealH = 0
  I = ListIcoCount - (Obj.ScaleHeight - lTop) / (TextH + 1) + 1
  If I <> ScrL.Max Then
    If I > 0 Then
      ScrL.Max = I
      If ScrL.Visible = False Then ScrL.Visible = True
    Else
      If ScrL.Max <> 0 Then ScrL.Max = 0
      If ScrL.Visible = True Then ScrL.Visible = False
    End If
  End If
  ScW = ScrL.Width * CInt(ScrL.Visible) * -1
  
  If Obj.Visible = False Then Exit Sub
  
  If ScrL.LargeChange <> Fix(Obj.ScaleHeight / TextH) - 4 And Fix(Obj.ScaleHeight / TextH) - 4 > 0 Then ScrL.LargeChange = Fix(Obj.ScaleHeight / TextH) - 4

  For IndCound = ScrL.Value To ListIcoCount - 1
    Lanf = 0
    If Mode < 10 Or Mode - 10 = IndCound Then
      Obj.ForeColor = BasicFColor
      If Mode <> 3 Or IndCound = LastLIndex Or IndCound = LIndex Then
        Obj.Line (1, (IndCound - ScrL.Value) * (TextH + 1) + 1 + lTop)-Step(Obj.ScaleWidth - ScW - 2, TextH), Obj.BackColor, BF
      End If
      If LIndex = IndCound Then
        DrawSelectionRect Obj.hDC, 1, (IndCound - ScrL.Value) * (TextH + 1) + 1 + lTop, Obj.ScaleWidth - ScW - 2, TextH
        If Not SupportSelledStyle Then
          Obj.Line (1, (IndCound - ScrL.Value) * (TextH + 1) + 1 + lTop)-Step(Obj.ScaleWidth - ScW - 2, TextH), &H8000000D, BF
        End If
      End If
    End If
    
    For I = 0 To ColumCount - 1
      I2 = Colums(I).Width
      If I2 < 0 Then I2 = Obj.ScaleWidth - Lanf - 2 - ScW
      If I2 = 0 Then I2 = Obj.ScaleWidth - ScW - 2
    
      If Mode < 10 Or Mode - 10 = IndCound Then
        If LIndex = IndCound And SupportSelledStyle = False Then
          Obj.ForeColor = &H8000000E
        Else
          Obj.ForeColor = BasicFColor
        End If
        
        cXPos = 4 + Lanf
        If I = 0 Then Obj.CurrentX = cXPos + IconSize Else Obj.CurrentX = cXPos
        cYPos = (IndCound - ScrL.Value) * (TextH + 1) + 1 + lTop + TRealH
        Obj.CurrentY = cYPos
        If cYPos > Obj.ScaleHeight Then Exit For
        If (Mode <> 3 Or IndCound = LastLIndex Or LIndex = IndCound) Then
          If Colums(I).NoScrollRef = True Then
            If Scroll = False Then
              If LIndex = IndCound Then
                Obj.DrawMode = 11
                PrintText ListIco(I, IndCound) ' Draw colored text
                Obj.DrawMode = 13
              Else
                PrintText ListIco(I, IndCound) ' Draw colored text
              End If
            End If
          End If
          If I = 0 And TextH >= IconSize And ListIco(-1, IndCound) <> "" Then
            PrintIcon Obj, 2, cYPos + (TextH - IconSize) \ 2, Val(ListIco(-1, IndCound))
          End If
          outChr = 0
          '----------------------------------
          If RangIco = True Then
            SignChar = Left(ListIco(0, IndCound), 1)
            If GetCharVals(SignChar) < 128 Then
              Select Case SignChar
                Case "~": outChr = 79 '48
                Case "&": outChr = 80 '47
                Case "*": outChr = 49
                Case "!": outChr = 43
                Case "@": outChr = 44
                Case "%": outChr = 45
                Case "+": outChr = 46
                Case ""
                Case Else: outChr = 73
              End Select
            ElseIf InStr(1, cvPrefixSign, SignChar) > 0 Then
              Select Case SignChar
                Case "~": outChr = 48
                Case "&": outChr = 47
              End Select
            End If
          End If
          '----------------------------------
          If Colums(I).NoScrollRef = False Then
            If outChr = 0 Or Len(ListIco(I, IndCound)) < 2 Then
              If Left(ListIco(I, IndCound), 1) = "%" And Right(ListIco(I, IndCound), 1) = "%" Then
                I3 = Val(Mid(ListIco(I, IndCound), 2, Len(ListIco(I, IndCound)) - 2))
                If I3 < 0 Then baColor = ColorGrayText Else baColor = &H8000000D
                I3 = Abs(I3)
                If I3 > 100 Then I3 = 100
                Obj.Line (cXPos, cYPos - TRealH + 2)-Step(Colums(I).Width - 8, TextH - 4), Obj.ForeColor, B
                If I3 <> 0 Then
                  Obj.Line (cXPos + 1, cYPos - TRealH + 8 + 2)-Step((Colums(I).Width - 9) * I3 / 100 - 1, TextH - 5 - 8), baColor, BF
                  DrawFlow Obj, cXPos + 1, cYPos - TRealH + 3, (Colums(I).Width - 9) * I3 / 100, 6, Obj.BackColor, baColor
                End If
                'Obj.CurrentX = cXPos + Colums(I).Width / 2 - 12
                'Obj.CurrentY = cYPos
                'Obj.Print CStr(I3) + " %"
                TextOutW Obj.hDC, cXPos + Colums(I).Width / 2 - 12, cYPos, StrPtr(CStr(I3) + " %"), Len(CStr(I3) + " %")
              Else
                If I = 0 Then
                  rectColumn.Left = cXPos + IconSize
                Else
                  rectColumn.Left = cXPos
                End If
                rectColumn.Top = cYPos
                rectColumn.Right = cXPos + I2 - 3
                rectColumn.Bottom = cYPos + TextH
                If Left(ListIco(I, IndCound), 5) = "\\-->" Then
                  DAT = Mid(ListIco(I, IndCound), 12, 2) + "." + Mid(ListIco(I, IndCound), 10, 2) _
                  + "." + Mid(ListIco(I, IndCound), 6, 4)
                Else
                  DAT = ListIco(I, IndCound)
                End If
                If Len(ListIco(-2, IndCound)) Then
                  Obj.ForeColor = Val(ListIco(-2, IndCound))
                  DrawText Obj.hDC, DAT, Len(DAT), rectColumn, DT_NOPREFIX
                  Obj.ForeColor = BasicFColor
                Else
                  DrawText Obj.hDC, DAT, Len(DAT), rectColumn, DT_NOPREFIX
                End If
              End If
            Else
              If I = 0 Then
                rectColumn.Left = cXPos + IconSize
              Else
                rectColumn.Left = cXPos
              End If
              rectColumn.Top = cYPos
              rectColumn.Right = cXPos + I2 - 3
              rectColumn.Bottom = cYPos + TextH
              DAT = ChatNoSignGlobal(ListIco(I, IndCound))
              If Len(ListIco(-2, IndCound)) Then
                Obj.ForeColor = Val(ListIco(-2, IndCound))
                DrawText Obj.hDC, DAT, Len(DAT), rectColumn, DT_NOPREFIX
                Obj.ForeColor = BasicFColor
              Else
                DrawText Obj.hDC, DAT, Len(DAT), rectColumn, DT_NOPREFIX
              End If
              PrintIcon Obj, 2, cYPos + (TextH - IconSize) / 2 - 4, outChr
            End If
          End If
        End If
      End If
  
      Lanf = Lanf + I2 + 1
      If Lanf > Obj.ScaleWidth Then Exit For
    Next
  Next

  Obj.ForeColor = BasicFColor

  Lanf = 0
  For I = 0 To ColumCount - 1
    I2 = Colums(I).Width
    If I2 < 0 Then I2 = Obj.ScaleWidth - Lanf - 2 - ScW
    If I2 = 0 Then I2 = Obj.ScaleWidth - ScW - 2

    If Mode < 2 And lTop > 0 Then
      DrawRec Lanf + 1, Oanf + 1, Lanf + I2 + 1, lTop, Colums(I).Caption, Colums(I).Down
    End If
    Lanf = Lanf + I2 + 1
  Next
  If Lanf < Obj.ScaleWidth And lTop > 0 Then
    If Mode < 2 And lTop > 0 Then
      DrawRec Lanf + 1, Oanf + 1, Obj.ScaleWidth - 2 + ScW, lTop, ""
    End If
  End If
'    For IndCound = ScrL.Value To ListIcoCount - 1
'      I = (IndCound - ScrL.Value) * (TextH + 1) + 1 + lTop
'      If I > Obj.ScaleHeight Then Exit For
'      If LIndex = IndCound Then
'        Obj.Line (Lanf, I)- _
'        Step(Obj.ScaleWidth - Lanf - ScW - 1, TextH), &H8000000D, BF
'      Else
'        Obj.Line (Lanf, I)- _
'        Step(Obj.ScaleWidth - Lanf - ScW - 1, TextH), Obj.BackColor, BF
'      End If
'    Next

  If ListIcoCount = 0 Then cYPos = lTop - TextH
  If cYPos < Obj.ScaleHeight Then
    Obj.Line (1, (IndCound - ScrL.Value) * (TextH + 1) + 1 + lTop)-(Obj.ScaleWidth - ScW - 2, Obj.ScaleHeight - 2), Obj.BackColor, BF
  End If
  If BorderStyle = 1 Then
    Obj.Line (0, 0)-(0, Obj.ScaleHeight - 1), ColorButtonShadow
    Obj.Line (0, 0)-(Obj.ScaleWidth - 1, 0), ColorButtonShadow
    Obj.Line (Obj.ScaleWidth - 1, 0)-(Obj.ScaleWidth - 1, Obj.ScaleHeight - 1), ColorHighlight3D
    Obj.Line (0, Obj.ScaleHeight - 1)-(Obj.ScaleWidth, Obj.ScaleHeight - 1), ColorHighlight3D
    Lanf = 1
    Oanf = 1
  ElseIf BorderStyle = 2 Then
    Obj.Line (0, 0)-(0, Obj.ScaleHeight - 1), ColorButtonShadow
    Obj.Line (0, 0)-(Obj.ScaleWidth - 1, 0), ColorButtonShadow
    Obj.Line (Obj.ScaleWidth - 1, 0)-(Obj.ScaleWidth - 1, Obj.ScaleHeight - 1), ColorButtonShadow
    Obj.Line (0, Obj.ScaleHeight - 1)-(Obj.ScaleWidth, Obj.ScaleHeight - 1), ColorButtonShadow
    Lanf = 1
    Oanf = 1
  ElseIf BorderStyle = 3 Then
    Obj.Line (0, 0)-(Obj.ScaleWidth - 1, Obj.ScaleHeight - 1), Obj.BackColor, B
    Lanf = 1
    Oanf = 1
  End If
End Sub

Private Sub DrawRec(X1, Y1, X2, Y2, Text As String, Optional Down As Boolean)
  Dim rectColumn As RECT
  Dim TempC As Long
  Dim lShadow As Long
  
  lShadow = GetMixedColor(ColorButtonShadow, ColorBackColor, 50)
  DrawFlow Obj, X1, Y1, X2 - X1, 9, ColorHighlight3D, GetMixedColor(ColorBackColor, ColorHighlight3D, 30)
  DrawFlow Obj, X1, 9, X2 - X1, Y2 - 9, GetMixedColor(ColorBackColor, ColorHighlight3D, 80), ColorBackColor
  If Down = False Then
    Obj.Line (X1, Y1)-(X1, Y2), ColorHighlight3D
    Obj.Line (X2, Y1 - 1)-(X2, Y2 + 1), lShadow
    Obj.Line (X1, Y2)-(X2, Y2), lShadow
    rectColumn.Left = X1 + 3
    rectColumn.Top = Y1 + 2
  Else
    Obj.Line (X1, Y1)-(X1, Y2), lShadow
    Obj.Line (X1, Y1)-(X2, Y1), lShadow
    Obj.Line (X2, Y1)-(X2, Y2 + 1), ColorHighlight3D
    Obj.Line (X1, Y2)-(X2, Y2), ColorHighlight3D
    rectColumn.Left = X1 + 4
    rectColumn.Top = Y1 + 3
  End If
  If Text <> "" Then
    rectColumn.Right = X2 - 2
    rectColumn.Bottom = Y2 - 1
    TempC = Obj.ForeColor
    Obj.ForeColor = ColorButtonText
    DrawText Obj.hDC, Text, Len(Text), rectColumn, DT_LEFT
    Obj.ForeColor = TempC
  End If
End Sub

Private Sub QuickSort(vArray As Variant, l As Integer, r As Integer)
  Dim I As Integer
  Dim J As Integer
  Dim Zae As Integer
  Dim X
  Dim Y()
  Dim AltItemName As String
  Dim StartRem As Boolean
  If LIndex < ListIcoCount And LIndex > -1 Then AltItemName = ListIco(0, LIndex)

  ReDim Y(-2 To ColumCount - 1)
  I = l
  J = r
  X = UCase(vArray(CSortIndex, (CLng(l) + r) / 2))
  While (I <= J)
    While (IsBigger(UCase(vArray(CSortIndex, I)), X, RevSort) And I < r)
      I = I + 1
    Wend
    While (IsBigger(X, UCase(vArray(CSortIndex, J)), RevSort) And J > l)
      J = J - 1
    Wend
    If (I <= J) Then
      For Zae = -2 To ColumCount - 1
        Y(Zae) = vArray(Zae, I)
        vArray(Zae, I) = vArray(Zae, J)
      Next
      For Zae = -2 To ColumCount - 1
        vArray(Zae, J) = Y(Zae)
      Next
      I = I + 1
      J = J - 1
    End If
  Wend
  If (l < J) Then QuickSort vArray, l, J
  If (I < r) Then QuickSort vArray, I, r
  GotoItem AltItemName
End Sub

Private Function IsBigger(ByVal Str1 As String, ByVal Str2 As String, Optional Kleiner As Boolean) As Boolean
  Dim strW1 As Byte
  Dim strW2 As Byte
  
  strW1 = GetCharVals(Left(Str1, 1))
  strW2 = GetCharVals(Left(Str2, 1))
  
  If Kleiner = False Then
    If strW1 = strW2 Then
      IsBigger = ChatNoSignGlobal(Str1) > ChatNoSignGlobal(Str2)
    Else
      IsBigger = strW1 > strW2
    End If
  Else
    If strW1 = strW2 Then
      IsBigger = ChatNoSignGlobal(Str1) < ChatNoSignGlobal(Str2)
    Else
      IsBigger = strW1 < strW2
    End If
  End If
End Function

Private Function GetCharVals(Char As String) As Byte
  Dim I As Integer
  
  I = InStr(1, cvPrefixSign, Char)
  
  If I = 0 Then
    GetCharVals = 128
  Else
    'Abwärtskompatibilität mit dem NettalkIRCD
    If Mid(cvPrefix, I, 1) = "x" Or Mid(cvPrefix, I, 1) = "y" Then
      GetCharVals = 128
    Else
      GetCharVals = I - 1
    End If
  End If
End Function


Public Sub PrintText(Data As String)
  Dim I As Integer
  Dim I2 As Integer
  Dim DAT As String
  Dim sPara As Integer
  Dim sAltPara As Integer
  Dim sColor As Integer
  Dim sAltColor As Integer
  Dim sBackColor As Integer
  Dim sAltBackcolor As Integer
  Dim CCheck As Integer
  Dim Bdat As Long
  Dim OldFColor As Long
  Dim OldBColor As Long
  Dim cx As Long
  Dim cy As Long
  
  cx = Obj.CurrentX
  cy = Obj.CurrentY
  OldFColor = Obj.ForeColor
  OldBColor = Obj.BackColor
  sAltColor = -1
  sAltBackcolor = -1
  sAltPara = -1
  sColor = -1
  sBackColor = -1
  sPara = -1
  I = 1
  For I = 1 To Len(Data)
    Bdat = AscW(Mid(Data, I, 1))
    If Bdat > 31 Or Bdat = 13 Or Bdat = 10 Then
      DAT = DAT + ChrW(Bdat)
    Else
      If Bdat = 3 Then
        CCheck = 0
        For I2 = I + 1 To Len(Data)
          Select Case AscW(Mid(Data, I2, 1))
            Case 0 To 43, 45 To 47, 58 To 255
              If CCheck = 0 Then
                If I2 - I - 1 > 2 Then
                  sColor = Val(Mid(Data, I + 1, 2))
                Else
                  sColor = Val(Mid(Data, I + 1, I2 - I - 1))
                End If
              Else
                If I2 - CCheck - 1 > 2 Then
                  sBackColor = Val(Mid(Data, CCheck + 1, 2))
                Else
                  sBackColor = Val(Mid(Data, CCheck + 1, I2 - CCheck - 1))
                End If
              End If
              Exit For
            Case 44
              CCheck = I2
              sColor = Val(Mid(Data, I + 1, I2 - I - 1))
          End Select
        Next
        I = I2 - 1
      End If
    End If
    If sAltColor <> sColor Or sAltBackcolor <> sBackColor Or sAltPara <> sPara Or I >= Len(Data) Then
      If DAT <> "" Then
        Obj.Line (cx, cy)-(cx + TextWW(DAT, Obj.hDC), cy + Obj.TextHeight(DAT)), GetIRCColor(sAltBackcolor, OldBColor), BF
        Obj.ForeColor = GetIRCColor(sAltColor, OldFColor)
        If cx > Obj.ScaleWidth - ScW - 4 Then Exit For
'        Obj.CurrentX = cx
'        Obj.CurrentY = cy
'        Obj.Print DAT
        TextOutW Obj.hDC, cx, cy, StrPtr(DAT), Len(DAT)
        cx = cx + TextWW(DAT, Obj.hDC)
        Obj.ForeColor = OldFColor
        DAT = ""
      End If
      sAltColor = sColor
      sAltBackcolor = sBackColor
      sAltPara = sPara
    End If
  Next
End Sub

Public Sub GotoItem(ItemName As String)
  Dim I As Integer
  If LIndex > -1 And LIndex < ListIcoCount Then
    If ListIco(0, LIndex) = ItemName Then Exit Sub
    If LIndex + 1 < ListIcoCount Then
      If ChatNoSignGlobal(ListIco(0, LIndex + 1)) = ItemName Then
        LIndex = LIndex + 1
        Exit Sub
      End If
    End If
    If LIndex > 0 Then
      If ChatNoSignGlobal(ListIco(0, LIndex - 1)) = ItemName Then
        LIndex = LIndex - 1
        Exit Sub
      End If
    End If
  End If
  For I = 0 To ListIcoCount - 1
    If ChatNoSignGlobal(ListIco(0, I)) = ItemName Then
      LIndex = I
      Exit For
    End If
  Next
End Sub

Public Sub ScrollToIndex()
  Dim I As Integer
  Dim TextH As Integer
  TextH = Obj.TextHeight("l")
  If TextH < IconSize Then TextH = IconSize
  I = -1
  If (LIndex - ScrL.Value) + 1 > ((Obj.ScaleHeight - lTop) / (TextH + 1)) Then
    I = LIndex - Fix(((Obj.ScaleHeight - lTop) / (TextH + 1))) + 1
  End If
  If (LIndex - ScrL.Value) < 0 Then
    I = LIndex
  End If
  If I = -1 Then Exit Sub
  If I > ScrL.Max Then I = ScrL.Max
  If I < 0 Then I = 0
  ScrL.Value = I
End Sub

Public Sub Search(Text As String)
  Dim I As Integer
  Dim I2 As Integer
  Dim StartPos As Long
  
  StartPos = ListIndex
  I = ListIndex + 1
  Do
    If I = ListCount Then I = 0
    If I = StartPos Then Exit Do
    
    For I2 = 0 To 2
      If InStr(1, Me.List(I, I2), Text, vbTextCompare) > 0 Then
        GotoItem ChatNoSignGlobal(Me.List(I, 0))
        ScrollToIndex
        Refresh
        Exit Do
      End If
    Next
    
    I = I + 1
  Loop
End Sub

Public Function Add(Text As String, Optional Icon As Integer = -1, Optional Refresh As Boolean = True, Optional GotoNotToItem As Boolean, Optional Sort As Boolean = True) As Integer
  Dim nOb As Long
  Dim nUn As Long
  Dim nMit As Long
  Dim I As Long
  Dim DAT As String
  Dim I2 As Long
  Dim InPos As Long
  Dim AltItemName As String
  Dim AddArr() As String
  If Len(Text) = 0 Or ListIcoCount > 32000 Then Exit Function
  If LIndex < ListIcoCount And LIndex > -1 Then
    AltItemName = ListIco(0, LIndex)
  End If
  ReDim AddArr(-2 To ColumCount - 1) As String
  Do
    I2 = I
    I = InStr(I + 1, Text, Chr(0))
    If I = 0 Then I = Len(Text) + 1
    AddArr(InPos) = Mid(Text, I2 + 1, I - I2 - 1)
    InPos = InPos + 1
  Loop Until I >= Len(Text) Or InPos > ColumCount - 1
  
  If Sort = True Then
    DAT = UCase(AddArr(CSortIndex))
    nUn = 0
    nOb = ListIcoCount
    I = 0
    Do
      I = I + 1
      nMit = Fix((nOb - nUn) / 2 + nUn)
      If (I > 1 Or ListIcoCount = 0) And (nMit = I2) Then
        Exit Do
      End If
      If IsBigger(DAT, UCase(ListIco(CSortIndex, nMit))) Then
        nUn = nMit
        I2 = nMit
      Else
        nOb = nMit
        I2 = nMit
      End If
    Loop
  
    InPos = nOb '+ 1
    If nUn > ListIcoCount - 1 Then InPos = ListIcoCount
  End If
  ListIcoCount = ListIcoCount + 1
  ReDim Preserve ListIco(-2 To ColumCount - 1, ListIcoCount - 1)
  If Sort = True Then
    For I2 = -2 To ColumCount - 1
      For I = ListIcoCount - 1 To InPos + 1 Step -1
        ListIco(I2, I) = ListIco(I2, I - 1)
      Next
      ListIco(I2, InPos) = AddArr(I2)
    Next
  Else
    InPos = ListIcoCount - 1
    For I2 = -2 To ColumCount - 1
      ListIco(I2, InPos) = AddArr(I2)
    Next
  End If
  If Icon > -1 Then ListIco(-1, InPos) = Str(Icon) Else ListIco(-1, InPos) = ""
  Add = InPos
  If GotoNotToItem = False Then GotoItem AltItemName
  If Refresh = True Then
    If InPos < ScrL.Value Then
      If ScrL.Value < ScrL.Max Then
        NScrollRefr = True
        ScrL.Value = ScrL.Value + 1
        NScrollRefr = False
      End If
    Else
      Resize
    End If
  End If
End Function

Public Function ListCount() As Integer
  ListCount = ListIcoCount
End Function

Public Sub Remove(ByVal ListIndex As Integer)
  Dim I As Integer
  Dim I2 As Integer
  For I = ListIndex To ListIcoCount - 2
    For I2 = -2 To ColumCount - 1
      ListIco(I2, I) = ListIco(I2, I + 1)
    Next
  Next
  If I = ListIcoCount Then Exit Sub
  ListIcoCount = ListIcoCount - 1
  If ListIcoCount > 0 Then
    ReDim Preserve ListIco(-2 To ColumCount - 1, ListIcoCount - 1)
  End If
  Resize
End Sub

Public Sub RemoveByText(NickName As String)
  Dim I As Integer
  Dim I2 As Integer
  Dim Text As String
  Dim AltItemName As String
  Dim StartRem As Boolean
  
  Text = UCase(ChatNoSignGlobal(NickName))
  If LIndex < ListIcoCount And LIndex > -1 Then AltItemName = ListIco(0, LIndex)
  For I = 0 To ListIcoCount - 1
    If Text = UCase(ChatNoSignGlobal(ListIco(0, I))) Then StartRem = True
    If StartRem = True And ListIcoCount > I + 1 Then
      For I2 = -2 To ColumCount - 1
        ListIco(I2, I) = ListIco(I2, I + 1)
      Next
    End If
  Next
  If StartRem = True Then
    ListIcoCount = ListIcoCount - 1
    If ListIcoCount < 1 Then Exit Sub
    ReDim Preserve ListIco(-2 To ColumCount - 1, ListIcoCount - 1)
    GotoItem AltItemName
    Resize
  End If
End Sub

Public Function List(ByVal ListIndex As Integer, Optional Colum As Integer) As String
  If ListIndex > UBound(ListIco, 2) Or ListIndex < 0 Then Exit Function
  If Colum > UBound(ListIco, 1) Or Colum < 0 Then Exit Function
  List = ListIco(Colum, ListIndex)
End Function

Public Sub Clear(Optional NoRefr As Boolean)
  ListIcoCount = 0
  ReDim ListIco(-2 To ColumCount - 1, 0)
  If NoRefr = False Then Resize
End Sub

Public Sub Scroll()
  Refresh , , , True, 2
End Sub

Public Sub Change()
  If NScrollRefr = False Then Refresh , , , False, 2
End Sub

Public Sub KeyDown(KeyCode As Integer, Shift As Integer)
  Dim I As Integer
  
  I = LIndex
  LastLIndex = LIndex
  If KeyCode = vbKeyDown And LIndex + 1 < ListIcoCount Then LIndex = LIndex + 1
  If KeyCode = vbKeyUp And LIndex > 0 Then LIndex = LIndex - 1
  If KeyCode = 34 Then
    If LIndex + ScrL.LargeChange < ListIcoCount Then
      LIndex = LIndex + ScrL.LargeChange
    Else
      LIndex = ListIcoCount - 1
    End If
  End If
  If KeyCode = 33 Then
    If LIndex - 1 > ScrL.LargeChange Then
      LIndex = LIndex - ScrL.LargeChange
    Else
      LIndex = 0
    End If
  End If
  If I <> LIndex Then
    ScrollToIndex
    Refresh , , , , 3
    RaiseEvent Change
  End If
End Sub

Public Sub KeyPress(KeyAscii As Integer)
  Dim I As Integer
  Dim I2 As Integer
  Dim OldLI As Integer
  
  OldLI = LIndex
  If AltTimeDiff(SuchTo) > 0 Or Len(SuchStr) > 15 Then SuchStr = ""
  If Left(SuchStr, 1) <> Chr(KeyAscii) Or Len(SuchStr) > 1 Then
    SuchStr = SuchStr + Chr(KeyAscii)
    SuchTo = AltTimer + 1.3
  Else
    SuchTo = AltTimer
  End If
  If Len(SuchStr) = 1 Then I2 = LIndex Else I2 = LIndex - 1
  If I2 < 0 Then I2 = ListIcoCount - 1
  I = I2
  Do
    I = I + 1
    If I > ListIcoCount - 1 Then I = 0
    If UCase(Left(ChatNoSignGlobal(ListIco(0, I)), Len(SuchStr))) = UCase(SuchStr) Then
      LastLIndex = LIndex
      LIndex = I
      Exit Do
    End If
  Loop Until I = I2 Or I2 < 0
  I2 = ScrL.Value
  ScrollToIndex
  If ScrL.Value <> I2 And I < ScrL.Max Then ScrL.Value = I
  Refresh , , , , 3
  If LIndex <> OldLI Then RaiseEvent Change
End Sub

Public Sub MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim I As Integer
  Dim I2 As Long
  
  LastX = X
  LastY = Y
  If Y < lTop Then
    I2 = 1
    For I = 0 To ColumCount - 1
      ColumResPos = I2
      I2 = I2 + Colums(I).Width + 1
      If X > I2 - 4 And X < I2 + 4 Then Exit For
    Next
    If I < ColumCount Then
      ColumResX = I + 1
    End If
  End If
  If ColumResX = 0 Then
    If X > Obj.ScaleWidth - 2 Then Exit Sub
    SelectItem False
    RaiseEvent MouseDown(Button, Shift, X, Y)
  End If
End Sub

Private Sub SelectItem(Optional DblClick As Boolean)
  Dim I As Integer
  Dim I2 As Integer
  Dim Lanf As Integer
  Dim TempLI As Integer
  Dim OldLI As Integer
  
  OldLI = LIndex
  If LastY < lTop Then
    For I = 0 To ColumCount - 1
      I2 = Colums(I).Width
      If I2 < 0 Then I2 = Obj.ScaleWidth - Lanf - 2
      If LastX < Lanf + I2 Then
        Colums(I).Down = True
        Exit For
      End If
      Lanf = Lanf + I2 + 1
      If Lanf > Obj.ScaleWidth Then Exit For
    Next
    Refresh , , , False, 1
  Else
    TempLI = (LastY - lTop + 7) / (TextH + 1) - 1 + ScrL.Value
    If TempLI > -1 And TempLI < ListIcoCount Then
      LastLIndex = LIndex
      LIndex = TempLI
      If LastLIndex <> LIndex Then Refresh , , , False, 3
      If DblClick = True Then RaiseEvent DblClick
    End If
  End If
  If OldLI <> LIndex Then RaiseEvent Change
End Sub

Public Sub MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim I As Integer
  Dim I2 As Long
    
  If ColumResX = 0 Then
    If Y < lTop Then
      I2 = 1
      For I = 0 To ColumCount - 1
        I2 = I2 + Colums(I).Width + 1
        If X > I2 - 4 And X < I2 + 4 Then Exit For
      Next
      If I < ColumCount Then Obj.MousePointer = 9 Else Obj.MousePointer = 0
    Else
      If Obj.MousePointer = 9 Then Obj.MousePointer = 0
      If (Button = 1 Or Button = 2) And LastY >= lTop Then
        LastX = X
        LastY = Y
        SelectItem False
      End If
    End If
  Else
    If Button = 1 Then
      I2 = Colums(ColumResX - 1).Width + X - LastX
      If ColumResPos + I2 > Obj.ScaleWidth - 32 Then I2 = Obj.ScaleWidth - 32 - ColumResPos
      If I2 < 16 Then I2 = 16
      If I2 <> Colums(ColumResX - 1).Width Then
        Colums(ColumResX - 1).Width = I2
        Refresh , , , False
        LastX = X
      End If
    End If
  End If
End Sub

Public Sub ReSortList()
  QuickSort ListIco, 0, ListIcoCount - 1
End Sub

Public Sub MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim I As Integer
  Dim I2 As Integer
  Dim Lanf As Integer
  
  If ColumResX > 0 Then
    ColumResX = 0
    Refresh , , , False
  ElseIf LastY < lTop Then
    For I = 0 To ColumCount - 1
      I2 = Colums(I).Width
      If I2 < 0 Then I2 = Obj.ScaleWidth - Lanf - 2
      If X < Lanf + I2 Then
        If Y < lTop Then
          If I = CSortIndex Then RevSort = RevSort = False Else RevSort = True
          CSortIndex = I
          QuickSort ListIco, 0, ListIcoCount - 1
        End If
        Exit For
      End If
      Lanf = Lanf + I2 + 1
      If Lanf > Obj.ScaleWidth Then Exit For
    Next
    For I = 0 To ColumCount - 1
      Colums(I).Down = False
    Next
    Refresh , , , False
  Else
    LastX = X
    LastY = Y
    RaiseEvent MouseUp(Button, Shift, X, Y)
  End If
End Sub

Public Sub Click()
  RaiseEvent Click
End Sub

Public Sub DblClick()
  SelectItem True
End Sub

Public Sub Resize()
  If AutoRef = False Then Exit Sub
  If InstOK = True And Obj.ScaleHeight > 2 Then
    If BorderStyle > 0 Then
      ScrL.Top = lTop + 1
      If Obj.ScaleHeight > 2 + lTop Then
        ScrL.Height = Obj.ScaleHeight - 2 - lTop
      End If
      ScrL.Left = Obj.ScaleWidth - ScrL.Width - 1
    Else
      ScrL.Top = lTop
      ScrL.Height = Obj.ScaleHeight - lTop
      ScrL.Left = Obj.ScaleWidth - ScrL.Width
    End If
    Refresh , , , True
  End If
End Sub

Private Sub Class_Initialize()
  ColorGrayText = &H80000011
  ColorButtonShadow = &H80000010
  ColorHighlight3D = &H80000014
  ColorBackColor = &H8000000F
  ColorButtonText = &H80000012
End Sub
