物理模拟小球运动

本来是给兄弟做课程设计用的 可以用鼠标控制小球, 模拟重力阻力, 障碍反弹.  代码简单

源码下载地址: http://download.csdn.net/source/490690

'********************模块中**************************

Type TypePoint    '向量类型
    X As Long
    Y As Long
End Type

Type TypeBall      '小球的类型
    Pos As TypePoint   '位置
    Speed As TypePoint  '速度
    R As Long    '半径
    Color As Long   '颜色
    Box As PictureBox   
    G As Long               '重力
    Resi As Long            '阻力
    Ela As Long             '弹性
End Type

Global Ball As TypeBall

Global DownDeltaPos As TypePoint

Global OldPos As TypePoint
Global NewPos As TypePoint

Global BallDown As Boolean

'********************窗体中**************************

Private Sub cmdEla_Click()
    If Not LookUp(txtEla.Text) Then Exit Sub
    
    Ball.Ela = Int(txtEla.Text)
End Sub

Private Sub cmdG_Click()
    If Not LookUp(txtG.Text) Then Exit Sub
    
    Ball.G = Int(txtG.Text)
End Sub

Private Sub cmdResi_Click()
    If Not LookUp(txtResi.Text) Then Exit Sub
    
    Ball.Resi = Int(txtResi.Text)
End Sub

Private Sub Form_Load()
    InitBall
    Timer1.Enabled = True
    Timer2.Enabled = True
End Sub

Private Sub InitBall()   '初始化小球
    Randomize
    With Ball
        
        .R = 500
        .Color = vbGreen
        
        .Pos.X = 550
        .Pos.Y = 550
        
        .Speed.X = Int(Rnd * 150) - 75
        .Speed.Y = Int(Rnd * 150) - 75
        
        .G = 0
        .Resi = 0
        .Ela = 0
        
        Set .Box = Me.Picbox
        .Box.FillColor = .Color
        .Box.FillStyle = 0
    End With
End Sub

Private Sub Picbox_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button <> vbLeftButton Then Exit Sub
    
    Dim DeltaX&, DeltaY&
    
    DeltaX = Abs(Ball.Pos.X - X)
    DeltaY = Abs(Ball.Pos.Y - Y)
    
    If Sqr(DeltaX ^ 2 + DeltaY ^ 2) >= Ball.R Then Exit Sub
    
    BallDown = True
    
    Timer1.Enabled = False
    Timer3.Enabled = True
    
    Ball.Speed.X = 0
    Ball.Speed.Y = 0
    
    DownDeltaPos.X = Ball.Pos.X - X
    DownDeltaPos.Y = Ball.Pos.Y - Y
    
    OldPos = Ball.Pos
    
    PaintBall
End Sub

Private Sub Picbox_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Timer1.Enabled Then Exit Sub
    
    Timer2.Enabled = False
    
    Ball.Pos.X = X + DownDeltaPos.X
    Ball.Pos.Y = Y + DownDeltaPos.Y
    
    If X + DownDeltaPos.X - Ball.R < 0 Then
        Ball.Pos.X = Ball.R
    End If
    
    If X + DownDeltaPos.X + Ball.R > Ball.Box.Width Then
        Ball.Pos.X = Ball.Box.Width - Ball.R
    End If
    
    If Y + DownDeltaPos.Y - Ball.R < 0 Then
        Ball.Pos.Y = Ball.R
    End If
    
    If Y + DownDeltaPos.Y + Ball.R > Ball.Box.Height Then
        Ball.Pos.Y = Ball.Box.Height - Ball.R
    End If
    
    NewPos = Ball.Pos
    
    PaintBall
    Timer2.Enabled = True
End Sub

Private Sub Picbox_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button <> vbLeftButton Then Exit Sub
    
    If Not BallDown Then Exit Sub
    
    BallDown = False
    
    Ball.Speed.X = (Ball.Pos.X - OldPos.X) / 10
    Ball.Speed.Y = (Ball.Pos.Y - OldPos.Y) / 10
    
    Timer3.Enabled = False
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
    TestG
    
    TestResi
    
    MoveBall
    
    TestBall
    
    PaintBall
End Sub

Private Sub MoveBall()
    If Ball.Pos.X - Ball.R + Ball.Speed.X <= 0 Then
        Ball.Pos.X = Ball.R
    Else
        Ball.Pos.X = Ball.Pos.X + Ball.Speed.X
    End If
    
    If Ball.Pos.X + Ball.R + Ball.Speed.X >= Ball.Box.Width Then
        Ball.Pos.X = Ball.Box.Width - Ball.R
    Else
        Ball.Pos.X = Ball.Pos.X + Ball.Speed.X
    End If
    
    If Ball.Pos.Y - Ball.R + Ball.Speed.Y <= 0 Then
        Ball.Pos.Y = Ball.R
    Else
        Ball.Pos.Y = Ball.Pos.Y + Ball.Speed.Y
    End If
    
    If Ball.Pos.Y + Ball.R + Ball.Speed.Y >= Ball.Box.Height Then
        Ball.Pos.Y = Ball.Box.Height - Ball.R
    Else
        Ball.Pos.Y = Ball.Pos.Y + Ball.Speed.Y
    End If
End Sub

Private Sub TestBall()

    If Ball.Pos.X - Ball.R <= 0 Then
        If Ball.Speed.X < 0 Then
            If Ball.Resi = 0 Then
                Ball.Speed.X = -Ball.Speed.X
            Else
                Ball.Speed.X = -Ball.Speed.X - Ball.Ela * 10
            End If
        End If
    End If
    
    If Ball.Pos.X + Ball.R >= Ball.Box.Width Then
        If Ball.Speed.X > 0 Then
            If Ball.Resi = 0 Then
                Ball.Speed.X = -Ball.Speed.X
            Else
                Ball.Speed.X = -Ball.Speed.X + Ball.Ela * 10
            End If
        End If
    End If
    
    If Ball.Pos.Y - Ball.R <= 0 Then
        If Ball.Speed.Y < 0 Then
            If Ball.G = 0 Then
                Ball.Speed.Y = -Ball.Speed.Y
            Else
                Ball.Speed.Y = -Ball.Speed.Y - Ball.Ela * 10
            End If
        End If
    End If
    
    If Ball.Pos.Y + Ball.R >= Ball.Box.Height Then
        If Ball.Speed.Y > 0 Then
            If Ball.G = 0 Then
                Ball.Speed.Y = -Ball.Speed.Y
            Else
                Ball.Speed.Y = -Ball.Speed.Y + Ball.Ela * 10
            End If
        End If
    End If
    
End Sub

Private Sub PaintBall()
    Picbox.Cls
    Picbox.Circle (Ball.Pos.X, Ball.Pos.Y), Ball.R
End Sub

Private Sub TestG()
    Ball.Speed.Y = Ball.Speed.Y + Ball.G * 10
End Sub

Private Sub TestResi()

    If Ball.Speed.X < 0 Then
        If Ball.Speed.X + Ball.Resi > 0 Then
            Ball.Speed.X = 0
        Else
            Ball.Speed.X = Ball.Speed.X + Ball.Resi
        End If
    ElseIf Ball.Speed.X > 0 Then
        If Ball.Speed.X - Ball.Resi < 0 Then
            Ball.Speed.X = 0
        Else
            Ball.Speed.X = Ball.Speed.X - Ball.Resi
        End If
    End If
End Sub

Private Function IsNumber(Text As String) As Boolean
    Dim i&, Str1$
    
    For i = 1 To Len(Text)
        Str1 = Mid$(Text, 1, 1)
        If Asc(Str1) < Asc("0") Or Asc(Str1) > Asc("9") Then
            IsNumber = False
            Exit Function
        End If
    Next
    IsNumber = True
End Function

Private Sub Timer2_Timer()
    PaintBall
End Sub

Private Function LookUp(Text As String) As Boolean
    
    LookUp = False
    
    If Not IsNumber(Text) Then
        MsgBox "只能输入数字!"
        Exit Function
    End If
    
    If Int(Text) > 10 Or Int(Text) < 0 Then
        MsgBox "只能输入0~10之间的整数!"
        Exit Function
    End If
    
    LookUp = True
End Function

Private Sub Timer3_Timer()

    Ball.Speed.X = (NewPos.X - OldPos.X) / 10
    Ball.Speed.Y = (NewPos.Y - OldPos.Y) / 10
    
    OldPos = NewPos
End Sub