本来是给兄弟做课程设计用的 可以用鼠标控制小球, 模拟重力阻力, 障碍反弹. 代码简单
源码下载地址: 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