Seit Visual Basic 6 können Sie dynamisch Steuerelemente beliebig
"aus dem Nichts" nachladen. Damit Sie jedoch auf
Ereignisse jedes so nachgeladenen Steuerelements reagieren können,
müssen Sie eigentlich dafür vorab jeweils eine eigene
Ereignisempfänger-Variable deklarieren und die entsprechenden
Ereignisprozeduren anlegen. Eine direkte Möglichkeit, wie bei
Control-Arrays die verschiedenen Ereignisse zentral in den
dazugehörenden Ereignisprozeduren auflaufen zu lassen und den
jeweiligen konkreten Absender über den Index zu bestimmen, gibt es
für dynamisch nachgeladene Steuerelemente nicht.
Sie können aber mit Hilfe von Klassen für dynamisch
nachgeladene Steuerelemente etwas ähnliches wie ein Control-Array
konstruieren. Sie brauchen dazu für jede nachgeladene Instanz eines
Steuerelements eine Klasse ("Ereignisklasse"), die
zunächst dessen Ereignisse empfängt. Für jedes dort ankommende
Ereignis wird eine entsprechende Methode einer weiteren Klasse
("Sammelklasse") aufgerufen, die nun wiederum ein
entsprechendes Ereignis feuert und dabei in einem zusätzlichen
Parameter den ursprünglichen Absender mitliefert. Im Container, in
dem die Steuerelemente nachgeladen werden, brauchen Sie so nur noch
eine einzige Ereignisempfänger-Variable und die jeweiligen
Ereignisprozeduren anzulegen. Anhand des mitgelieferten Absenders
können Sie diesen analog zum Index beim Control-Array eindeutig
identifizieren.
Für Projekt-interne UserControls und externe Steuerelemente
können Sie eine allgemein verwendbare Ereignisklasse und
Sammelklasse verwenden, wenn Sie sich mit den Ereignissen des
VBControlExtender-Objekts, insbesondere mit dem ObjectEvent-Ereignis
begnügen können. Sie können damit sogar Steuerelemente
verschiedenen Typs in einer Gruppe zusammenfassen. Für VB-eigene
Steuerelemente müssen Sie jedoch beide Klassen spezifisch anlegen,
da sich ein VB-eigenes Steuerelement nicht einer
Ereignisempfänger-Variablen des Typs VBControlExtender zuweisen
lässt.
Sowohl bei den Ereignisklassen als auch bei den Sammelklassen
können Sie alle Ereignisse des betreffenden Steuerelements
berücksichtigen, brauchen es aber nicht. Sie können sich auf die
Ereignisse beschränken, die Sie tatsächlich benötigen. Bei der
allgemeinen Sammelklasse können Sie auch gegebenenfalls eine
Vorabauswertung der Info-Parameters beim ObjektEvent-Ereignis
vornehmen und in separate Ereignisse verzweigen.
Da sowohl einige Parameter als auch Rückgabewerte der Methoden
und Eigenschaften der Klassen als VB-interne Objekte deklariert
werden, eigenen sich die Klassen nicht für eine öffentliche
Verwendung und eine Auslagerung etwa in eine ActiveX-Komponente. Sie
können Sie nur als private Klassen im jeweiligen Projekt verwenden.
Zur Vereinfachung der Verwaltung dieser Konstruktion kann die
Sammelklasse mit allen notwendigen Funktionen ausgestattet werden.
Sie kann auch die Aufgabe des Nachladens und des wieder Entfernens
übernehmen. Auf die von einer solchen Sammelklasse verwalteten
Steuerelemente können Sie ähnlich wie auf die Elemente eines
Control-Arrays per Indexnummer und auch über den nach wie vor
notwendigen eindeutigen Namen eines nachgeladenen Steuerelements
zugreifen. Der Unterschied zum Zugriff auf die nachgeladenen
Steuerelemente bei einem Control-Array besteht lediglich darin, dass
die Folge der Indexnummern nur lückenlos sein kann (wegen der
Verwaltung der Steuerelemente in einer internen Collection) und dass
Sie sich selbst um die Vergabe eines Namens kümmern müssen. Zwar
sorgt eine Automatik dafür, dass bei einem nichteindeutigen Namen
automatisch eine fortlaufende Nummerierung erfolgt (ähnlich wie bei
zur Entwicklungszeit neu in einen Container eingefügten
Steuerelementen). Doch wenn Sie die Vergabe von eindeutigen Namen
selbst übernehmen, sind Sie dabei nicht an einen Stammnamen
gebunden, sondern können die Namen vollkommen frei und flexibel
wählen.
Sie übergeben der Methode Add der Sammelklasse die
Controls-Collection des Containers, in den das neue Steuerelement
nachgeladen werden soll, die ProgId des Steuerelements und den
eindeutigen Namen. Optional können Sie noch die Angaben zur
Positionierung (Left, Top, Width und Height) und die Einstellungen
für die Eigenschaften Visible und Enabled machen. Die
Voreinstellung für Enabled ist True - falls der Container oder das
Steuerelement selbst (noch) nicht sichtbar sein sollte, wird die
Einstellung ignoriert. Bei einer spezifischen Sammelklasse für
VB-interne Steuerelemente entfällt die ProgId - sie wird in der
spezifischen Sammelklasse festgelegt.
Der Remove-Methode (bei der allgemeinen und bei spezifischen
Sammelklassen gleich) zum Entladen eines nachgeladenen
Steuerelements übergeben Sie wahlweise das zu entladende
Steuerelement selbst, dessen Namen oder eine Indexnummer.
Auf die in einer Sammelklasse geladenen Steuerelemente können
Sie über die Control-Eigenschaft unter Angabe des
Steuerelement-Namens oder unter der Angabe einer Indexnummer
jederzeit zugreifen. Die Anzahl der aktuell in der Sammelklasse
geladenen Steuerelemente erhalten Sie über die Eigenschaft Count.
Über eine NewEnum-Methode zur Verwendung in einer For...Each-Schleife
verfügen die Sammelklassen nicht, da über diese nur die in der
internen Collection enthaltenen Ereignisklassen geliefert würden,
jedoch nicht die eigentlichen Steuerelemente.
Der Code der allgemeinen Sammelklasse sieht so aus:
Private mControls As Collection
Public Enum dcehErrorConstants
dcehErrControlNotFound = vbObjectError + 11000
End Enum
Public Event DragDrop(Ctl As Control, Source As Control, _
X As Single, Y As Single)
Public Event DragOver(Ctl As Control, Source As Control, _
X As Single, Y As Single, State As Integer)
Public Event GotFocus(Ctl As Control)
Public Event LostFocus(Ctl As Control)
Public Event ObjectEvent(Ctl As Control, Info As EventInfo)
Public Event Validate(Ctl As Control, Cancel As Boolean)
'--- Events -----------------------------------------------------
Public Sub OnDragDrop(Ctl As Control, Source As Control, _
X As Single, Y As Single)
RaiseEvent DragDrop(Ctl, Source, X, Y)
End Sub
Public Sub OnDragOver(Ctl As Control, Source As Control, _
X As Single, Y As Single, State As Integer)
RaiseEvent DragOver(Ctl, Source, X, Y, State)
End Sub
Public Sub OnGotFocus(Ctl As Control)
RaiseEvent GotFocus(Ctl)
End Sub
Public Sub OnLostFocus(Ctl As Control)
RaiseEvent LostFocus(Ctl)
End Sub
Public Sub OnObjectEvent(Ctl As Control, Info As EventInfo)
RaiseEvent ObjectEvent(Ctl, Info)
End Sub
Public Sub OnValidate(Ctl As Control, Cancel As Boolean)
RaiseEvent Validate(Ctl, Cancel)
End Sub
'--- Collection -------------------------------------------------
Private Sub Class_Initialize()
Set mControls = New Collection
End Sub
Private Sub Class_Terminate()
Set mControls = Nothing
End Sub
Public Property Get Count() As Long
Count = mControls.Count
End Property
Public Property Get Control(NameOrIndex As Variant) As Control
On Error Resume Next
Set Control = mControls(NameOrIndex).Control
If Err.Number Then
Err.Raise Err.Number, _
"clsDynaCtlEventHandler.Control[Get]", Err.Description
End If
End Property
Public Function Add(Controls As Object, _
ProgId As String, _
Name As String, _
Optional ByVal Left As Variant, _
Optional ByVal Top As Variant, _
Optional ByVal Width As Variant, _
Optional ByVal Height As Variant, _
Optional ByVal Visible As Boolean, _
Optional ByVal Enabled As Boolean = True) _
As VBControlExtender
Dim nEvents As clsDynaCtlEvents
Dim nCtl As VBControlExtender
Dim nLeft As Single
Dim nTop As Single
Dim nWidth As Single
Dim nHeight As Single
Dim nCounter As Integer
Dim nName As String
nName = Name
On Error Resume Next
Do
Set nCtl = Controls.Add(ProgId, nName)
Select Case Err.Number
Case 0
Exit Do
Case 727
Err.Clear
nCounter = nCounter + 1
nName = Name & nCounter
Case Else
Err.Raise Err.Number, _
"clsDynaCtlEventHandler.Add", Err.Description
End Select
Loop
On Error GoTo 0
Set nEvents = New clsDynaCtlEvents
nEvents.SetControl nCtl, Me
With nCtl
mControls.Add nEvents, .Name
If IsMissing(Left) Then
nLeft = .Left
Else
nLeft = Left
End If
If IsMissing(Top) Then
nTop = .Top
Else
nTop = Top
End If
If IsMissing(Width) Then
nWidth = .Width
Else
nWidth = Width
End If
If IsMissing(Height) Then
nHeight = .Height
Else
nHeight = Height
End If
.Move nLeft, nTop, nWidth, nHeight
.Visible = Visible
If .Visible Then
.Enabled = Enabled
End If
End With
Set Add = nCtl
End Function
Public Sub Clear()
Dim nCtl As Control
Do While mControls.Count
Set nCtl = mControls(1).Control
mControls.Remove 1
With nCtl
.Parent.Controls.Remove .Name
End With
Loop
Set mControls = New Collection
End Sub
Public Sub Remove(Item As Variant)
Dim l As Long
Dim nCtl As Control
If IsObject(Item) Then
If TypeOf Item Is Control Then
For l = 1 To mControls.Count
If mControls(l).Control Is Item Then
Set nCtl = mControls(l).Control
Exit For
End If
Next 'l
End If
Else
On Error Resume Next
Set nCtl = mControls(Item).Control
On Error GoTo 0
End If
If nCtl Is Nothing Then
Err.Raise dcehErrControlNotFound, _
"clsDynaCtlEventHandler.Remove"
Else
With nCtl
On Error Resume Next
.Parent.Controls.Remove .Name
If Err.Number Then
Err.Raise Err.Number, _
"clsDynaCtlEventHandler.Remove", Err.Description
Else
mControls.Remove .Name
End If
End With
End If
End Sub
Dazu der Code der Ereignisklasse:
Private WithEvents eVBControlExtender As VBControlExtender
Private mCtl As Control
Private mEventHandler As clsDynaCtlEventHandler
Public Property Get Control() As Control
Set Control = mCtl
End Property
Public Sub SetControl(Ctl As VBControlExtender, _
EventHandler As clsDynaCtlEventHandler)
Set eVBControlExtender = Ctl
Set mCtl = Ctl
Set mEventHandler = EventHandler
End Sub
Private Sub eVBControlExtender_DragDrop(Source As Control, _
X As Single, Y As Single)
mEventHandler.OnDragDrop mCtl, Source, X, Y
End Sub
Private Sub eVBControlExtender_DragOver(Source As Control, _
X As Single, Y As Single, State As Integer)
mEventHandler.OnDragOver mCtl, Source, X, Y, State
End Sub
Private Sub eVBControlExtender_GotFocus()
mEventHandler.OnGotFocus mCtl
End Sub
Private Sub eVBControlExtender_LostFocus()
mEventHandler.OnLostFocus mCtl
End Sub
Private Sub eVBControlExtender_ObjectEvent(Info As EventInfo)
mEventHandler.OnObjectEvent mCtl, Info
End Sub
Private Sub eVBControlExtender_Validate(Cancel As Boolean)
mEventHandler.OnValidate mCtl, Cancel
End Sub
Im folgenden nun ein Beispiel für ein UserControl, das in einem
Form nachgeladen werden soll:
Public Event Click()
Public Event Unload()
Private mState As Boolean
Public Sub Action()
mState = Not mState
With UserControl
Select Case mState
Case False
.BackColor = vbWindowBackground
Case True
.BackColor = vbRed
End Select
End With
End Sub
Private Sub cmdClick_Click()
RaiseEvent Click
End Sub
Private Sub cmdUnload_Click()
RaiseEvent Unload
End Sub
Der Code im Form könnte dazu beispielsweise so aussehen:
Private WithEvents eDynaControls As clsDynaCtlEventHandler
Private Sub eDynaControls_ObjectEvent(Ctl As Control, _
Info As EventInfo)
Select Case Info.Name
Case "Click"
Ctl.Action
Case "Unload"
eDynaControls.Remove Ctl
End Select
End Sub
Private Sub Form_Load()
Dim nCtl As VBControlExtender
Set eDynaControls = New clsDynaCtlEventHandler
With eDynaControls
.Add Controls, "DynaControlsEvents.ucTest", "ucTest1", _
(Me.ScaleWidth \ 2) - 1170, (Me.ScaleHeight - 1155) \ 2, _
, , True
.Add Controls, "DynaControlsEvents.ucTest", "ucTest1", _
(Me.ScaleWidth \ 2) + 3 * Screen.TwipsPerPixelX, _
(Me.ScaleHeight - 1155) \ 2, , , True
End With
End Sub
Ein Beispiel für spezifische Klassen für VB-interne CheckBoxen
und deren Verwendung finden Sie im zu diesem Artikel
herunterladbaren Beispiel-Projekt.
|