دوستان به احتمال زياد مي دونن كه چطور در حالت اجرا مي توان به يك فرم كنترل اضافه كرد. با استفاده از اين حالت و براي نوشتن برنامه هاي خاص مي توان كارهاي جالبي انجام داد ولي مشكل در كنترل كردن Event هاي اين كنترل هاست كه در حالت اجرا توليد ميشن. من قصد دارم در كد زير به شما نشون بدم كه چطور مي تونيد كنترل ها رو در زمان اجرا توليد كنيد و به Event هاي اونا بدون محدوديت تعدادشون جواب بدين.
ميدونيد كه با استفاده از Withevents در دستور Dim ميشه Event هاي يك Object رو هم كنترل كرد

Private WithEvents objectTemp As TextBox

ولي مسلمآ‌ براي تعداد مشخص كنترل ها ميشه اينكارو كرد و نه براي كنترلهايي كه تعداد اونا نامشخص هست. براي حل اين مشكل من از Subclassing استفاده كردم تا تمام پيغامهايي رو كه ويندوز به كنترل مي فرسته رو كنترل كنم و بعد اونا رو به پيغامهاي قابل فهم براي VB تبديل كردم. ابتدا فرض كنيد كدي شبيه كد زير دارم:


Option Explicit
Public WithEvents textboxTemp As TextBox
Dim aHwnd() As Long

Private Sub Form_Load()
'
Dim controlTemp As Control
ReDim aHwnd(1) As Long

Set controlTemp = Me.Controls.Add("VB.TextBox", "Test")
controlTemp.Visible = True
aHwnd(0) = controlTemp.hwnd
Call Hook(controlTemp.hwnd)
Call SetProp(controlTemp.hwnd, "objectPointer", ObjPtr(controlTemp))

Set controlTemp = Me.Controls.Add("VB.TextBox", "Test1")
controlTemp.Visible = True
controlTemp.Move 1000, 1000
aHwnd(1) = controlTemp.hwnd
Call Hook(controlTemp.hwnd)
Call SetProp(controlTemp.hwnd, "objectPointer", ObjPtr(controlTemp))
'
End Sub

Private Sub Form_Unload(Cancel As Integer)
'
Dim i As Byte

For i = 0 To UBound(aHwnd)
If aHwnd(i) Then
Call UnHook(aHwnd(i))
End If
Next
'
End Sub

Private Sub textboxTemp_Change()
Label1.Caption = textboxTemp.Text
End Sub

در Form_Load Event, دو تا Textbox به صورت Dynamic به VB اضافه شدن. بعد شروع به Subclassing ميشن و بعد آدرس هر كنترل رو در حافظه همراه خود كنترل نگه داشته ميشه. حالا فقط كافيه پيغامها رو بگيريم بعد به كنترل از طريق آدرسي كه ازش نگه داشته بوديم دسترسي پيدا كنيم و پيغام ها رو به VB بسپريم.


'in a module
Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
'
Private 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

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)

Private Const GWL_WNDPROC = -4
Private lpPrevWndProc As Long

Public Sub Hook(ByVal hwnd As Long)
lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub

Public Sub UnHook(hwnd)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long


WindowProc = CallWindowProc(lpPrevWndProc, hw, _
uMsg, wParam, lParam)

Dim objectTemp As Object
Call CopyMemory(objectTemp, GetProp(hw, "objectPointer"), 4)

If Not objectTemp Is Nothing Then
Set Form1.textboxTemp = objectTemp
Call CopyMemory(objectTemp, 0, 0)
End If

End Function




با استفاده از اين تكنيك ميتونيد پروژه ها يا ActiveX ها قدرتمندي كه قادر هستند در زمان اجرا كنترل به خودشون اضافه كنند و به پيفامهاي اونا جواب بدن رو توليد كنيد.