GESTIONE REGISTRAZIONI

Option Explicit



Public gstrMess As String
Public gstrTitle As String
Public gintStyle As Integer

Dim mstrSite(1 To 100) As String

Dim mstrName(1 To 100) As String
Dim mstrUtente(1 To 100) As String
Dim mstrPass(1 To 100) As String
Dim mstrEmail(1 To 100) As String

Dim LI As ListItem

Private Sub cmdEdit_Click()
On Error Resume Next
    Dim X, Y As Integer
    
    Y = 0
    For X = 0 To 3
        If txtsite(X).Text = "" Then
            Y = Y + 1
        End If
    Next X
    If Y <> 0 Then
        gstrMess = "Nessun elemento selezionato oppure campi vuoti"
        gstrTitle = "Error...Edita "
        gintStyle = gStyle
        MsgBox gstrMess, gintStyle, gstrTitle
        Exit Sub
    End If

    Set LI = lvSites.ListItems(lblKey.Caption)
    LI.Text = txtsite(0).Text
    LI.SubItems(1) = txtsite(1).Text
    LI.SubItems(2) = txtsite(2).Text
    LI.SubItems(3) = txtsite(3).Text

    Call proClearFields

End Sub


Private Sub cmdDelete_Click()
On Error Resume Next
    Dim X, Y As Integer

    
    Y = 0
    For X = 0 To 1
        If txtsite(X).Text = "" Then
            Y = Y + 1
        End If
    Next X
    If Y <> 0 Then
        gstrMess = "Selezionare un nome nell' elenco."
        gstrTitle = "Error...Rimuovi"
        gintStyle = gStyle
        MsgBox gstrMess, gintStyle, gstrTitle
        Exit Sub
    End If
    lvSites.ListItems.Remove (lblKey.Caption)
    
    Call proClearFields
End Sub


Private Sub cmdAdd_Click()
On Error Resume Next
    Dim X, Y As Integer
    
    Y = 0
    For X = 0 To 1
        If txtsite(X).Text = "" Then
            Y = Y + 1
        End If
    Next X
    If Y <> 0 Then
        gstrMess = "Riempire i campi vuoti."
        gstrTitle = "Error...Aggiungi "
        gintStyle = gStyle
        MsgBox gstrMess, gintStyle, gstrTitle
        Exit Sub
    End If

    Set LI = lvSites.ListItems.Add()
    LI.Text = txtsite(0).Text
    LI.SubItems(1) = txtsite(1).Text
    LI.SubItems(2) = txtsite(2).Text
    LI.SubItems(3) = txtsite(3).Text
    
    Call proClearFields
End Sub



Private Sub cmdDown_Click()
On Error Resume Next
    Dim X As Integer
    Dim strSite(0 To 4) As String
    If lvSites.SelectedItem.Index = lvSites.ListItems.Count Then
        Set lvSites.DropHighlight = lvSites.SelectedItem
    Else
        X = lvSites.SelectedItem.Index
        strSite(0) = lvSites.SelectedItem.Key
        strSite(1) = lvSites.SelectedItem.Text
        strSite(2) = lvSites.SelectedItem.SubItems(1)
        strSite(3) = lvSites.SelectedItem.SubItems(2)
        strSite(4) = lvSites.SelectedItem.SubItems(3)
        lvSites.ListItems.Remove X
        Set LI = lvSites.ListItems.Add(X + 1, strSite(0), strSite(1))
        LI.SubItems(1) = strSite(2)
        LI.SubItems(2) = strSite(3)
        LI.SubItems(3) = strSite(4)
        Set lvSites.SelectedItem = lvSites.ListItems(X + 1)
        Set lvSites.DropHighlight = lvSites.SelectedItem
    End If
End Sub


Private Sub cmdUp_Click()
On Error Resume Next
    Dim X As Integer
    Dim strSite(0 To 4) As String
    If lvSites.SelectedItem.Index = 1 Then
        Set lvSites.DropHighlight = lvSites.SelectedItem
    Else
        X = lvSites.SelectedItem.Index
        strSite(0) = lvSites.SelectedItem.Key
        strSite(1) = lvSites.SelectedItem.Text
        strSite(2) = lvSites.SelectedItem.SubItems(1)
        strSite(3) = lvSites.SelectedItem.SubItems(2)
        strSite(4) = lvSites.SelectedItem.SubItems(3)
        lvSites.ListItems.Remove X
        Set LI = lvSites.ListItems.Add(X - 1, strSite(0), strSite(1))
        LI.SubItems(1) = strSite(2)
        LI.SubItems(2) = strSite(3)
        LI.SubItems(3) = strSite(4)
        Set lvSites.SelectedItem = lvSites.ListItems(X - 1)
        Set lvSites.DropHighlight = lvSites.SelectedItem
    End If
End Sub

Private Sub Command1_Click()
    Call proClearFields
End Sub

Private Sub Form_Load()
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2
    
    Call GetSitesList
End Sub


Public Sub GetSitesList()

    Dim X, Y, intFree As Integer
    
   
    
    intFree = FreeFile
    X = 1
    Open App.Path & "\Sites.dat" For Input As #intFree
        Do Until EOF(intFree)
            Input #intFree, mstrName(X), mstrUtente(X), mstrPass(X), mstrEmail(X)
            X = X + 1
        Loop
    Close
    
    lvSites.ListItems.Clear
    For Y = 1 To X - 1
        Set LI = lvSites.ListItems.Add()
        LI.Key = CStr(Y & "A")
        LI.Text = mstrName(Y)
        LI.SubItems(1) = mstrUtente(Y)
        LI.SubItems(2) = mstrPass(Y)
        LI.SubItems(3) = mstrEmail(Y)
    Next Y
    
    Call proClearFields

    
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim X, intFree As Integer
    intFree = FreeFile
    
    Open App.Path & "\Sites.dat" For Output As #intFree
    For X = 1 To lvSites.ListItems.Count
        Write #intFree, lvSites.ListItems(X).Text, lvSites.ListItems(X).SubItems(1), lvSites.ListItems(X).SubItems(2), lvSites.ListItems(X).SubItems(3)
    Next X

End Sub


Private Sub lvSites_Click()
    txtsite(0).Text = lvSites.SelectedItem.Text
    txtsite(1).Text = lvSites.SelectedItem.SubItems(1)
    txtsite(2).Text = lvSites.SelectedItem.SubItems(2)
    txtsite(3).Text = lvSites.SelectedItem.SubItems(3)
    lblKey.Caption = lvSites.SelectedItem.Key
End Sub

Public Sub proClearFields()
    Dim Y As Integer
    
    For Y = 0 To 3
        txtsite(Y).Text = ""
    Next Y
    lblKey.Caption = ""
End Sub



Private Sub cmdClose_Click()
     gstrMess = "Gestione registrazioni by Stefano (CH)"
        gstrTitle = "Gestione registrazioni"
        gintStyle = gStyle
        MsgBox gstrMess, gintStyle, gstrTitle
    Unload Me
End Sub

---------------------------------------------------------------
.BAS


Option Explicit




Public gstrMess As String
Public gstrTitle As String
Public gintStyle As Integer
Public Const gStyle = vbOKOnly + vbApplicationModal + vbExclamation + vbDefaultButton1

Télécharger le zip