codice:
Public Sub calcola_classifica()
Dim db As Database
Dim rsESISTENZA As New ADODB.Recordset
Dim rsCALENDARIO As New ADODB.Recordset
Dim rsCLASSIFICA As New ADODB.Recordset
Dim esiste As Boolean
Dim goal_casa, goal_fuori As Integer
Dim id_squadra As Integer
Dim giocate_casa As Integer
Dim punti_casa As Integer
Dim vinte_casa As Integer
Dim perse_casa As Integer
Dim X_casa As Integer
Dim giocate_fuori As Integer
Dim punti_fuori As Integer
Dim vinte_fuori As Integer
Dim perse_fuori As Integer
Dim X_fuori As Integer
Dim g_fatti_casa As Integer
Dim g_subiti_casa As Integer
Dim g_fatti_fuori As Integer
Dim g_subiti_fuori As Integer
Dim diff_reti As Integer
id_campionato = 1
Conn_Calcetto.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\campionato.mdb;"
Conn_Calcetto.CursorLocation = adUseClient
Conn_Calcetto.Open
Set db = OpenDatabase(App.Path & "\campionato.mdb")
db.Execute "delete from classifica_app", dbFailOnError
db.Close
rsCALENDARIO.Open "SELECT * FROM CALENDARIO ORDER BY " & _
"1, 2, 3", Conn_Calcetto, 1, 3
rsCALENDARIO.MoveFirst
Do Until rsCALENDARIO.EOF
goal_casa = goal_fatti(rsCALENDARIO("id_giornata"), rsCALENDARIO("id_squadra_casa"))
goal_fuori = goal_fatti(rsCALENDARIO("id_giornata"), rsCALENDARIO("id_squadra_fuori"))
GoSub carica_record_casa
GoSub controlla_esistenza
If esiste Then
GoSub update_classifica
Else
GoSub insert_classifica
End If
GoSub carica_record_fuori
GoSub controlla_esistenza
If esiste Then
GoSub update_classifica
Else
GoSub insert_classifica
End If
rsCALENDARIO.MoveNext
Loop
rsCLASSIFICA.Open "SELECT * FROM CLASSIFICA_APP ORDER BY " & _
"1", Conn_Calcetto, 1, 3
Set F_classifica.DataGrid1.DataSource = rsCLASSIFICA
Exit Sub
insert_classifica:
Set db = OpenDatabase(App.Path & "\campionato.mdb")
db.Execute "INSERT INTO CLASSIFICA_APP " & _
"VALUES( " & _
id_squadra & ", " & _
giocate_casa & ", " & _
giocate_fuori & ", " & _
punti_casa & ", " & _
punti_fuori & ", " & _
vinte_casa & ", " & _
perse_casa & ", " & _
X_casa & ", " & _
vinte_fuori & ", " & _
perse_fuori & ", " & _
X_fuori & ", " & _
g_fatti_casa & ", " & _
g_subiti_casa & ", " & _
g_fatti_fuori & ", " & _
g_subiti_fuori & ", " & _
diff_reti & ")", dbFailOnError
db.Close
Return
update_classifica:
Set db = OpenDatabase(App.Path & "\campionato.mdb")
db.Execute "update CLASSIFICA_APP SET " & _
"GIOCATE_CASA = GIOCATE_CASA + " & giocate_casa & _
", GIOCATE_FUORI = GIOCATE_FUORI + " & giocate_fuori & _
", PUNTI_CASA = PUNTI_CASA + " & punti_casa & _
", PUNTI_FUORI = PUNTI_FUORI + " & punti_fuori & _
", VINTE_CASA = VINTE_CASA + " & vinte_casa & _
", PERSE_CASA = perse_casa + " & perse_casa & _
", X_CASA = X_CASA + " & X_casa & _
", VINTE_FUORI = VINTE_FUORI + " & vinte_fuori & _
", PERSE_FUORI = PERSE_FUORI + " & perse_fuori & _
", X_FUORI = X_FUORI + " & X_fuori & _
", G_FATTI_CASA = G_FATTI_CASA + " & g_fatti_casa & _
", G_SUBITI_CASA = G_SUBITI_CASA + " & g_subiti_casa & _
", G_FATTI_FUORI = G_FATTI_FUORI + " & g_fatti_fuori & _
", G_SUBITI_FUORI = G_SUBITI_FUORI + " & g_subiti_fuori & _
", DIFF_RETI = DIFF_RETI + " & diff_reti & _
" where ID_SQUADRA = " & id_squadra, dbFailOnError
db.Close
Return
controlla_esistenza:
rsESISTENZA.Open "select id_squadra from CLASSIFICA_APP " & _
"where id_squadra = " & id_squadra, Conn_Calcetto, 1, 3
If rsESISTENZA.EOF Or rsESISTENZA.BOF Then
esiste = False
Else
esiste = True
End If
rsESISTENZA.Close
Return
carica_record_casa:
'valorizzo record per la squadra in casa
id_squadra = rsCALENDARIO("id_squadra_casa")
giocate_casa = 1
giocate_fuori = 0
If goal_casa > goal_fuori Then
punti_casa = 3
vinte_casa = 1
perse_casa = 0
X_casa = 0
Else
If goal_casa = goal_fuori Then
punti_casa = 1
vinte_casa = 0
perse_casa = 0
X_casa = 1
Else
punti_casa = 0
vinte_casa = 0
perse_casa = 1
X_casa = 0
End If
End If
punti_fuori = 0
vinte_fuori = 0
perse_fuori = 0
X_fuori = 0
g_fatti_casa = goal_casa
g_fatti_fuori = 0
g_subiti_casa = goal_fuori
g_subiti_fuori = 0
diff_reti = g_fatti_casa - g_subiti_casa
Return
carica_record_fuori:
'valorizzo record per la squadra fuori casa
id_squadra = rsCALENDARIO("id_squadra_fuori")
giocate_casa = 0
giocate_fuori = 1
If goal_fuori > goal_casa Then
punti_fuori = 3
vinte_fuori = 1
perse_fuori = 0
X_fuori = 0
Else
If goal_fuori = goal_casa Then
punti_fuori = 1
vinte_fuori = 0
perse_fuori = 0
X_fuori = 1
Else
punti_fuori = 0
vinte_fuori = 0
perse_fuori = 1
X_fuori = 0
End If
End If
punti_casa = 0
vinte_casa = 0
perse_casa = 0
X_casa = 0
g_fatti_fuori = goal_fuori
g_fatti_casa = 0
g_subiti_fuori = goal_casa
g_subiti_casa = 0
diff_reti = g_fatti_fuori - g_subiti_fuori
Return
End Sub
Public Function goal_fatti(id_giornata, id_squadra)
Dim Conn As New ADODB.Connection
Dim rsGOALFATTI As New ADODB.Recordset
Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\campionato.mdb;"
Conn.CursorLocation = adUseClient
Conn.Open
rsGOALFATTI.Open "SELECT SUM(TOTALE_GOAL) AS GOAL FROM MARCATORI " & _
"WHERE" & _
" ID_SQUADRA = " & id_squadra & _
" AND ID_GIORNATA = " & id_giornata & _
" AND ID_CAMPIONATO = " & id_campionato _
, Conn, 1, 3
goal_fatti = rsGOALFATTI("goal")
rsGOALFATTI.Close
Conn.Close
End Function