-
Notifications
You must be signed in to change notification settings - Fork 1
/
frmPlayer.frm
384 lines (374 loc) · 12.7 KB
/
frmPlayer.frm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
VERSION 5.00
Begin VB.Form frmPlayer
BackColor = &H00404040&
BorderStyle = 1 'Fixed Single
Caption = "用户"
ClientHeight = 5220
ClientLeft = 45
ClientTop = 390
ClientWidth = 9840
LinkTopic = "Form3"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5220
ScaleWidth = 9840
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox txtName
Appearance = 0 'Flat
BackColor = &H00000000&
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00E0E0E0&
Height = 495
Left = 5040
TabIndex = 3
Text = "Text1"
Top = 3600
Width = 1935
End
Begin VB.ListBox lstPlayer
Appearance = 0 'Flat
BackColor = &H00000000&
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 4020
Left = 240
TabIndex = 0
Top = 240
Width = 2895
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H00404040&
Caption = "选手状态"
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 255
Left = 3240
TabIndex = 10
Top = 240
Width = 2055
End
Begin VB.Label lblBest
Appearance = 0 'Flat
BackColor = &H00000000&
Caption = "Label1"
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0C0FF&
Height = 2295
Left = 6600
TabIndex = 9
Top = 600
Width = 3015
End
Begin VB.Label lblBestName
Appearance = 0 'Flat
BackColor = &H00404040&
Caption = "状元榜"
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H008080FF&
Height = 495
Left = 6840
TabIndex = 8
Top = 240
Width = 2055
End
Begin VB.Label lblChangeName
Appearance = 0 'Flat
BackColor = &H00404040&
Caption = "更改登录密码"
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0C0C0&
Height = 495
Index = 3
Left = 6240
TabIndex = 7
Top = 4680
Width = 2055
End
Begin VB.Label lblChangeName
Appearance = 0 'Flat
BackColor = &H00404040&
Caption = "确定"
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0C0C0&
Height = 495
Index = 2
Left = 8760
TabIndex = 6
Top = 4680
Width = 855
End
Begin VB.Label lblCur
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H00404040&
Caption = "当前选中选手"
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 495
Left = 3000
TabIndex = 5
Top = 4680
Width = 2775
End
Begin VB.Label lblChangeName
Appearance = 0 'Flat
BackColor = &H00404040&
Caption = "选择高亮的选手"
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0C0C0&
Height = 495
Index = 1
Left = 360
TabIndex = 4
Top = 4440
Width = 2415
End
Begin VB.Label lblChangeName
Appearance = 0 'Flat
BackColor = &H00404040&
Caption = "更新选手"
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0C0C0&
Height = 495
Index = 0
Left = 3600
TabIndex = 2
Top = 3720
Width = 1215
End
Begin VB.Label lblStat
Appearance = 0 'Flat
BackColor = &H00000000&
Caption = "Label1"
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 2295
Left = 3240
TabIndex = 1
Top = 600
Width = 3015
End
End
Attribute VB_Name = "frmPlayer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub ShowPlayer(ndx As Long, lbl As Label)
Dim strSt As String
With gv.players(ndx)
strSt = "选手姓名: " & .sName
strSt = strSt & Chr$(13) & Chr$(10) & "战斗总数 : " & CStr(.playCnt)
strSt = strSt & Chr$(13) & Chr$(10) & "胜利总数 : " & CStr(.winCnt)
If .playCnt <> 0 Then
strSt = strSt & Chr$(13) & Chr$(10) & "胜利比率 : " & Format(CDbl(.winCnt) / .playCnt, "0.#%")
Else
strSt = strSt & Chr$(13) & Chr$(10) & "胜利比率 : -"
End If
strSt = strSt & Chr$(13) & Chr$(10) & " 总分数: " & CStr(.scoreAcc)
strSt = strSt & Chr$(13) & Chr$(10) & " 最高分: " & CStr(.scoreHigh)
End With
lbl.Caption = strSt
End Sub
Private Sub Form_Load()
Dim i As Long
For i = 1 To gv.playerCnt
Me.lstPlayer.AddItem gv.players(i - 1).sName
Next i
Me.lstPlayer.ListIndex = gv.playerNdx
ShowPlayer gv.playerNdx, Me.lblStat
lblCur.Caption = lstPlayer.Text
ShowBestPlayer
End Sub
Private Sub Label2_Click()
End Sub
Private Sub lblChangeName_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
lblChangeName(Index).BackColor = 0
End Sub
Private Sub ShowBestPlayer()
ShowPlayer gv.highestScoreNdx, Me.lblBest
End Sub
Private Sub ChangePassword(ndx As Long)
Dim sInPass As String, sIn2Pass As String
With gv.players(ndx)
sInPass = "123456": sIn2Pass = "123456"
If .sPassword <> "123456" Then
sInPass = InputBox("请输入" & .sName & "的登录密码")
End If
If sInPass = .sPassword Then
sInPass = InputBox("请为" & .sName & "输入新的登录密码")
If sInPass = "" Then sInPass = "123456"
sIn2Pass = InputBox("请再次为" & .sName & "输入新的登录密码")
If sIn2Pass = "" Then sIn2Pass = "123456"
If sInPass = .sPassword Then
MsgBox "新密码和旧密码不能相同！"
Else
If sInPass <> sIn2Pass Then
MsgBox "两次输入的密码不一致！"
Else
.sPassword = sInPass
UpdatePlayer ndx
MsgBox "更新登录密码成功！"
End If
End If
End If
End With
End Sub
Private Sub lblChangeName_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim sInPass As String, sIn2Pass As String, sOldName As String
Dim i As Long
sInPass = "123456"
lblChangeName(Index).BackColor = rgb(63, 63, 63)
If Index = 0 Then
If Len(txtName.Text) <> 0 And txtName.Text <> lstPlayer.Text Then
For i = 1 To gv.playerCnt
If txtName.Text = gv.players(i - 1).sName Then
MsgBox "新选手和当前选手列表中的重名!"
Exit Sub
End If
Next i
If MsgBox("更换选手会删除当前选手的资料，你确定吗？", vbYesNo, "更换选手") = vbYes Then
With gv.players(lstPlayer.ListIndex)
If .sPassword <> "123456" Then
sInPass = InputBox("请输入当前选手的登录密码")
End If
If sInPass = .sPassword Then
sInPass = InputBox("请输入新选手的登录密码")
If sInPass = "" Then sInPass = "123456"
sIn2Pass = InputBox("请再次输入新选手的登录密码")
If sIn2Pass = "" Then sIn2Pass = "123456"
If sInPass = sIn2Pass Then
sOldName = .sName
.sName = txtName.Text
.scoreAcc = 0
.scoreHigh = 0
.winCnt = 0
.playCnt = 0
.sPassword = sInPass
UpdatePlayer lstPlayer.ListIndex
lstPlayer.List(lstPlayer.ListIndex) = .sName
MsgBox "更换选手成功！ " & sOldName & " -> " & .sName
GetBestPlayerNdx
ShowBestPlayer
Else
MsgBox "两次密码不一致！无法新建用户！"
End If
Else
MsgBox "密码错误！无法删除当前用户" & .sName
End If
End With
End If
End If
ElseIf Index = 1 Then
With gv.players(lstPlayer.ListIndex)
sInPass = "123456"
If .sPassword <> "123456" Then
sInPass = InputBox("请输入" & lstPlayer.Text & "的登录密码")
End If
If sInPass = .sPassword Then
gv.playerNdx = lstPlayer.ListIndex
Form1.lblPlayer.Caption = gv.players(gv.playerNdx).sName
lblCur.Caption = lstPlayer.Text
UpdateCurrentPlayer lstPlayer.ListIndex
Else
MsgBox "登录密码错误！"
End If
End With
ElseIf Index = 2 Then '退出
Unload Me
ElseIf Index = 3 Then '更改登录密码
ChangePassword gv.playerNdx
End If
End Sub
Private Sub lstPlayer_Click()
ShowPlayer lstPlayer.ListIndex, Me.lblStat
End Sub