Printable View
I was researching something for someone I work with on trying to loop through a control's, in this case a textbox, properties and to me it looks like you cannot. I used Google and searched here without coming close. For example in a loop check the values of the following:
The VB-Intrinsic-Controls don't conform well to the "COM-rules" which
on all 3rd-party Controls (as well as on all selfmade VB6-UserControls)
otherwise apply.
E.g. you cannot cast a VB.TextBox to the type vbControlExtender.
This might serve as a good test, to make yourself aware which controls will
allow Property-Enumeration - and which will not.
Not sure how important the usage of the normal, intrinsic TextBox is for you...
...Krools Unicode-Controls are an alternative (e.g. his Uni-TextBox implementation).
These are native VB6-UserControls - and are all castable to the vbControlExtender -
hence they could be enumerated with regards to their Public Properties easily.
Olaf
Maybe something like this
Code:Option Explicit
'Modified from http://www.vb-helper.com/howto_get_property_information.html
'Set a project reference to the TypeLib Information library
Public Enum EPType
ReadableProperties = 2
WriteableProperties = 4
End Enum
Public Function EnumerateProperties(pObject As Object, pType As EPType) As Variant
Dim TypeLib As TLI.InterfaceInfo, Prop As TLI.MemberInfo, Ret As Variant
Set TypeLib = TLI.InterfaceInfoFromObject(pObject)
On Error Resume Next
For Each Prop In TypeLib.Members
If Prop.InvokeKind = pType Then
Ret = TLI.InvokeHook(pObject, Prop.MemberId, INVOKE_PROPERTYGET)
If Err = 0 Then Debug.Print Left$(Prop.Name & Space$(30), 30) & Left$(TypeName(Ret) & Space$(10), 10) & Ret
Err.Clear
End If
Next
End Function
Private Sub Form_Load()
EnumerateProperties Text1, ReadableProperties
'EnumerateProperties Text1, WriteableProperties
End Sub
Code:_Default String Text1
Name String Text1
BackColor Long -2147483643
ForeColor Long -2147483640
Left Single 3120
Top Single 2040
Width Single 1335
Height Single 735
Enabled Boolean True
Visible Boolean False
MousePointer Integer 0
Text String Text1
FontName String MS Sans Serif
FontSize Single 8,25
FontBold Boolean False
FontItalic Boolean False
FontStrikethru Boolean False
FontUnderline Boolean False
TabIndex Integer 0
BorderStyle Integer 1
LinkTopic String
LinkItem String
LinkMode Integer 0
MultiLine Boolean False
ScrollBars Integer 0
SelStart Long 0
SelLength Long 0
SelText String
DragMode Integer 0
DragIcon Long 0
LinkTimeout Integer 50
TabStop Boolean True
Tag String
PasswordChar String
HideSelection Boolean True
Alignment Integer 0
MaxLength Long 0
HelpContextID Long 0
hWnd Long 17106228
DataField String
DataChanged Boolean False
MouseIcon Long 0
Locked Boolean False
Font String MS Sans Serif
WhatsThisHelpID Long 0
Appearance Integer 1
RightToLeft Boolean False
ToolTipText String
OLEDragMode Integer 0
OLEDropMode Integer 0
CausesValidation Boolean True
DataMember String
Ah, good catch (should have thought, that tlbinf32.dll will take the oddities of the intrinsic-controls
into account, since it's also used in the VB-IDE, which obviously has no problems with them).
When I enumerate the Interface with Eduardo Morcillos olelib.tlb, then the VB.Textbox's
ReadDirection-Properties are reported with a ParameterCount of 1 (and such critters
exist, but have no place in a Property-Grid-Visualization), but in case of e.g. the
TextBox.Text-Property this is clearly wrong in its interface-definition (this sprung
the filter-condition in the stuff I tested it with, before my post).
Olaf
Thanks to both of you for taking the time to post. I've run into a small bug which I can't seem to find a solution to. It is Run-time error "343": Object not an array and it only occurs on the
"EnumerateProperties Text1, ReadableProperties" call to Public Function EnumerateProperties.
It occurs on line: Ret = TLI.InvokeHook(pObject, Prop.MemberId, INVOKE_PROPERTYGET)
after writing these two lines:
_Default String Text1
Name String Text1
The call to get writable properties is what my coworker was interested in so my original request has been satisfied. It would be nice for somebody else searching here to get a complete working example though.
I added a couple of radio buttons for read and write selecting and write the output to a listview. Here is the code reflecting that:
Any further help would be appreciated.Code:Option Explicit
'Modified from http://www.vb-helper.com/howto_get_property_information.html
'Set a project reference to the TypeLib Information library
Public Enum EPType
ReadableProperties = 2
WriteableProperties = 4
End Enum
Public Function EnumerateProperties(pObject As Object, pType As EPType) As Variant
Dim templist As ListItem
Dim TypeLib As TLI.InterfaceInfo, Prop As TLI.MemberInfo, Ret As Variant
Set TypeLib = TLI.InterfaceInfoFromObject(pObject)
On Error Resume Next
ListView1.ListItems.Clear
For Each Prop In TypeLib.Members
If Prop.InvokeKind = pType Then
Ret = TLI.InvokeHook(pObject, Prop.MemberId, INVOKE_PROPERTYGET)
If Err = 0 Then
'Debug.Print Left$(Prop.Name & Space$(30), 30) & Left$(TypeName(Ret) & Space$(10), 10) & Ret
Set templist = Me.ListView1.ListItems.Add
templist.ListSubItems.Add , , (CStr(Prop.Name))
templist.ListSubItems.Add , , (Left$(TypeName(Ret) & Space$(10), 10))
templist.ListSubItems.Add , , (Ret)
Err.Clear
End If
End If
Next
End Function
Private Sub cmdGo_Click()
If optReadOnly.Value = True Then
EnumerateProperties Text1, ReadableProperties
Else
EnumerateProperties Text1, WriteableProperties
End If
End Sub
Private Sub Form_Load()
OptWritable.Value = True
End Sub
Private Sub optReadOnly_Click()
If optReadOnly.Value = True Then
OptWritable.Value = False
End If
End Sub
Private Sub OptWritable_Click()
If OptWritable.Value = True Then
optReadOnly = False
End If
End Sub
Should be (not tested)Code:Ret = TLI.InvokeHook(pObject, Prop.MemberId, INVOKE_PROPERTYGET)
If Err = 0 Then
'Debug.Print Left$(Prop.Name & Space$(30), 30) & Left$(TypeName(Ret) & Space$(10), 10) & Ret
Set templist = Me.ListView1.ListItems.Add
templist.ListSubItems.Add , , (CStr(Prop.Name))
templist.ListSubItems.Add , , (Left$(TypeName(Ret) & Space$(10), 10))
templist.ListSubItems.Add , , (Ret)
Err.Clear
End If
Code:Ret = TLI.InvokeHook(pObject, Prop.MemberId, INVOKE_PROPERTYGET)
If Err = 0 Then
'Debug.Print Left$(Prop.Name & Space$(30), 30) & Left$(TypeName(Ret) & Space$(10), 10) & Ret
Set templist = Me.ListView1.ListItems.Add
templist.ListSubItems.Add , , (CStr(Prop.Name))
templist.ListSubItems.Add , , (Left$(TypeName(Ret) & Space$(10), 10))
templist.ListSubItems.Add , , (Ret)
End If
Err.Clear
I'm missing something...the error is on:
Ret = TLI.InvokeHook(pObject, Prop.MemberId, INVOKE_PROPERTYGET)
All I see, and tested, is Err.Clear was moved out of the if.
It still is getting the error, you did mention it was not tested though so thanks for testing but still "no joy".
Did you add the TypeLib Information reference to your project?Quote:
Originally Posted by TysonLPrice
Yep...as I mentioned it only occurs on the ReadableProperties" call. The WriteableProperties call works fine.Quote:
Originally Posted by LaVolpe
Here's a modification which works without Error-Handling.
OlafCode:Option Explicit
Private Sub Form_Load()
EnumerateProperties Text1, INVOKE_PROPERTYGET
EnumerateProperties Text1, INVOKE_PROPERTYPUT
End Sub
Public Function EnumerateProperties(pObject As Object, pType As InvokeKinds)
Dim TypeLib As TLI.InterfaceInfo, Prop As TLI.MemberInfo, Ret
Set TypeLib = TLI.InterfaceInfoFromObject(pObject)
For Each Prop In TypeLib.Members
If Prop.InvokeKind = pType And Prop.Name <> "Index" Then
AssignVariantValue Ret, TLI.InvokeHook(pObject, Prop.MemberId, INVOKE_PROPERTYGET)
Debug.Print Left$(Prop.Name & Space$(25), 25); TypeName(Ret), IIf(IsObject(Ret), "<ObjRef>", Ret)
End If
Next
End Function
Private Sub AssignVariantValue(Dst, Src)
If IsObject(Src) Then Set Dst = Src Else Dst = Src
End Sub
In additionto "<> Test" I had to add
And Prop.Name <> "Parent" _
And Prop.Name <> "Container" _
And Prop.Name <> "DataSource" _
And Prop.Name <> "DataFormat")
I'm curious why but I'm marking this resolved.
But other than that read and write properties both list now.
Thanks to everyone that responded! I'm going to attach the final code in case someone searches on this.
You need to add a component for a listview and a listview named ListView1 (Microsoft windows common controls 6.0)
Set a project reference to the TypeLib Information library
Two option buttons (optReadOnly and OptWritable)
A command button cmdGo
A textbox Text1
There is logic to sort by clicking on the listview column header.
I'm done playing with it. My coworker got his answer from the writable logic.
Thanks again all!
Code:Option Explicit
'Modified from http://www.vb-helper.com/howto_get_property_information.html
'Set a project reference to the TypeLib Information library
Public Function EnumerateProperties(pObject As Object, pType As InvokeKinds)
Dim TypeLib As TLI.InterfaceInfo, Prop As TLI.MemberInfo, Ret
Dim templist As ListItem
Set TypeLib = TLI.InterfaceInfoFromObject(pObject)
ListView1.ListItems.Clear
For Each Prop In TypeLib.Members
If Prop.InvokeKind = pType And (Prop.Name <> "Index" _
And Prop.Name <> "Parent" _
And Prop.Name <> "Container" _
And Prop.Name <> "DataSource" _
And Prop.Name <> "DataFormat") Then
AssignVariantValue Ret, TLI.InvokeHook(pObject, Prop.MemberId, INVOKE_PROPERTYGET)
Set templist = Me.ListView1.ListItems.Add
templist.ListSubItems.Add , , (CStr(Prop.Name))
templist.ListSubItems.Add , , (Left$(TypeName(Ret) & Space$(10), 10))
templist.ListSubItems.Add , , (Ret)
End If
Next
End Function
Private Sub AssignVariantValue(Dst, Src)
If IsObject(Src) Then Set Dst = Src Else Dst = Src
End Sub
Private Sub cmdGo_Click()
If optReadOnly.Value = True Then
EnumerateProperties Text1, INVOKE_PROPERTYGET
Else
'Note the index is provided below. A loop would be needed to go through an array.
EnumerateProperties Text1, INVOKE_PROPERTYPUT
End If
End Sub
Private Sub Form_Load()
OptWritable.Value = True
End Sub
Private Sub optReadOnly_Click()
If optReadOnly.Value = True Then
OptWritable.Value = False
End If
End Sub
Private Sub OptWritable_Click()
If OptWritable.Value = True Then
optReadOnly = False
End If
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim lstItem As ListItem
Dim intSelectedColumn As Integer
intSelectedColumn = ColumnHeader.Index - 1
ListView1.Sorted = False
If ListView1.SortOrder = lvwAscending Then
ListView1.SortOrder = lvwDescending
Else
ListView1.SortOrder = lvwAscending
End If
ListView1.Sorted = True
SortListView ListView1, ColumnHeader
Exit Sub
End Sub
Private Sub SortListView(ByRef lvwList As MSComctlLib.ListView, ByVal ColumnHeader As MSComctlLib.ColumnHeader)
If lvwList.SortKey = (ColumnHeader.Index - 1) Then
If lvwList.SortOrder = lvwAscending Then
lvwList.SortOrder = lvwDescending
Else
lvwList.SortOrder = lvwAscending
End If
lvwList.Sorted = True
Else
lvwList.SortKey = (ColumnHeader.Index - 1)
lvwList.Sorted = True
lvwList.SortOrder = lvwAscending
End If
End Sub