新概念的 Visual Basic 6.0 教程 - 补充教材


如何让屏幕保护程序在“小屏幕”上面跑?(01/25)


以书本 16-3 节的 Saver03.vbp 为基础, 首先在 Saver03.frm 窗体的最上面增加以下定义式:

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

Const WS_CHILD = &H40000000
Const GWL_HWNDPARENT = (-8)
Const GWL_STYLE = (-16)
Const HWND_TOPMOST = -1&
Const HWND_TOP = 0&
Const HWND_BOTTOM = 1&

Const SWP_NOSIZE = &H1&
Const SWP_NOMOVE = &H2
Const SWP_NOZORDER = &H4
Const SWP_NOREDRAW = &H8
Const SWP_NOACTIVATE = &H10
Const SWP_FRAMECHANGED = &H20
Const SWP_SHOWWINDOW = &H40
Const SWP_HIDEWINDOW = &H80
Const SWP_NOCOPYBITS = &H100
Const SWP_NOOWNERZORDER = &H200
Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Const SWP_NOREPOSITION = SWP_NOOWNERZORDER

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Sub 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)

接着将 Saver03.frm 窗体以下的语句:

If UCase(Left(Command, 2)) = "/P" Then ' 小屏幕
    Unload Me: End
End If

修改成:

If UCase(Left(Command, 2)) = "/P" Then ' 小屏幕
    Dim hwndDsp As Long
    Dim r As RECT

    hwndDsp = Val(Mid(Command, 3))
    GetClientRect hwndDsp, r
    Me.Caption = "Preview"
    Style = GetWindowLong(Me.hwnd, GWL_STYLE)
    Style = Style Or WS_CHILD
    SetWindowLong Me.hwnd, GWL_STYLE, Style

    SetParent Me.hwnd, hwndDsp
    SetWindowLong Me.hwnd, GWL_HWNDPARENT, hwndDsp
    SetWindowPos Me.hwnd, HWND_TOP, 0&, 0&, r.Right, r.Bottom, SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_SHOWWINDOW

End If

或者直接下载笔者所修改之后的 saver03.frm 以代既有的 saver03.frm 文档。