【问】控件如何捕获窗体的事件？

Question

比如双击应用程序窗体，在此窗体上的某个控件就能感应到，并触发控件内部的Private Sub
事件（就是不能在控件以外的地方调用的自定义事件）

Answer 1

这样行吗??一个笨方法
在每个窗体事件设置一个标志,再利用一个TIMER来判断每个标志,如果那个标志为真,就触发特定的件.例如:双击事件
Private Sub Form_DblClick()
dblclick_flag = True
End Sub
Private Sub Timer1_Timer()
if(dblclick_flag=true)then
  '控件事件
endif
End Sub
不知道你是不是这个意思??

Answer 2

不是楼上这个意思吧？窗体本身就有DblClick事件，直接在这里通知控件就行了，哪用那么麻烦楼主是不是说的用户控件？自己写的控件想影响所在窗体的事件？
好像没什么意义哦，用户使用时直接在窗体的相应事件里通知你的控件不行吗？

Answer 3

private sub form_dblclick()
 sendmessage 控件名.hwnd,你指定的控件消息,wp,lp
end sub

Answer 4

有谁见过"状态栏控件"的宽度调整，要我们在Form里写代码的？
它就是捕获了父窗体的Resize消息，然后自动调整宽度的！请不要再说从外部编代码去控制此控件了，
我就想要做一个能自动捕获父窗体的事件的控件，
所有代码写在控件内部，不想在外部窗体里写一行程序！！！

Answer 5

'控件中的代码
Option Explicit
Public Event FrmMsg(ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
Dim bFlag As BooleanPrivate Sub UserControl_Initialize()
  Set Uc = Me
  bFlag = False
End SubPublic Sub SetFrmMsg(ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
   RaiseEvent FrmMsg(Msg, wParam, lParam)
End Sub
    
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  If bFlag = False Then
    AddProc UserControl.Extender.Parent.hwnd
    bFlag = True
  End If
End SubPrivate Sub UserControl_Terminate()
  If bFlag = True Then
    ' RemoveProc UserControl.Extender.Parent.hwnd
     bFlag = False
  End If
End Sub
'控件模块
Option ExplicitPublic OldWindowProc As Long       '旧的窗口进程号'将消息传答窗口函数
Public 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
'设置窗口附加内存长型数值
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONUP = &H205
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Uc As Object
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    Select Case Msg
     Case WM_LBUTTONUP, WM_RBUTTONUP, WM_LBUTTONDBLCLK, WM_LBUTTONDOWN, WM_RBUTTONDBLCLK, WM_RBUTTONDOWN
      Uc.SetFrmMsg Msg, wParam, lParam
    End Select
    '发送其余的消息到原先的窗口信息处理进程
    NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End FunctionPublic Sub AddProc(hwnd As Long)
    ' 设置新的窗口信息处理进程             '窗口进程        '窗口进程地址
    OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
Public Sub RemoveProc(hwnd As Long)
    ' 恢复原来窗口信息处理进程.
    SetWindowLong hwnd, GWL_WNDPROC, OldWindowProc
End Sub
'测试程序
Option ExplicitPrivate Sub UserControl11_FrmMsg(ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
   Text1 = Msg
   Text2 = wParam
   Text3 = lParam
End Sub

Answer 6

yefanqiu(叶帆) 
不错！高人啊，衷心的佩服佩服！下面我想，能否通过另一种简单点的方法来实现呢？
我试过用WithEvents＋UserControl.Extender.Parent
但却出错，说对象不支持事件集，能否解释一下原因吗？能否在控件内部通过其它的办法建一个WithEvents Form?
这样就可避开子类技术，对VB代码来说会更“安全”些，也更方便调试！请高人指点，谢谢！

Answer 7

’这种方法你看可不可以
Option ExplicitDim WithEvents frm As Form'捕获窗口的事件
Private Sub frm_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
     MsgBox "你单击了父窗体"
End Sub
  
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   On Error GoTo GoErr    '必须加出错处理，否则程序退出时，该代码再次执行会出错
    Set frm = UserControl.Extender.Parent
GoErr:
End Sub

Answer 8

真是高人啊，果然行，心情特好！
但我发现这样只能做到后期绑定，也就是说只能在窗体运行时才能捕获，
能否做到前期绑定呢？就是在窗体设计时，控件就能捕获？
类似于Tab控件，在窗体设计时，单击此控件上不同的标签就能显示不同的页面。还想做到，如改变窗体大小时，控件也能自动调整自己位置，注意此时，是在设计状态，也就是应用程序未运行时！请指教！谢谢！

Answer 9

不是什么高人，有些问题我也不太明白，控件在VB IDE开发环境和运行环境中，有些事件的触发是基于不同机制甚至不同实体（即开发环境下的实体与运行中的实体不是同一个）所以在开发环境中某些对象的MouseDown、Resize事件有可能就不会触发目前，我认为须用子类或钩子技术才能实现你说的功能
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    Select Case Msg
      Case WM_SIZE
        ' Debug.Print Msg
        '根据父窗体大小调整控件本身大小
    End Select
    '发送其余的消息到原先的窗口信息处理进程
    NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End Function