7,789
社区成员
发帖
与我相关
我的任务
分享请发表友善的回复…
发表回复
junwhj 2002-07-18
- 打赏
- 举报
To: hello8118(hello)
'==================================
'禁止鼠标移动的例子
'==================================
Private Declare Function ClipCursor Lib "user32" (lpRect As RECT) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Sub Form_Load()
Dim rc As RECT
rc.Left = Screen.Width / Screen.TwipsPerPixelX / 2
rc.Top = Screen.Height / Screen.TwipsPerPixelY / 2
rc.Right = rc.Left
rc.Bottom = rc.Top
Call ClipCursor(rc)
'Call ShowCursor(0) '隐藏鼠标
End Sub
Private Sub Command1_Click()
Dim rc As RECT
rc.Left = 0
rc.Top = 0
rc.Bottom = Screen.Height / Screen.TwipsPerPixelY
rc.Right = Screen.Width / Screen.TwipsPerPixelX
Call ClipCursor(rc)
'Call ShowCursor(1) '显示鼠标
End Sub
'==================================
'禁止鼠标移动的例子
'==================================
Private Declare Function ClipCursor Lib "user32" (lpRect As RECT) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Sub Form_Load()
Dim rc As RECT
rc.Left = Screen.Width / Screen.TwipsPerPixelX / 2
rc.Top = Screen.Height / Screen.TwipsPerPixelY / 2
rc.Right = rc.Left
rc.Bottom = rc.Top
Call ClipCursor(rc)
'Call ShowCursor(0) '隐藏鼠标
End Sub
Private Sub Command1_Click()
Dim rc As RECT
rc.Left = 0
rc.Top = 0
rc.Bottom = Screen.Height / Screen.TwipsPerPixelY
rc.Right = Screen.Width / Screen.TwipsPerPixelX
Call ClipCursor(rc)
'Call ShowCursor(1) '显示鼠标
End Sub
doubleyang 2002-07-17
- 打赏
- 举报
除第一个外没有能在2000下通过的
vbanswer 2002-07-05
- 打赏
- 举报
禁止使用 Alt-Tab 或 Ctrl-Alt-Del
Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Integer, ByVal aBOOL As Integer) As Integer
Private Declare Function IsWindowEnabled Lib "user32" (ByVal hWnd As Integer) As Integer
Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Integer) As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Private TaskBarhWnd As Long
Private IsTaskBarEnabled As Integer
Private TaskBarMenuHwnd As Integer
'禁止或允许使用 Alt-Tab
Sub FastTaskSwitching(bEnabled As Boolean)
Dim X As Long, bDisabled As Long
bDisabled = Not bEnabled
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
'禁止使用Ctrl-Alt-Del
Public Sub DisableTaskBar()
Dim EWindow As Integer
TaskBarhWnd = FindWindow("Shell_traywnd", "")
If TaskBarhWnd <> 0 Then
EWindow = IsWindowEnabled(TaskBarhWnd)
If EWindow = 1 Then
IsTaskBarEnabled = EnableWindow(TaskBarhWnd, 0)
End If
End If
End Sub
'允许使用Ctrl-Alt-Del
Public Sub EnableTaskBar()
If IsTaskBarEnabled = 0 Then
IsTaskBarEnabled = EnableWindow(TaskBarhWnd, 1)
End If
End Sub
禁止 Ctrl+Alt+Del
声明(For Win95)：
Const SPI_SCREENSAVERRUNNING = 97
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
lpvParam As Any, ByVal fuWinIni As Long) As Long
使用：
'禁止
Dim pOld As Boolean
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
'开启
Dim pOld As Boolean
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
........................................................................................................................................................................................
禁止使用 Alt+F4 关闭窗口
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private Sub Form_Load()
Dim hwndMenu As Long
Dim c As Long
hwndMenu = GetSystemMenu(Me.hwnd, 0)
c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION
c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION
End Sub
........................................................................................................................................................................................
如何让窗体右上角的X失效？
在VB中，每个窗体都有两个卸载事件，不同的是，QueryUnload事件不仅允许用户
取消进程，并且告诉程序做些什么来开始卸载工作。为使窗体右上角的X失效，并
下面的代码放在该事件中就行了。
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = -1
End Sub
........................................................................................................................................................................................
让窗口拒绝接受键盘和鼠标事件
声明：
Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
使用：
'拒绝接受键盘和鼠标事件
Call EnableWindow(Form.hwnd, 0)
'允许接受键盘和鼠标事件
Call EnableWindow(Form.hwnd, 1)
........................................................................................................................................................................................
禁止使用 Alt+F4 关闭窗口
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private Sub Form_Load()
Dim hwndMenu As Long
Dim c As Long
hwndMenu = GetSystemMenu(Me.hwnd, 0)
c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION
c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION
End Sub
........................................................................................................................................................................................
禁止x按钮及关闭菜单
Option Explicit
Private Declare Function GetSystemMenu Lib "user32"_
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32"_
(ByVal hMenu As Long) As Long
Private Declare Function RemoveMenu Lib "user32"_
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32"_
(ByVal hwnd As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private Const MF_REMOVE = &H1000&
Private Sub DisableX()
Dim hMenu As Long
Dim nCount As Long
hMenu = GetSystemMenu(Me.hWnd, 0)
nCount = GetMenuItemCount(hMenu)
'Get rid of the Close menu and its separator
Call RemoveMenu(hMenu, nCount - 1, MF_REMOVE Or MF_BYPOSITION)
Call RemoveMenu(hMenu, nCount - 2, MF_REMOVE Or MF_BYPOSITION)
'Make sure the screen updates
'our change DrawMenuBar Me.hWnd
End Sub
Private Sub Form_Load()
DisableX
End Sub
Private Sub Form_Click()
'We need a way out, since the X button'doesn't work :-)
Unload Me
End Sub
应该是可以的吧!
Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Integer, ByVal aBOOL As Integer) As Integer
Private Declare Function IsWindowEnabled Lib "user32" (ByVal hWnd As Integer) As Integer
Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Integer) As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Private TaskBarhWnd As Long
Private IsTaskBarEnabled As Integer
Private TaskBarMenuHwnd As Integer
'禁止或允许使用 Alt-Tab
Sub FastTaskSwitching(bEnabled As Boolean)
Dim X As Long, bDisabled As Long
bDisabled = Not bEnabled
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
'禁止使用Ctrl-Alt-Del
Public Sub DisableTaskBar()
Dim EWindow As Integer
TaskBarhWnd = FindWindow("Shell_traywnd", "")
If TaskBarhWnd <> 0 Then
EWindow = IsWindowEnabled(TaskBarhWnd)
If EWindow = 1 Then
IsTaskBarEnabled = EnableWindow(TaskBarhWnd, 0)
End If
End If
End Sub
'允许使用Ctrl-Alt-Del
Public Sub EnableTaskBar()
If IsTaskBarEnabled = 0 Then
IsTaskBarEnabled = EnableWindow(TaskBarhWnd, 1)
End If
End Sub
禁止 Ctrl+Alt+Del
声明(For Win95)：
Const SPI_SCREENSAVERRUNNING = 97
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
lpvParam As Any, ByVal fuWinIni As Long) As Long
使用：
'禁止
Dim pOld As Boolean
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
'开启
Dim pOld As Boolean
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
........................................................................................................................................................................................
禁止使用 Alt+F4 关闭窗口
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private Sub Form_Load()
Dim hwndMenu As Long
Dim c As Long
hwndMenu = GetSystemMenu(Me.hwnd, 0)
c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION
c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION
End Sub
........................................................................................................................................................................................
如何让窗体右上角的X失效？
在VB中，每个窗体都有两个卸载事件，不同的是，QueryUnload事件不仅允许用户
取消进程，并且告诉程序做些什么来开始卸载工作。为使窗体右上角的X失效，并
下面的代码放在该事件中就行了。
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = -1
End Sub
........................................................................................................................................................................................
让窗口拒绝接受键盘和鼠标事件
声明：
Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
使用：
'拒绝接受键盘和鼠标事件
Call EnableWindow(Form.hwnd, 0)
'允许接受键盘和鼠标事件
Call EnableWindow(Form.hwnd, 1)
........................................................................................................................................................................................
禁止使用 Alt+F4 关闭窗口
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private Sub Form_Load()
Dim hwndMenu As Long
Dim c As Long
hwndMenu = GetSystemMenu(Me.hwnd, 0)
c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION
c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION
End Sub
........................................................................................................................................................................................
禁止x按钮及关闭菜单
Option Explicit
Private Declare Function GetSystemMenu Lib "user32"_
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32"_
(ByVal hMenu As Long) As Long
Private Declare Function RemoveMenu Lib "user32"_
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32"_
(ByVal hwnd As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private Const MF_REMOVE = &H1000&
Private Sub DisableX()
Dim hMenu As Long
Dim nCount As Long
hMenu = GetSystemMenu(Me.hWnd, 0)
nCount = GetMenuItemCount(hMenu)
'Get rid of the Close menu and its separator
Call RemoveMenu(hMenu, nCount - 1, MF_REMOVE Or MF_BYPOSITION)
Call RemoveMenu(hMenu, nCount - 2, MF_REMOVE Or MF_BYPOSITION)
'Make sure the screen updates
'our change DrawMenuBar Me.hWnd
End Sub
Private Sub Form_Load()
DisableX
End Sub
Private Sub Form_Click()
'We need a way out, since the X button'doesn't work :-)
Unload Me
End Sub
应该是可以的吧!
hello8118 2002-07-05
- 打赏
- 举报
需要这么多代码吗?，还有如何可以实现标止mouse 移动这个功能呢?--不管怎么样还是要多谢谢 junwhj() 网友：），请大虾不吝告之>
junwhj 2002-07-04
- 打赏
- 举报
只能在WIN2K下运行,且不能屏蔽Ctrl+Alt+Del
模块中:
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Type PKBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Const HC_ACTION = 0
Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYUP = &H105
Private Const VK_TAB = &H9
Private Const VK_ESCAPE = &H1B
Private Const VK_CONTROL = &H11
Private Const WH_KEYBOARD_LL = 13
Private Const LLKHF_ALTDOWN = &H20
Private PrevHook As Long
Public Function LowLevelKeyboardProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim fEatKeystroke As Boolean
Dim p As PKBDLLHOOKSTRUCT
If ncode = HC_ACTION Then
Select Case wParam
Case WM_KEYDOWN, WM_SYSKEYDOWN, WM_KEYUP, WM_SYSKEYUP
CopyMemory p, ByVal lParam, Len(p)
If (p.flags And LLKHF_ALTDOWN) <> 0 Then 'Alt + AnyKey
fEatKeystroke = True
End If
If (p.vkCode = VK_ESCAPE) And ((GetKeyState(VK_CONTROL) And &H8000) <> 0) Then 'Ctrl + Esc
fEatKeystroke = True
End If
Case Else
'do nothing
End Select
End If
If fEatKeystroke Then
LowLevelKeyboardProc = 1
Else
CallNextHookEx WH_KEYBOARD_LL, ncode, wParam, lParam
End If
End Function
Public Sub Hook()
PrevHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
End Sub
Public Sub UnHook()
UnhookWindowsHookEx PrevHook
End Sub
窗体中:
Private Sub Form_Load()
Hook()
End Sub
Private Sub Form_UnLoad(Cancel as integer)
UnHook()
End Sub
模块中:
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Type PKBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Const HC_ACTION = 0
Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYUP = &H105
Private Const VK_TAB = &H9
Private Const VK_ESCAPE = &H1B
Private Const VK_CONTROL = &H11
Private Const WH_KEYBOARD_LL = 13
Private Const LLKHF_ALTDOWN = &H20
Private PrevHook As Long
Public Function LowLevelKeyboardProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim fEatKeystroke As Boolean
Dim p As PKBDLLHOOKSTRUCT
If ncode = HC_ACTION Then
Select Case wParam
Case WM_KEYDOWN, WM_SYSKEYDOWN, WM_KEYUP, WM_SYSKEYUP
CopyMemory p, ByVal lParam, Len(p)
If (p.flags And LLKHF_ALTDOWN) <> 0 Then 'Alt + AnyKey
fEatKeystroke = True
End If
If (p.vkCode = VK_ESCAPE) And ((GetKeyState(VK_CONTROL) And &H8000) <> 0) Then 'Ctrl + Esc
fEatKeystroke = True
End If
Case Else
'do nothing
End Select
End If
If fEatKeystroke Then
LowLevelKeyboardProc = 1
Else
CallNextHookEx WH_KEYBOARD_LL, ncode, wParam, lParam
End If
End Function
Public Sub Hook()
PrevHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
End Sub
Public Sub UnHook()
UnhookWindowsHookEx PrevHook
End Sub
窗体中:
Private Sub Form_Load()
Hook()
End Sub
Private Sub Form_UnLoad(Cancel as integer)
UnHook()
End Sub
