دوستان به احتمال زیاد می دونن که چطور در حالت اجرا می توان به یک فرم کنترل اضافه کرد. با استفاده از این حالت و برای نوشتن برنامه های خاص می توان کارهای جالبی انجام داد ولی مشکل در کنترل کردن 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 ها قدرتمندی که قادر هستند در زمان اجرا کنترل به خودشون اضافه کنند و به پیفامهای اونا جواب بدن رو تولید کنید.
