功能2(使屏幕变暗): '''''''''''''''''''''''''''''''''''''''''''''''''''' Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal aBitmap As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Sub Dull() '使屏幕变暗 Dim aDC As Long, aBitmap As Long, aBrush As Long, aDesktopWnd As Long Dim lWidth5 As Long, lHeight As Long, bBit(1 To 16) As Byte
下面的代码也许还不完善,我没敢实际测试,呵呵模块中: Option ExplicitPublic Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long Public myHwnd As LongPublic Function EnumWindowsProc1(ByVal hwnd As Long, ByVal lParam _ As Long) As Boolean Dim sTitle As String, Ret As Long Ret = GetWindowTextLength(hwnd) sTitle = Space(Ret) GetWindowText hwnd, sTitle, Ret + 1 If sTitle <> "" And IsWindowVisible(hwnd) <> 0 And hwnd <> myHwnd Then Debug.Print sTitle EnableWindow hwnd, 0 End If EnumWindowsProc1 = True End FunctionPublic Function EnumWindowsProc2(ByVal hwnd As Long, ByVal lParam _ As Long) As Boolean Dim sTitle As String, Ret As Long Ret = GetWindowTextLength(hwnd) sTitle = Space(Ret) GetWindowText hwnd, sTitle, Ret + 1 If sTitle <> "" And IsWindowVisible(hwnd) <> 0 And hwnd <> myHwnd Then Debug.Print sTitle EnableWindow hwnd, 1 End If EnumWindowsProc2 = True End Function窗体中: Private Sub Command1_Click() '禁止措作其他窗口 EnumWindows AddressOf EnumWindowsProc1, 0& End SubPrivate Sub Command2_Click() '恢复 EnumWindows AddressOf EnumWindowsProc2, 0& End SubPrivate Sub Form_Load() '记录本窗口hwnd避免把自己也给搞得不响应了 myHwnd = Me.hwnd End Sub
抓取当前屏幕图像,做一个全屏显示的窗体(即form1.borderstyle=0,然后在form_load中写一句me.move 0,0,screen.width,screen.height),覆盖住桌面以及任务栏,并以刚才抓取的图像作为窗体的背景,显示在你的窗体的当前窗口的下方,这虽然只是一种假象,但是也基本可以达到要求的效果。
2.用bitblt直接写入屏幕dc,让屏幕变暗。
3。显示你的窗体。。
4.用clipcursor限制鼠标的移动区域只能在你的窗体内活动。
如果将“WIN”键和“ALT + F4”键屏蔽掉,,然后把窗口置前并充满个屏幕不就可以了??
对了,,还要屏蔽“任务管理器”和“Windows 安全”。。
''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal aBitmap As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Sub Dull() '使屏幕变暗
Dim aDC As Long, aBitmap As Long, aBrush As Long, aDesktopWnd As Long
Dim lWidth5 As Long, lHeight As Long, bBit(1 To 16) As Byte
aDC = GetDC(0)
lWidth5 = Screen.Width \ Screen.TwipsPerPixelX
lHeight = Screen.Height \ Screen.TwipsPerPixelY
bBit(1) = &H55
bBit(2) = &H0
bBit(3) = &HAA
bBit(4) = &H0
bBit(5) = &H55
bBit(6) = &H0
bBit(7) = &HAA
bBit(8) = &H22
bBit(9) = &H55
bBit(10) = &H0
bBit(11) = &HAA
bBit(12) = &H0
bBit(13) = &H55
bBit(14) = &H0
bBit(15) = &HAA
bBit(16) = &H0
aBitmap = CreateBitmap(8, 8, 1, 1, bBit(1))
aBrush = CreatePatternBrush(aBitmap)
Call SelectObject(aDC, aBrush)
Call PatBlt(aDC, 0, 0, lWidth5, lHeight, &HA000C9)
Call DeleteObject(aBrush)
End SubPrivate Sub Comeback() '恢复屏幕变暗
Call InvalidateRect(0, 0, 1)
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''
遍历当前所有窗体并获得句柄,如果不是自己的窗口,就用EnableWindow hwnd, 0来禁止它响应鼠标键盘事件,也就达到只能操作你的应用程序的目的了。
Option ExplicitPublic Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Public myHwnd As LongPublic Function EnumWindowsProc1(ByVal hwnd As Long, ByVal lParam _
As Long) As Boolean
Dim sTitle As String, Ret As Long
Ret = GetWindowTextLength(hwnd)
sTitle = Space(Ret)
GetWindowText hwnd, sTitle, Ret + 1
If sTitle <> "" And IsWindowVisible(hwnd) <> 0 And hwnd <> myHwnd Then
Debug.Print sTitle
EnableWindow hwnd, 0
End If
EnumWindowsProc1 = True
End FunctionPublic Function EnumWindowsProc2(ByVal hwnd As Long, ByVal lParam _
As Long) As Boolean
Dim sTitle As String, Ret As Long
Ret = GetWindowTextLength(hwnd)
sTitle = Space(Ret)
GetWindowText hwnd, sTitle, Ret + 1
If sTitle <> "" And IsWindowVisible(hwnd) <> 0 And hwnd <> myHwnd Then
Debug.Print sTitle
EnableWindow hwnd, 1
End If
EnumWindowsProc2 = True
End Function窗体中:
Private Sub Command1_Click() '禁止措作其他窗口
EnumWindows AddressOf EnumWindowsProc1, 0&
End SubPrivate Sub Command2_Click() '恢复
EnumWindows AddressOf EnumWindowsProc2, 0&
End SubPrivate Sub Form_Load() '记录本窗口hwnd避免把自己也给搞得不响应了
myHwnd = Me.hwnd
End Sub