怎样制作屏幕保护程序的预览窗体?
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