如何把VB程序应用到屏保程序中

如何把VB程序应用到屏保程序中,第1张

首先你得保证你的程序没有错误。是一个能够脱离VB窗做绝前口运行的可执行文件。如果你宏渣程序都没写好,怎么能当屏保纯清?

先编成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


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/12414909.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-25
下一篇 2023-05-25

发表评论

登录后才能评论

评论列表(0条)

保存