Работа с контейнером

Dim mm As Object
For Each mm In Me
   If (TypeOf mm Is CommandButton) AND (mm.Tag = "option") Then MsgBox mm.Name
Next

Dim WithEvents NewLabel As Label
 
Private Sub Form_Load()
   Delta = 1            'смещение по оси Y
   For i = 0 To 9
      MyName$ = "Elem_" & CStr(i)
      
      Set NewLabel = Controls.Add("VB.Label", MyName$, Pic)
         With NewLabel
            .Width = 900: .Height = 200: .Top = .Top + Delta
            .Visible = True
            .Caption = MyName$
         End With
      Delta = Delta + 300
   Next i
End Sub
 
Private Sub NewLabel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If InStr(NewLabel.Name, "5") Then _
      Me.Caption = NewLabel.Caption
End Sub

Private Sub Command1_Click()
    
    Dim v
    For Each v In Me.Controls
        If v.Container.hWnd = Picture1.hWnd Then
            Debug.Print v.Name
        End If
    Next
 
End Sub

Option Explicit
'
'Калькулятор (by the fever.brain 2017)
'
Const r = 90
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim WithEvents cbx As ComboBox, WithEvents txb As TextBox, WithEvents but As CommandButton
Dim i&, j&, ii&, l&, t&, w&, h&, x&, y&, s$, u$, v, Script As Object, pic As PictureBox
 
Sub EnCode()
    Dim b() As Byte, i&, j#, ii&, n&, f$, h$(): ReDim h$(0): On Error Resume Next: ChDir App.Path: If Len(Dir("41.ico")) > 0 Then Exit Sub
    h(0) = "`````fЫ‰°№pmc`зИ№``f```````С†єpАs`ma``ыd``aЕАeжs„Е}nzc`pp``zxwґ±·dnК€dЮpk}цЪzzВпзѕhklµіґУj®ДяiviпдtИИ„dИВПЌбыЮ°ЮsЕ®jІЃlиТkъЮ·fѕr¶ЂfКdЉh€»y№ШОч»‚Су№jоеЉ…лрЮ|зщЯѕМЬизЯзщЊічgг‡ЗoЗпЯз№ЬйЬ»xyеЯbrpmisrjмЙЭfcbюСЧvdЉѕБЗ~pжЌФepЮpatuе°стД®‚ШхцМъ»Къы°·рЭЬrЦyвСзЩКep¶ґ`Шbвnk‚vШЇЙуФgѕ…Ыc®кuрaоп‹нОЇ·јНКѕюъuєє‹cббa}Мї±МЬасЙ}эШgУММРwАзЯЦ‹`sСМЅБрбЩcЗёЦжнhsЗ‡~ЫЇmЊЛВ‡чщЇъшоnЮqцПХЧмцЩxаocъо°ъЖрлА~jШ·аiУИrд`x‰eѕМмvЧпхn€xщК`ЂЯЌеh„u|щѓѕѕІяэjgµ±lwХxЩ·mґФkй~„в°ГЙНс„ЯІтТьЩ±ЕЙk№Икк|гмgЬП»u…|tѓэёtеµЅКнОн‡езПт±fцІЬц‹Ь¶РЛЩiщщщщiййьрФОэїЕї±єяє|c»июпЩhoйпЗЮоГeЧв„„·fг·ґ}cЧОcфж·‰uІТg‹іВТ‰„иИшГв|УАvИфЭмюЌ`яpуµжЊdik‰уъГёТиХТлЩАЂМиЉЙЕїЇ‚ЃґпЊaдСъnфeb`щхФжeкѓ‚†uЭє±эйЉэ`ЂРo®Гv°лЯоЬtЧ}Ю‚aШЕ®‚жзtг·eжјjО·Пдиs®єpЩїшебеєэ}ж€miШgwлЪokцяДјв†цpЩТі°·Еv№ае}}ж€mЌііѓмЩБwБЩzЧЮbиЧы†djaеЭbkФу…Ъхь}яч†mµ»іkВСфщxеvxЫРaнКжЃyeф±{nіlСнЖЮАlЬФБэКїdЊ…tСсхйС¶aуФэ®ЉБСкГеЕйzЊ€baґпЯxп‚€wтбшМЭуhiьѓШqoЮМ·яЉ°¶їhв~Ѕ`Ђc`Љ…``qtlР»бЊГЌкіФгѕюмУъµЯуzвчС`ЌЪ‹МuЙmШи№аЅП±зэјx†гwЖВjСЫёЫkХнaјhт°эєИчТяхxЗf…‚ОbТwp»м`Л‚†qgуpg»ГклЉ·ґРbГwv†Е|Зптhp`мµбµиХВi"
    For i = 1 To Len(h(0)): Do While Asc(Mid$(h(0), i, 1)) < 174: Mid$(h(0), i, 1) = Chr$(Asc(Mid$(h(0), i, 1)) + 32): Exit Do: Loop: Next: For i = 1 To 7: j = j * 128 + (Asc(Mid$(h(0), i, 1)) - 128): Next: ReDim b(j - 1): ii = j + i - 1: For i = i To ii: Do While i Mod 7 = 1: ii = ii + 1: n = (Asc(Mid$(h(0), ii, 1)) - 128): Exit Do: Loop: b(i - 8) = (Asc(Mid$(h(0), i, 1)) - 128) * 2 + n Mod 2: n = n \ 2: Next: Erase h: f = "tmpEnCoderArc.rar": i = FreeFile: Open f$ For Binary As #i: Put #i, 1, b: Close #i: Call CreateObject("WScript.Shell").Run("WinRAR x -y """ & f & "", 1, True):  Kill f
End Sub
 
Sub AppProp(Optional ByVal Caption$, _
                            Optional ByVal Icon$, _
                            Optional ByVal BorderStyle& = 1, _
                            Optional ByVal MaxButton As Boolean = 0, _
                            Optional ByVal CenterScreen As Boolean = 1, _
                            Optional ByVal Align As Boolean = 1)
    Const r = 90: Dim i&, v, sz&(1)
    With Me
        If BorderStyle Then .BorderStyle = BorderStyle
        If Align Then
            For Each v In Controls
                If v.Left + v.Width > sz(0) Then sz(0) = v.Left + v.Width
                If v.Top + v.Height > sz(1) Then sz(1) = v.Top + v.Height
            Next: .Move .Left, .Top, sz(0) + (.Width - .ScaleWidth) + r, sz(1) + (.Height - .ScaleHeight) + r
        End If
        If CenterScreen Then .Move (Screen.Width - .Width) / 2, (Screen.Height - .Height) / 2
        If Len(Caption) Then .Caption = Caption
        If Len(Icon) Then On Error Resume Next: Set .Icon = LoadPicture(Icon): For i = 0 To 1: Call SendMessage(hwnd, &H80, i, ByVal .Icon.Handle): Next
        If Not MaxButton Then SetWindowLong hwnd, -16, GetWindowLong(hwnd, -16) And Not &H10000: Me.Tag = 1: .WindowState = 2
    End With
End Sub
 
Private Sub Form_Resize()
    If Len(Me.Tag) Then If WindowState <> 1 Then WindowState = 0
End Sub
Private Sub Form_Load()
    Def l, r, t, r, w, r * 31, h, r * 3, x, Screen.TwipsPerPixelX, y, Screen.TwipsPerPixelY
    Set cbx = Controls.Add("vb.ComboBox", "cbx"): With cbx
        .Move l, t, w
        .Visible = 1
    End With
    Set txb = Controls.Add("vb.textbox", "txb"): With txb
        .Move l + x, t + y, w - r * 3 - x * 2, h: t = t + .Height + r
        .ZOrder 0: .Text = 0: .BorderStyle = 0: .Visible = 1
    End With
    Def l, r, w, r * 6, h, r * 4, ii, 0, s, "123=C456+-789*/,0^()", v, Split("sin cos tan sqr abs atn exp log rnd und")
    For i = 1 To 6: If i = 5 Then t = t + r
        For j = 1 To 5
            With Controls.Add("vb.CommandButton", "but" & ii)
                 If j = 4 Then l = l + r
                .Move l, t, w, h: Def l, l + w, ii, ii + 1
                .FontBold = 1
                If i < 5 Then .Caption = Mid$(s, ii, 1) Else .Caption = v(ii - 21)
                .Visible = 1
            End With
    Next: Def l, r, t, t + h: Next
    Set Script = CreateObject("MSScriptControl.ScriptControl"): Script.Language = "VBScript"
    Call EnCode: AppProp "Калькулятор", "41.ico"
End Sub
 
Private Sub but_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    ii = txb.SelStart
    If Mid$(but.Caption, 1, 1) Like "[a-z]" Then txb.SelText = but.Caption & "(": ii = ii + 1 Else txb.SelText = but.Caption
    txb.SelStart = ii + Len(but.Caption)
End Sub
 
Private Sub txb_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then KeyAscii = 0: txb.Text = txb.Text & "="
End Sub
 
Private Sub cbx_Click()
    With txb: .Text = cbx.Text: .SelStart = Len(.Text): End With
End Sub
 
Private Sub txb_Change()
    With txb
        On Error Resume Next
        s = .Text:: If Len(u) = 0 Then u = s
        If InStr(1, s, "=") > 0 Then
            s = Replace(Replace(Replace(s, " ", ""), "=", ""), ",", "."): u = s
            s = Script.eval(s)
            If Err Then MsgBox Err.Description & vbLf & Err.Number Else cbx.AddItem s, 0
            .Text = s
        ElseIf InStr(1, s, "C") Then
            u = Replace(s, "C", "")
            .Text = 0
        ElseIf InStr(1, s, "und", 1) Then
            .Text = u
        End If
        If Len(s) > 1 Then If Mid$(s, 1, 1) = "0" And IsNumeric(Mid$(s, 2, 1)) Or IsNumeric(Mid$(s, 1, 1)) And Mid$(s, 2, 1) Like "[a-z]" Then .Text = Mid$(s, 2)
        .SelStart = Len(s)
    End With
End Sub
 
Sub Def(ParamArray w()): Dim i&: For i = 0 To UBound(w) Step 2: w(i) = w(i + 1): Next: End Sub
Private Sub but_LostFocus(): On Error Resume Next: Set but = ActiveControl: End Sub
Private Sub cbx_LostFocus(): but_LostFocus: End Sub
Private Sub txb_LostFocus(): but_LostFocus: End Sub

Option Explicit
Dim i As Integer, Var As Integer
Const N = 10
 
Private Sub Form_Load()
'Загружаем на форму все объекты массива
    For i = 1 To N
        Load Text1(i)
     Next
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    For i = 1 To N
        If X <> Text1(0).Left Or X <> Text1(0).Width Then Text1(i).Visible = False
        Text1(i).Top = Text1(i - 1).Top + Text1(0).Height
    Next
    Cls
    'Print Text1(0).Left, Text1(0).Width
End Sub
 
Private Sub Text1_Change(Index As Integer)
    Text1(0) = Var
End Sub
 
Private Sub Text1_DblClick(Index As Integer)
     Var = Text1(Index)
 End Sub
 
Private Sub Text1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 Dim Y_Height As Integer
            ' делаем видимыми все объекты массива
    For i = 1 To N
        Text1(0) = ""
        Text1(i).Locked = True
        Text1(i).Top = Text1(i - 1).Top + Text1(0).Height
        Text1(i).Visible = True
        Text1(i) = i * 10 ' Заполняем массив к примеру его индексами
        ' Запишем в переменную Y_Height значение Height каждого объекта массива
        If Index = i Then Y_Height = Text1(Index).Height Else Y_Height = 0
        If Y_Height > 0 Then
            Text1(i).BackColor = &HFF0000  ' синий
            Text1(i).ForeColor = &HFFFFFF  ' белый
        Else
            Text1(i).BackColor = &HFFFFFF  ' белый
            Text1(i).ForeColor = 0         ' черный
        End If
    Next
    Cls
   ' Print Y_Height
End Sub

    Dim Ctl As Control
    
    For Each Ctl In Me.Controls
        If Ctl.Container Is Frame1 Then
            If TypeName(Ctl) = "PictureBox" Then
                Debug.Print "Found PictureBox: " & Ctl.Name
            End If
        End If
    Next

Option Explicit
 
Dim mo_Events As Collection
 
Private Sub Form_Load()
    Dim i&
    Dim Btn As CommandButton
    Set mo_Events = New Collection
    For i = 1 To 3
        Set Btn = Me.Controls.Add("VB.CommandButton", "Cmd_" & i)
        Btn.Move 0, 360 * (i - 1), 3600, 360
        Btn.Visible = True
        mo_Events.Add New cEvents
        mo_Events(i).Add_CommandButton Btn, i
    Next
End Sub
 
Public Sub ButtonClick(p_idx As Long)
    MsgBox "Button is clicked # " & p_idx
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Set mo_Events = Nothing
End Sub

Option Explicit
 
Public WithEvents Button As CommandButton
 
Private m_idx As Long
 
Public Function Add_CommandButton(p_Btn As CommandButton, p_idx As Long)
    m_idx = p_idx
    Set Button = p_Btn
End Function
 
Private Sub Button_Click()
    Button.Parent.ButtonClick m_idx
End Sub
 
Private Sub Class_Terminate()
    Set Button = Nothing
End Sub

Option Explicit
 
Private Sub Form_Load()
 
    PrintControlsArray mnuArr
    PrintControlsArray txtArr
    PrintControlsArray imgArr
    PrintControlsArray uctArr
    PrintControlsArray rtbArr
    
End Sub
 
Private Sub PrintControlsArray( _
            ByVal cArr As IVB6ControlsArray)
    Dim cCtl    As Control
    
    Set cCtl = cArr(1)
    
    Debug.Print
    Debug.Print "Controls name: "; cCtl.Name
    Debug.Print "Count: "; cArr.Count()
    Debug.Print "LBound: "; cArr.LBound()
    Debug.Print "UBound: "; cArr.UBound()
    Debug.Print
    
End Sub