Imports System
Imports System.Windows.Interop
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Namespace PreTranslate
Public Class Commands
' Keys
Const MK_SHIFT As Integer = 4
Const MK_CONTROL As Integer = 8
' Keyboard messages
Const WM_KEYDOWN As Integer = 256
Const WM_KEYUP As Integer = 257
Const WM_CHAR As Integer = 258
Const WM_SYSKEYDOWN As Integer = 260
Const WM_SYSKEYUP As Integer = 261
' Mouse messages
Const WM_MOUSEMOVE As Integer = 512
Const WM_LBUTTONDOWN As Integer = 513
Const WM_LBUTTONUP As Integer = 514
Shared Function MakeLong(LoWord As Integer, HiWord As Integer) As Long
Return (HiWord << 16) Or (LoWord And &HFFFF)
End Function
Shared Function MakeLParam(LoWord As Integer, HiWord As Integer) As IntPtr
Return CType(MakeLong(LoWord, HiWord), IntPtr)
End Function
Shared Function HiWord(Number As Integer) As Integer
Return (Number >> 16) And &HFFFF
End Function
Shared Function LoWord(Number As Integer) As Integer
Return Number And &HFFFF
End Function
Private vMode As Boolean
Private hMode As Boolean
Private ptx As Integer
Private pty As Integer
' 强制将字母字符输入为大写
<CommandMethod("caps")>
Public Sub Caps()
AddHandler Application.PreTranslateMessage, AddressOf CapsHandler
End Sub
<CommandMethod("uncaps")>
Public Sub UnCaps()
RemoveHandler Application.PreTranslateMessage, AddressOf CapsHandler
End Sub
<CommandMethod("vhmouse")>
Public Sub Vhmouse()
AddHandler Application.PreTranslateMessage, AddressOf VhmouseHandler
End Sub
<CommandMethod("unvhmouse")>
Public Sub UnVhmouse()
RemoveHandler Application.PreTranslateMessage, AddressOf VhmouseHandler
End Sub
<CommandMethod("watchCC")>
Public Sub WatchCC()
AddHandler Application.PreTranslateMessage, AddressOf WatchCCHandler
End Sub
<CommandMethod("unwatchCC")>
Public Sub UnWatchCC()
RemoveHandler Application.PreTranslateMessage, AddressOf WatchCCHandler
End Sub
<CommandMethod("noX")>
Public Sub NoX()
AddHandler Application.PreTranslateMessage, AddressOf NoXHandler
End Sub
<CommandMethod("yes")>
Public Sub YesX()
RemoveHandler Application.PreTranslateMessage, AddressOf NoXHandler
End Sub
' 强制将字母字符输入为大写
Sub CapsHandler(sender As Object, e As PreTranslateMessageEventArgs)
If e.Message.message = WM_CHAR AndAlso (e.Message.wParam.ToInt32() >= 97 AndAlso e.Message.wParam.ToInt32() <= 122) Then
Dim msg As MSG = e.Message
msg.wParam = CType((e.Message.wParam.ToInt32() - 32), IntPtr)
e.Message = msg
End If
End Sub
'强制鼠标水平或垂直移动
Sub VhmouseHandler(sender As Object, e As PreTranslateMessageEventArgs)
' 只看鼠标消息
If e.Message.message = WM_MOUSEMOVE OrElse e.Message.message = WM_LBUTTONDOWN OrElse e.Message.message = WM_LBUTTONUP Then
If (e.Message.message = WM_LBUTTONDOWN OrElse e.Message.message = WM_LBUTTONUP) AndAlso (vMode OrElse hMode) Then
Dim msg As MSG = e.Message
msg.lParam = MakeLParam(ptx, pty)
e.Message = msg
Return
End If
If e.Message.wParam.ToInt32() = MK_CONTROL Then '如果按下 Control 键，鼠标竖向移动
If vMode Then
Dim msg As MSG = e.Message
msg.lParam = MakeLParam(ptx, HiWord(e.Message.lParam.ToInt32()))
e.Message = msg
pty = HiWord(e.Message.lParam.ToInt32())
Else
ptx = LoWord(e.Message.lParam.ToInt32())
End If
vMode = True
hMode = False
ElseIf e.Message.wParam.ToInt32() = MK_SHIFT Then '如果按下 Shift 键，鼠标水平移动
If hMode Then
Dim msg As MSG = e.Message
msg.lParam = MakeLParam(LoWord(e.Message.lParam.ToInt32()), pty)
e.Message = msg
ptx = LoWord(e.Message.lParam.ToInt32())
Else
pty = HiWord(e.Message.lParam.ToInt32())
End If
hMode = True
vMode = False
Else
'按了其他内容，所以取消我们的过滤
vMode = hMode = False
End If
End If
End Sub
' 监视并输出 Ctrl+C 被按下的消息
Sub WatchCCHandler(sender As Object, e As PreTranslateMessageEventArgs)
If e.Message.message = WM_CHAR AndAlso e.Message.wParam.ToInt32() = 3 Then
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
doc.Editor.WriteMessage(vbLf & "Ctrl+C 组合键被按下")
End If
End Sub
' 过滤掉字母 x/X 的使用
Sub NoXHandler(sender As Object, e As PreTranslateMessageEventArgs)
' 如果按下小写或大写 x，通过将 Handled 属性设置为 true 来筛选消息
If e.Message.message = WM_CHAR AndAlso (e.Message.wParam.ToInt32() = 120 OrElse e.Message.wParam.ToInt32() = 88) Then
e.Handled = True
End If
End Sub
End Class
End Namespace
https://through-the-interface.typepad.com/thro ... 2008/05/filtering-windo.html
