Программное создание и получение событий от любых создаваемых контролов

@AAAAlexeyyyy · Регистрация: 20.07.2010

Студворк — интернет-сервис помощи студентам

Люди интересная задача, просмотрел по форуму есть 2 или 3 топика по этому вопросу, но приведены частные решения только для определенных заранее контролов.
Суть задачи имеется форма UserForm на которой в зависимости от диалога с пользователем, он отмечает checkboxы, вводит информацию в textBoxы и.т.д. и как следствие выводятся новые элементы для продолжения диалога. Все выводимые контролы забиваются в один массив лейблов. Как сделать так чтобы можно было получать события от этих контролов или например передать фокус определенному элементу Пример:

Код VBA
Основная программа:
Declaration

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Public cArrayOfControls(30) As MSForms.Label
Sub xxx()
    UserForm1.Show (vbModeless)
    Call CreateControl(2, "Label", 55, 6, 180, 18, True, "Insert a doctor's family name", "")
    Call CreateControl(1, "TextBox", 20, 25, 230, 20, True, "", "")
    cArrayOfControls(1).SetFocus (выдает ошибку)
    ...
End Sub
 
Public Sub CreateControl(nNumbContr, sContr, nXPos, nYPos, nWidth, nHeight, bVis As Boolean, _
    Optional sName, Optional sTag)
    Set cArrayOfControls(nNumbContr) = UserForm1.Controls.Add("Forms." + sContr + ".1")
    With cArrayOfControls(nNumbContr)
        .Width = nWidth
        .Height = nHeight
        .Left = nXPos
        .Top = nYPos
        .Visible = bVis
        ...
    End With
End Sub
 
UserForm's cod
Sub cArrayOfControls(1)_Change()
   ...
End Sub

И вообще возможно ли реализовать что либо подобное.
Заранее благодарен Алексей.

toiai · 08.10.2012, 21:43

Реализовать можно с помощью класса WithEvents.
Создать класс BtnClass:

Visual Basic
1
2
3
4
5
Public WithEvents ButtonGroup As CommandButton
 
Private Sub ButtonGroup_Click()
..... коды обработки нажатия клавиши
End siub

а в форме вставить код

Visual Basic
1
2
3
4
5
6
7
8
 ......   
   For Each ctl In Me.Controls
       If ctl.Visible Then
          i = i + 1
          Set Buttons(i).ButtonGroup = ctl
       End If
    Next ctl
    .....

то при срабатывании события Click в класс будет передаваться свойства Control

Добавлено через 9 минут
Ах да забыл в начале кода формы объявить:

Visual Basic
1
2
3
Option Explicit
 
Dim Buttons() As New BtnClass

@Казанский · 08.10.2012, 21:50

Сообщение от AAAAlexeyyyy

И вообще возможно ли реализовать что либо подобное

Читайте эту тему и по ссылкам из нее: Как проверить, в каком из Checkbox пользователь сделал выбор?

Сообщение от AAAAlexeyyyy

(выдает ошибку)

Ошибка возникает в другом месте: при попытке присвоить ссылку на TextBox элементу массива, объявленному As MSForms.Label. Следует объявить массив

Visual Basic
1
Public cArrayOfControls(30) As MSForms.Control

или просто As Object или вообще без указания типа, т.е. Variant.

@AAAAlexeyyyy · 22.10.2012, 20:27 **[ТС]**

Все! всем спасибо за помощь, (поздно написал так как не было времени разбираться)
особенное спасибо toiai за его совет как занести класс в массив. До этого я ни разу с классами (хотя класс это тот же объект) не работал, поэтому никак ни мог врубиться как связать withevents с массивом.
Для тех кому интересно, может кому пригодиться привожу общее решение, ну пожалуй на все случаи (с которыми я сталкивался) работы с программно создаваемыми контролами.
Эх помню были времена BASICа, все было просто INPUT "Введи то... введи сё...", kk, а далее делай с kk все что хочешь, сейчас же целый геморрой, правда красивый "Геморрой в диалогах".
Ну, чтож

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
NewContrClass 's Declaration
 
Public nIdenOfContr As Integer 'номер создаваемого контрола в массиве
Public sIdenOfContr As String 'название создаваемого контрола
Public WithEvents TextBoxGroup As TextBox 'группа textbox-ов
Public WithEvents LabelGroup As Label '...
Public WithEvents ...Group As ..,.
 
NewContrClass 's Code
 
Private Sub TextBoxGroup_Change()
'    Call TxtBoxDoing(nIdenOfContr, sIdenOfContr) ' можно сделать так переправлять в процедуру для обработки
    Select Case nIdenOfContr ' а можно так 
        Case 1
            'Call обработчик 'как вариант
            Debug.Print "это строка фамилии"
        Case 2
            Debug.Print "Это другая строка"
    End Select
End Sub
 
Modul's Declaration
 
Public clArrayCtr(30) As NewContrClass
 
Modul's Code
 
Sub ModMain()
    Call CreateControl(0, "Label", 25, 10, 110, 18, , "Insert your name", "") 'создает label
    Call CreateControl(1, "TextBox", 25, 30, 110, 18, , "", "") 'создает textbox
    Call CreateControl(2, "TextBox", 25, 50, 110, 18, , "", "") ' второй textBox для примера
    Call InvertVisibility(1) 'инвертирует видимость любого контрола
    Call InvertVisibility(0)
    UserForm1.Show
End Sub
Public Sub CreateControl(nNumbControl, sContr, nXPos, nYPos, nWidth, nHeight, Optional bVis As Boolean, _
        Optional sCaption As String, Optional sTag As String)
    Set clArrayCtr(nNumbControl) = New NewContrClass
    clArrayCtr(nNumbControl).nIdenOfContr = nNumbControl
    clArrayCtr(nNumbControl).sIdenOfContr = sContr
    Select Case sContr
        Case "TextBox"
            Set clArrayCtr(nNumbControl).TextBoxGroup = UserForm1.Controls.Add("Forms." + sContr + ".1")
            With clArrayCtr(nNumbControl).TextBoxGroup
                .Left = nXPos
                .Top = nYPos
                .Width = nWidth
                .Height = nHeight
                .Tag = sTag
            End With
        Case "Label"
            Set clArrayCtr(nNumbControl).LabelGroup = UserForm1.Controls.Add("Forms." + sContr + ".1")
            With clArrayCtr(nNumbControl).LabelGroup
                .Left = nXPos
                .Top = nYPos
                .Width = nWidth
                .Height = nHeight
                .Tag = sTag
                .Caption = sCaption
            End With
    End Select
End Sub
Sub TxtBoxDoing(dd, kk)' это в качестве примера
    Debug.Print dd, kk 
End Sub
Public Sub InvertVisibility(nNumbContr)
    If UserForm1.Controls(nNumbContr).Visible Then UserForm1.Controls(nNumbContr).Visible = False Else UserForm1.Controls(nNumbContr).Visible = True
End Sub
 
Form's Code
 
в форме ничего писать не надо.

Кстати так и не понял зачем нужен Option Explicit может конечно если мы работаем из кода формы. Ну да бог с ним мне не понадобился.
кстати возник следующий вопрос, опять к знатокам возможно ли оптимизировать следующий код

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
    Select Case sContr
        Case "TextBox"
            Set clArrayCtr(nNumbControl).TextBoxGroup = UserForm1.Controls.Add("Forms." + sContr + ".1")
            With clArrayCtr(nNumbControl).TextBoxGroup
                .Left = nXPos
                .Top = nYPos
                .Width = nWidth
                .Height = nHeight
                .Tag = sTag
            End With
        Case "Label"
            Set clArrayCtr(nNumbControl).LabelGroup = UserForm1.Controls.Add("Forms." + sContr + ".1")
            With clArrayCtr(nNumbControl).LabelGroup
                .Left = nXPos
                .Top = nYPos
                .Width = nWidth
                .Height = nHeight
                .Tag = sTag
                .Caption = sCaption
            End With
    End Select

до чего то более простого типа...

Visual Basic
1
2
3
4
5
6
7
8
9
10
    
     Set clArrayCtr(nNumbControl).UniversalIdentOfGroup = UserForm1.Controls.Add("Forms." + sContr + ".1")
     With clArrayCtr(nNumbControl).UniversalIdentOfGroup ' возможно ли сделать или использовать _
             UniversalIdentOfGroup таким образом UniversalIdenOfGroup = sContr+"Group"
                .Left = nXPos
                .Top = nYPos
                .Width = nWidth
                .Height = nHeight
                .Tag = sTag
            End With

так как многие параметры высота, ширина позиция, одни и те-же.
Еще один вопрос если не трудно раньше в BASIC-е был один очень удобный для работы оператор,

Visual Basic
1
2
3
4
5
Data 4,25,65,2,6,4,65,...n
Dim a(n)
For i=1 to n
Read a(i)
Next i ' массив заполнялся значениями из DATA

вообще в asm существует такая штуковина очень кстати удобная для данных dw, db, dq ... очень похожая на этот оператор data
интересно в VBA есть что либо подобное?
Ну ладно всем спасибо за внимание, может кому моя информация окажется полезной.
Заранее благодарен Алексей.

Новые блоги и статьи Все статьи Все блоги /
Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .
SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image 8Observer8 10.02.2026 Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .	Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .	SDL3 для Web (WebAssembly): Работа со звуком через SDL3_mixer 8Observer8 08.02.2026 Содержание блога Пошагово создадим проект для загрузки звукового файла и воспроизведения звука с помощью библиотеки SDL3_mixer. Звук будет воспроизводиться по клику мышки по холсту на Desktop и по. . .