' Esta clase es una CÁPSULA que engloba una colección y un timer
' la colección admite la posibilidad de limitar cantidad de elementos.
' el timer se reparte en 2 eventos, y se ha añadido una función de consulta...
' Toda la funcionalidad es común a las 3 clases, es por ello que se unifica en una sola clase
' y las instancias exponen sólo las diferencias específicas de cada una.
Private WithEvents s_Crono As Timer
Private s_Coleccion As Collection
Private p_TamañoCola As Long ' determina si hay un límite máximo en cola de entrada, y si lo hay lo fija en un tamaño.
Private p_LimitarCola As Boolean
Private p_PausadoEntrantes As Boolean
Public Condicion As Boolean ' condicion para servir elemento
' ambos eventos los provee el timer...
' sólo salta el evento si la colección tiene eventos y no se cumple la condición
Public Event Crono()
' sólo salta el evento si la colección tiene elementos y se cumple la condición.
' la condición debemos activarla cuando queramos que nos devuelva el primer elemento.
Public Event ServirElemento(ByRef Elemento As Object)
Private Sub Class_Initialize()
p_LimiteCola = 0 ' indica que no hay límite de transacciones de entrada.
p_LimitarColaSolicitud = False
Set s_Coleccion = New Collection
p_PausadoEntrantes = False
Condicion = False
End Sub
' debe invocarse esta función justo tras ser creada la clase.
Friend Function SetTimer(ByRef Tim As Timer) As Boolean
On Local Error Resume Next
Set s_Crono = T
s_Crono.Interval = 1000
s_Crono.Enabled = False
SetTimer = (s_Crono Is Nothing)
End Function
Private Sub Class_Terminate()
If Not (s_Crono Is Nothing) Then
s_Crono.Enabled = False
Set s_Crono = Nothing
End If
Set s_Coleccion = Nothing
End Sub
' PRECAUCIÓN: sólo debería usarse en la instancia de solicitudes.
' o incluso en la instanacia llamada de ejecución, pero nunca en la siguiente.
' se debe recordar que funcionan en cascada...
Public Property Get PausaEntrantes() As Boolean
PausaEntrantes = p_PausadoEntrantes
End Property
Public Property Let PausaEntrantes(ByVal p As Boolean)
If p_PausadoEntrantes <> p Then
p_PausadoEntrantes = p
End If
End Property
' pausa, pausa tanto entrantes como salientes....
Public Property Get Pausa() As Boolean
Pausa = Not s_Crono.Enabled
End Property
Public Property Let Pausa(ByVal p As Boolean)
If p_Pausado <> p Then
p_PausadoEntrantes = p
s_Crono.Enabled = Not p
End If
End Property
Friend Property Get Intervalo() As Integer
Intervalo = s_Crono.Interval
End Property
Friend Property Let Intervalo(ByVal x As Integer)
s_Crono.Interval = x
End Property
' el timer provee 2 eventos, ambos sólo si la colección tiene elementos.
' Se sirve el primer elemento siempre que se cumpla la condición.
' la condición es un valor buleano que asigna la instancia de esta clase.
' es allí donde se decide cuales son las justificaciones de la condición.
' puesto que cada instancia tendrá condiciones distintas, lo único común es
' precisamente, definir que se 'cumplió la condición' ... de este modo es común a todas las instancias.
' cuando no se cumple la condición se genera el evento crono, que ofrece la oportunidad de evaluar si se cumple o no la condición.
' es allí donde debe establecerse si se cumple o no la condición.
' Dado que se ignora cuando se incumple la condición para cada instancia
' debe decidirse en cualquiera de los 2 eventos el caso que no, o podría activarse la línea comentada
' en cuyo caso sólo se puede decidir si se cumple la condición en el evento crono... dividiendo la frecuencia de entregas...
Private Sub s_Crono_Timer()
If s_Coleccion.Count > 0 Then
If Condicion = True Then
Dim it As Object
Condicion = False
Set it = s_Coleccion.Item(1)
RaiseEvent ServirElemento(it)
' se elimina desde la clase que lo añade a otra colección, para hacerlo compatible con
' la nueva propiedad añadida a última hora: PausarEntrantes
'Call s_Coleccion.Remove(1)
Set it = Nothing
Else
RaiseEvent Crono
End If
End If
End Sub
' es una propiedad de administrador
' si se establece el valor a true, no se podrán añadir elementos mientras
' el nº de elementos en la colección sea mayor= que el tamaño de cola.
Public Property Get LimitarCola() As Boolean
LimitarCola = p_LimitarCola
End Property
Public Property Let LimitarCola(ByVal lc As Boolean)
If lc <> p_LimitarCola Then
p_LimitarCola = lc
End If
End Property
' es una propiedad de administrador
' esta propiedad sólo indica en tamaño de cola, pero quien determina si se limita o no, es Limitarcola
Public Property Get TamañoCola() As Long
TamañoCola = p_TamañoCola
End Property
Public Property Let TamañoCola(ByVal lm As Long)
If lm > p_TamañoCola Then
p_TamañoCola = lm
End If
End Property
Public Property Get Count() As Long
Count = s_Coleccion.Count
End Property
' lo hemos puesto variant poque igual puede pedirse por índice que por key
Public Property Get Elemento(ByVal Index As Variant)
On Local Error Resume Next
Set Elemento = s_Coleccion.Item(Index)
End Property
Friend Property Set Elemento(ByVal Index As Variant, ByRef it As Object)
On Local Error Resume Next
Set s_Coleccion.Item(Index) = it
End Property
' ni añadir ni eliminar se dejan públicas, ya que sólo una clase añade a otra.
Friend Function Añadir(ByRef T As Object, ByVal Key As String, Optional Despues As Boolean = False, Optional DetrasDe As Long = 1) As enAñadiendo
If p_PausadoEntrantes = False Then
If p_LimitarCola = True Then
If s_Coleccion.Count >= p_TamañoCola Then Exit Function
End If
On Local Error Resume Next
Err.Number = 0
If Despues = False Then
Call s_Coleccion.Add(T, Key)
Else ' esta versión sólo la utiliza la clase de solicitudes...
Call s_Coleccion.Add(T, Key, after:=DetrasDe)
End If
If (Err.Number = 0) Then
Añadir = ADD_AÑADIDO
Else
Añadir = ADD_ERROR_COLECCION ' se supone que no puede ser: ADD_ERROR_DATOS, se hubiera detectado en la llamada Add_Transaccion de 1ª fase...(cSolicitudes)
End If
Else
Añadir = ADD_PAUSADO
End If
End Function
' lo normal es eliminar siempre el elemento 1º, las s_Colecciones están basadas en ínndice 1
' no usamos esta función en la práctiva, se provee para futuras necesidades...
Friend Function Eliminar(Optional Posicion As Long = 1) As Boolean
On Local Error Resume Next
If Posicion > 0 Then
Err.Number = 0
s_Coleccion.Remove (Posicion)
Eliminar = (Err.Number = 0)
End If
End Function
Public Function Consulta_MisPedidosEnCola(ByRef IdRef As Form) As Long
Dim n As Long, k As Long
Dim tr As infoTransaccion
On Local Error Resume Next
For k = 1 To s_Coleccion.Count
Set tr = s_Coleccion.Item(k)
If tr.Control.IdRef.Name = IdRef.Name Then
n = n + 1
End If
Next
Set tr = Nothing
Consulta_MisPedidosEnCola = n
End Function