CAD里创建非模态窗体

kenny.bao

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.

yyzhan12

太复杂了,可以很简单实现

SetParent FindWindow(vbNullString, UserForm1.Caption), ThisDrawing.Application.HWND

diadblo

yyzhan12 发表于 2009-10-16 16:14
太复杂了,可以很简单实现SetParent FindWindow(vbNullString, UserForm1.Caption), ThisDrawing.Applicatio ...

具体怎么用?