db_explore.frm

TMS（小型票务管理VB+Access）

End Sub

Private Sub mnuproperties_Click()
properties.Show
End Sub

Private Sub mnurefresh_Click()
Call rebuild
Call func_load
End Sub

Private Sub mnutrouve_Click()
Call fct_find
End Sub
Private Sub mnufind_Click()
Call fct_find
End Sub
Private Sub mnuarrange_Click()
If mnuarrange.Checked = False Then
  ListView1.Arrange = lvwAutoLeft
  mnuarrange.Checked = True
ElseIf mnuarrange.Checked = True Then
  ListView1.Arrange = lvwNone
  mnuarrange.Checked = False
End If
End Sub

Private Sub mnuarrange2_Click()
ListView1.Arrange = lvwAutoLeft
End Sub

Private Sub mnudetails_Click()

   mnularge.Checked = False
   mnusmall.Checked = False
   mnulist.Checked = False
   mnudetails.Checked = True

ListView1.View = lvwReport

End Sub

Private Sub mnuExit_Click()
 Unload Me
End Sub

Private Sub mnularge_Click()
   mnularge.Checked = True
   mnusmall.Checked = False
   mnulist.Checked = False
   mnudetails.Checked = False
ListView1.View = lvwIcon
End Sub

Private Sub mnulist_Click()

   mnularge.Checked = False
   mnusmall.Checked = False
   mnulist.Checked = True
   mnudetails.Checked = False
 
 ListView1.View = lvwList

End Sub

Private Sub mnuplayer_Click()
 MsgBox "You will need to refresh after adding...", vbInformation, "Info"
 add_player.Show
End Sub

Private Sub mnusmall_Click()
   mnularge.Checked = False
   mnusmall.Checked = True
   mnulist.Checked = False
   mnudetails.Checked = False
ListView1.View = lvwSmallIcon
End Sub

Private Sub mnustands_Click()
Add_stands.Show
End Sub

Private Sub mnuwhat_Click()
DB_explore.WhatsThisMode
End Sub

Private Sub StatusBar1_PanelDblClick(ByVal Panel As MSComctlLib.Panel)
 StatusBar1.Panels.Item(5).text = "Maxime Gheysen"
End Sub

Private Sub Text1_Change()
 Text2.text = ""
End Sub

Private Sub tvwDB_Click()
 tvwDB.SelectedItem.CreateDragImage
tvwDB.Sorted = True

End Sub

Private Sub tvwDB_Collapse(ByVal Node As MSComctlLib.Node)
 Node.Image = "closed"
End Sub

Private Sub tvwDB_DblClick()
Call get_Properties
End Sub

Private Sub tvwDB_Expand(ByVal Node As MSComctlLib.Node)
Node.Image = "opened"
End Sub
Function get_Properties()
Dim i
Dim j As Integer
Dim var1, var2
label1.Visible = True
Label2.Visible = True
Text1.Visible = True
Text2.Visible = True
Cmd_ok.Visible = True
Text1.text = tvwDB.SelectedItem.text
If Text1.text = "Stands" Or Text1.text = "Lands" Or Text1.text = "Sponsors" _
 Or Text1.text = "Sexe" Or Text1.text = "Players" Or Text1.text = "Dates" Then
  Text2.text = "Recordset"
  frarank.Visible = False
  Datelist.Visible = False
  Exit Function
End If

'with stands
If tvwDB.Nodes(1).Expanded = True Then
frarank.Visible = False
Datelist.Visible = False
label1.Caption = "Name"
Label2.Caption = "Type"
Data1.Recordset.MoveFirst
Data1.Recordset.MoveFirst
With Data1.Recordset
For i = 1 To 100
If Text1 = !nom Then
 Text2 = !Type
 Else
 .MoveNext
End If
Next
End With
Exit Function
End If

'with pays
If tvwDB.Nodes(2).Expanded = True Then
frarank.Visible = False
Datelist.Visible = False
label1.Caption = "Land"
Label2.Caption = "ID"
Data2.Recordset.MoveFirst
Data2.Recordset.MoveFirst
With Data2.Recordset
For i = 1 To 100
If Text1 = !Pays Then
 Text2 = !ID
 Else
 .MoveNext
End If
Next
End With
End If

'with sponsor
If tvwDB.Nodes(3).Expanded = True Then
frarank.Visible = False
Datelist.Visible = False
label1.Caption = "Name"
Label2.Caption = "ID"
Data3.Recordset.MoveFirst
Data3.Recordset.MoveFirst
With Data3.Recordset
For i = 1 To 100
If Text1 = !sponsor Then
 Text2 = !ID
 Else
 .MoveNext
End If
Next
End With
End If

'with sexe
If tvwDB.Nodes(4).Expanded = True Then
frarank.Visible = False
Datelist.Visible = False
label1.Caption = "Sexe"
Label2.Caption = "ID"
Data4.Recordset.MoveFirst
Data4.Recordset.MoveFirst
With Data4.Recordset
For i = 1 To 100
If Text1 = !Sexe Then
 Text2 = !ID
 Else
 .MoveNext
End If
Next
End With
End If

'with participant_complet
If tvwDB.Nodes(5).Expanded = True Then
frarank.Visible = True
Datelist.Visible = False
label1.Caption = "Name"
Label2.Caption = "Surname"
Data5.Recordset.MoveFirst
Data5.Recordset.MoveFirst
With Data5.Recordset
For i = 1 To 100
If Text1 = !nom Then
 Text2 = !prenom
 Text3.text = !rang
 Else
 .MoveNext
End If
Next
End With
End If

'with dates
If tvwDB.Nodes(6).Expanded = True Then
frarank.Visible = False
Datelist.Visible = True
label1.Caption = "Date"
Label2.Caption = "Names"
Data6.Recordset.MoveFirst
Data6.Recordset.MoveFirst
Datelist.Clear
With Data6.Recordset
For i = 1 To 100
If Text1 = !dd_mm_yyyy Then
   Datelist.AddItem !Nom_prenom
 Else
 .MoveNext
End If
Next
End With

End If
End Function

Private Sub tvwDB_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
 Image1.OLEDropMode = 0
End Sub
Private Sub tvwDB_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If Button = 2 Then
  DB_explore.PopupMenu mnuaddnew
 End If
End Sub
Function rebuild()
  tvwDB.Nodes.Clear
  intIndex = 0
  Unload Me
  refresher.Show

 'Call func_load
End Function
Function func_load()
   Dim rsStands
   Dim rsPays
   Dim rsSponsor
   Dim rsSexe
   Dim rsParticipant_complet
   Dim rsDates
   Set rsStands = DBtennis.OpenRecordset("Stands", dbOpenDynaset)
   Set rsPays = DBtennis.OpenRecordset("Pays", dbOpenDynaset)
   Set rsSponsor = DBtennis.OpenRecordset("Sponsor", dbOpenDynaset)
   Set rsSexe = DBtennis.OpenRecordset("Sexe", dbOpenDynaset)
   Set rsParticipant_complet = DBtennis.OpenRecordset("Participant_complet", dbOpenDynaset)
   Set rsDates = DBtennis.OpenRecordset("Dates", dbOpenDynaset)

   rsStands.MoveFirst


   
   Do Until rsStands.EOF
      Set Mnode = tvwDB.Nodes.add(1, tvwChild)
      Mnode.text = rsStands!nom
      Mnode.Tag = "Stands"
      Mnode.Image = "file"
    '  Mnode.Key = CInt(rsStands!Num) & " ID"
      intIndex = Mnode.Index
      rsStands.MoveNext
   Loop
   
   rsPays.MoveFirst
   
   Do Until rsPays.EOF
      Set Mnode1 = tvwDB.Nodes.add(2, tvwChild)
      Mnode1.text = rsPays!Pays
      Mnode1.Tag = "Pays"
      Mnode1.Image = "file"
     ' Mnode1.Key = CInt(rsPays!Num) & " ID"
      intIndex = Mnode1.Index
      rsPays.MoveNext
   Loop
   
   rsSponsor.MoveFirst
   
   Do Until rsSponsor.EOF
      Set Mnode2 = tvwDB.Nodes.add(3, tvwChild)
      Mnode2.text = rsSponsor!sponsor
      Mnode2.Tag = "Sponsor"
      Mnode2.Image = "file"
      'Mnode2.Key = CInt(rsSponsor!Num) & " ID"
      intIndex = Mnode2.Index
      rsSponsor.MoveNext
   Loop
   
   rsSexe.MoveFirst
   
   Do Until rsSexe.EOF
      Set Mnode3 = tvwDB.Nodes.add(4, tvwChild)
      Mnode3.text = rsSexe!Sexe
      Mnode3.Tag = "Sexe"
      Mnode3.Image = "file"
     ' Mnode3.Key = CInt(rsSexe!Num) & " ID"
      intIndex = Mnode3.Index
      rsSexe.MoveNext
   Loop
   
   rsParticipant_complet.MoveFirst
   
   Do Until rsParticipant_complet.EOF
      Set Mnode4 = tvwDB.Nodes.add(5, tvwChild)
      Mnode4.text = rsParticipant_complet!nom
      Mnode4.Tag = "Nom"
      Mnode4.Image = "file"
     ' Mnode4.Key = CInt(rsParticipant_complet!Num) & " ID"
      intIndex = Mnode4.Index
      rsParticipant_complet.MoveNext
   Loop
   
   rsDates.MoveFirst
   
   Do Until rsDates.EOF
      Set Mnode5 = tvwDB.Nodes.add(6, tvwChild)
      Mnode5.text = rsDates!dd_mm_yyyy
      Mnode5.Tag = "Date"
      Mnode5.Image = "file"
     ' Mnode5.Key = CInt(rsDates!Num) & " ID"
      intIndex = Mnode5.Index
      rsDates.MoveNext
   Loop
   
   
   cmdload.Enabled = False

End Function
Function fct_find()
Dim mot
Dim itmX As ListItem
Dim i As Integer
mot = InputBox("Find What? :", "Find?")
Data1.Recordset.MoveFirst
 Do Until Data1.Recordset.EOF = True
   If Data1.Recordset!nom = mot Then
     Set itmX = ListView1.ListItems.add()
       itmX.text = Data1.Recordset!nom
       itmX.SubItems(1) = Data1.Recordset!Type
       itmX.SubItems(2) = Data1.Recordset!ID
       itmX.SubItems(3) = "Stand"
       itmX.Icon = 3
       itmX.SmallIcon = 3
   End If
   Data1.Recordset.MoveNext
 Loop
 Data4.Recordset.MoveFirst
 Do Until Data4.Recordset.EOF = True
   If Data4.Recordset!Sexe = mot Then
     Set itmX = ListView1.ListItems.add()
       itmX.text = Data4.Recordset!Sexe
       itmX.SubItems(1) = "Sexe ;-)"
       itmX.SubItems(2) = Data4.Recordset!ID
       itmX.Icon = 3
       itmX.SmallIcon = 3
   End If
   Data4.Recordset.MoveNext
 Loop
 Data2.Recordset.MoveFirst
 Do Until Data2.Recordset.EOF = True
   If Data2.Recordset!Pays = mot Then
     Set itmX = ListView1.ListItems.add()
       itmX.text = Data2.Recordset!Pays
       itmX.SubItems(1) = "Land"
       itmX.SubItems(2) = Data2.Recordset!ID
       itmX.Icon = 3
       itmX.SmallIcon = 3
   End If
   Data2.Recordset.MoveNext
 Loop
  Data3.Recordset.MoveFirst
 Do Until Data3.Recordset.EOF = True
   If Data3.Recordset!sponsor = mot Then
     Set itmX = ListView1.ListItems.add()
       itmX.text = Data3.Recordset!sponsor
       itmX.SubItems(1) = Data3.Recordset!atribut
       itmX.SubItems(2) = Data3.Recordset!ID
       itmX.SubItems(3) = "Official Sponsor"
       itmX.Icon = 3
       itmX.SmallIcon = 3
   End If
   Data3.Recordset.MoveNext
 Loop
End Function
Function fctDelete()
Dim mot
Dim i As Integer
mot = tvwDB.SelectedItem.text
Data1.Recordset.MoveFirst
 Do Until Data1.Recordset.EOF = True
   If Data1.Recordset!nom = mot Then
     Data1.Recordset.Delete
     Exit Function
   End If
   Data1.Recordset.MoveNext
 Loop
 Data4.Recordset.MoveFirst
 Do Until Data4.Recordset.EOF = True
   If Data4.Recordset!Sexe = mot Then
     Data4.Recordset.Delete
     Exit Function
   End If
   Data4.Recordset.MoveNext
 Loop
 Data2.Recordset.MoveFirst
 Do Until Data2.Recordset.EOF = True
   If Data2.Recordset!Pays = mot Then
     Data2.Recordset.Delete
     Exit Function
   End If
   Data2.Recordset.MoveNext
 Loop
  Data3.Recordset.MoveFirst
 Do Until Data3.Recordset.EOF = True
   If Data3.Recordset!sponsor = mot Then
     Data3.Recordset.Delete
     Exit Function
   End If
   Data3.Recordset.MoveNext
 Loop
End Function