Option Explicit
Public Ammontare As Long
Public Password As String
Public Nome As String
Public XCorso As String
Public Modifica As Boolean
Private Type Intestazione
Nome As String
Password As String
End Type
Private Type recLibretto
Data As Date
Denaro As Long
Commento As String * 256
End Type
'FUNCTION SUB #####################################################################################################
Private Sub Salva(Percorso)
Dim Dati As recLibretto
Dim Testa As Intestazione
Dim Oggetti() As String
Dim I As Integer
If Dir(Percorso) <> "" Then Kill (Percorso)
Me.Caption = CDialog.FileTitle & " - Libretto Contabile"
Open Percorso For Random As 1 Len = Len(Dati)
Modifica = False
Testa.Nome = Nome
Testa.Password = Password
Put 1#, , Testa
For I = 0 To lstLibretto.ListCount - 1
Oggetti = Split(lstLibretto.List(I), vbTab)
Dati.Data = CDate(Replace(Oggetti(0), " ", ""))
Dati.Denaro = CLng(Replace(Oggetti(1), " ", ""))
Dati.Commento = Oggetti(2)
Put 1#, , Dati
Next I
Close #1
End Sub
Private Function Controllo() As Boolean
If IsDate(txtData) = False Then
MsgBox "Errore, formato data non valido" & vbCrLf & "Inserisci una date nel formato gg/mm/aaaa", vbExclamation
txtData = ""
Controllo = False
Exit Function
Else
Controllo = True
End If
txtDenaro = Val(txtDenaro)
If txtDenaro = 0 Or txtDenaro > 1000000 Or txtDenaro < -1000000 Then
MsgBox "Errore, valore numerico inserito non corretto" & vbCrLf & "Inserisci un valore numerico diverso da 0 e compreso tra 10000 e -10000", vbExclamation
txtDenaro = ""
Controllo = False
Else
Controllo = True
End If
End Function
Private Function ControlloModifica() As VbMsgBoxResult
Dim Risposta As VbMsgBoxResult
If Modifica = False Then
ControlloModifica = vbNo
Exit Function
End If
Risposta = MsgBox("I dati in questa finestra sono stati cambiati" & vbCrLf & vbCrLf & "Salvare i dati prima di aprire un altro file?", vbQuestion + vbYesNoCancel)
If Risposta = vbYes Then flSalvaNome_Click
Modifica = False
ControlloModifica = Risposta
End Function
Private Function ControlloUscita() As Boolean
Dim Risposta As VbMsgBoxResult
If Modifica = True Then
Risposta = MsgBox("Salvare i dati prima di uscire?", vbQuestion + vbYesNoCancel)
If Risposta = vbYes Then flSalva_Click
If Risposta = vbCancel Then ControlloUscita = True
Else
End
End If
End Function
Private Sub AggiungiALista(Data As Date, Denaro As String, Commento As String, Posizione As Integer)
Data = Data & Space(10 - Len(Data))
Denaro = Space(8 - Len(Denaro)) & Denaro
Modifica = True
Somma (CLng(Denaro))
lstLibretto.List(Posizione) = Data & vbTab & Denaro & vbTab & Commento
End Sub
Private Sub Somma(Denaro As Long)
Ammontare = Ammontare + Denaro
lblAmmontare.Caption = "Ammontare: " & Ammontare
End Sub
'COMMAND BUTTON ###################################################################################################
Private Sub cmdAggiungi_Click()
If Controllo = True Then AggiungiALista txtData, txtDenaro, txtCommento, lstLibretto.ListCount
End Sub
Private Sub cmdElimina_Click()
If MsgBox("Conferma eliminazione dati", vbQuestion + vbYesNo) = vbYes Then
lstLibretto_Click
Somma (txtDenaro)
lstLibretto.RemoveItem lstLibretto.ListIndex
Modifica = True
End If
End Sub
Private Sub cmdModifica_Click()
If Controllo = True Then AggiungiALista txtData, txtDenaro, txtCommento, lstLibretto.ListIndex
End Sub
Private Sub cmdInserisci_Click()
Dim I As Integer
If Controllo = True Then
For I = lstLibretto.ListCount To lstLibretto.ListIndex Step -1
lstLibretto.List(I) = lstLibretto.List(I - 1)
Next I
AggiungiALista txtData, txtDenaro, txtCommento, lstLibretto.ListIndex
End If
End Sub
'MENU FILE ########################################################################################################
Private Sub flApri_Click()
Dim Dati As recLibretto
Dim Testa As Intestazione
Dim Avanzati() As String
If ControlloModifica = vbCancel Then Exit Sub
CDialog.ShowOpen
If CDialog.CancelError = True Then Exit Sub
XCorso = CDialog.FileName
Me.Caption = CDialog.FileTitle & " - Libretto Contabile"
Open XCorso For Random As 1 Len = Len(Dati)
Get #1, , Testa
Nome = Testa.Nome
lblNome.Caption = "Intestatario libretto: " & Nome
Password = StrReverse(Testa.Password)
If Password <> "" Then
frmPassword.cmdAzione.Caption = "&OK"
frmPassword.Show 1
If frmPassword.StatoPassword = False Then GoTo Fine
End If
lstLibretto.Clear
Do While EOF(1) = False
Get 1#, , Dati
AggiungiALista Dati.Data, CStr(Dati.Denaro), Dati.Commento, lstLibretto.ListCount
Loop
If lstLibretto.ListCount <> 0 Then lstLibretto.RemoveItem lstLibretto.ListCount - 1
Modifica = False
Fine:
Close
End Sub
Private Sub flEsci_Click()
If ControlloUscita = False Then End
End Sub
Private Sub flNuovo_Click()
If ControlloModifica = vbCancel Then Exit Sub
txtData = ""
txtDenaro = ""
txtCommento = ""
lstLibretto.Clear
End Sub
Private Sub flSalva_Click()
If XCorso = "" Then
flSalvaNome_Click
Exit Sub
End If
Salva XCorso
End Sub
Private Sub flSalvaNome_Click()
CDialog.ShowSave
If CDialog.CancelError = True Then Exit Sub
XCorso = CDialog.FileName
Salva XCorso
End Sub
Private Sub flStampa_Click()
Dim I As Integer
CDialogTxt.ShowSave
If CDialogTxt.CancelError = True Then Exit Sub
Open CDialogTxt.FileName For Output As 1
Print #1, "LIBRETTO CONTABILE DI: " & Nome & vbTab & "AMMONTARE: " & Ammontare
Print #1, vbCrLf
For I = 0 To lstLibretto.ListCount - 1
Print #1, lstLibretto.List(I)
Next I
Print #1, vbCrLf
Print #1, "Per una migliore visualizzazione del testo si consiglia di utilizzare il caratte: ""Courier New"""
Close
End Sub
'FORM ###############################################################################################################
Private Sub Form_Load()
Me.Hide
frmIntestazioneLibretto.Show
lstLibretto_LostFocus
End Sub
Private Sub Form_Unload(Cancel As Integer)
If ControlloUscita = True Then Cancel = 1
End Sub
'LISTA #############################################################################################################
Private Sub lstLibretto_Click()
Dim Dati() As String
Dati = Split(lstLibretto.List(lstLibretto.ListIndex), vbTab)
txtData = Dati(0)
txtDenaro = Dati(1)
txtCommento = Dati(2)
End Sub
Private Sub lstLibretto_GotFocus()
cmdElimina.Enabled = True
cmdInserisci.Enabled = True
cmdModifica.Enabled = True
If lstLibretto.ListIndex = -1 Then lstLibretto_LostFocus
End Sub
Private Sub lstLibretto_LostFocus()
cmdElimina.Enabled = False
cmdInserisci.Enabled = False
cmdModifica.Enabled = False
If lstLibretto.ListIndex <> -1 Then lstLibretto_GotFocus
End Sub
'MENU ##############################################################################################################
Private Sub pasElimina_Click()
frmPassword.cmdAzione.Caption = "Elimina Password"
frmPassword.Show 1
End Sub
Private Sub pasInserisci_Click()
If Password <> "" Then
MsgBox "Password già esistente!" & vbCrLf & "Prima impostare una nuova password eliminare quella esistente" & vbCrLf & vbCrLf & "In caso di dimenticanza della password contattare il fornitore del programma", vbExclamation
Exit Sub
End If
frmPassword.cmdAzione.Caption = "Inserisci Password"
frmPassword.lblPassword.Visible = True
frmPassword.txtPassword(1).Visible = True
frmPassword.Show 1
End Sub
Private Sub modNome_Click()
Nome = InputBox("Inserisci il nuovo nome dell' intestatario del Libretto", , Nome)
lblNome.Caption = "Intestatario libretto: " & Nome
Modifica = True
End Sub
