高分,高手来。想用vb做个屏保,锁屏的,要用密码解的那种…
发布网友
发布时间:2023-01-04 15:25
我来回答
共2个回答
热心网友
时间:2023-11-04 16:49
网上找找,有源码的.
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
热心网友
时间:2023-11-04 16:50
你上网找个软件不就可以了? ~~ 用那么麻烦嘛~~