El primero código que te ofrece Leandro, es más limpio... no exige recorrer todos los controles de un formulario en busca del tuyo...
Modificándolo un poco puede hacer lo mismo que el segundo...
En este código, puede especificarse un máximo por aplicación y un máximo por formulario (o contenedor si se cambia adecuadamente):
Este código va en un módulo:
Private colPresencias As New Collection
Private p_MaxInstanciasXApp As Long
Private p_MaxInstanciasXFrm As Byte
' Devuelve la cantidad de instancias añadidas.
Public Property Get Count() As Long
Count = colPresencias.Count
End Property
' Un valor <=0, permite ilimitadas instancias.
' Un valor mayor que 0, limita a ese número *
' * (si aún no se alcanzó dicho límite, si ya se guardaron 10, y luego se limita a 5, seguirán existiendo 10)
Public Property Let MaxInstanciasXApp(ByVal X As Long)
p_MaxInstanciasXApp = X
End Property
' OJO: Esta propiedad y la anterior, conviene establecerse SOLO cuando la colección no tiene ningún control.
Public Property Let MaxInstanciasXFrm(ByVal X As Byte)
p_MaxInstanciasXFrm = X
End Property
' Intenta añadir una nueva instancia (solo si no se alcanzó el límite para ese formulario y el límite establecido para la aplicación).
Public Function Add(byval hWnd As Long) As Boolean
Dim Intentos As Byte, sWnd As String
On Local Error GoTo YaExiste
If ((colPresencias.Count <= p_MaxInstanciasXApp) Or (p_MaxInstanciasXApp < 1)) Then
sWnd = CStr(hWnd) & CStr(Intentos)
Call colPresencias.Add(hWnd, sWnd)
Add = True
End If
Exit Function
YaExiste:
Err.Clear
' Si ya existe, se intentará más veces, cambiando la 'key' usada para añadirlo a la colección...
If (p_MaxInstanciasXFrm > 0) Then
Intentos = (Intentos + 1)
If (Intentos < p_MaxInstanciasXFrm) Then
sWnd = CStr(hWnd) & CStr(Intentos)
' irá sucediendo valores de key así:
' ejemplo para 4 instancias por formulario:
'987654&0
'987654&1
'987654&2
'987654&3 <--- esta será la ultima key para el form con hWnd: 987654.
Resume
End If
Else
Add = True ' ya fue añadido un control para este formulario, pero puede añadirse infinitos controles al formulario, no es necesario que se guarde en la colección, la constancia de cada uno.
End If
End Function
' Intenta eliminar una instancia.
Public Sub Delete(ByVal hWnd As Long)
Dim Intentos As Byte, sWnd As String
Intentos = p_MaxInstanciasXFrm
sWnd = CStr(hWnd) & CStr(Intentos)
On Local Error GoTo NoExiste '0 ' el error ocurriría, si no existe...
Call colPresencias.Remove(sWnd)
Exit Sub
NoExiste:
Err.Clear
' Si no existe, se intentará más veces, cambiando la 'key' que fue usada para añadirlo a la colección...
If ((p_MaxInstanciasXFrm > 0) or (colPresencias.count) >0) Then
Intentos = (Intentos - 1)
If (Intentos > 0) Then
sWnd = CStr(hWnd) & CStr(Intentos)
' irá intentando eliminar instancias (con valores de key así):
' ejemplo para 4 instancias por formulario:
'987654&3
'987654&2
'987654&1
'987654&0 <--- esta será la ultima key para el form con hWnd: 987654.
Resume
End If
End If
End Sub
Si prefrieres tener un control más completo de todo el trabajo (como eliminar la colección), el código sería mejor portarlo a una clase (la clase debería declararse Privada), y en el módulo (bas) simplemente crear una única instancia que se comparte entre todos tus controles en la aplicación cliente de la siguiente forma:
private p_RefControlInstancias as new clsControlInstancias '<---- supuesto el caso de darle este nombre.
public property get ControlInstancias as clsControlInstancias
set ControlInstancias = p_RefControlInstancias
end property
Este otro código va en el usercontrol, Eventos InitProperties (no en Initialize, porque aún no está disponible el sitio cliente) y en el evento Terminate:
Private Sub UserControl_InitProperties()
' Limitación del número de controles por aplicación y formulario...
If (Module1.Count = 0) Then
' Recuerda un valor 0 o menor, indica sin límites...
Module1.MaxInstanciasXApp = 0 ' ilimitado número de instancias por aplicación.
Module1.MaxInstanciasXFrm = 1 ' pero limitado a 1 control por formulario
' en resumen podría poner 200 instancias del control si pone 200 formularios...
End If
If (Module1.Add(UserControl.Parent.hWnd) = False) Then
' error 419: Permission to use object denied
Call Err.Raise(419, UserControl.Extender.Name, "Solo se permiten X instancias del control por formulario. ----> e indicar también el límite total para la aplicación, si lo hay... ")
End If
End Sub
Private Sub UserControl_Terminate()
Call Module1.Delete(UserControl.Parent.hWnd)
End Sub
--------------------------------
p.d.: He añadido, algo de código más, por si quieres pasarlo a una clase para tener un control más exhaustivo del proceso... por ejemplo al destruir la clase, en el evento terminate, podrías vacíar la colección... en vez de dejarlo como tarea para el sistema.
También recomendarte que si esto lo vas a usar mucho (por ejemplo el código del módulo), sería muy acorde crear el módulo con el código, e incluso copiar al módulo y comentar el código que va en el usercontrol, y luego guardar el módulo en la ruta: "Unidad:\Programa File\Microsoft visual Studio\VB98\Template\Modules", obviamente cambiando lo que proceda en la ruta específica en que VS, está instalado en tu equipo. De estemodo cada vez que quieras añadirlo a un proyecto, cuando el dés a añadir módulo, tendrás presente esa plantilla, para elegirla entre las disponibles (es más cómodo que recordar donde lo guardaste en el disco y tener que buscarlo).
---------------------------------------------
p.d2.: Este código, es un código que se ha hecho rápido y no se ha probado a conciencia, por ello contiene algunos errores, por ejemplo, en el Usercontrol debe ejecutarse el mismo código en el evento ReadProperties, no solo en InitProperties, y le falta tratar error en el evento Terminate... Algunos mensajes más abajo, hay un código más robusto, listo para descargarse... el código sobre el módulo se ha movido a una clase.
