module1.bas

完整的屏保

Attribute VB_Name = "Module1"
Option Explicit

' API函数声明
'这三个函数的说明可以参见其他源码的讲解
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
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'-------------------------------------------
'【VB声明】
'  Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

'【说明】
'  取得指定窗口的系统菜单的句柄。在vb环境，“系统菜单”的正式名称为“控制菜单”，即单击窗口左上角的控制框时出现的菜单

'【返回值】
'  Long，如执行成功，返回系统菜单的句柄；零意味着出错。如bRevert设为TRUE，也会返回零（简单的恢复原始的系统菜单）

'【备注】
'  在vb里使用：系统菜单会向窗口发送一条WM_SYSCOMMAND消息，而不是WM_COMMAND消息

'【参数表】
'  hwnd -----------  Long，窗口的句柄

'  bRevert --------  Long，如设为TRUE，表示接收原始的系统菜单
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
'---------------------------------------------
'【VB声明】
'  Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long

'【说明】
'  在指定的菜单里添加一个菜单项

'【返回值】
'  Long，非零表示成功，零表示失败。会设置GetLastError

'【备注】
'  Declare Function AppendMenu&  Lib
'  "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As
'  Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String)

'【参数表】
'  hMenu ----------  Long，菜单句柄

'  wFlags ---------  Long，参考ModifyMenu函数中的菜单常数标志定义表，其中列出了允许使用的所有常数

'  wIDNewItem -----  Long，指定菜单条目的新命令ID。如果在wFlags参数中指定了MF_POPUP字段，那么这应该是指向一个弹出式菜单的句柄

'  lpNewItem ------  String（相应的vb声明见注解），如果在wFlags参数中指定了MF_STRING标志，这就代表在菜单中设置的字串。如设置了MF_BITMAP标志，这就代表一个Long型变量，其中包含了一个位图句柄。如设置了MF_OWNERDRAW，这个值就会包括在DRAWITEMSTRUCT和MEASUREITEMSTRUCT结构中，在条目需要重画的时候由windows发送出去
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
'----------------------------------------------
' 常数声明
Public Const WM_SYSCOMMAND = &H112
' 单击控制框产生此消息
Public Const MF_SEPARATOR = &H800&
' 为菜单加一条分隔线
Public Const MF_STRING = &H0&
' 在菜单中加一个字符串
Public Const GWL_WNDPROC = (-4)

' 全局变量
Public OldWindowProc As Long
' 保存默认的窗口函数地址
Public SysMenuHwnd As Long
' 保存系统菜单句柄

Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
    If Msg <> WM_SYSCOMMAND Then
        WindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
        ' 如果消息不是WM_SYSCOMMAND，就调用 默认的窗口函数处理
        Exit Function
    End If
    
    Select Case wp
        Case 2001       '是“帮助”项的ID，前面AppendMenu中定义
            MsgBox "本程序实现了修改系统菜单的功能  ", vbOKOnly, "关于"
        Case 2003       '是“恢复”项的ID，前面AppendMenu中定义
            
            '恢复为默认的系统菜单
            Call GetSystemMenu(Form1.hwnd, True)
            '取消子类化，恢复原来的窗体属性，即恢复默认的窗体函数来接收消息
            Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, OldWindowProc)
            MsgBox "已经恢复了默认的系统菜单", vbOKOnly, "恢复"
        Case Else
            '把消息传递给原 窗体函数 ，让它来处理
            WindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
            Exit Function
    End Select
    
    WindowProc = True
        
End Function