求助！！歌咏比赛的评分系统代码
提示: 作者被禁止或删除 内容自动屏蔽
回复 楼主 babycy
代码还有一点小问题.form1
程序代码：Option Explicit
Private Sub Command1_Click()
Load Form3 '显示大屏,为报分数做准备
Form3.显示
Form3.Show vbModal
Command2.Default = True '设置增加为默认按钮
End Sub
Private Sub Command2_Click()
'显示增加分数的
Form2.Show vbModal
End Sub
Private Sub Command3_Click()
'保存分数
Dim file As String
CommonDialog1.Filter = "CSV文件|*.csv"
CommonDialog1.ShowSave
If CommonDialog1.FileName <> "" Then
file = CommonDialog1.FileName
Else
Exit Sub
End If
Dim i As Long, j As Long
Open file For Output As #1
Print #1, "序号,姓名,总分,平均分,排名,";
For i = 1 To 评委数
Print #1, "第"; i; "号评委,";
Next i
Print #1,
For j = 1 To 选手数
With 选手(j)
Print #1, .编号; ","; .姓名; ","; .总数; ","; .平均分; ","; .排名; ",";
For i = 1 To 评委数
Print #1, .小分(i); ",";
Next i
Print #1,
End With
Next j
Close #1
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim j As String, i As Long
Dim lt As ListItem
'要求输入评委数
j = InputBox("请输入有几位评委", "评委数", 9)
Do
If IsNumeric(j) Then
评委数 = CLng(j)
Exit Do
Else
j = InputBox("请输入有几位评委", "评委数", 9)
End If
Loop
'要求输入选手数
j = InputBox("请输入有几位参赛选手", "选手数", 20)
Do
If IsNumeric(j) Then
选手数 = CLng(j)
Exit Do
Else
j = InputBox("请输入有几位参赛选手", "选手数", 20)
End If
Loop
'生成列标题
ListView1.ColumnHeaders.Add , , "编号", 800
ListView1.ColumnHeaders.Add , , "姓名", 1440
ListView1.ColumnHeaders.Add , , "总分", 1200
ListView1.ColumnHeaders.Add , , "平均分", 1200
ListView1.ColumnHeaders.Add , , "排名", 800
For i = 1 To 评委数
ListView1.ColumnHeaders.Add , , "第" & i & "评委", 1200
Next i
'生成选手数据及显示的行
ReDim 选手(选手数)
For i = 1 To 选手数
ReDim 选手(i).小分(评委数)
选手(i).编号 = i
Set lt = ListView1.ListItems.Add
lt.Text = i
Next i
Set ListView1.SelectedItem = ListView1.ListItems(1)
选手号 = 1
End Sub
Private Sub Form_Resize()
'随窗口变化大小
On Error Resume Next
'数据区
ListView1.Move 120, 120, Me.ScaleWidth - 240, Me.ScaleHeight - 640
'四个按钮
Command1.Move Me.ScaleWidth - 6400, Me.ScaleHeight - 480
Command2.Move Me.ScaleWidth - 4800, Me.ScaleHeight - 480
Command3.Move Me.ScaleWidth - 3200, Me.ScaleHeight - 480
Command4.Move Me.ScaleWidth - 1600, Me.ScaleHeight - 480
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
选手号 = Item.Text '单击选中行,确定选中的选手
End Sub
Public Sub 保存数据()
Dim lt As ListItem
Dim i As Long
Dim j As Single
Dim k As Single
Dim o As Long
Dim m As Long
'更新当前选手号的数据,数据是在 form2 中输入或其它来的
Set lt = ListView1.SelectedItem
lt.SubItems(1) = 选手(选手号).姓名
lt.SubItems(2) = 选手(选手号).总数
lt.SubItems(3) = 选手(选手号).平均分
'显示小分
For i = 1 To 评委数
lt.SubItems(4 + i) = 选手(选手号).小分(i)
Next i
'计算名次
For i = 1 To 选手数
If 选手(i).总数 > 0 Then
o = 0
For m = 1 To 选手数
If 选手(i).总数 < 选手(m).总数 Then
o = o + 1
End If
Next m
选手(i).排名 = o + 1
ListView1.ListItems(i).SubItems(4) = 选手(i).排名
End If
Next i
'显示大屏,为报分作准备
Load Form3
Form3.显示
Form3.Show vbModal
'设置下一个选手号,为下一次输入作准备
If 选手号 < 选手数 + 1 Then
选手号 = 选手号 + 1
Set ListView1.SelectedItem = ListView1.ListItems(选手号)
ListView1.SetFocus
Else
MsgBox "所有的选手的分数均又录入,请查看得分情况"
End If
End Sub
form2
程序代码：Option Explicit
Private Sub Command1_Click()
Dim i As Long, j As Single
Dim k1 As Long, k2 As Long
选手(选手号).姓名 = Form2.Text1
选手(选手号).最低分 = 1
选手(选手号).最高分 = 1
For i = 1 To 评委数
选手(选手号).小分(i) = Val(TextFS(i - 1)) '保存分数
If 选手(选手号).小分(选手(选手号).最低分) > 选手(选手号).小分(i) Then 'k1 为最低分
选手(选手号).最低分 = i
End If
If 选手(选手号).小分(选手(选手号).最高分) < 选手(选手号).小分(i) Then 'k1 为最低分
选手(选手号).最高分 = i
End If
Next i
For i = 1 To 评委数
If i <> 选手(选手号).最高分 And i <> 选手(选手号).最低分 Then
j = j + 选手(选手号).小分(i)
End If
Next i
选手(选手号).总数 = j
选手(选手号).平均分 = Round(j / 评委数, 2)
Me.Hide
Call Form1.保存数据
Unload Me
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
'me.Height =
Dim i As Long, j As Long
i = Me.Height - Me.ScaleHeight '差
j = 600 + 480 * 评委数
Me.Height = i + j
For i = 1 To 评委数 - 1
Load LabelB(i)
LabelB(i).Top = LabelB(i - 1).Top + 480
LabelB(i).Caption = "第 " & i + 1 & " 位评委"
LabelB(i).Visible = True
LabelB(i).TabIndex = 2 + i * 2
Load TextFS(i)
TextFS(i).Top = TextFS(i - 1).Top + 480
TextFS(i).Visible = True
TextFS(i).TabIndex = 3 + i * 2
Next i
Label1.Caption = "第 " & 选手号 & " 号选手"
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
TextFS(0).SetFocus
End If
End Sub
Private Sub TextFS_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
If Index < 评委数 - 1 Then
TextFS(Index + 1).SetFocus
Else
Call Command1_Click '确定
End If
End If
End Sub
form3
程序代码：Option Explicit
Const 边距 = 500
Const 间距 = 1000
Public Sub 显示()
Me.Font.Size = 32
Me.CurrentX = 边距
Me.CurrentY = 边距
Me.ForeColor = vbBlack
Print "第";
Me.ForeColor = vbRed
Print 选手号;
Me.ForeColor = vbBlack
Print "号选手 ";
Me.ForeColor = vbRed
Print 选手(选手号).姓名
Me.CurrentX = 边距
Me.CurrentY = 边距 + 间距
Me.ForeColor = vbBlack
Print "去掉一个最高分:";
Me.ForeColor = vbRed
Print 选手(选手号).小分(选手(选手号).最高分)
Me.CurrentX = 边距
Me.CurrentY = 边距 + 间距 * 2
Me.ForeColor = vbBlack
Print "去掉一个最低分:";
Me.ForeColor = vbRed
Print 选手(选手号).小分(选手(选手号).最低分)
Me.CurrentX = 边距
Me.CurrentY = 边距 + 间距 * 3
Me.ForeColor = vbBlack
Print "第";
Me.ForeColor = vbRed
Print 选手号;
Me.ForeColor = vbBlack
Print "号选手最后得分:";
Me.ForeColor = vbRed
Print 选手(选手号).平均分
Me.CurrentX = 边距
Me.CurrentY = 边距 + 间距 * 4
Me.ForeColor = vbBlack
Print "目前排在第";
Me.ForeColor = vbRed
Print 选手(选手号).排名;
Me.ForeColor = vbBlack
Print "名"
End Sub
Private Sub Form_Click()
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Unload Me
End Sub
模块
程序代码：Option Explicit
Public 评委数 As Long
Public 选手数 As Long
Public 选手号 As Long
Public Type 选手分数类型
姓名 As String
编号 As Long
总数 As Single
平均分 As Single
小分() As Single
排名 As Long
最低分 As Long
最高分 As Long
End Type
Public 选手() As 选手分数类型
评分.rar
(5.31 KB)
---------------------------------------------------
为什么我就上传不了图片呢???
