用VB制作流星雨屏保

软件世界

阿俊

如果现在问什么电视剧最红，大部分人都会回答是《流星花园》。不错，随着该电视剧的播出，F4们唱的《流星雨》也传遍大江南北，我们是多么希望能够一睹流星划过上空的壮观场面，但并非每个人都那么走运。但别急，我就来教大家用VB编写一个流星雨程序，体验一下那种感觉。Let’s go！
1.启动VB 6.0，新建一个标准工程。
2.在Form1中添加一个定时器控件(Timer)，把Timer1的Interval属性设置为“1”，然后把Form1的AutoRedraw属性设置为“True”，ScaleMode属性设置为“3”，BorderStyle属性设置为“0”，WindowState属性设置为“2”。
3.程序代码如下：
Option Explicit
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long， ByVal X1 As Long， ByVal Y1 As Long， ByVal X2 As Long， ByVal Y2 As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long， ByVal X As Long， ByVal Y As Long， ByVal nWidth As Long， ByVal nHeight As Long， ByVal hSrcDC As Long， ByVal xSrc As Long， ByVal ySrc As Long， ByVal dwRop As Long) As Long
' 定义小星星
Private Type Star
X As Long
Y As Long
Speed As Long
Size As Long
Color As Long
End Type
Dim Stars(49) As Star
Const MaxSize As Long = 5
Const MaxSpeed As Long = 25
Private Sub Form_KeyDown(KeyCode As Integer， Shift As Integer)
Unload Me
End Sub
Private Sub Form_MouseMove(Button As Integer， Shift As Integer， X As Single， Y As Single)
' 判断鼠标是否移动
Static currentX， currentY As Single
Dim orignX， orignY As Single
orignX = X
orignY = Y
If currentX = 0 And currentY = 0 Then
currentX = orignX
currentY = orignY
Exit Sub
End If
If Abs(orignX - currentX)>1 Or Abs(orignY - currentY)>1 Then
X = ShowCursor(True)
End
End If
End Sub
Private Sub Form_Load()'窗体载入
Dim I As Long
Randomize
' 产生100个小星星
For I = LBound(Stars) To UBound(Stars)
Stars(I).X = Me.ScaleWidth * Rnd + 1
Stars(I).Y = Me.ScaleHeight * Rnd + 1
Stars(I).Size = MaxSize * Rnd + 1
Stars(I).Speed = MaxSpeed * Rnd + 1
Stars(I).Color = RGB(Rnd * 255 + 1， Rnd * 255 + 1， Rnd * 255 + 1)
Next I
End Sub
Private Sub Timer1_Timer()
Dim I As Long
' 清屏
BitBlt Me.hdc， 0， 0， Me.ScaleWidth， Me.ScaleHeight， 0， 0， 0， vbBlackness
For I = 0 To UBound(Stars)
' 移动小星星
Stars(I).Y = (Stars(I).Y Mod Me.ScaleHeight) + Stars(I).Speed
' 重定位X位置
If Stars(I).Y > Me.ScaleHeight Then
Stars(I).X = Me.ScaleWidth * Rnd + 1
Stars(I).Speed = MaxSpeed * Rnd + 1
End If
' 设置小星星颜色
Me.FillColor = Stars(I).Color
Me.ForeColor = Stars(I).Color
' 绘制小星星颜色
Ellipse Me.hdc， Stars(I).X， Stars(I).Y， Stars(I).X + Stars(I).Size， Stars(I).Y + Stars(I).Size
Next I
Me.Refresh
End Sub