Ordering / ordinamento

Soyez le premier à donner votre avis sur cette source.

Vue 5 256 fois - Téléchargée 559 fois

Description

Syntax:

<Record> <Number>

Component:

2 CommandButton;
1 TextBox;
1 ListView;

Source / Exemple :


[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]

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.