怎样制作屏幕保护程序的预览窗体?

hzwjt 2004-03-05 06:17:34
你好,请看这是屏保程序的窗体,基本没有用command命令行参数,没制作预鉴窗体,书上说的也不是很具体,有没有通过测试的例子参考?
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(199) 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()
If App.PrevInstance = True Then
End
End If
If InStr(Command, "/p") > 0 Then

ElseIf InStr(Command, "/c") > 0 Then
Form1.Show
End If


ShowCursor (False)
Dim i As Long
Randomize
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 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
End
ShowCursor (True)
End If
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
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

...全文
9 点赞 收藏 回复
写回复
回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
相关推荐
发帖
VB基础类
创建于2007-09-28

7518

社区成员

VB 基础类
申请成为版主
帖子事件
创建了帖子
2004-03-05 06:17
社区公告
暂无公告