流星雨屏保 程序代码

•百度首页 |

•登录新闻网页贴吧知道MP3图片视频百科

vb

百度一下

吧内搜索| 帮助

进入贴吧

贴子搜索按作者搜索

百度贴吧 > vb吧 > 浏览贴子吧主：谷歌VIP用户4添加到搜藏|快速回复贴吧投诉

重庆软件编程培训

重庆朗沃软件编程培训,专业提供java培训课程.多年专注于JAVA培训,..

编程适配器--威龙 USB 编程器

威磊科技(电子)是开发生产VP系列USB通用编程器（烧录器）,ISP编程..

指数武汉编程学习, 美国Zend..

PHPhubei教育,武汉网编程学习,美国Zend华中地区唯一的官方授权认证..

户外手控, 自控编程探照灯--..

为了更好满足广大用户及工程商的需求,厂家长期供应大型户外全天候:..

新一代低功耗可视化编程智能..

深圳海比邻的液晶模块低功耗,自动温补,可视化编程,可直接电脑,带自..

来我校游戏图形编程培训, 轻..

游戏学院(重庆)直属培训中心,是游戏图形编程培训的摇篮,本校地处重..

来百度推广vb

共有7篇贴子

1 这是一个流星雨屏保中的vb代码，请问是如何产生小星星的呢？

Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, B yVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As

Long) As Long

'描绘一个椭圆，由指定的矩形围绕。椭圆用当前选择的画笔描绘，并用当前选择的刷子填充

Ellipse Me.hdc, Stars(I).X, Stars(I).Y, Stars(I).X + Stars(I).Size, Sta rs(I).Y + Stars(I).Size ‘这句话

作者：cxy5636917

2008-3-23 20:06 回复此发言

2 回复：这是一个流星雨屏保中的vb代码，请问是如何产生小星星的呢？

全部代码：

Option Explicit

Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByV al X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

'描绘一个椭圆，由指定的矩形围绕。椭圆用当前选择的画笔描绘，并用当前选择的刷子填充

'返回值

'Long，非零表示成功，零表示失败。会设置GetLastError

'参数表

'参数类型及说明

'hdc Long，设备场景的句柄

'X1，Y1 Long，约束矩形采用逻辑坐标的左上角位置

'X2，Y2 Long，约束矩形采用逻辑坐标的右下角位置

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHe ight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

'Star Type

Private Type Star

X As Long

Y As Long

Speed As Long

Size As Long

Color As Long

End Type

'Star field array

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_Load()

Dim I As Long

Randomize

'Generate the 100 stars

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 TimerStarField_Timer()

Dim I As Long

'clear the form

'BitBlt Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, 0, 0, 0, vbBlack ness

For I = 0 To UBound(Stars)

'Move the star

Stars(I).Y = (Stars(I).Y Mod Me.ScaleHeight) + Stars(I).Speed

'Relocate the X position

If Stars(I).Y > Me.ScaleHeight Then

Stars(I).X = Me.ScaleWidth * Rnd + 1