先编成xxx.EXE程序,然后改成xxx.SCR后缀名,放到c:\windows\system32\文件夹下面,然后在windows的屏幕保护里面就可以看到你的那个文件了。你的怎么不行,我用系统的cmd.exe都能当屏保。
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
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)