playing.frm

[原创]非常耐玩的足球小游戏

Private Sub addpassing_Click()
passingpp = passingpp + 1
additionpp = additionpp - 1
sx
yz
End Sub

Private Sub addshoting_Click()
shotingpp = shotingpp + 2
additionpp = additionpp - 1
sx
yz
End Sub

Private Sub addsturdiness_Click()
sturdinesspp = sturdinesspp + 1
additionpp = additionpp - 1
sx
yz
End Sub

Private Sub Command1_Click()
s_l
End Sub

Private Sub Command10_Click()
puckx = 7920
pucky = 0
End Sub

Private Sub Command11_Click()
puckx = 4080
pucky = 8640
End Sub

Private Sub Command12_Click()
vpuckx = -20
vpucky = -20
End Sub

Private Sub Command13_Click()
c_f
End Sub

Private Sub Command14_Click()
vpuckx = 20
vpucky = -20
End Sub

Private Sub Command15_Click()
c_l
End Sub

Private Sub Command16_Click()
vpuckx = 0
vpucky = 0
End Sub

Private Sub Command17_Click()
c_r
End Sub

Private Sub Command18_Click()
vpuckx = -20
vpucky = 20
End Sub

Private Sub Command19_Click()
c_b
End Sub

Private Sub Command2_Click()
s_r
End Sub

Private Sub Command20_Click()
vpuckx = 20
vpucky = 20
End Sub

Private Sub Command21_Click()
save_num = 3
save_file
End Sub

Private Sub Command22_Click()
load_num = 3
load_file
yz
End Sub

Private Sub Command23_Click()
save_num = 2
save_file
End Sub

Private Sub Command24_Click()
load_num = 2
load_file
yz
End Sub

Private Sub Command25_Click()
vpucky = 0
vpuckx = -80
End Sub

Private Sub Command26_Click()
vpucky = 0
vpuckx = 80
End Sub

Private Sub Command27_Click()
Form1.Hide
Form2.Label7.Caption = namep.Caption
InitializeRes800
End Sub

Private Sub Command28_Click()
vpucky = 10
vpuckx = 80
End Sub

Private Sub Command29_Click()
vpucky = 10
vpuckx = -80
End Sub

Private Sub Command3_Click()
s_f
End Sub

Private Sub Command30_Click()
If Command30.Caption = "Personal" Then
Picture3.Left = 8640
Picture3.Top = 0
Command30.Caption = "Personal(s)"
Else
Picture3.Left = 20000
Picture3.Top = 20000
Command30.Caption = "Personal"
End If
End Sub

Private Sub Command31_Click()
If Command31.Caption = "Header" Then
header.Left = 8640
header.Top = 1080
Command31.Caption = "Header(s)"
Else
header.Left = 20000
header.Top = 20000
Command31.Caption = "Header"
End If
End Sub

Private Sub Command32_Click()
If Command32.Caption = "Shotting" Then
shotting.Left = 12840
shotting.Top = 960
Command32.Caption = "Shotting(s)"
Else
shotting.Left = 20000
shotting.Top = 20000
Command32.Caption = "Shotting"
End If
End Sub

Private Sub Command33_Click()
If Command33.Caption = "System" Then
System.Left = 5160
System.Top = 7560
Command33.Caption = "System(s)"
Else
System.Left = 20000
System.Top = 20000
Command33.Caption = "System"
End If
End Sub

Private Sub Command34_Click()
If Command34.Caption = "B.Control" Then
bc.Left = 12840
bc.Top = 2640
Command34.Caption = "B.Control(s)"
Else
bc.Left = 20000
bc.Top = 20000
Command34.Caption = "B.Control"
End If
End Sub

Private Sub Command35_Click()
If Command35.Caption = "Passing" Then
Passing.Left = 8640
Passing.Top = 5400
Command35.Caption = "Passing(s)"
Else
Passing.Left = 20000
Passing.Top = 20000
Command35.Caption = "Passing"
End If
End Sub

Private Sub Command4_Click()
vpuckx = 0
vpucky = 0
End Sub

Private Sub Command5_Click()
puckx = 1320
pucky = 3120
End Sub

Private Sub Command6_Click()
puckx = 3960
pucky = 3120
End Sub

Private Sub Command7_Click()
puckx = 6600
pucky = 3120
End Sub

Private Sub Command8_Click()
 puckx = 4080
 pucky = 5640
End Sub

Private Sub Command9_Click()
puckx = 100
pucky = 100
End Sub
Private Function rtv_ini_data$(ini_File$, ini_select$, ini_entry$)
        ' rtv_ini_data("XXX.INI","ENVIRONMENT","PATH")
        Dim temp_string As String
        Dim DefaultValue As String
        Dim Entry As String
        Dim EntryValue As String
        Dim EntryValueSize  As String
        Dim box_msg  As String
        Dim Len_string  As String
        Dim X As Integer
        rtv_ini_data$ = ""
        
        Section$ = ini_select$
        Entry$ = ini_entry$
        DefaultValue$ = "unknown"
        EntryValue$ = Space$(1000)
        EntryValueSize = 1000
        X% = GetPrivateProfileString(Section$, Entry$, DefaultValue$, EntryValue$, EntryValueSize, ini_File$)
        If X% = 0 Then
            box_msg$ = " 非法条目 -> " + Section$ + "/" + Entry$
            MsgBox box_msg$, 16, "找不到所需字段"
        End If
        
        Len_string = Len(Trim$(EntryValue$)) - 1
        temp_string = Left$(EntryValue$, Len_string)
        rtv_ini_data$ = temp_string
End Function

Private Function upd_ini_data$(ini_File$, ini_select$, ini_entry$, EntryValue$)
        ' upd_ini_data("XXX.INI","ENVIRONMENT","PATH", "C:\")
        
        upd_ini_data$ = ""
        
        Section$ = ini_select$
        Entry$ = ini_entry$
        X% = WritePrivateProfileString(Section$, Entry$, EntryValue$, ini_File$)
        If X% = 0 Then
            box_msg$ = " 非法条目 -> " + Section$ + "/" + Entry$
            MsgBox box_msg$, 16, "读取时出错"
        End If
        
End Function

Private Sub Form_Load()
Picture1.MousePointer = 2
puckx = puck.Left
pucky = puck.Top
vpuckx = 0
vpucky = 0

additionpp = 50
rp = 0
mp = 5
r.Caption = rp
m.Caption = mp
headerpp = 10
sturdinesspp = 10
fitnesspp = 10
shotingpp = 10
passingpp = 10
Bcpp = 10
headerp.Caption = headerpp
fitnessp.Caption = fitnesspp
sturdinessp.Caption = sturdinesspp
passingp.Caption = passingpp
shotingp.Caption = shotingpp
additionp.Caption = additionpp
Bcp.Caption = Bcpp

namep.Caption = InputBox("What's your Captain's name?", "Start a new player")
agep.Caption = InputBox("How old is your captain?", "Start a new player")
positionp.Caption = InputBox("Which position does your captain like?", "Start a new player")
MsgBox "OK,then you have 50 addition points, you can add it to the skill which skill you like.", , "Start a new player"
MsgBox "You can also click the system menu,there are at most 3 player who have been created in the past,you can load it to your team(one team can only load 1 player!)", , "Player loading"
savefile_refresh

End Sub


Private Sub Image2_Click()

End Sub

Private Sub Imformationshowbutton_Click()
If Imformationshowbutton.Caption = "->Imformation Hide" Then
Frame1.Height = 200
Imformationshowbutton.Caption = "<-Imformation Show"
Else
Frame1.Height = 3315
Imformationshowbutton.Caption = "->Imformation Hide"
End If
End Sub

Private Sub loadbutton_Click()
load_num = 1
load_file
yz
End Sub

Private Sub paddle1_Click()

End Sub

Private Sub Picture1_Click()
vpucky = -200
vpuckx = 0
 'tip
addtip ("Oh!!" + namep.Caption + "shot by himself!")
End Sub

Private Sub picture1_KeyPress(keyascii As Integer)
Select Case keyascii
    Case vbKeyInsert
        vpuckx = -80
        vpucky = 0
        
    Case vbKeySpace
        vpuckx = -0
        vpucky = 0
    Case vbKeyUp
        paddle1.Top = paddle1.Top - 30
    Case vbKeyDown
        paddle1.Top = paddle1.Top + 30
    Case vbKeyLeft
        paddle1.Left = paddle1.Left - 30
    Case vbKeyRight
        paddle1.Left = paddle1.Left + 30
    Case vbKeyHome
        If Command13.Enabled = True Then
        c_f
        End If
    Case vbKeyDelete
        If Command15.Enabled = True Then
        c_l
        End If
    Case vbKeyPageDown
        If Command17.Enabled = True Then
        c_r
        End If
    Case vbKeyEnd
        If Command19.Enabled = True Then
        c_b
        End If
    'q
    Case vbKeyPageUp
        If Command26.Enabled = True Then
        vpuckx = 80
        vpucky = 0
        End If
    Case vbKeyZ
        If Command1.Enabled = True Then
        s_l
        End If
    Case vbKeyC
        If Command2.Enabled = True Then
        s_r
        End If
    Case vbKeyX
        If Command3.Enabled = True Then
        s_f
        End If
    Case vbKeyEscape
        Form1.Hide
        Form2.Label7.Caption = namep.Caption
        InitializeRes800
    End Select
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
paddle1.Left = X - 120
paddle1.Top = max(Y - 120, Line3.Y1)
End Sub
Function max(ByVal a As Single, ByVal b As Single)
If a > b Then
    max = a
    Else
    max = b
End If
End Function
Function min(ByVal a As Single, ByVal b As Single)
If a > b Or a < 0 Then
    min = b
    Else
    min = a
End If
End Function

Private Sub Picture4_Click()
If Timer1.Interval = 1 Then
Timer1.Interval = 5000
Else
Timer1.Interval = 1
End If
End Sub

Private Sub savebutton_Click()
save_num = 1