📄 3).txt
字号:
VERSION 5.00
Begin VB.Form fdui
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 6180
ClientLeft = 45
ClientTop = 330
ClientWidth = 6690
Icon = "worlddui.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6180
ScaleWidth = 6690
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command6
Caption = "移出左侧所有球队名称"
Enabled = 0 'False
Height = 375
Left = 3720
TabIndex = 11
Top = 2040
Width = 2175
End
Begin VB.CommandButton Command5
Caption = "保存当前球队编排情况"
Enabled = 0 'False
Height = 375
Left = 3720
TabIndex = 10
Top = 3240
Width = 2175
End
Begin VB.ListBox List3
Height = 600
Left = 1440
TabIndex = 9
Top = 3360
Visible = 0 'False
Width = 1455
End
Begin VB.CommandButton Command4
Caption = "球队下移"
Enabled = 0 'False
Height = 375
Left = 4800
TabIndex = 8
Top = 2640
Width = 1095
End
Begin VB.CommandButton Command3
Caption = "球队上移"
Enabled = 0 'False
Height = 375
Left = 3720
TabIndex = 7
Top = 2640
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "移出左侧选中球队名称"
Enabled = 0 'False
Height = 375
Left = 3720
TabIndex = 6
Top = 1440
Width = 2175
End
Begin VB.CommandButton Command1
Caption = "添加以上球队名称"
Enabled = 0 'False
Height = 375
Left = 3720
TabIndex = 4
Top = 840
Width = 2175
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 3720
TabIndex = 3
Top = 360
Width = 2175
End
Begin VB.Frame Frame1
Caption = "代号 投注号 对应球队名称"
Height = 3855
Left = 120
TabIndex = 0
Top = 120
Width = 3375
Begin VB.ListBox List1
Height = 4920
Left = 120
TabIndex = 2
Top = 240
Width = 975
End
Begin VB.ListBox List2
Height = 2760
Left = 1200
TabIndex = 1
Top = 240
Width = 2055
End
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 10
Left = 5880
Top = 120
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 840
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 4680
Visible = 0 'False
Width = 2295
End
Begin VB.TextBox Text2
Enabled = 0 'False
Height = 1935
Left = 3720
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 12
Text = "worlddui.frx":030A
Top = 3840
Width = 2175
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "球队名称："
Height = 180
Left = 3720
TabIndex = 5
Top = 120
Width = 900
End
End
Attribute VB_Name = "fdui"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
If Trim(Text1.Text) <> "" Then
If strlens(Trim(Text1.Text)) > 10 Then
MsgBox Chr(13) + "球队名称最长只能为５个汉字长度！ ", vbCritical
Exit Sub
End If
For i = 1 To Len(Trim(Text1.Text))
If Asc(Mid(Trim(Text1.Text), i, 1)) >= 0 Then
MsgBox Chr(13) + "球队名称只能由汉字组成！ ", vbCritical
Exit Sub
End If
Next i
If List2.ListCount < List1.ListCount Then
List2.AddItem Trim(Text1.Text)
List2.ListIndex = List2.ListCount - 1
Text1.Text = ""
Text1.SetFocus
Else
MsgBox Chr(13) + "球队数量已满！ ", vbCritical
End If
Else
MsgBox Chr(13) + "先输入球队名称！ ", vbCritical
Text1.SetFocus
End If
End Sub
Private Sub Command2_Click()
If List2.Text = "" Then
MsgBox Chr(13) + "先选择球队名称！ ", vbCritical
Else
If MsgBox(Chr(13) + "移出球队“" + List2.Text + "”？ ", vbQuestion + vbYesNo) = vbYes Then
List2.RemoveItem List2.ListIndex
End If
End If
End Sub
Private Sub Command3_Click()
If List2.ListCount <= 1 Or List2.ListIndex = 0 Then
MsgBox Chr(13) + "当前无法向上移动球队！ ", vbInformation
Else
If List2.Text = "" Then
MsgBox Chr(13) + "先选择球队名称！ ", vbCritical
Else
tp2 = List2.Text
n1 = List2.ListIndex
List2.ListIndex = n1 - 1
tp1 = List2.Text
List3.Clear
For i = 0 To n1 - 2
List2.ListIndex = i
List3.AddItem List2.Text
Next i
List3.AddItem tp2
List3.AddItem tp1
For i = n1 + 1 To List2.ListCount - 1
List2.ListIndex = i
List3.AddItem List2.Text
Next i
List2.Clear
For i = 0 To List3.ListCount - 1
List3.ListIndex = i
List2.AddItem List3.Text
Next i
List2.ListIndex = n1 - 1
End If
End If
End Sub
Private Sub Command4_Click()
If List2.ListCount <= 1 Or List2.ListIndex = List2.ListCount - 1 Then
MsgBox Chr(13) + "当前无法向上移动球队！ ", vbInformation
Else
If List2.Text = "" Then
MsgBox Chr(13) + "先选择球队名称！ ", vbCritical
Else
tp1 = List2.Text
n1 = List2.ListIndex
List2.ListIndex = n1 + 1
tp2 = List2.Text
List3.Clear
For i = 0 To n1 - 1
List2.ListIndex = i
List3.AddItem List2.Text
Next i
List3.AddItem tp2
List3.AddItem tp1
For i = n1 + 2 To List2.ListCount - 1
List2.ListIndex = i
List3.AddItem List2.Text
Next i
List2.Clear
For i = 0 To List3.ListCount - 1
List3.ListIndex = i
List2.AddItem List3.Text
Next i
List2.ListIndex = n1 + 1
End If
End If
End Sub
Private Sub Command5_Click()
Dim qd(0 To 31) As String
If List2.ListCount <> 32 Then
MsgBox Chr(13) + "球队数量不正确！ ", vbExclamation
Exit Sub
End If
If MsgBox(Chr(13) + "本次保存后，球队名称及顺序将不能更改， " + Chr(13) + Chr(13) + "执行本功能前请认真检查球队名称及排列顺序。 " + Chr(13) + Chr(13) + "是否开始保存？ ", vbQuestion + vbYesNo) = vbYes Then
Data1.DatabaseName = wmdb
Data1.RecordSource = "name"
Data1.Refresh
For i = 0 To List2.ListCount - 1
List2.ListIndex = i
List1.ListIndex = i
tp1 = Left(List1.Text, 3)
tp2 = List2.Text
qd(i) = tp2
Data1.Refresh
Data1.Recordset.FindFirst "dh='" + tp1 + "'"
If Data1.Recordset.NoMatch Then
MsgBox Chr(13) + "数据库错误： " + Chr(13) + Chr(13) + "找不到球队代号" + tp1 + " ", vbCritical
Exit Sub
End If
Data1.Recordset.Edit
Data1.Recordset.Fields(1).Value = tp2
Data1.Recordset.Update
Data1.Refresh
Next i
Data1.Database.Close
Data1.DatabaseName = wmdb
Data1.RecordSource = "score"
Data1.Refresh
i = 0
While Not Data1.Recordset.EOF
Data1.Recordset.Edit
If i Mod 5 = 0 Then
For j = 1 To 4
Data1.Recordset.Fields(j).Value = qd(i + j - 1 - i \ 5)
Next j
Else
Data1.Recordset.Fields(0).Value = qd(i - 1 - i \ 5)
k = i - i \ 5
If k Mod 4 = 0 Then
Data1.Recordset.Fields(4) = "×"
Else
Data1.Recordset.Fields(k Mod 4) = "×"
End If
End If
Data1.Recordset.Update
Data1.Recordset.MoveNext
i = i + 1
Wend
Data1.Database.Close
Data1.DatabaseName = wmdb
Data1.RecordSource = "jd"
Data1.Refresh
Data1.Recordset.Edit
Data1.Recordset.Fields(0).Value = 1
Data1.Recordset.Update
Data1.Refresh
Data1.Database.Close
MsgBox Chr(13) + "数据已经保存成功！ ", vbInformation
Me.Hide
fcon.Show
fcon.Timer1.Enabled = True
End If
End Sub
Private Sub Command6_Click()
If MsgBox(Chr(13) + "移出所有球队吗？ ", vbQuestion + vbYesNo) = vbYes Then
List2.Clear
End If
End Sub
Private Sub Form_Load()
Me.Caption = App.Title + "－球队编排 ［" + fco.Combo1.Text + "世界杯］"
Me.Width = Text1.Width + Text1.Left + Frame1.Left * 2
List1.Height = 6000
List2.Height = List1.Height
Frame1.Height = List1.Height + List1.Left * 3
Me.Height = Frame1.Height + Frame1.Top + 300 + Frame1.Left * 2
Text2.Top = Frame1.Top + Frame1.Height - Text2.Height
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
fcon.Show
fcon.Timer1.Enabled = True
End Sub
Private Sub List1_Click()
On Error Resume Next
List2.ListIndex = List1.ListIndex
End Sub
Private Sub List2_Click()
On Error Resume Next
List1.ListIndex = List2.ListIndex
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
If Trim(Text1.Text) <> "" Then Call Command1_Click
End If
If KeyAscii = 27 Then KeyAscii = 0
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
Text1.Text = ""
List1.Clear
List2.Clear
Data1.DatabaseName = wmdb
Data1.RecordSource = "name"
Data1.Refresh
On Error Resume Next
While Not Data1.Recordset.EOF
List1.AddItem Data1.Recordset.Fields(0).Value + " " + Data1.Recordset.Fields(2).Value
List2.AddItem Data1.Recordset.Fields(1).Value
Data1.Recordset.MoveNext
Wend
List1.ListIndex = 0
Data1.Database.Close
If jindu > 0 Then
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command6.Enabled = False
Else
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -