利用Timer控件的Tick()事件在自定义控件上绘制动画!

key_rock 2007-03-20 01:28:27
新建一个Windows控件项目,将Usercontrol.vb重命名为leftToright.vb
代码如下:

Public Class leftToright
Public Enum LineStatus
'公开枚举

特快 = 1
普快 = 2
中等 = 3
普慢 = 4
特慢 = 5
停止 = 6

End Enum

'初始化_速度 为枚举常量2
Dim _速度 As LineStatus = LineStatus.普快

<System.ComponentModel.Description("运行的状态")> _
Public Property 速度() As LineStatus
Get
Return _速度
End Get
Set(ByVal Value As LineStatus)
_速度 = Value
If 速度 = LineStatus.普快 Then
Me.BackColor = Color.Green
Me.Timer1.Enabled = True
Me.Timer1.Interval = 16
End If
If 速度 = LineStatus.特快 Then
Me.BackColor = Color.Green
Me.Timer1.Enabled = True
Me.Timer1.Interval = 8
End If
If 速度 = LineStatus.中等 Then
Me.BackColor = Color.Green
Me.Timer1.Enabled = True
Me.Timer1.Interval = 20
End If
If 速度 = LineStatus.普慢 Then
Me.BackColor = Color.Green
Me.Timer1.Enabled = True
Me.Timer1.Interval = 25
End If
If 速度 = LineStatus.特慢 Then
Me.BackColor = Color.Green
Me.Timer1.Enabled = True
Me.Timer1.Interval = 35
End If
If 速度 = LineStatus.停止 Then
Me.Timer1.Enabled = False
Me.BackColor = Color.Red
End If
End Set
End Property

'用来“装”矩形的位图
Dim bitmap(4) As Bitmap

Dim x, r, j, k, y As Integer
'offsetX表示矩形每次沿x轴移动的距离
Dim offsetX As Integer
'位图的宽和高
Dim bitmapWidth, bitmapHeight As Integer


Private Sub leftToright_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint

'初始化变量
r = Me.Width / 7
x = 0
y = 2 * r + 2 * offsetX
j = 4 * r + 2 * offsetX
k = 6 * r + 2 * offsetX
offsetX = 5

'位图必须足够大,不仅能容纳矩形本身,还能遮住上一个循环中位图留下的痕迹
bitmapWidth = r + 6 * offsetX
bitmapHeight = Me.Height

'在位图中间画一个矩形
bitmap(1) = New Bitmap(bitmapWidth, bitmapHeight)
bitmap(2) = New Bitmap(bitmapWidth, bitmapHeight)
bitmap(3) = New Bitmap(bitmapWidth, bitmapHeight)
bitmap(4) = New Bitmap(bitmapWidth, bitmapHeight)
Dim g1 As Graphics
Dim g2 As Graphics
Dim g3 As Graphics
Dim g4 As Graphics
g1 = Graphics.FromImage(bitmap(1))
g2 = Graphics.FromImage(bitmap(2))
g3 = Graphics.FromImage(bitmap(3))
g4 = Graphics.FromImage(bitmap(4))
With g1
.Clear(BackColor)
.FillRectangle(Brushes.Lime, New Rectangle(Me.Width * 0.06, 0, r, Me.Height))
.Dispose()
End With

With g2
.Clear(BackColor)
.FillRectangle(Brushes.Red, New Rectangle(Me.Width * 0.06, 0, r, Me.Height))
.Dispose()
End With

With g3
.Clear(BackColor)
.FillRectangle(Brushes.Yellow, New Rectangle(Me.Width * 0.06, 0, r, Me.Height))
.Dispose()
End With
With g4
.Clear(BackColor)
.FillRectangle(Brushes.Blue, New Rectangle(Me.Width * 0.06, 0, r, Me.Height))
.Dispose()
End With
End Sub

Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick
Dim g1 As Graphics = CreateGraphics()
Dim g2 As Graphics = CreateGraphics()
Dim g3 As Graphics = CreateGraphics()
Dim g4 As Graphics = CreateGraphics()
'在恰当的位置画出位图(矩形)
g1.DrawImage(bitmap(1), x, 0, CInt(bitmapWidth * 1.25), bitmapHeight)
g2.DrawImage(bitmap(2), y, 0, CInt(bitmapWidth * 1.25), bitmapHeight)
g3.DrawImage(bitmap(3), j, 0, CInt(bitmapWidth * 1.25), bitmapHeight)
g4.DrawImage(bitmap(4), k, 0, CInt(bitmapWidth * 1.25), bitmapHeight)
g1.Dispose()
g2.Dispose()
g3.Dispose()
g4.Dispose()

If x > Me.Width Then
x = -bitmapWidth + Me.Width * 0.03
End If

If y > Me.Width Then
y = -bitmapWidth + Me.Width * 0.03
End If

If j > Me.Width Then
j = -bitmapWidth + Me.Width * 0.03
End If

If k > Me.Width Then
k = -bitmapWidth + Me.Width * 0.03
End If
'改变矩形的位置,以产生运动
x += offsetX 'g1
y += offsetX 'g2
j += offsetX 'g3
k += offsetX 'g4
End Sub
End Class
...全文
178 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
losedxyz 2007-03-21
  • 打赏
  • 举报
回复
interesting
cfreez 2007-03-21
  • 打赏
  • 举报
回复
不得不说,这是个笨办法,其实可以某些控件代替矩形
jackson5 2007-03-21
  • 打赏
  • 举报
回复
我还没学到这里
谢谢你拉
key_rock 2007-03-21
  • 打赏
  • 举报
回复
要是画圆就没控件替代了 啊

16,554

社区成员

发帖
与我相关
我的任务
社区描述
VB技术相关讨论,主要为经典vb,即VB6.0
社区管理员
  • VB.NET
  • 水哥阿乐
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧