list the properties of a object

[BIacksun]

How do i go about listing all the properties of a object?

[filburt1]

I don't think you can iterate through all the properties. But you can parse through the .frm file (it is just text) to see what properties are not set as the defaults.

[BIacksun]

THen how can the callbyname work?

[filburt1]

CallByName won't work if you don't know the names of the properties.

[BIacksun]

then if that is true then there must be a quick way right?

other then trying every name to see it one works?

[filburt1]

Well, every intrinsic control has certain properties, like Name, Tag, Left, Top, etc. But short of parsing the .frm file I don't think there is a way to list all the properties.

So how does VB know them, you ask? I dunno.

[BIacksun]

where can i go to find out how callbyname woks!

[BIacksun]

when ever i ask this question the post stops.

[filburt1]

It's only been 5 minutes. I already told you, I don't THINK it is possible. What's your end goal?

[BIacksun]

i want to make my game have the option to change everything in the game forms

[BIacksun]

and maby other programs in windows using objects.

[Patoooey]

CallByName demo. If your trying to use it to change parts of another program......Uhmmmm...forget it. I tried to get CallByName working with setting properties and couldn't get it to work. Even with the property names.

Private Sub Command1_Click()
Dim v As Variant
Dim func(1) As String
ReDim v(1 To 3)
 
v(1) = "Hi"
v(2) = "Howdy"
v(3) = "Hello world"
 
func(1) = "s"
    Call CallByName(Form1, func(1), VbMethod, v)
End Sub
Public Function s(a As Variant)
    MsgBox a(1)
    MsgBox a(2)
    MsgBox a(3)
End Function

[filburt1]

Originally posted by Patoooey
CallByName demo. If your trying to use it to change parts of another program......Uhmmmm...forget it. I tried to get CallByName working with setting properties and couldn't get it to work. Even with the property names.

Not only does it not work, but it doesn't answer his question.

[Patoooey]

Originally posted by BIacksun
How do i go about listing all the properties of a object?

Well....I DID answered his 2nd question about CallByName.

His first question, I'll leave to you to deal with. hehehehehe

[filburt1]

If we can figure out how VB does it (lists the members of an OCX), then things will be easier...

[BIacksun]

is there anywhere i can view the code for callbyname?
in c++ or... (THAT is what i mean by how callbyname works?)
is there a command simmaler to callbyname for c++ that i can use?

[BIacksun]

http://www.vbforums.com/showthread.p...hreadid=100914

is a nother subject on the same subject

[cyrillic]

Open the Object Browser you dimbwits (Hotkey: F2)

[filburt1]

Originally posted by cyrillic
Open the Object Browser you dimbwits (Hotkey: F2)

1. Don't insult us
2. Read the frickin' question first. He wants it done in code, obviously.

[cyrillic]

Originally posted by filburt1
1. Don't insult us

Hehe, i didn't thought it would be insulting, but please accept my appologies.

And about . 2: Why would you like to call ALL the functions? That would be the only reason to look them up in code. In any other situation it's easier to precompile a list.

[BIacksun]

like i said

i want to make my game have the option to change object properties. (eg right click on an object and get a list of properties)

and even in other windows programs maby

[filburt1]

Originally posted by cyrillic
Why would you like to call ALL the functions? That would be the only reason to look them up in code. In any other situation it's easier to precompile a list.

I dunno, he justs wants to list the values of all properties for some psycho reason. So far, hard-coding the names is the only idea. And hard-coding is bad.

[BIacksun]

Hard coding?

[Patoooey]

Just found out about the TypeLibInfo DLL.

Throw this in a form with 2 listboxes, a label(big enuf for 3-4 lines) and a commandbutton and reference "TypeLib Information"(TLBINF32.DLL).

Option Explicit
 
Private m_TLInf As TypeLibInfo
 
Private Sub Form_Load()
    Set m_TLInf = New TypeLibInfo
    m_TLInf.AppObjString = "<Unqualified>"
End Sub
 
Private Sub Command1_Click()
    On Error Resume Next
    m_TLInf.ContainingFile = "c:\win98\system\mscomctl.ocx"
    If Err Then
        Beep
        Exit Sub
    End If
    List1.Clear
    List2.Clear
    m_TLInf.GetTypesDirect List1.hWnd
    If List1.ListCount Then
        List1.ListIndex = 0
    End If
End Sub
 
Private Sub List1_Click()
    List2.Clear
      'Retrieve the SearchData from the ItemData property
    m_TLInf.GetMembersDirect List1.ItemData(List1.ListIndex), List2.hWnd
End Sub
 
Private Sub List2_Click()
Dim InvKinds As TLI.InvokeKinds
    
    InvKinds = List2.ItemData(List2.ListIndex)
    Label1 = PrototypeMember(m_TLInf, _
                            List1.ItemData(List1.ListIndex), _
                            InvKinds, , List2.[_Default])
End Sub
 
' worker functions
Function PrototypeMember( _
  TLInf As TypeLibInfo, _
  ByVal SearchData As Long, _
  ByVal InvokeKinds As InvokeKinds, _
  Optional ByVal MemberId As Long = -1, _
  Optional ByVal MemberName As String) As String
Dim pi As ParameterInfo
Dim fFirstParameter As Boolean
Dim fIsConstant As Boolean
Dim fByVal As Boolean
Dim retVal As String
Dim ConstVal As Variant
Dim strTypeName As String
Dim VarTypeCur As Integer
Dim fDefault As Boolean, fOptional As Boolean, fParamArray As Boolean
Dim TIType As TypeInfo
Dim TIResolved As TypeInfo
Dim TKind As TypeKinds
  With TLInf
    fIsConstant = GetSearchType(SearchData) And tliStConstants
    With .GetMemberInfo(SearchData, InvokeKinds, MemberId, MemberName)
      If fIsConstant Then
        retVal = "Const "
      ElseIf InvokeKinds = INVOKE_FUNC Or InvokeKinds = INVOKE_EVENTFUNC Then
        Select Case .ReturnType.VarType
          Case VT_VOID, VT_HRESULT
            retVal = "Sub "
          Case Else
            retVal = "Function "
        End Select
      Else
        retVal = "Property "
      End If
      retVal = retVal & .Name
      With .Parameters
        If .Count Then
          retVal = retVal & "("
          fFirstParameter = True
          fParamArray = .OptionalCount = -1
          For Each pi In .Me
            If Not fFirstParameter Then
              retVal = retVal & ", "
            End If
            fFirstParameter = False
            fDefault = pi.Default
            fOptional = fDefault Or pi.Optional
            If fOptional Then
              If fParamArray Then
                'This will be the only optional parameter
                retVal = retVal & "[ParamArray "
              Else
                retVal = retVal & "["
              End If
            End If
            With pi.VarTypeInfo
              Set TIType = Nothing
              Set TIResolved = Nothing
              TKind = TKIND_MAX
              VarTypeCur = .VarType
              If (VarTypeCur And Not (VT_ARRAY Or VT_VECTOR)) = 0 Then
              'If Not .TypeInfoNumber Then 'This may error, don't use here
                On Error Resume Next
                Set TIType = .TypeInfo
                If Not TIType Is Nothing Then
                  Set TIResolved = TIType
                  TKind = TIResolved.TypeKind
                  Do While TKind = TKIND_ALIAS
                    TKind = TKIND_MAX
                    Set TIResolved = TIResolved.ResolvedType
                    If Err Then
                      Err.Clear
                    Else
                      TKind = TIResolved.TypeKind
                    End If
                  Loop
                End If
                Select Case TKind
                  Case TKIND_INTERFACE, TKIND_COCLASS, TKIND_DISPATCH
                    fByVal = .PointerLevel = 1
                  Case TKIND_RECORD
                    'Records not passed ByVal in VB
                    fByVal = False
                  Case Else
                    fByVal = .PointerLevel = 0
                End Select
                If fByVal Then retVal = retVal & "ByVal "
                retVal = retVal & pi.Name
                If VarTypeCur And (VT_ARRAY Or VT_VECTOR) Then retVal = retVal & "()"
                If TIType Is Nothing Then 'Error
                  retVal = retVal & " As ?"
                Else
                  If .IsExternalType Then
                    retVal = retVal & " As " & _
                             .TypeLibInfoExternal.Name & "." & TIType.Name
                  Else
                    retVal = retVal & " As " & TIType.Name
                  End If
                End If
                On Error GoTo 0
              Else
                If .PointerLevel = 0 Then retVal = retVal & "ByVal "
                retVal = retVal & pi.Name
                If VarTypeCur <> vbVariant Then
                  strTypeName = TypeName(.TypedVariant)
                  If VarTypeCur And (VT_ARRAY Or VT_VECTOR) Then
                    retVal = retVal & "() As " & Left$(strTypeName, Len(strTypeName) - 2)
                  Else
                    retVal = retVal & " As " & strTypeName
                  End If
                End If
              End If
              If fOptional Then
                If fDefault Then
                  retVal = retVal & ProduceDefaultValue(pi.DefaultValue, TIResolved)
                End If
                retVal = retVal & "]"
              End If
            End With
          Next
          retVal = retVal & ")"
        End If
      End With
      If fIsConstant Then
        ConstVal = .Value
        retVal = retVal & " = " & ConstVal
        Select Case VarType(ConstVal)
          Case vbInteger, vbLong
            If ConstVal < 0 Or ConstVal > 15 Then
              retVal = retVal & " (&H" & Hex$(ConstVal) & ")"
            End If
        End Select
      Else
        With .ReturnType
          VarTypeCur = .VarType
          If VarTypeCur = 0 Or (VarTypeCur And Not (VT_ARRAY Or VT_VECTOR)) = 0 Then
          'If Not .TypeInfoNumber Then 'This may error, don't use here
            On Error Resume Next
            If Not .TypeInfo Is Nothing Then
              If Err Then 'Information not available
                retVal = retVal & " As ?"
              Else
                If .IsExternalType Then
                  retVal = retVal & " As " & _
                           .TypeLibInfoExternal.Name & "." & .TypeInfo.Name
                Else
                  retVal = retVal & " As " & .TypeInfo.Name
                End If
              End If
            End If
            If VarTypeCur And (VT_ARRAY Or VT_VECTOR) Then retVal = retVal & "()"
            On Error GoTo 0
          Else
            Select Case VarTypeCur
              Case VT_VARIANT, VT_VOID, VT_HRESULT
              Case Else
                strTypeName = TypeName(.TypedVariant)
                If VarTypeCur And (VT_ARRAY Or VT_VECTOR) Then
                  retVal = retVal & "() As " & Left$(strTypeName, Len(strTypeName) - 2)
                Else
                  retVal = retVal & " As " & strTypeName
                End If
            End Select
          End If
        End With
      End If
      PrototypeMember = retVal & vbCrLf & "  " & _
                        "Member of " & TLInf.Name & "." & _
                        TLInf.GetTypeInfo(SearchData And &HFFFF&).Name & _
                        vbCrLf & "  " & .HelpString
    End With
  End With
End Function

[Patoooey]

Private Function ProduceDefaultValue(DefVal As Variant, ByVal TI As TypeInfo) As String
Dim lTrackVal As Long
Dim MI As MemberInfo
Dim TKind As TypeKinds
    If TI Is Nothing Then
        Select Case VarType(DefVal)
            Case vbString
                If Len(DefVal) Then
                    ProduceDefaultValue = """" & DefVal & """"
                End If
            Case vbBoolean 'Always show for Boolean
                ProduceDefaultValue = DefVal
            Case vbDate
                If DefVal Then
                    ProduceDefaultValue = "#" & DefVal & "#"
                End If
            Case Else 'Numeric Values
                If DefVal <> 0 Then
                    ProduceDefaultValue = DefVal
                End If
        End Select
    Else
        'See if we have an enum and track the matching member
        'If the type is an object, then there will never be a
        'default value other than Nothing
        TKind = TI.TypeKind
        Do While TKind = TKIND_ALIAS
            TKind = TKIND_MAX
            On Error Resume Next
            Set TI = TI.ResolvedType
            If Err = 0 Then TKind = TI.TypeKind
            On Error GoTo 0
        Loop
        If TI.TypeKind = TKIND_ENUM Then
            lTrackVal = DefVal
            For Each MI In TI.Members
                If MI.Value = lTrackVal Then
                    ProduceDefaultValue = MI.Name
                    Exit For
                End If
            Next
        End If
    End If
End Function
'VB SearchData routines
Function GetSearchType(ByVal SearchData As Long) As TliSearchTypes
  If SearchData And &H80000000 Then
    GetSearchType = ((SearchData And &H7FFFFFFF) \ &H1000000 And &H7F&) Or &H80
  Else
    GetSearchType = SearchData \ &H1000000 And &HFF&
  End If
End Function
Function GetTypeInfoNumber(ByVal SearchData As Long) As Integer
  GetTypeInfoNumber = SearchData And &HFFF&
End Function
Function GetLibNum(ByVal SearchData As Long) As Integer
  SearchData = SearchData And &H7FFFFFFF
  GetLibNum = ((SearchData \ &H2000& And &H7) * &H100&) Or _
               (SearchData \ &H10000 And &HFF&)
End Function
Function GetHidden(ByVal SearchData As Long) As Boolean
    If SearchData And &H1000& Then GetHidden = True
End Function
Function BuildSearchData( _
   ByVal TypeInfoNumber As Integer, _
   ByVal SearchTypes As TliSearchTypes, _
   Optional ByVal LibNum As Integer, _
   Optional ByVal Hidden As Boolean = False) As Long
  If SearchTypes And &H80 Then
    BuildSearchData = _
      (TypeInfoNumber And &H1FFF&) Or _
      ((SearchTypes And &H7F) * &H1000000) Or &H80000000
  Else
    BuildSearchData = _
      (TypeInfoNumber And &H1FFF&) Or _
      (SearchTypes * &H1000000)
  End If
 
  If LibNum Then
    BuildSearchData = BuildSearchData Or _
      ((LibNum And &HFF) * &H10000) Or _
      ((LibNum And &H700) * &H20&)
  End If
  If Hidden Then
    BuildSearchData = BuildSearchData Or &H1000&
  End If
End Function

[filburt1]

God, why didn't I think of that in the first place?

[DaoK]

I think this code is simply crazy and made by crazy programmer Good Job to the person who did that because it simply to hard for me! I wish be able to do that a day

[filburt1]

It was probably buried in MSDN somewhere.

[Patoooey]

Originally posted by filburt1
God, why didn't I think of that in the first place?

It doesn't get any easier.


I'd rather read War & Peace again then figure out this code.

hehehehehe