Option Explicit
    Private mCol As Collection
 
 
' -----------------------------------------------------------------
' Erstellt das Collection Objekt beim erstem Zugriff auf die Klasse
' -----------------------------------------------------------------
 
Private Sub Class_Initialize()
  Set mCol = New Collection
End Sub
 
' -----------------------------------------------------------------
' Zerstört das Collection Objekt wenn die Klasse beendet wird
' -----------------------------------------------------------------
 
Private Sub Class_Terminate()
  Set mCol = Nothing
End Sub
 
' -----------------------------------------------------------------
' Objekt der Collection zurückgeben
' -----------------------------------------------------------------
 
Public Property Get Item(ByVal Index As Long) As clsControl
  Set Item = mCol(Index)
End Property
 
' -----------------------------------------------------------------
' Anzahl der Objekte durchreichen
' -----------------------------------------------------------------
 
Public Property Get Count() As Long
  Count = mCol.Count
End Property
 
' -----------------------------------------------------------------
' Anzahl der Objekte durchreichen
' -----------------------------------------------------------------
 
Public Function Add(ByVal lTop As Long, _
  ByVal lLeft As Long, _
  ByVal lWidth As Long, _
  ByVal lHeight As Long, _
  ByVal sName As String, _
  ByVal iFontSize As Single) As clsControl
 
  On Local Error GoTo 0
  ' -------------------------------- Eigenschaften zuweisen
  Dim objNewMember As clsControl
  Set objNewMember = New clsControl
  With objNewMember
    .top = lTop
    .left = lLeft
    .Height = lHeight
    .Width = lWidth
    .Tag = mCol.Count + 1
    .name = sName
    .FontSize = iFontSize
  End With
 
  ' -------------------------------- Objekt der Collection zuweisen
  mCol.Add objNewMember, sName
  ' -------------------------------- Objekt zurückgeben
  Set Add = objNewMember
  ' -------------------------------- neues Objekt zerstören
  Set objNewMember = Nothing
End Function
 
Public Function AddLine(ByVal lX1 As Long, _
  ByVal lX2 As Long, _
  ByVal lY1 As Long, _
  ByVal lY2 As Long, _
  sName As String) As clsControl
 
  On Local Error GoTo 0
  Dim objNewMember As clsControl
  Set objNewMember = New clsControl
 
  ' Eigenschaften zuweisen
  With objNewMember
    .x1 = lX1
    .x2 = lX2
    .Y1 = lY1
    .Y2 = lY2
    .ResizeOption = 0
    .Tag = mCol.Count + 1
    .name = sName
  End With
 
  ' -------------------------------- Objekt der Collection zuweisen
  mCol.Add objNewMember, sName
  ' -------------------------------- Objekt zurückgeben
  Set AddLine = objNewMember
  ' -------------------------------- neues Objekt zerstören
  Set objNewMember = Nothing
End Function