Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0681: Eigenschaften eines VB-Steuerelements zur Laufzeit mit TypeLib-Information ermitteln

VB 5/6-Tipp 0681: Eigenschaften eines VB-Steuerelements zur Laufzeit mit TypeLib-Information ermitteln

 von Sascha Wittling

Schwierigkeitsgrad:

Verwendete API-Aufrufe: keine

Download: Download des Beispielprojektes [3,37 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
' Es muss ein Verweis auf 'TypeLib Information' gesetzt werden.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------

Option Explicit

'//////////////////////////
'
' Author:           Sascha Wittling
' Zweck der Übung:  Ermitteln der Eigenschaften eingebauter VB-
'                   Steuerelemente zur Laufzeit
' Bei Fragen:       baum@ich-will-net.de
' Sonst was:        Steuerelemente braucht man keine auf Form1 zu
'                   pinseln, das macht wie man sehen kann Form_Load()
'                   schon selber ;)
'
'\\\\\\\\\\\\\\\\\\\\\\\\\\

'Listbox für Steuerelemente
Private WithEvents lstControls As VB.ListBox

'Listbox für Eigenschaften der Steuerelemente
Private WithEvents lstMembers As VB.ListBox

'Textbox für den Wert einer Eigenschaft
Private txtValue As VB.TextBox

Private Sub Form_Load()
    Dim ctlControl As Control
    
    'Steuerelemente generieren und platzieren
    Set lstControls = Me.Controls.Add("VB.ListBox", "lstControls")
    Set lstMembers = Me.Controls.Add("VB.ListBox", "lstMembers")
    Set txtValue = Me.Controls.Add("VB.TextBox", "txtValue")
    
    With lstControls
        Call .Move(120, 355, 2000, 3000)
        .Visible = True
    End With
    
    With lstMembers
        Call .Move(2220, 355, 2000, 3000)
        .Visible = True
    End With
    
    With txtValue
        Call .Move(4340, 355, 2000, 355)
        .Visible = True
    End With
    
    With Me.Controls.Add("VB.Label", "lblControls")
        Call .Move(120, 120)
        .AutoSize = True
        .Caption = "Steuerelemente:"
        .Visible = True
    End With
    
    With Me.Controls.Add("VB.Label", "lblMembers")
        Call .Move(2220, 120)
        .AutoSize = True
        .Caption = "Eigenschaften:"
        .Visible = True
    End With
    
    With Me.Controls.Add("VB.Label", "lblValue")
        Call .Move(4340, 120)
        .AutoSize = True
        .Caption = "Wert:"
        .Visible = True
    End With
    
    'meine Größe anpassen
    Call Me.Move(Me.Left, _
                 Me.Top, _
                 txtValue.Left + txtValue.Width + 120, _
                 lstControls.Top + lstControls.Height + 520 _
                 )
    
    'Steuerelemente-Liste auffüllen
    For Each ctlControl In Me.Controls
        Call lstControls.AddItem(ctlControl.Name)
    Next ctlControl
End Sub

Private Sub lstControls_Click()
    Call GetMembers(Me.Controls(lstControls.Text))
End Sub

Private Sub GetMembers(objObject As Object)
    'typeninfo. hier kann jede beliebige Typenbibliothek geladen werden
    Dim objTLI As TypeLibInfo
    
    'InterfaceInfo gibt alles zurück,
    'was man über eine Klasse wissen muss
    Dim objInterFace As InterfaceInfo
    
    'die Members sind die Mitglieder der Klasse
    Dim objMember As MemberInfo
    
    Dim i As Integer
    Dim strTypeName As String, strLastAdded As String
    
    Set objTLI = New TypeLibInfo
    
    'in objTLI.ContainingFile sollte der korrekte Pfad
    'zur vb6.olb eingetragen werden.
    'in der vb6-ide benötigt man keine Pfadangabe.
    'und nicht vergessen: wenn das Programm auf nem andren Rechner
    'laufen soll, wäre es ratsam die vb6.olb gleich mitzuliefern!
    objTLI.ContainingFile = "VB6.OLB"
    Call lstMembers.Clear
    
    'Typennamen derer Objekte ermitteln, deren namen sich nicht
    'per TypeName() ermitteln lässt
    If (TypeOf objObject Is MDIForm) Then
        strTypeName = "MDIForm"
    ElseIf (TypeOf objObject Is Form) Then
        strTypeName = "Form"
    Else
        strTypeName = TypeName(objObject)
    End If
    
    'Interface mit dem richtigen Typennamen suchen
    For i = 1 To objTLI.TypeInfos.Count
        If (objTLI.TypeInfos(i).Name = strTypeName) Then
            Set objInterFace = objTLI.TypeInfos(i).Interfaces(1)
            Exit For
        End If
    Next i
    
    If Not (objInterFace Is Nothing) Then
        'sämtliche Members (sofern sie Eigenschaften sind,
        'prozeduren werden nicht richtig zurückgegeben) der
        'Eigenschaftenliste hinzfügen. Dabei darauf achten,
        'dass es keine doppelten Einträge gibt.
        For Each objMember In objInterFace.Members
            If Not (Left$(objMember.Name, 1) = "_") And _
               Not (objMember.Name = strLastAdded) And _
                (objMember.InvokeKind = INVOKE_PROPERTYGET Or _
                 objMember.InvokeKind = INVOKE_PROPERTYPUT Or _
                 objMember.InvokeKind = INVOKE_PROPERTYPUTREF) Then
               
                Call lstMembers.AddItem(objMember.Name)
                strLastAdded = objMember.Name
            End If
        Next objMember
    End If

End Sub

Private Sub lstMembers_Click()
    On Local Error Goto err_Handler
    
    'Wert ermitteln.
    txtValue.Text = CallByName(Me.Controls(lstControls.Text), _
                               lstMembers.Text, _
                               VbGet)
    
    Exit Sub
err_Handler:
    txtValue.Text = "(fehler)"
    Resume Next
End Sub

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.