VB怎么制作屏保

AutoRedraw = -1 'True

BackColor = &H00000000&

BorderStyle = 0 'None

Caption = "star"

ClientHeight = 3195

ClientLeft = 0

ClientTop = 0

ClientWidth = 4680

ControlBox = 0 'False

FillColor = &H008080FF&

FillStyle = 0 'Solid

KeyPreview = -1 'True

LinkTopic = "Form1"

ScaleHeight = 213

ScaleMode = 3 'Pixel

ScaleWidth = 312

ShowInTaskbar = 0 'False

StartUpPosition = 3 '窗口缺省

WindowState = 2 'Maximized

代码：

Option Explicit

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 Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _

(ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni 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

'Dim QuitFlag As Boolean

Const MaxSize As Long = 5

Const MaxSpeed As Long = 25

Const SPI_SETSCREENSAVEACTIVE = 17

'显示鼠标光标:

Private Sub ShowMouse()

While ShowCursor(True) < 0

Wend

End Sub

'隐藏鼠标光标:

Private Sub HideMouse()

While ShowCursor(False) >= 0

Wend

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

ShowMouse

End

'QuitFlag = True

End Sub

Private Sub Form_Load()

Dim i As Long

Dim x As Long

'用APP对象的PrevInstance属性

'If AppPrevInstance = True Then

'防止同时运行屏幕保护程序的两个实例

'Unload Me

'Exit Sub

'End If

x = SystemParametersInfo(17, 0, ByVal 0&, 0)

'Select Case UCase$(Left$(Command$, 2))

'装载命令行参数

'Case "/S" '在显示器属性对话框中单击了预览按钮或屏幕保护程序被系统正常调用

'Show

HideMouse

Randomize

'产生50个小星星

For i = LBound(Stars) To UBound(Stars)

Stars(i)x = MeScaleWidth Rnd + 1

Stars(i)Y = MeScaleHeight 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

'Case Else

'Unload Me

'Exit Sub

'End Select

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)

ShowMouse

End

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)

Static xorign As Single, yorign As Single

Dim xnow As Single, ynow As Single

'记录当前位置

xnow = x

ynow = Y

'第一次触发MouseMove事件,记录当前位置

If xorign = 0 And yorign = 0 Then

xorign = xnow

yorign = ynow

Exit Sub

End If

'仅当鼠标移动足够迅速(一次2个像素以上)才恢复屏幕

If Abs(xnow - xorign) > 2 Or Abs(ynow - yorign) > 2 Then

ShowMouse

'end

'quitflag = True

End If

End Sub

Private Sub Form_Unload(Cancel As Integer)

Dim x As Long

x = SystemParametersInfo(17, 1, ByVal 0&, 0)

ShowMouse

End Sub

Private Sub Timer1_Timer()

Dim i As Long

'清屏

BitBlt Mehdc, 0, 0, MeScaleWidth, MeScaleHeight, 0, 0, 0, vbBlackness

For i = 0 To UBound(Stars)

'移动小星星

Stars(i)Y = (Stars(i)Y Mod MeScaleHeight) + Stars(i)Speed

'判断小星星是否已出了窗口

If Stars(i)Y > MeScaleHeight Then

Stars(i)x = MeScaleWidth Rnd + 1

Stars(i)Speed = MaxSpeed Rnd + 1

End If

'设置小星星的颜色

MeFillColor = Stars(i)Color

MeForeColor = Stars(i)Color

'画星星

Ellipse Mehdc, Stars(i)x, Stars(i)Y, Stars(i)x + Stars(i)Size, Stars(i)Y + Stars(i)Size

Next i

MeRefresh

End Sub

Private Declare Function ShellExecute Lib "shell32dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Command1_Click()

Call ShellExecute(vbNull, "open", 屏保文件路径, vbNull, vbNull, SW_SHOWNORMAL)

End Sub

以上就是关于VB怎么制作屏保全部的内容，包括:VB怎么制作屏保、怎么用vb打开屏幕保护程序,不是定时运行,是让它立刻运行、等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！