- 积分
- 18771
- 贡献
-
- 精华
- 在线时间
- 小时
- 注册时间
- 2011-6-21
- 最后登录
- 1970-1-1
|
登录后查看更多精彩内容~
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
本帖最后由 传说中的谁 于 2011-8-25 15:01 编辑
在气象中,我们经常要通过动画显示图片(雷达图、云图)的方式来观测天气系统的连续演变。今天给大家介绍一种用VB实现动画的方法。这个方法完全是由传说和笨笨设计并实现的,个人感觉它的优点在于可以任意选择图片来动画显示,而不是只能选择连续的几张图片。
需要用到的控件:一个PictureBox,两个listbox,一个timer控件,一个commandbutton,一个滑动条slider,一个commandialog。
commandbutton用于设置资料路径(懒得配置菜单栏了,有兴趣的可以自己弄),slider用于控制动画时间间隔。需要添加的引用:Microsoft Windows Common Contorls 6.0 (SP6). 添加部件:Microsoft Common Dialog Contorls 6.0 (SP6)。timer的intterval值设为500,list1的multiselect属性设为2,list2的visilbale属性设成false。
代码如下:
- Private Sub Command1_Click()
- Dim FilePath As String
- CommonDialog1.ShowOpen
- FilePath = CommonDialog1.FileName
- Open App.Path & "\FilePath.txt" For Output As #1
- Print #1, CurDir(FilePath)
- Close #1
- End Sub
- Private Sub Form_Load()
- On Error Resume Next
- Dim FilePath As String
- Dim A()
- Dim B()
- Open App.Path & "\FilePath.txt" For Input As #1
- Line Input #1, FilePath
- Close #1
- Form1.List1.Clear
- ss = Dir(FilePath & "/*.GIF")
- While ss <> ""
- i = i + 1
- ReDim Preserve A(i + 1)
- ReDim Preserve B(i + 1)
- A(i) = ss
- B(i) = DateDiff("s", FileDateTime(Path & ss), Now)
- ss = Dir
- Wend
- For i = 1 To UBound(B) - 1
- Form1.List1.AddItem A(i)
- Next i
- Form1.List1.ListIndex = Form1.List1.NewIndex
- Picture1.Picture = LoadPicture(List1.List(List1.ListIndex))
- Slider1.Min = 1
- Slider1.Max = 10
- End Sub
- Private Sub List1_Click()
- On Error Resume Next
- Picture1.Picture = LoadPicture(List1.List(List1.ListIndex))
- List2.Clear
- For i = 1 To List1.ListCount
- If List1.SelCount > 1 Then
- Timer1.Enabled = True
- If List1.Selected(i) = True Then
- List2.AddItem List1.List(i)
- End If
- Else: Timer1.Enabled = False
- End If
- Next i
- End Sub
- Private Sub Slider1_Click()
- Timer1.Interval = Slider1.Value * 100
- End Sub
- Private Sub Timer1_Timer()
- On Error Resume Next
- Static j As Integer
- j = j + 1
- If j > List2.ListCount Then
- j = 0
- End If
- FileName = Form1.List2.List(j)
- DoEvents
- Form1.Picture1.Picture = LoadPicture(FilePath & FileName)
- End Sub
复制代码 界面:
程序在附件里:
动画.rar
(633 KB, 下载次数: 92)
|
评分
-
查看全部评分
|