adtxtform.frm

NBA的部分球员

i = 0

While Data6.Recordset.Fields(2) < Val(Combo6)
    Call Command12_Click
    i = i + 1
    If i >= n Then Exit Sub
Wend

End Sub

Private Sub Command1_Click()
'球员记录：“上一条”
On Error GoTo pre_err

If ad1 = True Then
Data4.Recordset.CancelUpdate
ad1 = False
Command3.Enabled = True
Command2.Caption = "添加"
End If

If Label4.Caption = "" Then
'遍历所有记录
    Data4.Recordset.MovePrevious
Else
'遍历特定球员记录
    Call MovePreviousByID(Data4.Recordset, Val(Label4.Caption))
End If

Label11.Caption = GetName(rs1, Data4.Recordset.Fields(0))
Exit Sub

'到顶
pre_err:
    MsgBox ("记录已到顶！")
    Data4.Recordset.MoveNext
End Sub

Private Sub Command10_Click()
'添加教练记录
If ad3 Then
'处于待确定状态
    Data6.Recordset.Fields(0) = Val(Label6.Caption)
    Data6.Recordset.Fields(5) = Val(Label9.Caption) + 1
    Data6.Recordset.Update
    Data6.Recordset.Bookmark = Data6.Recordset.LastModified
    ad3 = False
    Label9.Caption = Val(Label9.Caption) + 1
    Command11.Enabled = True
    Combo5.Enabled = True
    Command10.Caption = "添加"
Else
'处于普通状态
    Command11.Enabled = False
    Combo5.Enabled = False
    Command10.Caption = "确定"
    Data6.Recordset.AddNew
    ad3 = True
End If
End Sub

Private Sub Command11_Click()
'修改教练记录
If Not judge3() Then
    MsgBox ("信息填写有误！")
Else
    On Error GoTo mferr
        
    Data6.Recordset.Edit
    Data6.Recordset.Update
    Data6.Recordset.Bookmark = Data6.Recordset.LastModified
End If

Exit Sub

mferr:
MsgBox ("修改数据无效！")
Unload Me
End Sub

Private Sub Command12_Click()
'教练记录：“下一条”
On Error GoTo next_err

If ad3 = True Then
Data6.Recordset.CancelUpdate
ad3 = False
Command11.Enabled = True
Command10.Caption = "添加"
End If

If Label6.Caption = "" Then
'遍历所有记录
    Data6.Recordset.MoveNext
Else
'遍历特定球员记录
    Call MoveNextByID(Data6.Recordset, Val(Label6.Caption))
End If

Label13.Caption = GetName(rs3, Data6.Recordset.Fields(0))
Exit Sub

'到底
next_err:
    MsgBox ("记录已到底！")
    Data6.Recordset.MovePrevious
End Sub

Private Sub Command13_Click()
'重置
Label4.Caption = ""
Label5.Caption = ""
Label6.Caption = ""

On Error GoTo 5
Data4.Recordset.MoveFirst

5:
On Error GoTo 6
Data5.Recordset.MoveFirst

6:
On Error GoTo ed
Data6.Recordset.MoveFirst

ed:
End Sub

Private Sub Command14_Click()
'退出本界面
Unload Me
End Sub

Private Sub Command2_Click()
'添加球员记录
If ad1 Then
'处于待确定状态
    Data4.Recordset.Fields(0) = Val(Label4.Caption)
    Data4.Recordset.Fields(5) = Val(Label7.Caption) + 1
    Data4.Recordset.Update
    Data4.Recordset.Bookmark = Data4.Recordset.LastModified
    ad1 = False
    Label7.Caption = Val(Label7.Caption) + 1
    Command3.Enabled = True
    Combo1.Enabled = True
    Command2.Caption = "添加"
Else
'处于普通状态
    Command3.Enabled = False
    Combo1.Enabled = False
    Command2.Caption = "确定"
    Data4.Recordset.AddNew
    ad1 = True
End If
End Sub

Private Sub Command3_Click()
'修改球员记录
If Not judge1() Then
    MsgBox ("信息填写有误！")
Else
    On Error GoTo mferr
        
    Data4.Recordset.Edit
    Data4.Recordset.Update
    Data4.Recordset.Bookmark = Data4.Recordset.LastModified
End If

Exit Sub

mferr:
MsgBox ("修改数据无效！")
Unload Me
End Sub

Private Sub Command4_Click()
'下一条球员记录
On Error GoTo next_err

If ad1 = True Then
Data4.Recordset.CancelUpdate
ad1 = False
Command3.Enabled = True
Command2.Caption = "添加"
End If

If Label4.Caption = "" Then
'遍历所有记录
    Data4.Recordset.MoveNext
Else
'遍历特定球员记录
    Call MoveNextByID(Data4.Recordset, Val(Label4.Caption))
End If

Label11.Caption = GetName(rs1, Data4.Recordset.Fields(0))
Exit Sub

'到底
next_err:
    MsgBox ("记录已到底！")
    Data4.Recordset.MovePrevious
End Sub

Private Sub Command5_Click()
'上一条球队记录
On Error GoTo pre_err

If ad2 = True Then
Data5.Recordset.CancelUpdate
ad2 = False
Command7.Enabled = True
Command6.Caption = "添加"
End If

If Label5.Caption = "" Then
'遍历所有记录
    Data5.Recordset.MovePrevious
Else
'遍历特定球员记录
    Call MovePreviousByID(Data5.Recordset, Val(Label5.Caption))
End If

Label12.Caption = GetName(rs2, Data5.Recordset.Fields(0))
Exit Sub

'到顶
pre_err:
    MsgBox ("记录已到顶！")
    Data5.Recordset.MoveNext
End Sub

Private Sub Command6_Click()
'添加球队记录
If ad2 Then
'处于待确定状态
    Data5.Recordset.Fields(0) = Val(Label5.Caption)
    Data5.Recordset.Fields(5) = Val(Label8.Caption) + 1
    Data5.Recordset.Update
    Data5.Recordset.Bookmark = Data5.Recordset.LastModified
    ad2 = False
    Label8.Caption = Val(Label8.Caption) + 1
    Command7.Enabled = True
    Combo3.Enabled = True
    Command6.Caption = "添加"
Else
'处于普通状态
    Command7.Enabled = False
    Combo3.Enabled = False
    Command6.Caption = "确定"
    Data5.Recordset.AddNew
    ad2 = True
End If
End Sub

Private Sub Command7_Click()
'修改球队记录
If Not judge2() Then
    MsgBox ("信息填写有误！")
Else
    On Error GoTo mferr
        
    Data5.Recordset.Edit
    Data5.Recordset.Update
    Data5.Recordset.Bookmark = Data5.Recordset.LastModified
End If

Exit Sub

mferr:
MsgBox ("修改数据无效！")
Unload Me
End Sub

Private Sub Command8_Click()
'下一条球队记录
On Error GoTo next_err

If ad2 = True Then
Data5.Recordset.CancelUpdate
ad2 = False
Command7.Enabled = True
Command6.Caption = "添加"
End If

If Label5.Caption = "" Then
'遍历所有记录
    Data5.Recordset.MoveNext
Else
'遍历特定球员记录
    Call MoveNextByID(Data5.Recordset, Val(Label5.Caption))
End If

Label12.Caption = GetName(rs2, Data5.Recordset.Fields(0))
Exit Sub

'到底
next_err:
    MsgBox ("记录已到底！")
    Data5.Recordset.MovePrevious
End Sub

Private Sub Command9_Click()
'上一条教练记录
On Error GoTo pre_err

If ad3 = True Then
Data6.Recordset.CancelUpdate
ad3 = False
Command11.Enabled = True
Command10.Caption = "添加"
End If

If Label6.Caption = "" Then
'遍历所有记录
    Data6.Recordset.MovePrevious
Else
'遍历特定球员记录
    Call MovePreviousByID(Data6.Recordset, Val(Label6.Caption))
End If

Label13.Caption = GetName(rs3, Data6.Recordset.Fields(0))
Exit Sub

'到顶
pre_err:
    MsgBox ("记录已到顶！")
    Data6.Recordset.MoveNext
End Sub

Private Sub Form_Load()
'检查数据库路径
If dbpath = "" Then Unload Me

'设修改状态标志位
ad1 = False
ad2 = False
ad3 = False

'打开DAO数据库
Set db = OpenDatabase(dbpath)

'建立数据集
Set rs1 = db.OpenRecordset("Player")
Set rs2 = db.OpenRecordset("Team")
Set rs3 = db.OpenRecordset("Coach")

'打开data数据库
Data4.DatabaseName = dbpath
Data5.DatabaseName = dbpath
Data6.DatabaseName = dbpath

'设立数据集且排序
Data4.RecordSource = "Select *  from Player_Text order by Year,Month,Day,ID,Index"
Data5.RecordSource = "Select *  from Team_Text order by Year,Month,Day,ID,Index"
Data6.RecordSource = "Select *  from Coach_Text order by Year,Month,Day,ID,Index"

'重置
'Call Command13_Click

'将球员信息加入条目
Do Until rs1.EOF
    Combo1.AddItem (rs1.Fields(2) & "(" & rs1.Fields(1) & ")" & "-" & str$(rs1.Fields(0)))
    rs1.MoveNext
Loop

'将球队信息加入条目
Do Until rs2.EOF
    Combo3.AddItem (rs2.Fields(2) & "(" & rs2.Fields(1) & ")" & "-" & str$(rs2.Fields(0)))
    rs2.MoveNext
Loop

'将教练信息加入条目
Do Until rs3.EOF
    Combo5.AddItem (rs3.Fields(2) & "(" & rs3.Fields(1) & ")" & "-" & str$(rs3.Fields(0)))
    rs3.MoveNext
Loop

'将时间段加入条目
Combo2.AddItem ("1950")
Combo2.AddItem ("1960")
Combo2.AddItem ("1970")
Combo2.AddItem ("1980")
Combo2.AddItem ("1990")
Combo2.AddItem ("2000")

Combo4.AddItem ("1950")
Combo4.AddItem ("1960")
Combo4.AddItem ("1970")
Combo4.AddItem ("1980")
Combo4.AddItem ("1990")
Combo4.AddItem ("2000")

Combo6.AddItem ("1950")
Combo6.AddItem ("1960")
Combo6.AddItem ("1970")
Combo6.AddItem ("1980")
Combo6.AddItem ("1990")
Combo6.AddItem ("2000")
End Sub

Private Sub Form_Unload(Cancel As Integer)
'监测修改状态位
If ad1 = True Then Data4.Recordset.CancelUpdate
If ad2 = True Then Data5.Recordset.CancelUpdate
If ad3 = True Then Data6.Recordset.CancelUpdate
End Sub


Private Function GetSum(rs As Recordset, id As Integer) As Integer
'从Recodset中求出该ID的记录条目
GetSum = 0

On Error GoTo next_err

bm = rs.Bookmark    '记录当前位置

rs.MoveFirst

While Not rs.EOF
If id Then
    If rs.Fields(0) = id Then
        GetSum = GetSum + 1
        If GetSum = 1 Then bm = rs.Bookmark
    End If
Else
    GetSum = GetSum + 1
End If
rs.MoveNext
Wend

rs.Bookmark = bm
Exit Function

next_err:
End Function

Private Sub MoveNextByID(rs As Recordset, id As Integer)
'根据ID选下一条记录
On Error GoTo next_err
bm = rs.Bookmark

rs.MoveNext
While rs.Fields(0) <> id
    rs.MoveNext
Wend

Exit Sub

next_err:
'MsgBox ("MoveNext:搜索完全部记录。")
rs.Bookmark = bm
End Sub

Private Sub MovePreviousByID(rs As Recordset, id As Integer)
'根据ID选上一条记录
On Error GoTo pre_err
bm = rs.Bookmark

rs.MovePrevious
While rs.Fields(0) <> id
    rs.MovePrevious
Wend

Exit Sub

pre_err:
'MsgBox ("MovePrevious:搜索完全部记录。")
rs.Bookmark = bm
End Sub

Private Function GetName(rs As Recordset, id As Integer) As String
If id = 0 Then
    GetName = "All"
Else
    rs.MoveFirst
    
    While rs.Fields(0) <> id
        rs.MoveNext
    Wend
    
    GetName = rs.Fields(2) & "(" & rs.Fields(1) & ")"
End If
End Function

Private Function judge1() As Boolean
judge1 = True
'具体信息规范判断待添加
End Function

Private Function judge2() As Boolean
judge2 = True
'具体信息规范判断待添加
End Function

Private Function judge3() As Boolean
judge3 = True
'具体信息规范判断待添加
End Function