ORDERING / ORDINAMENTO

[form]
Option Explicit

Private Sub Command1_Click()
ControlFile "\scores.txt"
ReadeR
End Sub

Private Sub Command2_Click()
ControlFile "\scores.txt"
WriteR (Split(Text1.Text, " ")(0)), (Split(Text1.Text, " ")(1))
End Sub
[end]

[Module]
Option Explicit

Public Type Scores
    Id As Integer
    User As String
    Point As Integer
End Type
Dim LstPoint(0 To 256) As Scores

Public Function ReadeR(Optional str As String, Optional N As Integer)
On Error GoTo e
Dim LetturaDati As String
Dim lItem As ListItem
Dim i, J As Integer
i = Main.LP.ListItems.Count
Open App.Path & "\scores.txt" For Input As #1
    Main.LP.ListItems.Clear
    Do While Not (EOF(1))
        Line Input #1, LetturaDati
        LstPoint(i).Id = Split(LetturaDati, " ")(0)
        LstPoint(i).User = Split(LetturaDati, " ")(1)
        LstPoint(i).Point = Split(Replace(LetturaDati, "  ", " "), " ")(2)
        Set lItem = Main.LP.ListItems.Add(, , LstPoint(i).Id)
            lItem.ListSubItems.Add = LstPoint(i).User
            lItem.ListSubItems.Add = LstPoint(i).Point
    Loop
Close #1
Ordina 'Function per ordinare
Exit Function
e:
MsgBox "Errore nella lettura del file, " & vbCrLf & "[" & App.Path & "\scores.txt]" & vbCrLf & "Chiusura forzata.", vbCritical, "Errore"
Close #1
End Function

Public Function WriteR(str As String, N As Integer)
Dim i As Integer
Dim lItem As ListItem
If (Main.LP.ListItems.Count < 1) Then

    Debug.Print "Dati lista < 1"
    Open App.Path & "\scores.txt" For Output As #1
        Print #1, Main.LP.ListItems.Count & " " & str & " " & N
    Close #1

Else

    If (ControlClone(str, N) = False) Then 'Effettua controllo se cloni
    
        Debug.Print "Clone Rilevato. Sostituzione valori..."
        
        Open App.Path & "\scores.txt" For Output As #1
            For i = 1 To Main.LP.ListItems.Count
                Print #1, LstPoint(i).Id & " " & LstPoint(i).User & " " & LstPoint(i).Point
            Next i
        Close #1
        
    Else
    
        Debug.Print "Clone non rilevato..."
        
        Open App.Path & "\scores.txt" For Append As #1
            Print #1, Main.LP.ListItems.Count & " " & str & " " & N
        Close #1

    End If
End If
ReadeR 'Carica Nuovi dati
End Function

Public Function ControlClone(str As String, Score As Integer) As Boolean
ReadeR 'Carica dati
Dim i As Integer

For i = 1 To Main.LP.ListItems.Count
    Debug.Print i
    LstPoint(i).Id = i
    LstPoint(i).User = Main.LP.ListItems(i).ListSubItems(1).Text
    LstPoint(i).Point = Int(Main.LP.ListItems(i).ListSubItems(2).Text)
Next i

    For i = 1 To Main.LP.ListItems.Count
        If (LCase(str) = LCase(LstPoint(i).User)) Then
            LstPoint(i).Point = LstPoint(i).Point + Score
            Main.LP.ListItems(i).ListSubItems(2).Text = LstPoint(i).Point
            Main.LP.Refresh
            ControlClone = False 'Controllo negativo. Clone rilevato
            Exit Function

        Else

            ControlClone = True 'Controllo positivo
            
        End If
    Next i
End Function

Function FileExists(Path As String) As Boolean
On Error GoTo e
Dim FL As Long
FL = FileLen(Path)
FileExists = True
e:
End Function

Public Function MkFiles(Path As String)
Open App.Path & Path For Output As #1
Close #1
End Function

Public Function ControlFile(Path As String)
If FileExists(App.Path & Path) = True Then
    Exit Function
Else
    MkFiles (Path)
End If
End Function

Sub Ordina()
Dim i, J, Temp As Integer
Dim Name As String

For i = Main.LP.ListItems.Count - 1 To 1 Step -1
  For J = 1 To i
  
  If Int(Main.LP.ListItems(J).ListSubItems(2).Text) < Int(Main.LP.ListItems(J + 1).ListSubItems(2).Text) Then
     
     Name = Main.LP.ListItems(J).ListSubItems(1).Text
     Temp = Main.LP.ListItems(J).ListSubItems(2).Text
     Main.LP.ListItems(J).ListSubItems(1).Text = Main.LP.ListItems(J + 1).ListSubItems(1).Text
     Main.LP.ListItems(J).ListSubItems(2).Text = Main.LP.ListItems(J + 1).ListSubItems(2).Text
     Main.LP.ListItems(J + 1).ListSubItems(1).Text = Name
     Main.LP.ListItems(J + 1).ListSubItems(2).Text = Temp
  
  End If
  
  Next J
Next i

For i = 1 To Main.LP.ListItems.Count
    
    Main.LP.ListItems(i).Text = i

Next i
End Sub
[end]

Télécharger le zip