如何用VB制作一个屏幕保护程序

2024-12-17 09:18:04
推荐回答(5个)
回答1:

查了些资料,这里是一个解决方案

添加一个窗体frm_Run,和frm_Setup。在frmRun中添加代码:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If Mod_Main.Scan_RUN Then '如果此时是在运行屏保则关闭屏保
        modMain.CloseSCR
    End If
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Mod_Main.Scan_RUN Then '如果此时是在运行屏保则关闭屏保
        modMain.CloseSCR
    End If
End Sub
  
Private Sub Form_Unload(Cancel As Integer)
    modMain.CloseSCR
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static sx As Single, sy As Single
    If sx = 0 And sy = 0 Then
        sx = X
        sy = Y
    Else
        If Abs(sx - X) > 5 Or Abs(sy - Y) > 5 Then End '鼠标移动了5象素则退出
    End If
End Sub

添加一个模块modMain,添加代码:

Option Explicit

Public Const WM_LOOK As String = "屏保预览(demo)"
Public Const WM_SET As String = "屏保设置(demo)"
Public Const WM_RUN As String = "屏保运行(demo)"
Public Const HWND_TOP As Long = 0&
Public Const WS_CHILD As Long = &H40000000
Public Const GWL_STYLE As Long = (-16)

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Const SWP_NOZORDER = &H4
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const WM_CLOSE = &H10

Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Sub Main() '程序运行入口
    Dim ClassName As String * 64  '存放窗口的类名
    Dim ExeCmd As String '存放命令行参数
  
    GetClassName frm_Setup.hwnd, ClassName, 64 '取得窗口的类名
    ExeCmd = UCase(Command$) '将调用的屏保的参数转换成大写后存放在变量ExeCmd里
    
    If Not (InStr(ExeCmd, "/P") = 0) Then '有“/P”参数,(小窗口预览)
        If Not (FindWindow(ClassName, WM_LOOK) = 0) Then End '如果找到已有同一个运行方式的实例存在则程序结束
        ClosePreWindow ClassName, WM_SET '关闭前面已启动的其他运行方式的实例
        ClosePreWindow ClassName, WM_RUN '同上
        SCR_Look
    ElseIf Not (InStr(ExeCmd, "/S") = 0) Then '正常调用
        If Not (FindWindow(ClassName, WM_RUN) = 0) Then End
        ClosePreWindow ClassName, WM_LOOK '同上
        ClosePreWindow ClassName, WM_SET '同上
        Scr_Run
    Else '设置程序
        If Not (FindWindow(ClassName, WM_SET) = 0) Then End
        ClosePreWindow ClassName, WM_LOOK '同上
        ClosePreWindow ClassName, WM_RUN '同上
        Scr_Setup
    End If
End Sub
  
Public Sub ClosePreWindow(ClassName As String, WinCaption As String)
    Dim PreWnd As Long
    PreWnd = FindWindow(ClassName, WinCaption) '寻找类名为ClassName,标题为WinCaption的窗口
    If Not (PreWnd = 0) Then Call SendMessage(PreWnd, WM_CLOSE, 0, 0) '如果窗口已找到则关闭它
End Sub
Public Sub SCR_Look()
    Dim LookScrWnd As Long
    Dim Style As Long
    Dim LookRect As RECT

    frm_Run.Caption = WM_LOOK '赋上具有相应运行方式的标题
    
    LookScrWnd = Val(Right(Command$, Len(Command$) - 2)) '取得小屏幕的窗口句柄
    Style = GetWindowLong(frm_Run.hwnd, GWL_STYLE) '取得窗口的样式
    Style = Style Or WS_CHILD '在窗口的样式中加入子窗体常数
    SetWindowLong frm_Run.hwnd, GWL_STYLE, Style '改变窗体的样式
    SetParent frm_Run.hwnd, LookScrWnd '设置窗体的父窗体
    GetClientRect LookScrWnd, LookRect '取得小屏幕的大小

    SetWindowPos frm_Run.hwnd, HWND_TOP, 0, 0, LookRect.Right, LookRect.Bottom, SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
    '显示窗体并将窗体的大小设置为小屏幕的大小以便覆盖小屏幕
End Sub
  
Public Sub Scr_Setup()
    frm_Run.Caption = WM_SET '赋上具有相应运行方式的标题
    frm_Setup.Show
End Sub
  
Public Sub Scr_Run()
    frm_Run.Caption = WM_RUN '赋上具有相应运行方式的标题
    ShowCursor False '隐藏鼠标
    frm_Run.Move 0, 0, Screen.Width, Screen.Height
    frm_Run.Show
End Sub
  
Public Sub CloseSCR()
    ShowCursor True '显示鼠标
    Unload frm_Setup '卸载窗体关闭屏保
    Unload frm_Run '同上
End Sub
  
Public Function Scan_RUN() As Boolean '侦测当前屏保的运行方式
    If (frm_Run.Caption = WM_RUN) Then '如果屏保是以运行方式在运行则返回“真”,否则返回“假”
        Scan_RUN = True
    Else
        Scan_RUN = False
    End If
End Function

设置工程的启动项为Sub Main,生成程序后改为scr就行了。

模块中使用的一些API函数,主要是用来检查程序是否已经运行,和把程序整合到“显示属性”中的窗体中。这些无需关心。

真正需要修改的就是frm_Run和frm_Setup的代码,用来控制显示效果,存储设置信息.

回答2:

你只要装一个好看的程序,能够变换颜色,或是图片的程序作好,然后改扩展名为.scr 就可以了。

回答3:

大家都忽视了屏幕保护程序的诞生初衷
对于液晶屏幕,最怕的就是活动或者深色的图像,而其他显示器则相反

回答4:

b dong

回答5:

我不行的???