关机效果[紧急求助]

tangzhong 2006-10-02 10:53:02
我想得到类似系统关机的效果(运行在windows 2000系统):1、系统只响应我的应用程序,别的程序都不能进行任何操作(找了好多资料都没找到)!!!2、屏幕变暗,当前程序则是亮的(基本已经实现,但也欢迎提供代码)3、屏蔽热键(已经得到了相关dll)
紧急求助,分不够再加!也可以直接给我发QQ信息:405797768!
...全文
331 15 打赏 收藏 转发到动态 举报
写回复
用AI写文章
15 条回复
切换为时间正序
请发表友善的回复…
发表回复
tangzhong 2006-10-08
  • 打赏
  • 举报
回复
虽然并没得到我想要的,但还是感谢大家的热心了。由于国庆后要休息一段时间,所以先把帖子结了,嘿嘿,大家可以再次讨论,再次谢谢!
tangzhong 2006-10-06
  • 打赏
  • 举报
回复
好的,先谢谢了先^-^祝各位中秋快乐了,我去测试一下!
happy_sea 2006-10-06
  • 打赏
  • 举报
回复
下面的代码也许还不完善,我没敢实际测试,呵呵。。。

模块中:
Option Explicit

Public 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 Long

Public 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 Function

Public 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 Sub

Private Sub Command2_Click() '恢复
EnumWindows AddressOf EnumWindowsProc2, 0&
End Sub

Private Sub Form_Load() '记录本窗口hwnd避免把自己也给搞得不响应了
myHwnd = Me.hwnd
End Sub
蒋晟 2006-10-06
  • 打赏
  • 举报
回复
you can switch to another desktop
tangzhong 2006-10-06
  • 打赏
  • 举报
回复
答lsftest:限制了鼠标区域的话,如果弹出一个对话框,那么就会解除锁定了!happy_sea(开心海) 说的“就用EnableWindow hwnd, 0”我想可行,不知道能否提供源码?谢谢了
lsftest 2006-10-05
  • 打赏
  • 举报
回复
既然已屏蔽了热键,又用clipcursor限制了鼠标的移动区域,楼主还怎么操作别的程序???
happy_sea 2006-10-05
  • 打赏
  • 举报
回复
对于第一个问题,又想到了一个办法楼主不妨一试:
遍历当前所有窗体并获得句柄,如果不是自己的窗口,就用EnableWindow hwnd, 0来禁止它响应鼠标键盘事件,也就达到只能操作你的应用程序的目的了。
BUGStudio 2006-10-04
  • 打赏
  • 举报
回复
功能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 Long

Private 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 Sub

Private Sub Comeback() '恢复屏幕变暗
Call InvalidateRect(0, 0, 1)
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''
BUGStudio 2006-10-04
  • 打赏
  • 举报
回复
第一个功能。。。。
那你就试试置顶吧(不断的置顶)。。
tangzhong 2006-10-04
  • 打赏
  • 举报
回复
我说的很明白啊,第一个功能就是“系统只响应我的应用程序,别的程序都不能进行任何操作”,热键我都屏蔽了,问题是当有别的程序在运行时,我还是可以操作别的程序,而windows关机时,是不能操作别的其他任何程序了的,除非退出那个关机对话框!继续等待ing……
BUGStudio 2006-10-03
  • 打赏
  • 举报
回复
你的第一个功能不知道想实现什麽??
如果将“WIN”键和“ALT + F4”键屏蔽掉,,然后把窗口置前并充满个屏幕不就可以了??
对了,,还要屏蔽“任务管理器”和“Windows 安全”。。
lsftest 2006-10-03
  • 打赏
  • 举报
回复
1。屏蔽热键。。。
2.用bitblt直接写入屏幕dc,让屏幕变暗。
3。显示你的窗体。。
4.用clipcursor限制鼠标的移动区域只能在你的窗体内活动。。。。
happy_sea 2006-10-02
  • 打赏
  • 举报
回复
这个恐怕太难了吧,只能关注了。。。
tangzhong 2006-10-02
  • 打赏
  • 举报
回复
happy_sea(开心海)你好,还是很感谢你的热心回复,这个我已经想到了,就是我不想这么做才**嘿嘿,就是想知道怎么实现只响应当前程序的效果!
happy_sea 2006-10-02
  • 打赏
  • 举报
回复
对于第一个问题,想到了这样一个思路:
抓取当前屏幕图像,做一个全屏显示的窗体(即form1.borderstyle=0,然后在form_load中写一句me.move 0,0,screen.width,screen.height),覆盖住桌面以及任务栏,并以刚才抓取的图像作为窗体的背景,显示在你的窗体的当前窗口的下方,这虽然只是一种假象,但是也基本可以达到要求的效果。

1,486

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧