Option Explicit
Public linea As String
Public cont As Integer
Public i As Integer
Public Sub init()
'procedura che pulisce tutte le caselle di testo"
'all'apertura del form si carica un suono
'il tasto salva è disabilitato
Dim n As Integer
Frmagenda.BackColor = vbGreen
suono.FileName = App.path & "\drin.wav"
n = FreeFile
Txtnome.Text = ""
Txtcognome.Text = ""
Txttelefono.Text = ""
Txtnumero.Text = ""
Txtcognome.TabIndex = 1
Txtnome.TabIndex = 2
Txttelefono.TabIndex = 3
Txtnumero.TabIndex = 4
Cmdsalva.Enabled = False
optnome.Visible = False
optcognome.Visible = False
Cmdtrovaper.Visible = False
End Sub
Private Sub cmdesci_Click()
If MsgBox("Sei sicuro di voler abbandonare il programma?", vbQuestion + vbYesNoCancel, "Esci") = vbYes Then
End
End If
End Sub
Private Sub cmdmod_Click()
'questa procedura mette nella posizione corrente del record
'l'elemento selezionato dall'utente nella lista'
'mette il contenuto della riga nella 3 caselle di testo
'disabilita il bottone modifica
'Dim space As String, contatto As String
'Dim numero As Integer
'numero = FreeFile
'space = " "
'With contatti(cont)
'.cognome = Trim(LCase(Txtcognome.Text))
'.nome = Trim(LCase(Txtnome.Text))
'.tel = Trim(LCase(Txttelefono)) & " \ " & Trim(LCase(Txtnumero.Text))
' End With
'Open path For Append As #numero
'Print #numero, contatto
'Close #numero
'Txtnumero.Text = ""
'Txtcognome.Text = ""
'Txtnome.Text = ""
'Txttelefono.Text = ""
'cmdmod.Visible = False
End Sub
Private Sub Cmdsalva_Click()
'salva il contenuto delle caselle di testo
'lo scrive in coda al file'
'pulisce le caselle di testo
Dim space As String, contatto As String
Dim numero As Integer
numero = FreeFile
space = " "
If MsgBox("Sei sicuro di salvare il contatto?", vbQuestion + vbYesNoCancel, "&Salva") = vbYes Then
cont = cont + 1
Lblcancella.Enabled = True
ReDim Preserve contatti(1 To cont) As lista
With contatti(cont)
.cognome = Trim(LCase(Txtcognome.Text))
.nome = Trim(LCase(Txtnome.Text))
.tel = Trim(LCase(Txttelefono)) & " \ " & Trim(LCase(Txtnumero.Text))
End With
contatto = contatti(cont).cognome & contatti(cont).nome _
& contatti(cont).tel
listagenda.AddItem contatto
Label1.Visible = True
Label2.Visible = True
Label3.Visible = True
listagenda.Visible = True
Open path For Append As #numero
Print #numero, contatto
Close #numero
Txtnumero.Text = ""
Txtcognome.Text = ""
Txtnome.Text = ""
Txttelefono.Text = ""
Else
Exit Sub
End If
End Sub
Private Sub Cmdtrovaper_Click()
'cambia la proprietà caption del form trova
' a seconda della selezione dell'utente
If optnome.Value = True Then
Frmtrova.Caption = "Trova Nome"
Else
Frmtrova.Caption = "Trova Cognome"
End If
Frmtrova.Show
End Sub
Private Sub cmdvedi_Click()
'legge il contenuto del file
'e lo scrive nella textbox del form contatti
Dim nu As Integer, line As String, c As Integer
Dim tline As String
nu = FreeFile
Open path For Input As #nu
While Not EOF(nu)
Line Input #nu, line
Frmcontatti.Txtlista.Text = Frmcontatti.Txtlista.Text & line
Wend
Close #nu
If Trim(Frmcontatti.Txtlista.Text) <> "" Then
Frmcontatti.Show
Frmagenda.Enabled = False
Else
MsgBox "La lista è vuota!", vbInformation, "Lista vuota"
End If
End Sub
Private Sub Form_Load()
'percorso del file
'e procedura iniziale
path = "c:\agenda.dat"
Open path For Random As #1
Close #1
Call init
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If MsgBox("Sei sicuro di voler abbandonare il programma?", vbQuestion + vbYesNoCancel, "Esci") = vbYes Then
End
Else
Cancel = True
End If
End Sub
Private Sub Lblcancella_Click()
'cancella l'elemento selezionato dall'utente
'ed aggiorna il file riscrivendolo senza l'elemento eliminato
Dim numero3 As Integer
Dim r As Integer, j As Integer
If listagenda.ListIndex <> -1 And listagenda.ListCount <> 0 Then
r = MsgBox("Sei sicuro di voler eliminare l'elemento selezionato?", vbQuestion + vbYesNo, "Elimina file")
If r = vbYes Then
listagenda.RemoveItem listagenda.ListIndex
numero3 = FreeFile
Open path For Output As #numero3
For j = 0 To (listagenda.ListCount - 1)
Print #numero3, listagenda.List(j)
Next j
Close #numero3
End If
End If
End Sub
Private Sub Lblinserisci_Click()
Call init
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
listagenda.Visible = False
Txtcognome.SetFocus
End Sub
Private Sub Lblmodifica_Click()
Dim newriga As String, b As Integer, j As Integer
Dim lines As String, co As Integer
Dim lista2 As String, lines2 As String, l As String
Dim numero6 As Integer
numero6 = FreeFile
Cmdsalva.Enabled = False
Lblcancella.Enabled = False
cont = cont + 1
ReDim Preserve contatti(1 To cont) As lista
With contatti(cont)
.cognome = Trim(LCase(Txtcognome.Text))
.nome = Trim(LCase(Txtnome.Text))
.tel = Trim(LCase(Txttelefono.Text)) & " \ " & Trim(LCase(Txtnumero.Text))
End With
newriga = contatti(cont).cognome & contatti(cont).nome & contatti(cont).tel
Frmagenda.listagenda.List(listagenda.ListIndex) = newriga
cont = 0
Open path For Input As #numero6
Line Input #numero6, l
cont = cont + 1
ReDim Preserve contatti(1 To cont) As lista
With contatti(cont)
.cognome = Trim(LCase(Txtcognome.Text))
.nome = Trim(LCase(Txtnome.Text))
.tel = Trim(LCase(Txttelefono)) & " \ " & Trim(LCase(Txtnumero.Text))
End With
Close #6
Txtnumero.Text = ""
Txttelefono.Text = ""
Txtcognome.Text = ""
Txtnome.Text = ""
Cmdsalva.Enabled = False
'cmdmod.Visible = True
End Sub
Private Sub Lbltrova_Click()
optcognome.Visible = True
optnome.Visible = True
Cmdtrovaper.Visible = True
End Sub
Private Sub Optcel_Click()
scelta = "cellulare"
Cmdtrovaper.Enabled = True
End Sub
Private Sub listagenda_Click()
Cmdsalva.Enabled = False
If Frmagenda.listagenda.ListIndex > -1 Then
Lblcancella.Enabled = True
End If
End Sub
Private Sub listagenda_DblClick()
Dim frase As String
Dim j As Integer, numer As Integer
numer = FreeFile
Cmdsalva.Enabled = False
i = Frmagenda.listagenda.ListIndex
If i > -1 Then
frase = listagenda.List(listagenda.ListIndex)
If MsgBox("Vuoi modificare il contatto?", vbQuestion + vbYesNoCancel, "Modifica") = vbYes Then
'frase = listagenda.List(listagenda.ListIndex)
Lblcancella.Enabled = False
Txtcognome.Text = Mid(frase, 1, 20)
Txtnome.Text = Mid(frase, 21, 20)
Txttelefono.Text = Trim(Mid(frase, 40, 6))
Txtnumero.Text = Trim(Mid(frase, 46, 20))
Cmdsalva.Enabled = False
Close #numer
End If
End If
End Sub
Private Sub optcognome_Click()
scelta = "cognome"
Cmdtrovaper.Enabled = True
End Sub
Private Sub optnome_Click()
scelta = "nome"
Cmdtrovaper.Enabled = True
End Sub
Private Sub Txtcognome_Change()
If Cmdsalva.Enabled = False Then
Cmdsalva.Enabled = False
End If
If Txtcognome.Text <> "" And Txtnome.Text <> "" And Txttelefono.Text <> "" And Txtnumero <> "" Then
Cmdsalva.Enabled = True
Else
Cmdsalva.Enabled = False
End If
End Sub
Private Sub Txtnome_Change()
If Cmdsalva.Enabled = False Then
Cmdsalva.Enabled = False
End If
If Txtcognome.Text <> "" And Txtnome.Text <> "" And Txttelefono.Text <> "" And Txtnumero <> "" Then
Cmdsalva.Enabled = True
Else
Cmdsalva.Enabled = False
End If
End Sub
Private Sub Txtnumero_Change()
If Cmdsalva.Enabled = False Then
Cmdsalva.Enabled = False
End If
If Not IsNumeric(Txtnumero.Text) Then
Txtnumero.Text = ""
End If
If Txtcognome.Text <> "" And Txtnome.Text <> "" And Txttelefono.Text <> "" And Txtnumero <> "" Then
Cmdsalva.Enabled = True
Else
Cmdsalva.Enabled = False
End If
End Sub
Private Sub Txtnumero_KeyDown(keycode As Integer, Shift As Integer)
Call controlkeys(keycode)
End Sub
Private Sub Txttelefono_Change()
If Cmdsalva.Enabled = False Then
Cmdsalva.Enabled = False
End If
If Not IsNumeric(Txttelefono.Text) Then
Txttelefono.Text = ""
End If
If Txtcognome.Text <> "" And Txtnome.Text <> "" And Txttelefono.Text <> "" And Txtnumero <> "" Then
Cmdsalva.Enabled = True
Else
Cmdsalva.Enabled = False
End If
End Sub
Private Sub Txttelefono_KeyDown(keycode As Integer, Shift As Integer)
Call controlkeys(keycode)
End Sub
Public Sub controlkeys(keycode)
If keycode > 47 And keycode < 58 Then
suono.FileName = App.path & "\bip.wav"
Else
Exit Sub
End If
End Sub
