Option Explicit

Declare Function GetPrivateProfileString Lib "kernel32" Alias _
      "GetPrivateProfileStringA" (ByVal lpApplicationName _
      As String, ByVal lpKeyName As Any, ByVal lpDefault _
      As String, ByVal lpReturnedString As String, ByVal nSize _
      As Long, ByVal lpFileName As String) As Long

Declare Function WritePrivateProfileString Lib "kernel32" Alias _
      "WritePrivateProfileStringA" (ByVal lpApplicationName _
      As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
      ByVal lpFileName As String) As Long

'Lesen / Schreiben
Public iSection As String 'Sektion
Public iKey As String     'Schlüssel
Public iValue As String   'Wert
Public iR As Long         'Variable zum einlesen
Public iW As Long         'Variable zu schreiben
Public dt As String       'DefaultText wenn kein Wert

Option Explicit

Dim i As Integer
Dim idx As Integer
Dim PunkteHöher As Boolean
Dim ListPos As Integer
Dim PunkteDummy As Long
Dim oldPunkteDummy As Long
Dim oldNameDummy As String
Dim newPunkteDummy As Long
Dim newNameDummy As String

Private Sub Form_Load()
  'Highscore laden
  Call HighScoreLaden
End Sub

Private Sub cmdEintragen_Click()
  'Punkte eintragen
  Call PunkteEintragen
End Sub

Private Sub cmdPrüfen_Click()
  'Prüfen ob Punkte ausreichen
  Call HighScorePrüfen
End Sub

Private Sub cmdPrüfenEintragen_Click()
  'Punkte prüfen und eintragen
  Call HighScorePrüfen
  If PunkteHöher = True Then Call PunkteEintragen
End Sub

Private Sub HighScoreLaden()
  On Error Resume Next
  For i = 0 To 11
  'Name einlesen
    iSection = "NAMEN"
    iKey = "name" & i
    iValue = Space$(20)
    iR = GetPrivateProfileString(iSection, iKey, dt, iValue, 20, _
         App.Path & "\HighScore.ini")
    lblName(i).Caption = Left$(iValue, iR)

  'Punkte einlesen
    iSection = "PUNKTE"
    iKey = "score" & i
    iValue = Space$(20)
    iR = GetPrivateProfileString(iSection, iKey, dt, iValue, 20, _
         App.Path & "\HighScore.ini")
    lblPunkte(i).Caption = Left$(iValue, iR)
  Next i
End Sub

Private Sub HighScorePrüfen()
  On Error Resume Next
  'Prüfen ob Punkte ausreichen
  PunkteHöher = False
  PunkteDummy = txtPunkte.Text
  For i = 0 To 11
    If PunkteDummy > CLng(lblPunkte(i)) Then
      PunkteHöher = True
      ListPos = i
      Exit For
    End If
  Next i

  'Auswerten
  If PunkteHöher = True Then
    MsgBox "Neuer Highscore ! Bitte tragen Sie sich ein."
    cmdEintragen.Enabled = True
  Else
    MsgBox "Da müssen Sie wohl noch etwas besser werden !"
  End If
End Sub

Private Sub PunkteEintragen()
  On Error Resume Next
  'Neue Punktzahl eintragen
  newPunkteDummy = PunkteDummy
  newNameDummy = txtName.Text
  For i = ListPos To 11
    oldPunkteDummy = CLng(lblPunkte(i).Caption)
    oldNameDummy = lblName(i).Caption
    lblName(i).Caption = newNameDummy
    lblPunkte(i).Caption = newPunkteDummy
    newNameDummy = oldNameDummy
    newPunkteDummy = oldPunkteDummy
  Next i

  'Highscore speichern
  Call HighScoreSichern
End Sub

Private Sub HighScoreSichern()
  On Error Resume Next
  'Sichern der Einträge
  For i = 0 To 11
  'Name schreiben
    iSection = "NAMEN"
    iKey = "name" & i
    iValue = lblName(i)
    iW = WritePrivateProfileString(iSection, iKey, iValue, _
         App.Path & "\HighScore.ini")

  'Punkte schreiben
    iSection = "PUNKTE"
    iKey = "score" & i
    iValue = lblPunkte(i)
    iW = WritePrivateProfileString(iSection, iKey, iValue, _
         App.Path & "\HighScore.ini")
  Next i
End Sub

Private Sub lblName_Click(Index As Integer)
  'Liste bearbeiten
  idx = Index
  For i = 0 To 11
    lblName(i).BackColor = &H8000000F
    lblPunkte(i).BackColor = &H8000000F
  Next i
  lblName(Index).BackColor = vbRed
  lblPunkte(Index).BackColor = vbRed
  Me.PopupMenu mnPopUp, , (lblName(Index).Left + 120), _
               (lblName(Index).Top + 60)
End Sub

Private Sub mnAbbrechen_Click()
  'Liste bearbeiten abbrechen
  lblName(idx).BackColor = &H8000000F
  lblPunkte(idx).BackColor = &H8000000F
End Sub

Private Sub mnAlleLöschen_Click()
  'Alle Einträge löschen
  For i = 0 To 11
    lblName(i) = "KEIN EINTRAG"
    lblPunkte(i) = "0"
    lblName(i).BackColor = &H8000000F
    lblPunkte(i).BackColor = &H8000000F
  Next i

  Call HighScoreSichern
End Sub

Private Sub mnEintragLöschen_Click()
  On Error Resume Next
  'Gewählten Eintrag löschen
  lblName(idx).Caption = ""
  lblPunkte(idx).Caption = ""
  For i = idx To 11
    lblName(i).Caption = lblName(i + 1).Caption
    lblPunkte(i).Caption = lblPunkte(i + 1).Caption
    lblName(i).BackColor = &H8000000F
    lblPunkte(i).BackColor = &H8000000F
  Next i

  Call HighScoreSichern
End Sub

Private Sub txtPunkte_Change()
  cmdEintragen.Enabled = False
End Sub