قرار دادن رویداد برای دکمه های آرایه ای

[warrior_hamed]

سلام من میخوام 99 تا دکمه با کد موقع اجرا شدن فرم بسازم

کدشو بلدم

dim btn(99) as commandbutton

اما اگه بخوام برای هرکدوم روال رویداد click رو قرار بدم باید withevents استفاده کنم اما گیر میده

dim withevents btn(99) as commandbutton

ولی اگه 99 رو ننویسی ایرادی پیش نمیاد چرا نمیشه از آرگومان در این مورد استفاده کرد؟؟؟

جوابمو تو صفحات خارجی پیدا کردم اما آی کی یو ام نمیرسه http://www.iran-forum.ir/images/icons/vb-icone/a%20%2858%29.gif
http://www.vbforums.com/showthread.php?372811-Classic-VB-Why-can-t-I-use-WithEvents-on-arrays-of-objects

[Mr'Jamshidy]

2 راه داری

1. یک دکمه از نوع آرایه روی فرم بزاری و آرایه های اون رو لود کنی
2. بدون WithEvent بسازی و با API ، ایونت هاش رو هوک کنی

[vbhamed]

سلام
راه اصوليش اينه كه البته دوستمون آقاي جمشيدي عزيز هم اشاره كردن
اول يك كنترل كامند Index دار روي فرم بزار بعدش كد زير :

Private Sub Command1_Click(Index As Integer)

Select Case Index
Case 0
Case 1
'.
'.
'.
End Select

End Sub

Private Sub Form_Load()

Dim i%

For i = 1 To 99
Load Command1(i)
Next

End Sub

[mehran901]

قبلا در همین بخش ، در روز های اول راه اندازی بخش ویبی 6 در این مورد بحث شده بوده :

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

Option Explicit

'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
'
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 Declare Function 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 Function Hook(ByVal hwnd) As Long
lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, _
AddressOf WindowProc)
End Function

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


110204

دانلود