Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Libretto dei voti - frmLibretto.frm

frmLibretto.frm

Caricato da: Antometal
Scarica il programma completo

  1. Const Cartella As String = "C:\Libretto Voti\", XCorso As String = Cartella & "\Voti.ini"
  2. Const Orale As String = "Orale", Scritto As String = "Scritto", Pratico As String = "Pratico"
  3. Const OrMate As String = "Orale_Materia", ScMate As String = "Scritto_Materia", PrMate As String = "Pratico_Materia"
  4. Const NumVoti As String = "Numero_Voti_", Voto As String = "Voto"
  5. Const VotiSc As String = "Voti Scritto", VotiOr As String = "Voti Orale", VotiPr As String = "Voti Pratica"
  6.  
  7. Private Sub Salva()
  8. ScriviIni XCorso, "Colore", "Sfondo", Me.BackColor
  9. ScriviIni XCorso, "Colore", "Testo", lblMaterie.ForeColor
  10.     For i = 0 To 7
  11.         NOrale(i) = lsOrale(i).ListCount - 1
  12.         NScritto(i) = lsScritto(i).ListCount - 1
  13.         NPratico(i) = lsPratico(i).ListCount - 1
  14.         ScriviIni XCorso, NumVoti & Orale, lblMateria(i), CStr(NOrale(i))
  15.         ScriviIni XCorso, NumVoti & Scritto, lblMateria(i), CStr(NScritto(i))
  16.         ScriviIni XCorso, NumVoti & Pratico, lblMateria(i), CStr(NPratico(i))
  17.             For j = 0 To lsOrale(i).ListCount - 1
  18.                 ScriviIni XCorso, VotiOr, lblMateria(i) & Voto & j, lsOrale(i).List(j)
  19.             Next j
  20.             For j = 0 To lsScritto(i).ListCount - 1
  21.                 ScriviIni XCorso, VotiSc, lblMateria(i) & Voto & j, lsScritto(i).List(j)
  22.             Next j
  23.             For j = 0 To lsScritto(i).ListCount - 1
  24.                 ScriviIni XCorso, VotiPr, lblMateria(i) & Voto & j, lsPratico(i).List(j)
  25.             Next j
  26.     Next i
  27. End Sub
  28.  
  29. Private Sub Apri()
  30. Me.BackColor = LeggiIni(XCorso, "Colore", "Sfondo")
  31. Colore = LeggiIni(XCorso, "Colore", "Testo")
  32. ModificaColoreTesto
  33.     For i = 0 To 7
  34.         NOrale(i) = CDbl(LeggiIni(XCorso, NumVoti & Orale, lblMateria(i)))
  35.         NScritto(i) = CDbl(LeggiIni(XCorso, NumVoti & Scritto, lblMateria(i)))
  36.         NPratico(i) = CDbl(LeggiIni(XCorso, NumVoti & Pratico, lblMateria(i)))
  37.             For j = 0 To NOrale(i)
  38.                 lsOrale(i).List(j) = LeggiIni(XCorso, VotiOr, lblMateria(i) & Voto & j)
  39.             Next j
  40.             For j = 0 To NScritto(i)
  41.                 lsScritto(i).List(j) = LeggiIni(XCorso, VotiSc, lblMateria(i) & Voto & j)
  42.             Next j
  43.             For j = 0 To NPratico(i)
  44.                 lsPratico(i).List(j) = LeggiIni(XCorso, VotiPr, lblMateria(i) & Voto & j)
  45.             Next j
  46.     Next i
  47. End Sub
  48.  
  49. Private Sub CalcolaMedia()
  50. Dim NOr(7) As Integer, NSc(7) As Integer, NPr(7) As Integer, SommaFrequenze As Integer
  51. Dim Media(7) As Double, MediaTotale As Double
  52. Dim SValori As String
  53. Dim B As Boolean
  54. On Error Resume Next
  55. SommaFrequenze = 0
  56. MediaTotale = 0
  57.     For i = 0 To 7
  58.         B = False
  59.         Media(i) = 0
  60.         NOr(i) = lsOrale(i).ListCount - 1
  61.         NSc(i) = lsScritto(i).ListCount - 1
  62.         NPr(i) = lsPratico(i).ListCount - 1
  63.             For k = 0 To NOr(i)
  64.                 SValori = ""
  65.                     For j = 1 To Len(lsOrale(i).List(k))
  66.                             If Mid(lsOrale(i).List(k), j, 1) = "(" Then B = True
  67.                             If Mid(lsOrale(i).List(k), j + 1, 1) = ")" Then B = False
  68.                             If B = True Then SValori = SValori & Mid(lsOrale(i).List(k), j + 1, 1)
  69.                     Next j
  70.                 Media(i) = Media(i) + CDbl(SValori)
  71.             Next k
  72.             For k = 0 To NSc(i)
  73.                 SValori = ""
  74.                     For j = 1 To Len(lsScritto(i).List(k))
  75.                             If Mid(lsScritto(i).List(k), j, 1) = "(" Then B = True
  76.                             If Mid(lsScritto(i).List(k), j + 1, 1) = ")" Then B = False
  77.                             If B = True Then SValori = SValori & Mid(lsScritto(i).List(k), j + 1, 1)
  78.                     Next j
  79.                 Media(i) = Media(i) + CDbl(SValori)
  80.             Next k
  81.             For k = 0 To NPr(i)
  82.                 SValori = ""
  83.                     For j = 1 To Len(lsPratico(i).List(k))
  84.                             If Mid(lsPratico(i).List(k), j, 1) = "(" Then B = True
  85.                             If Mid(lsPratico(i).List(k), j + 1, 1) = ")" Then B = False
  86.                             If B = True Then SValori = SValori & Mid(lsPratico(i).List(k), j + 1, 1)
  87.                     Next j
  88.                 Media(i) = Media(i) + CDbl(SValori)
  89.             Next k
  90.             If Media(i) <> 0 Then
  91.                 Media(i) = Media(i) / (NOr(i) + NSc(i) + NPr(i) + 3)
  92.                 lblMediaMateria(i).Caption = Round(Media(i), 2)
  93.             End If
  94.             If lblMediaMateria(i).Caption <> "" Then SommaFrequenze = SommaFrequenze + 1
  95.         MediaTotale = Media(i) + MediaTotale
  96.     Next i
  97.     If MediaTotale <> 0 Then MediaTotale = MediaTotale / SommaFrequenze
  98.     If MediaTotale < 5.5 Then lblMediaTot.ForeColor = vbRed
  99.     If MediaTotale >= 5.5 Then lblMediaTot.ForeColor = vbGreen
  100. lblMediaTot.Caption = Round(MediaTotale, 2)
  101. End Sub
  102.  
  103. Private Sub ModificaColoreTesto()
  104. lblMaterie.ForeColor = Colore
  105. lblMedia.ForeColor = Colore
  106.     For i = 0 To 7
  107.         lblMateria(i).ForeColor = Colore
  108.             If i < 6 Then lblTipoVoto(i).ForeColor = Colore
  109.             If i < 2 Then lblInfo(i).ForeColor = Colore
  110.     Next i
  111. End Sub
  112.  
  113. Private Sub cmdOk_Click()
  114.     For i = 0 To 7
  115.         NOrale(i) = lsOrale(i).ListCount - 1
  116.         NScritto(i) = lsScritto(i).ListCount - 1
  117.         NPratico(i) = lsPratico(i).ListCount - 1
  118.             If txtOrale(i).Text <> "" Then
  119.                     If IsNumeric(txtOrale(i).Text) = False Then GoTo NoNumOrale
  120.                     If CDbl(txtOrale(i).Text) > 10 Or CDbl(txtOrale(i).Text) < 1 Then GoTo NonAccettabileOrale
  121.                 lsOrale(i).AddItem txtDataVoto.Text & " - (" & txtOrale(i).Text & ")"
  122.             End If
  123.             If txtScritto(i).Text <> "" Then
  124.                     If IsNumeric(txtScritto(i).Text) = False Then GoTo NoNumScritto
  125.                     If CDbl(txtScritto(i).Text) > 10 Or CDbl(txtScritto(i).Text) < 1 Then GoTo NonAccettabileScritto
  126.                 lsScritto(i).AddItem txtDataVoto.Text & " - (" & txtScritto(i).Text & ")"
  127.             End If
  128.             If txtPratico(i).Text <> "" Then
  129.                     If IsNumeric(txtPratico(i).Text) = False Then GoTo NoNumPratico
  130.                     If CDbl(txtPratico(i).Text) > 10 Or CDbl(txtPratico(i).Text) < 1 Then GoTo NonAccettabilePratico
  131.                 lsPratico(i).AddItem txtDataVoto.Text & " - (" & txtPratico(i).Text & ")"
  132.             End If
  133.     Next i
  134.    
  135. cmdRefresh_Click
  136. CalcolaMedia
  137. txtOrale(0).SetFocus
  138.  
  139. Exit Sub
  140. NoNumOrale:
  141. MsgBox "Scirivere un valore numerico o lasciare vuota la casella di testo", vbCritical, "Errore, tipo non corrispondente"
  142. txtOrale(i).Text = ""
  143. txtOrale(i).SetFocus
  144.  
  145. Exit Sub
  146. NoNumScritto:
  147. MsgBox "Scirivere un valore numerico o lasciare vuota la casella di testo", vbCritical, "Errore, tipo non corrispondente"
  148. txtScritto(i).Text = ""
  149. txtScritto(i).SetFocus
  150.  
  151. Exit Sub
  152. NoNumPratico:
  153. MsgBox "Scirivere un valore numerico o lasciare vuota la casella di testo", vbCritical, "Errore, tipo non corrispondente"
  154. txtPratico(i).Text = ""
  155. txtPratico(i).SetFocus
  156.  
  157. Exit Sub
  158. NonAccettabileOrale:
  159. MsgBox "Inserisci un voto compreso tra 1 e 10", vbExclamation, "Errore valore non accettabile"
  160. txtOrale(i).Text = ""
  161. txtOrale(i).SetFocus
  162.  
  163. Exit Sub
  164. NonAccettabileScritto:
  165. MsgBox "Inserisci un voto compreso tra 1 e 10", vbExclamation, "Errore valore non accettabile"
  166. txtScritto(i).Text = ""
  167. txtScritto(i).SetFocus
  168.  
  169. Exit Sub
  170. NonAccettabilePratico:
  171. MsgBox "Inserisci un voto compreso tra 1 e 10", vbExclamation, "Errore valore non accettabile"
  172. txtPratico(i).Text = ""
  173. txtPratico(i).SetFocus
  174. End Sub
  175.  
  176. Private Sub cmdRefresh_Click()
  177.     For i = 0 To 7
  178.         txtOrale(i).Text = ""
  179.         txtScritto(i).Text = ""
  180.         txtPratico(i).Text = ""
  181.     Next i
  182. End Sub
  183.  
  184. Private Sub Form_Load()
  185. On Error Resume Next
  186. MkDir (Cartella)
  187. Apri
  188. CalcolaMedia
  189. CMDialog.Flags = cdlCCFullOpen
  190. txtDataVoto.Text = Date
  191. End Sub
  192.  
  193. Private Sub Form_Unload(Cancel As Integer)
  194. Salva
  195. End Sub
  196.  
  197. Private Sub modColSfondo_Click()
  198. CMDialog.ShowColor
  199. Me.BackColor = CMDialog.Color
  200. End Sub
  201.  
  202. Private Sub modColTxt_Click()
  203. CMDialog.ShowColor
  204. Colore = CMDialog.Color
  205. ModificaColoreTesto
  206. End Sub
  207.  
  208. Private Sub txtOrale_Change(Index As Integer)
  209. On Error Resume Next
  210.     If Mid(txtOrale(Index).Text, txtOrale(Index).SelStart, 1) = "." Then
  211.         txtOrale(Index).Text = Mid(txtOrale(Index).Text, 1, Len(txtOrale(Index).Text) - 1) & ","
  212.         txtOrale(Index).SelStart = Len(txtOrale(Index).Text)
  213.     End If
  214.     If Mid(txtOrale(Index).Text, 1, 1) = 0 Then txtOrale(Index).Text = ""
  215. End Sub
  216.  
  217. Private Sub txtPratico_Change(Index As Integer)
  218. On Error Resume Next
  219.     If Mid(txtPratico(Index).Text, txtPratico(Index).SelStart, 1) = "." Then
  220.         txtPratico(Index).Text = Mid(txtPratico(Index).Text, 1, Len(txtPratico(Index).Text) - 1) & ","
  221.         txtPratico(Index).SelStart = Len(txtPratico(Index).Text)
  222.     End If
  223.     If Mid(txtPratico(Index).Text, 1, 1) = 0 Then txtPratico(Index).Text = ""
  224. End Sub
  225.  
  226. Private Sub txtScritto_Change(Index As Integer)
  227. On Error Resume Next
  228.     If Mid(txtScritto(Index).Text, txtScritto(Index).SelStart, 1) = "." Then
  229.         txtScritto(Index).Text = Mid(txtScritto(Index).Text, 1, Len(txtScritto(Index).Text) - 1) & ","
  230.         txtScritto(Index).SelStart = Len(txtScritto(Index).Text)
  231.     End If
  232.     If Mid(txtScritto(Index).Text, 1, 1) = 0 Then txtScritto(Index).Text = ""
  233. End Sub