|
Zum dynamischen Nachladen von Steuerelementen gibt es seit Visual Basic 6 nicht nur die Möglichkeit, Steuerelemente als Elemente eines Steuerelemente-Feldes (Control-Arrays) nachzuladen, sondern auch das Nachladen "aus dem Nichts" über die Methode Controls.Add eines Containers (Form, UserControl usw.). Ein Steuerelemente-Feld können Sie allerdings nicht "aus dem Nichts" erzeugen und später durch Nachladen von Elementen dieses Feldes erweitern. Sie können jedoch beide Techniken kombinieren und so doch zu einem Steuerelemente-Feld "aus dem Nichts" kommen: Sie legen das Basis-Steuerelement des Steuerelemente-Feldes einfach auf einem UserControl an - und eben dieses UserControl laden Sie erst später nach Wunsch dynamisch per Controls.Add nach. Das klingt einfach, oder? Ist es eigentlich auch. Ein paar Kleinigkeiten sind aber zu berücksichtigen, damit das Ganze auch bequem handzuhaben ist und rund läuft.
Schauen wir und das einmal am Beispiel eines TextBox-Feldes an. Selbstverständlich können Sie nach dem vorgestellten Verfahren Steuerelemente-Felder vieler Steuerlement-Typen erstellen. Einzige Voraussetzung ist, dass das Steuerelement ein eigenes Fenster hat und zum API-Zugriff darauf über eine hWnd-Eigenschaft verfügt. Für Labels und andere Steuerlemente, die kein eigenes Fenster haben, eignet sich das vorgestellte Verfahren leider nicht. Hier können Sie sich höchsten damit behelfen, dass Sie dafür eigene UserControls mit vergleichbarer Funktionalität anlegen, wobei das UserControl das benötigte Fenster liefert.
Sie legen eine TextBox auf einem UserControl an, nennen Sie sie "txt", und geben Sie ihr den Index 0. Da das UserControl zur Laufzeit sichtbar und Enabled sein muss, aber selbst den Fokus nicht durch Anklicken mit der Maus bekommen soll, setzen Sie die Eigenschaft BackStyle auf "0 - Transparent".
Über die Methode LoadCtl werden neue Elemente des Steuerelemente-Feldes geladen. Sie können einen bestimmten Index angeben, oder die Festlegung des neuen Index der Methode selbst überlassen (Parameter weglassen, Voreinstellung ist -1). Das neu geladene Element erhalten sie im Rückgabewert der Methode. Übergeben Sie als Index den Wert 0, wird kein neues Element geladen, sondern das Stamm-Element, das ja den Index 0 hat, zurückgegeben. Das neu geladene Element wird mittels der API-Funktion SetParent aus dem UserControl standardmäßig in den Container des UserControl-Parents verschoben. Geben Sie ein anderes Fenster-Handle als Container an, wird es dorthin verschoben. Wird ein Laufzeitfehler ausgelöst, etwa weil der gewünschte Index schon belegt ist, wird dieser Fehler per Err.Raise durchgereicht. Abschließend wird die Eigenschaft Enabled des UserControls auf True gesetzt und das Extender-Objekt sichtbar gemacht. Mit dem zurückgegebenen Element können Sie wie gewohnt verfahren.
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private mIndex As Long
Public Function LoadCtl(Optional ByVal Index = -1, _
Optional ParentWnd As Long) As TextBox
Dim nIndex As Integer
Select Case Index
Case 0
nIndex = 0
Case Is > 0
nIndex = Index
On Error Resume Next
Load txt(nIndex)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
On Error GoTo 0
Case Else
mIndex = mIndex + 1
nIndex = mIndex
On Error Resume Next
Load txt(nIndex)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
On Error GoTo 0
End Select
If ParentWnd Then
SetParent txt(nIndex).hwnd, ParentWnd
Else
SetParent txt(nIndex).hwnd, UserControl.Parent.hwnd
End If
Set LoadCtl = txt(nIndex)
UserControl.Enabled = True
Extender.Visible = True
End Function
Die Ereignisse der Elemente des Steuerelemente-Feldes reichen Sie nach Belieben als Ereignisse des UserControls nach außen weiter. Beispielsweise das Change-Ereignis der TextBox:
Public Event Change(ByVal Index As Integer)
Private Sub txt_Change(Index As Integer)
RaiseEvent Change(Index)
End Sub
Damit Sie auch später beliebig auf die einzelnen Elemente zugreifen können, wird das Objekt des Steuerelemente-Feldes als Eigenschaft offen gelegt:
Public Property Get CtlArray() As Object
Set CtlArray = txt
End Property
Über das hier zurückgegebene Objekt können Sie wie bei jedem Steuerelemente-Feld auch die Anzahl der geladenen Elemente (Count-Eigenschaft) und die Unter- bzw. Obergrenze (lbound- bzw. ubound-Eigenschaften) auslesen.
Zum Verschieben eines Elements in einen anderen Container können Sie allerdings nicht wie gewohnt die Container-Eigenschaft setzen. Sie können es selbst mittels der API-Funktion SetParent verschieben (dazu müssten Sie diese Funktion in Ihrem Projekt an passender Stelle deklarieren). Sie können aber auch auf die Methode SetCtlParent zurückgreifen:
Public Function SetCtlParent(ByVal Index As Integer, _
ByVal NewParentWnd As Long) As Long
On Error Resume Next
SetCtlParent = SetParent(txt(Index).hwnd, NewParentWnd)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Function
Zum Entladen eines Elements rufen Sie die Methode UnloadCtl mit dem Index des zu entladenden Elements auf:
Public Sub UnloadCtl(ByVal Index As Integer)
If Index = 0 Then
txt(0).Visible = False
Else
On Error Resume Next
Unload txt(Index)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
End If
End Sub
Da das UserControl seine eigene Controls-Verwaltung hat, gibt die ActiveControl-Eigenschaft des übergeordneten Containers immer das UserControl-Control zurück, wenn eines der Elemente den Fokus inne hat. Daher ist es sinnvoll, die Eigenschaft ActiveControl des UserControls nach außen weiterzureichen, um das tatsächlich aktive Element ermitteln zu können:
Public Property Get ActiveControl() As Object
Set ActiveControl = UserControl.ActiveControl
End Property
Bei der Initialisierung des UserControls (Ereignis InitProperties beim dynamischen Laden des UserControls bzw. ReadProperties, falls es bereits zur Entwicklungszeit auf einem Container platziert werden sollte) werden zur Laufzeit des Containers (Ambient.UserMode ist True) das Stamm-Element und das Extender-Objekt (und damit das UserControl) zunächst unsichtbar gemacht. Zur Entwicklungszeit des Containers sollte das Stamm-Element das UserControl sichtbar ausfüllen (hier bei einer TextBox als Stamm-Element wird das UserControl auf die feste Höhe der TextBox gesetzt).
Private Sub UserControl_InitProperties()
zInit
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
zInit
End Sub
Private Sub zInit()
If Ambient.UserMode Then
txt(0).Visible = False
Extender.Visible = False
Else
With txt(0)
.Width = UserControl.Width
UserControl.Height = .Height
End With
End If
End Sub
Die Fokus-Verwaltung für den Fall des Einsprungs in die TabIndex-Folge des Steuerelemente-Feldes im Rückwärtsgang (per Tastenkombination Umschalt+Tab) erfolgt wie in  "Rückwärtsgang" gezeigt. Zur Unterscheidung der gleichnamigen Fokus-relevanten Ereignisse GotFocus, LostFocus und Validate des UserControls und der Elemente des Steuerelemente-Feldes wird den Namen der hier durchgereichten Ereignisse ein "Ctl" vorangestellt.
Private Declare Function GetKeyState Lib "user32" _
(ByVal VirtualKeyCode As Long) As Long
Private mFocusBack As Boolean
Public Event CtlGotFocus(ByVal Index As Integer)
Public Event CtlLostFocus(ByVal Index As Integer)
Public Event CtlValidate(ByVal Index As Integer, Cancel As Boolean)
Private Sub txt_GotFocus(Index As Integer)
If Not mFocusBack Then
RaiseEvent CtlGotFocus(Index)
End If
End Sub
Private Sub txt_LostFocus(Index As Integer)
If mFocusBack Then
mFocusBack = False
Else
RaiseEvent CtlLostFocus(Index)
End If
End Sub
Private Sub txt_Validate(Index As Integer, Cancel As Boolean)
If Not mFocusBack Then
RaiseEvent CtlValidate(Index, Cancel)
End If
End Sub
Private Sub UserControl_EnterFocus()
Dim nControl As Control
Dim nLastControl As Control
Dim nMaxTabIndex As Integer
Dim nTabIndex As Integer
mFocusBack = False
If (GetKeyState(vbKeyTab) And &HF000&) = &HF000& Then
If (GetKeyState(vbKeyShift) And &HF000&) = &HF000& Then
nMaxTabIndex = -1
On Error Resume Next
For Each nControl In Controls
With nControl
nTabIndex = .TabIndex
If Err.Number Then
Err.Clear
Else
If nTabIndex > nMaxTabIndex Then
nMaxTabIndex = nTabIndex
If .TabStop Then
If .Visible Then
If .Enabled Then
Set nLastControl = nControl
End If
End If
End If
End If
End If
End With
Next
If Not (nLastControl Is Nothing) Then
mFocusBack = True
nLastControl.SetFocus
End If
End If
End If
End Sub
Der einzige Nachteil eines auf diese Weise dynamisch geladenen Steuerelemente-Feldes ist, dass Sie die Elemente nicht beliebig in die TabIndex-Reihenfolge des Containers einordnen können - sie bilden immer einen geschlossenen Block und können nur innerhalb dieses Blocks vorwärts bzw. Rückwärts mittels der Tabulator-Taste in der inneren TabIndex-Reihung innerhalb des UserControls durchlaufen werden. Innerhalb dieser inneren Reihung können Sie die Elemente jedoch wieder beliebig anordnen.
Abschließend ist noch Vorsorge zu treffen, wenn alle Elemente entladen oder unsichtbar gemacht werden oder bei allen geladenen Elemente die Enabled-Eigenschaft auf False gesetzt wird. Dann nämlich fällt der Fokus auf das UserControl selbst zurück. Im Ereignis GotFocus des UserControls das selbstdefinierte Ereignis UCGotFocus ausgelöst, das zugleich signalisiert, auf welche Weise das UserControl den Fokus erhalten hat. Im dem eben erwähnten Fall wird als Parameter dieses Ereignis der Wert dcaFMUnspecified geliefert. Hat das UserControl jedoch den Fokus durch einen Einsprung per Tabulator-Taste erhalten, wird die Einsprungrichtung signalisiert (dcaFMForward bzw. dcaFMBackward). In der Ereignis-Prozedur auf Seiten des Containers können Sie somit bequem festlegen, welches andere Steuerelement des Containers statt dessen den Fokus erhalten soll.
Public Event UCGotFocus(ByVal BackStep As dcaFocusModeConstants)
Public Enum dcaFocusModeConstants
dcaFMUnspecified
dcaFMForward
dcaFMBackward
End Enum
Private Sub UserControl_GotFocus()
If (GetKeyState(vbKeyTab) And &HF000&) = &HF000& Then
If (GetKeyState(vbKeyShift) And &HF000&) = &HF000& Then
RaiseEvent UCGotFocus(dcaFMBackward)
Else
RaiseEvent UCGotFocus(dcaFMForward)
End If
Else
RaiseEvent UCGotFocus(dcaFMUnspecified)
End If
End Sub
Nachstehend sehen Sie ein einfaches Beispiel zur Verwendung eines solchen dynamisch geladenen Steuerelemente-Feldes, wobei sich das UserControl im gleichen Projekt wie das Container-Objekt (Form) befindet.
Private WithEvents TextBoxArray As uclTextBoxArray
Private Sub cmdAdd_Click()
If TextBoxArray Is Nothing Then
Set TextBoxArray = _
Controls.Add("DynControlArraysTest.uclTextBoxArray", _
"TextBoxArray").object
End If
With TextBoxArray.LoadCtl()
.Move 0, (.Index - 1) * .Height
.Text = "Text(" & .Index & ")"
.Visible = True
.SetFocus
End With
End Sub
Private Sub TextBoxArray_Change(ByVal Index As Integer)
Debug.Print "Change - Index: "; Index
End Sub
Private Sub TextBoxArray_CtlGotFocus(ByVal Index As Integer)
With TextBoxArray.CtlArray(Index)
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Private Sub TextBoxArray_UCGotFocus _
(ByVal BackStep As dcaFocusModeConstants)
cmdAdd.SetFocus
End Sub
Wegen des bereits erwähnten Block-Charakters eines solchen Steuerelemente-Feldes hinsichtlich der TabIndex-Reihung erscheint es zunächst unmöglich, Elemente verschiedener Steuerelemente-Felder im Wechsel anzuordnen, etwa eine TextBox und eine Schaltfläche jeweils als Paar. Aber auch dies lässt sich lösen, indem Sie über ein UserControl parallel mehrere Steuerelemente-Felder anbieten. Ein Beispiel dafür zeigt der folgende Code.
Private Declare Function GetKeyState Lib "user32" _
(ByVal VirtualKeyCode As Long) As Long
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private mFocusBack As Boolean
Private mIndexCmd As Long
Private mIndexTB As Long
Public Event CmdClick(ByVal Index As Integer)
Public Event CmdGotFocus(ByVal Index As Integer)
Public Event CmdLostFocus(ByVal Index As Integer)
Public Event CmdValidate(ByVal Index As Integer, Cancel As Boolean)
Public Event TBChange(ByVal Index As Integer)
Public Event TBGotFocus(ByVal Index As Integer)
Public Event TBLostFocus(ByVal Index As Integer)
Public Event TBValidate(ByVal Index As Integer, Cancel As Boolean)
Public Event UCGotFocus(ByVal BackStep As dcaFocusModeConstants)
Public Enum dcaFocusModeConstants
dcaFMUnspecified
dcaFMForward
dcaFMBackward
End Enum
Public Property Get ActiveControl() As Object
Set ActiveControl = UserControl.ActiveControl
End Property
Public Property Get ArrayCmd() As Object
Set ArrayCmd = command
End Property
Public Property Get ArrayTB() As Object
Set ArrayTB = txt
End Property
Public Function LoadCmd(Optional ByVal Index = -1, _
Optional ParentWnd As Long) As Object
Dim nIndex As Integer
Select Case Index
Case 0
nIndex = 0
Case Is > 0
nIndex = Index
On Error Resume Next
Load command(nIndex)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
On Error GoTo 0
Case Else
mIndexCmd = mIndexCmd + 1
nIndex = mIndexCmd
On Error Resume Next
Load command(nIndex)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
On Error GoTo 0
End Select
If ParentWnd Then
SetParent command(nIndex).hwnd, ParentWnd
Else
SetParent command(nIndex).hwnd, UserControl.Parent.hwnd
End If
Set LoadCmd = command(nIndex)
UserControl.Enabled = True
Extender.Visible = True
End Function
Public Function LoadTB(Optional ByVal Index = -1, _
Optional ParentWnd As Long) As Object
Dim nIndex As Integer
Select Case Index
Case 0
nIndex = 0
Case Is > 0
nIndex = Index
On Error Resume Next
Load txt(nIndex)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
On Error GoTo 0
Case Else
mIndexTB = mIndexTB + 1
nIndex = mIndexTB
On Error Resume Next
Load txt(nIndex)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
On Error GoTo 0
End Select
If ParentWnd Then
SetParent txt(nIndex).hwnd, ParentWnd
Else
SetParent txt(nIndex).hwnd, UserControl.Parent.hwnd
End If
Set LoadTB = txt(nIndex)
UserControl.Enabled = True
Extender.Visible = True
End Function
Public Function SetCmdParent(ByVal Index As Integer, _
ByVal NewParentWnd As Long) As Long
On Error Resume Next
SetCmdParent = SetParent(command(Index).hwnd, NewParentWnd)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Function
Public Function SetTBParent(ByVal Index As Integer, _
ByVal NewParentWnd As Long) As Long
On Error Resume Next
SetTBParent = SetParent(txt(Index).hwnd, NewParentWnd)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Function
Public Sub UnloadCmd(ByVal Index As Integer)
If Index = 0 Then
command(0).Visible = False
Else
On Error Resume Next
Unload command(Index)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
End If
End Sub
Public Sub UnloadTB(ByVal Index As Integer)
If Index = 0 Then
txt(0).Visible = False
Else
On Error Resume Next
Unload txt(Index)
If Err.Number Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
End If
End Sub
Private Sub command_Click(Index As Integer)
RaiseEvent CmdClick(Index)
End Sub
Private Sub command_GotFocus(Index As Integer)
If Not mFocusBack Then
RaiseEvent CmdGotFocus(Index)
End If
End Sub
Private Sub command_LostFocus(Index As Integer)
If mFocusBack Then
mFocusBack = False
Else
RaiseEvent CmdLostFocus(Index)
End If
End Sub
Private Sub command_Validate(Index As Integer, Cancel As Boolean)
If Not mFocusBack Then
RaiseEvent CmdValidate(Index, Cancel)
End If
End Sub
Private Sub txt_Change(Index As Integer)
RaiseEvent TBChange(Index)
End Sub
Private Sub txt_GotFocus(Index As Integer)
If Not mFocusBack Then
RaiseEvent TBGotFocus(Index)
End If
End Sub
Private Sub txt_LostFocus(Index As Integer)
If mFocusBack Then
mFocusBack = False
Else
RaiseEvent TBLostFocus(Index)
End If
End Sub
Private Sub txt_Validate(Index As Integer, Cancel As Boolean)
If Not mFocusBack Then
RaiseEvent TBValidate(Index, Cancel)
End If
End Sub
Private Sub UserControl_EnterFocus()
Dim nControl As Control
Dim nLastControl As Control
Dim nMaxTabIndex As Integer
Dim nTabIndex As Integer
mFocusBack = False
If (GetKeyState(vbKeyTab) And &HF000&) = &HF000& Then
If (GetKeyState(vbKeyShift) And &HF000&) = &HF000& Then
nMaxTabIndex = -1
On Error Resume Next
For Each nControl In Controls
With nControl
nTabIndex = .TabIndex
If Err.Number Then
Err.Clear
Else
If nTabIndex > nMaxTabIndex Then
nMaxTabIndex = nTabIndex
If .TabStop Then
If .Visible Then
If .Enabled Then
Set nLastControl = nControl
End If
End If
End If
End If
End If
End With
Next
If Not (nLastControl Is Nothing) Then
mFocusBack = True
nLastControl.SetFocus
End If
End If
End If
End Sub
Private Sub UserControl_GotFocus()
If (GetKeyState(vbKeyTab) And &HF000&) = &HF000& Then
If (GetKeyState(vbKeyShift) And &HF000&) = &HF000& Then
RaiseEvent UCGotFocus(dcaFMBackward)
Else
RaiseEvent UCGotFocus(dcaFMForward)
End If
Else
RaiseEvent UCGotFocus(dcaFMUnspecified)
End If
End Sub
Private Sub UserControl_InitProperties()
zInit
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
zInit
End Sub
Private Sub zInit()
If Ambient.UserMode Then
txt(0).Visible = False
command(0).Visible = False
Extender.Visible = False
Else
With txt(0)
.Width = UserControl.Width * 0.75
UserControl.Height = .Height
command(0).Move .Width, 0, UserControl.ScaleWidth - .Width
End With
End If
End Sub
Abschließend sehen Sie nun noch ein Beispiel, wie dieses UserControl mit zwei kombinierten Steuerelemente-Feldern dynamisch geladen wird, wenn es sich in einem separaten ActiveX-Steuerelement-Projekt (OCX) befindet, und wie dabei die Ereignisse des UserControls verarbeitet werden. Hier sehen Sie auch, wie die Elemente in eine PictureBox als Unter-Container verschoben werden können.
Private WithEvents TBCmdArray As VBControlExtender
Private Sub cmdAdd_Click()
Dim nTB As TextBox
Dim nTBCmdArray As Object
If TBCmdArray Is Nothing Then
Set TBCmdArray = _
Controls.Add("TBCmdArray.uclTBCmdArray", "TBCmdArray")
TBCmdArray.TabIndex = 1
End If
Set nTBCmdArray = TBCmdArray.object
Set nTB = nTBCmdArray.LoadTB(, Picture1.hWnd)
With nTB
.Move 0, (.Index - 1) * .Height
.Text = "Text(" & .Index & ")"
.Visible = True
With nTBCmdArray.LoadCmd(nTB.Index, Picture1.hWnd)
.Move nTB.Width, nTB.Top
.Caption = "Cmd(" & .Index & ")"
.Visible = True
End With
.SetFocus
End With
End Sub
Private Sub Picture1_GotFocus()
cmdAdd.SetFocus
End Sub
Private Sub TBCmdArray_ObjectEvent(Info As EventInfo)
Dim nIndex As Integer
With Info
Select Case .Name
Case "CmdClick"
nIndex = .EventParameters("Index")
With TBCmdArray.object
.UnloadCmd nIndex
.UnloadTB nIndex
End With
Case "UCGotFocus"
Select Case .EventParameters("BackStep")
Case 0, 2
cmdAdd.SetFocus
Case 1
cmdDummy.SetFocus
End Select
End Select
End With
End Sub
|