Archief - [PROG][vba] hardloop programma...

Option Explicit
Dim dataarray(999, 2) As String
Dim arrayindex As Integer
Dim position As Integer

Function bsearch(lower As Integer, upper As Integer, keyfield As String) As Integer
  Dim middle As Integer
  
  middle = Fix(lower + upper) / 2
   If list1.List(middle) = keyfield Then
     bsearch = middle
     Exit Function
   End If
   If lower >= upper Then
     bsearch = -1
     Exit Function
   End If
     If keyfield < list1.List(middle) Then
       upper = middle - 1
     Else
       lower = middle + 1
     End If
     bsearch = bsearch(lower, upper, keyfield)
  
End Function

Sub clearfields()
  txt1.Text = ""
  txt2.Text = ""
  txt2.Locked = False
  txt3.Text = ""
  txt3.Locked = False
  cmddelete.Visible = False
  cmdadd.Visible = False
  cmdok.Visible = True
  cmdcancel.Visible = True
End Sub
Sub showbuttons()
  cmdok.Visible = False
  cmdcancel.Visible = False
  cmdadd.Visible = True
  cmddelete.Visible = True
  txt2.Locked = True
  txt3.Locked = True
 
End Sub

Private Sub cmdadd_Click()
  clearfields
End Sub

Private Sub cmdcancel_Click()
  showbuttons
End Sub

Private Sub cmddelete_Click()
  If list1.ListIndex < 0 Then
    MsgBox "geen item geselecteerd"
  Else
    list1.RemoveItem list1.ListIndex
  End If
End Sub

Private Sub cmdok_Click()
Dim key As String
Dim reply As Integer
  key = Trim(txt1.Text)
  If key = "" Then
    MsgBox "key field must b non empty"
    Exit Sub
  End If
  
  position = bsearch(0, list1.ListCount - 1, Trim(txt1.Text))
  If position > -1 Then
    reply = MsgBox("key exists. replace existing record?", vbYesNo)
    If reply = vbYes Then
      list1.RemoveItem position
    Else
      txt1.SetFocus
      Exit Sub
    End If
  End If
  
  arrayindex = arrayindex + 1
  list1.AddItem key
  list1.ItemData(list1.NewIndex) = arrayindex
  dataarray(arrayindex, 1) = txt2.Text
  dataarray(arrayindex, 2) = txt3.Text
  list1.ListIndex = list1.NewIndex
  showrecord
  showbuttons
End Sub

Private Sub Form_Load()
' 1ST player
    dataarray(0, 0) = "1"
    list1.AddItem dataarray(0, 0)
    dataarray(0, 1) = "Kevin"
    dataarray(0, 2) = "48"
    list1.ItemData(list1.NewIndex) = 0
' 2ND player
    dataarray(1, 0) = "2"
    list1.AddItem dataarray(1, 0)
    dataarray(1, 1) = "kristof"
    dataarray(1, 2) = "67"
    list1.ItemData(list1.NewIndex) = 1
' 3RD player
    dataarray(2, 0) = "3"
    list1.AddItem dataarray(2, 0)
    dataarray(2, 1) = "Camps"
    dataarray(2, 2) = "31"
    list1.ItemData(list1.NewIndex) = 2
End Sub

Private Sub list1_mouseup(button As Integer, shift As Integer, x As Single, y As Single)
  showrecord
End Sub

Sub showrecord()
Dim itemindex As Integer
  If list1.ListIndex < 0 Then
    txt1.Text = ""
    txt2.Text = ""
    txt3.Text = ""
    Exit Sub
  End If
   
  itemindex = list1.ItemData(list1.ListIndex)
  txt1.Text = list1.List(list1.ListIndex)
  txt2.Text = dataarray(itemindex, 1)
  txt3.Text = dataarray(itemindex, 2)
End Sub