|
|
CAD二次开发增加窗体时，尽管窗体的show属性为vbmodeless，运行时如果鼠标不在窗体内操作，窗体上的控件都是无法获得焦点的，例如根本无法在窗体内的文本框内输入文字。下面的代码可以做到随意时窗体和CAD获得焦点，方便操作。
================================[模块代码开始]=============
'API函数声明
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Dim ThisHwnd As Long
Public Const GWL_STYLE = -16
Public Const WS_POPUP = &H80000000
' 函数EnumWindowsProc返回值
Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Integer
Dim title As String * 32
Call GetWindowText(hwnd, ByVal title, 32)
If InStr(title, "示例窗体") Then '根据窗体的"Caption"值来枚举
ThisHwnd = hwnd '已找到窗体,则退出
EnumWindowsProc = False
Else
EnumWindowsProc = True '未找到,继续枚举
End If
End Function
Public Function SubClass() As Long
Dim Flags As Long
Flags = GetWindowLong(ThisHwnd, GWL_STYLE)
Flags = Flags Xor WS_POPUP
SetWindowLong ThisHwnd, GWL_STYLE, Flags
End Function
================================[模块代码结束]=============
================================[窗体代码开始]=============
Private Sub UserForm_Activate()
Call EnumWindows(AddressOf EnumWindowsProc, vbNull)
Call SubClass
End Sub
================================[窗体代码结束]=============
窗体的showmodal属性值必须设为False.
本帖以下内容被隐藏保护；需要你回复后，才能看到！ 游客，如果您要查看本帖隐藏内容请 回复 |
|
置顶卡
