Deve haver alguma solução elegante acessando alguma função das .dll
do diretório de instalação do Elipse, por exemplo. Porém há um workaround de baixo nível.
Atenção: necessita mais testes e melhorias.
Mas uma ideia é ler arquivo .lib
no formato hex
e extrair o nome dos XControls
dali. Outra vez, cabe aqui uma análise mais profunda do conteúdo hexadecimal do .lib
Segue:
Sub MyScreen_OnPreShow(Arg)
Dim dict
Dim oFSO
Dim sFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFile = ".\Caminho\Da\Biblioteca.lib"
If (oFSO.FileExists( sFile )) Then
Set dict = GetXControlsList( sFile )
AddXControlsToScreen dict
Else
MsgBox "[LIB] File not found.", vbExclamation
End If
End Sub
'
' Retorna dictionary
'
Private Function GetXControlsList( sFile )
Dim dict
Dim nByte
Dim oMatch
Dim oMatches
Dim rgx
Dim sContent
Dim sClass
Dim sLibName
Set dict = CreateObject("Scripting.Dictionary")
'Set rgx = CreateObject("VBScript.RegExp")
Set rgx = New RegExp
rgx.IgnoreCase = True
rgx.Global = True
rgx.Pattern = "LName(\w+)DocString0"
With CreateObject("ADODB.Stream")
.Type = 1
.Open
.LoadFromFile sFile
.Position = 0
Do Until .EOS
nByte = AscB(.Read(1))
If ( (nByte >= 46) And (nByte <= 122) ) Then
sContent = sContent & Chr(nByte)
End If
Loop
.Close
End With
Set oMatches = rgx.Execute(sContent)
' File name w/o .lib, e.g.: 'MyLib.lib' >> 'MyLib.'
With CreateObject("Scripting.FileSystemObject")
sLibName = Replace( .GetFileName(sFile), _
.GetExtensionName(sFile), "")
End With
For Each oMatch In oMatches
' e.g.: MyLib.NomeDoXControl
sClass = sLibName & oMatch.SubMatches(0)
If (Not dict.Exists( sClass )) Then
' dict.Add sClass, sLibName
dict.Add sClass, Nothing
End If
Next
Set GetXControlsList = dict
End Function
Private Sub AddXControlsToScreen( dict )
Dim i
Dim lYPos : lYPos = 0
Dim sClass
Dim xc
' Clear screen.
For Each xc In Screen
' TODO: Verificar classes de interesse
' a serem deletadas, no caso as mesmas
' a serem criadas.
Me.DeleteObject( xc.Name )
Next
For i = 0 To dict.Count - 1
sClass = dict.Keys()(i)
'sLibName = dict.Items()(i)
With AddObject( sClass, False )
' TODO: More improvements.
' e.g.: size, xpos, screen limits, etc...
.Y = (.Height + lYPos)
lYPos = .Height + .Y
.Activate()
End With
Next
End Sub