Run Code
|
API
|
Code Wall
|
Misc
|
Feedback
|
Login
|
Theme
|
Privacy
|
Patreon
CAI - Visual Basic - Ej. Citas Reloaded
' CITAS RELOADED ' Desarrollar la función PosiblesParejasEnProvincia que recibe como parámetro el ' código de persona de quien está buscando, el código de su provincia, y el código de ' sexo buscado por esta persona. Con esta información, devolver la cantidad de ' personas que serían parejas viables para esta persona (sin contar a la persona actual) Private Function PosiblesParejasEnProvincia(codPersona as Integer, codProvincia as Integer, codSexoBuscado as Integer) as Integer Dim totalPosiblesParejas as Integer totalPosiblesParejas = 0 Dim sexoPerActual as Integer sexoPerActual = buscarSexoPersona(codPersona) Dim amistades as RecordSet Set amistades = abrirTabla("Amistades", oDB) Dim criterioAmistades as String criterioAmistades = "ami_Activo = True" _ & " AND (ami_Origen = " & codPersona & " OR ami_Destino = " & codPersona & ")" amistades.FindFirst criterioAmistades Do while Not amistades.NoMatch Dim personas as RecordSet Set personas = abrirTabla("Persona", oDB) Dim codAmigo as Integer If amistades("ami_Origen") = codPersona Then codAmigo = amistades("ami_Destino") Else codAmigo = amistades("ami_Origen") End If Dim criterioPosiblePareja as String criterioPosiblePareja = _ "per_Activo = True" _ & " AND per_Codigo = " & codAmigo _ & " AND per_Provincia = " & codProvincia _ & " AND per_Sexo = " & codSexoBuscado _ & " AND per_SexoBuscado = " & sexoPerActual personas.FindFirst criterioPosiblePareja Do while Not personas.NoMatch totalPosiblesParejas = totalPosiblesParejas + 1 personas.FindNext criterioPosiblePareja Loop cerrarTabla personas amistades.FindNext criterioAmistades Loop cerrarTabla amistades PosiblesParejasEnProvincia = totalPosiblesParejas End Function Private Function buscarSexoPersona(codPersona as Integer) as Integer Dim sexoPersona as Integer Dim personas as Recordset Set personas = abrirTabla("Persona", oDB) Dim criterioPersona as String criterioPersona = "per_Activo = True AND per_Codigo = " & codPersona personas.FindFirst criterioPersona Do While Not personas.NoMatch sexoPersona = personas("per_Sexo") personas.FindNext criterioPersona Loop cerrarTabla personas buscarSexoPersona = sexoPersona End Function ' Implementar la rutina ObtenerAmigosPorNombre, que carga un listbox de resultados ' en base al ingreso parcial del nombre de los mismos (solo con el nombre completo y su ' código asociado). Esta función recibe como parámetro el código de la persona que está ' buscando, una cadena de texto con el nombre a buscar, un indicador booleano que ' determina si se debe buscar solo entre amigos (true) o en toda la base de datos (false), ' y una referencia al listbox en donde deben cargarse los resultados. Private Sub ObtenerAmigosPorNombre(codPersona as Integer, txtNombreABuscar as String, soloAmigos as Boolean, lstResultados as ListBox) lstResultados.Clear If soloAmigos = True Then Dim amistades as RecordSet amistades = abrirTabla("Amistades", oDB) Dim criterioAmistades as String criterioAmistades = "ami_Activo = True" _ & " AND (ami_Origen = " & codPersona & " OR ami_Destino = " & codPersona & ")" amistades.FindFirst criterioAmistades Do while Not amistades.NoMatch Dim personas as RecordSet Set personas = abrirTabla("Persona", oDB) Dim codAmigo as Integer If amistades("ami_Origen") = codPersona Then codAmigo = amistades("ami_Destino") Else codAmigo = amistades("ami_Origen") End If Dim criterioAmigo as String criterioAmigo = "per_Activo = True AND per_Codigo = " & codAmigo & " AND per_Nombre LIKE '*" & txtNombreABuscar & "*'" personas.FindFirst criterioAmigo Do while Not personas.NoMatch agregarItemLista lstResultados, personas("per_Nombre"), personas("per_Codigo") personas.FindNext criterioAmigo Loop cerrarTabla personas amistades.FindNext criterioAmistades Loop cerrarTabla amistades Else Dim personas as RecordSet Set personas = abrirTabla("Persona", oDB) Dim criterioPersonas as String criterioPersonas = _ "per_Activo = True" _ & " AND per_Codigo <> " codPersona _ & " AND per_Nombre LIKE '*" & txtNombreABuscar & "*'" personas.FindFirst criterioPersonas Do while not personas.NoMatch agregarItemLista lstResultados, personas("per_Nombre"), personas("per_Codigo") personas.FindNext criterioPersonas Loop cerrarTabla personas End If End Sub ' Asignar a la variable strCriterio cada uno de los criterios solicitados a continuación, ' considerando que se cuenta con la variable oRSPersona posicionada sobre el registro ' de la persona actual (ejemplo: strCriterio = “…”). ' Nota I: Tener presente que todos los selectores tienen un primer elemento con código inválido ' (-1) que solicitan al usuario que lleve a cabo la selección. ' Nota II: Tener en cuenta que el campo “activo” indica una baja lógica, por lo que siempre debe ' obtenerse registros “activos” a menos que se indique lo contrario ' A) Criterio que obtenga un recordset con las personas activas que están dentro ' de la misma provincia que el usuario actual, que estén activas y que hayan ' ingresado al sistema en los últimos X meses (donde X es intMesesInactividad), ' sin importar el sexo de las mismas. strCriterio = _ "per_Activo = True" _ & " AND per_Codigo <> " & oRSPersona("per_Codigo") _ & " AND per_Provincia = " & oRSPersona("per_Provincia") _ & " AND per_UltimoIngreso > " & Format(DateAdd("m", -intMesesInactividad, Date()), "yyyy-mm-dd") ' B) Criterio con todas las personas que tengan la cadena X dentro del nombre ' (donde X es strNombre) y que, estén activas y hayan ingresado hace menos de ' un mes. strCriterio = _ "per_Activo = True" _ & " AND per_Codigo <> " & oRSPersona("per_Codigo") _ & " AND per_Nombre LIKE '*" & strNombre & "*'" _ & " AND per_UltimoIngreso > " & Format(DateAdd("m", -1, Date()), "yyyy-mm-dd")
run
|
edit
|
history
|
help
0
check with hashset
loop 2 (until)
If Function returns not Nothing for DateTime
ss
Selected Shakespeare Sonnet for doy mod 150
Poem of the day from 'Selected Poems of Rumi (Dover Thrift Edition)'
No Fear Shakespeare sonnet of the day
kompasnaald
loop 1
Exercico 4