form1.frm

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

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 = 0
pucky = 0
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 name?", "Start a new player")
agep.Caption = InputBox("How old are you?", "Start a new player")
positionp.Caption = InputBox("Which position do you like?", "Start a new player")
MsgBox "OK,then you have 50 addition points, you can add it to which skill you like.", , "Start a new player"

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 Picture1_Click()
vpucky = -200
vpuckx = 0
End Sub

Private Sub Picture1_KeyPress(KeyAscii As Integer)
vpucky = 0
vpuckx = 0
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 savebutton_Click()
save_num = 1
save_file
End Sub


Private Sub Timer1_Timer()
On Error Resume Next
Dim a As Single
touche = False
touche1 = False
If gagne = True Then
    vpuckx = 0
    vpucky = 0
    If pucky < 100 Then
        Scorered.Caption = Scorered.Caption + 1
           rp = rp + 1
        r.Caption = rp
        If rp = mp Then
        additionpp = additionpp + 50
        yz
        mp = mp * 2
        MsgBox "Level Up!", , "Game Message"
          If mp = 160 Then
          MsgBox "Congratulations!You have been in the National team!", , "Win"
          mp = 6
          rp = 0
          End If
        End If
        r.Caption = rp
        m.Caption = mp
        additionp.Caption = additionpp
        MsgBox max(Scorered.Caption, Scoreblue.Caption) & " to " & min(Scorered.Caption, Scoreblue.Caption), vbDefaultButton1, "Red goal"
        paddle2.Top = 480
        paddle2.Left = 3840
        Else
        Scoreblue.Caption = Scoreblue.Caption + 1
        MsgBox max(Scorered.Caption, Scoreblue.Caption) & " to " & min(Scorered.Caption, Scoreblue.Caption), vbDefaultButton1, "Blue goal"
        paddle2.Left = 3690
        paddle2.Top = 600
    End If
    puckx = 3840
    pucky = 5880
    gagne = False
    Exit Sub
End If
If puckx < 0 Then
    Beep
    vpucky = 5
    vpuckx = 20
    puckx = -puckx
End If
If pucky < 0 Then
    If puckx < Line3.X2 And puckx > Line3.X1 Then
        gagne = True
        Exit Sub
    End If
    Beep
    vpucky = 100
    vpuckx = 0
    puckx = 3960
    pucky = 960
    paddle2.Left = 3960
End If
If puckx > 8295 Then
    Beep
    vpucky = 5
    vpuckx = -20
    puckx = 2 * 8295 - puckx
End If
If pucky > 11415 Then
    If puckx < Line3.X2 And puckx > Line3.X1 Then
        gagne = True
        Exit Sub
    End If
    Beep
    vpucky = -70
    vpuckx = 5
    puckx = 3960
    pucky = 10200
    paddle2.Left = 3960
End If
puckx = puckx + vpuckx
pucky = pucky + vpucky
puck.Left = puckx
puck.Top = pucky
padx1 = padx2
pady1 = pady2
pad2x1 = pad2x2
pad2y1 = pad2y2
padx2 = paddle1.Left
pady2 = paddle1.Top
If puckx > pad2x2 Then
    paddle2.Left = paddle2.Left + min(vpuckx, cpu.Value)
    Else
    paddle2.Left = paddle2.Left - min(Abs(vpuckx), cpu.Value)
End If
pad2x2 = paddle2.Left
If pucky < Line1.X1 And vpucky < 20 Then
    If pad2y2 - pucky > -240 Then
        pad2y2 = paddle2.Top
        Else
        paddle2.Top = paddle2.Top + 100
        pad2y2 = paddle2.Top
    End If
    Else
    If pucky < 500 And pucky > pad2y2 Then
        paddle2.Top = paddle2.Top + 100
        pad2y2 = paddle2.Top
        Else
        If paddle2.Top > 0 Then
            pad2y2 = paddle2.Top
        End If
    End If
End If

If Not (touche) And ((puckx - padx2) ^ 2 + (pucky - pady2) ^ 2) ^ (1 / 2) < 240 Then
    a = 240 / ((puckx - padx2) ^ 2 + (pucky - pady2) ^ 2) ^ (1 / 2)
    puckx = padx2 + a * (puckx - padx2)
    pucky = pady2 + a * (pucky - pady2)
    Beep
    nvitesse vpuckx, vpucky, puckx - padx2 + 0.05, pady2 - pucky
    vpuckx = (padx2 - padx1) * Abs(puckx - padx2) / 240
    vpucky = (pady2 - pady1) * Abs(pucky - pady2) / 240 - sturdinesspp
    End If
If Not (touche1) And ((puckx - pad2x2) ^ 2 + (pucky - pad2y2) ^ 2) ^ (1 / 2) < 240 Then
    a = 240 / ((puckx - padx2) ^ 2 + (pucky - pady2) ^ 2) ^ (1 / 2)
    puckx = pad2x2 + a * (puckx - pad2x2)
    pucky = pad2y2 + a * (pucky - pad2y2)
    Beep
    nvitesse vpuckx, vpucky, puckx - pad2x2 + 0.05, pad2y2 - pucky
    vpuckx = (pad2x2 - pad2x1) * Abs(puckx - pad2x2) / 240
    'CPU att or def
    If paddle2.Top < 1440 Then
    pucky = pucky + 1440
    vpucky = 10
    Else
    pucky = paddle2.Top + 400
    vpucky = 30
    End If
    'cpu shooting
    If paddle2.Top > 7940 And paddle2.Left < 2000 Then
    vpuckx = 200
    vpucky = 200
    End If
    If paddle2.Top > 7640 And paddle2.Left > 2000 And paddle2.Left < 6000 Then
    vpuckx = 0
    vpucky = 200
    End If
    If paddle2.Top > 7940 And paddle2.Left > 6000 Then
    vpuckx = -200
    vpucky = 200
    End If
End If
vpucky = vpucky * 0.99
vpuckx = vpuckx * 0.99
If vpucky > 100 Or vpucky < -100 Then
vpuckx = vpuckx - shotingpp / 100
End If
If pucky < 2400 Then
puck.BackColor = &HFF&
ElseIf pucky > 2400 And pucky < 7500 Then
puck.BackColor = &HFF00&
Else
puck.BackColor = &HC0C0C0
End If
If puck.Top > 5640 And paddle2.Top < 9520 Then
paddle2.Top = paddle2.Top + 20
End If
If puck.Top < paddle2.Top And paddle2.Top > 600 Then
paddle2.Top = paddle2.Top - 30
End If
End Sub
Sub nvitesse(vx As Single, vy As Single, dx As Single, dy As Single)
Dim angle As Single
Dim vx1, vy1 As Single
angle = Atn(dy / dx)
vx1 = vy * Cos(angle) + vx * Sin(angle)
vy1 = vy * Sin(angle) - vx * Cos(angle)
vx = vx1 * Sin(angle) + vy1 * Cos(angle)
vy = vx1 * Cos(angle) - vy1 * Sin(angle)
End Sub
Private Sub yz()
If shotingpp >= 50 Then
Command2.Enabled = True
End If
If shotingpp >= 100 Then
Command1.Enabled = True
End If
If Bcpp >= 10 Then
Command4.Enabled = True
Command16.Enabled = True
End If
If Bcpp >= 20 Then
Command13.Enabled = True
End If
If Bcpp >= 30 Then
Command19.Enabled = True
End If
If Bcpp >= 40 Then
Command12.Enabled = True
End If
If Bcpp >= 50 Then
Command14.Enabled = True
End If
If Bcpp >= 60 Then
Command15.Enabled = True
End If
If Bcpp >= 70 Then
Command17.Enabled = True
End If
If Bcpp >= 80 Then
Command18.Enabled = True
End If
If Bcpp >= 90 Then
Command20.Enabled = True
End If
If passingpp >= 30 Then
Command25.Enabled = True
End If
If passingpp >= 40 Then
Command28.Enabled = True
End If
If passingpp >= 50 Then
Command26.Enabled = True
End If
If passingpp >= 60 Then
Command29.Enabled = True
End If
If headerpp >= 10 Then
Command8.Enabled = True
End If
If headerpp >= 20 Then
Command6.Enabled = True
End If
If headerpp >= 30 Then
Command5.Enabled = True
End If
If headerpp >= 40 Then
Command7.Enabled = True
End If
If headerpp >= 50 Then
Command11.Enabled = True
End If
If headerpp >= 100 Then
Command9.Enabled = True
End If
If headerpp >= 150 Then
Command10.Enabled = True
End If
If additionpp > 0 Then
    addheader.Enabled = True
    addfitness.Enabled = True
    addsturdiness.Enabled = True
    addpassing.Enabled = True
    addshoting.Enabled = True
    addballcontrol.Enabled = True
    Else
    addheader.Enabled = False
addfitness.Enabled = False
addsturdiness.Enabled = False
addpassing.Enabled = False
addshoting.Enabled = False
addballcontrol.Enabled = False
End If
End Sub
Private Sub sx()
headerp.Caption = headerpp
fitnessp.Caption = fitnesspp
sturdinessp.Caption = sturdinesspp
passingp.Caption = passingpp
shotingp.Caption = shotingpp
additionp.Caption = additionpp
Bcp.Caption = Bcpp
r.Caption = rp
m.Caption = mp
End Sub
Private Sub save_file()
save_ini = App.Path + "\save.INI"
    xx = upd_ini_data(save_ini, save_num, "name", namep.Caption)
    xx = upd_ini_data(save_ini, save_num, "age", agep.Caption)
    xx = upd_ini_data(save_ini, save_num, "position", positionp.Caption)
    xx = upd_ini_data(save_ini, save_num, "headerpp", headerpp)
    xx = upd_ini_data(save_ini, save_num, "fitnesspp", fitnesspp)
    xx = upd_ini_data(save_ini, save_num, "passingpp", passingpp)
    xx = upd_ini_data(save_ini, save_num, "shotingpp", shotingpp)
    xx = upd_ini_data(save_ini, save_num, "additionpp", additionpp)
    xx = upd_ini_data(save_ini, save_num, "Bcpp", Bcpp)
    xx = upd_ini_data(save_ini, save_num, "rp", rp)
    xx = upd_ini_data(save_ini, save_num, "mp", mp)
    savefile_refresh
End Sub
Private Sub load_file()
save_ini = App.Path + "\save.INI"
    headerpp = Trim(rtv_ini_data(save_ini, load_num, "headerpp"))
    additionpp = Trim(rtv_ini_data(save_ini, load_num, "additionpp"))
    rp = Trim(rtv_ini_data(save_ini, load_num, "rp"))
    mp = Trim(rtv_ini_data(save_ini, load_num, "mp"))
    sturdinesspp = Trim(rtv_ini_data(save_ini, load_num, "sturdinesspp"))
    fitnesspp = Trim(rtv_ini_data(save_ini, load_num, "fitnesspp"))
    shotingpp = Trim(rtv_ini_data(save_ini, load_num, "shotingpp"))
    passingpp = Trim(rtv_ini_data(save_ini, load_num, "passingpp"))
    Bcpp = Trim(rtv_ini_data(save_ini, load_num, "Bcpp"))
    namep.Caption = Trim(rtv_ini_data(save_ini, load_num, "name"))
    agep.Caption = Trim(rtv_ini_data(save_ini, load_num, "age"))
    positionp.Caption = Trim(rtv_ini_data(save_ini, load_num, "position"))
    Form2.Label7.Caption = Trim(rtv_ini_data(save_ini, load_num, "name"))
sx
End Sub
Private Sub savefile_refresh()
save_ini = App.Path + "\save.INI"
  f1n.Caption = Trim(rtv_ini_data(save_ini, 1, "name"))
  f2n.Caption = Trim(rtv_ini_data(save_ini, 2, "name"))
  f3n.Caption = Trim(rtv_ini_data(save_ini, 3, "name"))
  f1r.Caption = Trim(rtv_ini_data(save_ini, 1, "rp"))
  f2r.Caption = Trim(rtv_ini_data(save_ini, 2, "rp"))
  f3r.Caption = Trim(rtv_ini_data(save_ini, 3, "rp"))
  f1m.Caption = Trim(rtv_ini_data(save_ini, 1, "mp"))
  f2m.Caption = Trim(rtv_ini_data(save_ini, 2, "mp"))
  f3m.Caption = Trim(rtv_ini_data(save_ini, 3, "mp"))
End Sub