Перекинуть Label из окна в контейнер пользовательского контрола

@Антихакер32 · Регистрация: 06.01.2014

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

Добрый день уважаемые форумчане
сейчас самостоятельно разрабатываю
компонент Спойлер..

исходники здесь

модификация здесь:

модуль UserControl'а

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Option Explicit
'
'   © Антихакер32™
'
Private Const def_cm1_Height = 300 'Высота кнопки
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TOOLWINDOW = 128
'
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare Function GetForegroundWindow Lib "user32" () As Long
'
Dim WithEvents cm1 As CommandButton
Dim WithEvents Pic As PictureBox
Dim Amb As Object
Dim mSpoilerAction As Boolean
'''''Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'''''Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
'''''Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
'''''Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
 
Public Sub WActivate()
    On Error GoTo errr
    SpoilerAction = False
errr:
End Sub
 
Public Sub WindowPosChaning()
    On Error GoTo errr
    Const ram = 60
    Static Left&, top&
    Left = Parent.Left - (Parent.ScaleWidth - Parent.Width + ram) + Amb.Left
    top = Parent.top - (Parent.ScaleHeight - Parent.Height + ram) + Amb.top + cm1.Height
    Pic.Move Left, top, Amb.Width, Amb.Height - cm1.Height
errr:
End Sub
 
Private Property Get SpoilerAction() As Boolean
    SpoilerAction = mSpoilerAction
End Property
 
Private Property Let SpoilerAction(ByVal vNewValue As Boolean)
    mSpoilerAction = vNewValue
    If vNewValue Then
        SetWindowPos Pic.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
        Pic.Visible = True
    Else
        SetWindowPos Pic.hWnd, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
        Pic.Visible = False
    End If
End Property
 
Private Sub cm1_Click()
    SpoilerAction = Not SpoilerAction
End Sub
 
Private Sub UserControl_ExitFocus()
SpoilerAction = False
End Sub
 
Private Sub UserControl_Initialize()
    Set cm1 = Controls.Add("vb.CommandButton", "cm1_" & hWnd)
    cm1.Visible = 1
    Set Pic = Controls.Add("vb.PictureBox", "pic_" & hWnd)
End Sub
 
 
Private Sub UserControl_Resize()
    On Error Resume Next
    cm1.Move 0, 0, Width, def_cm1_Height
    Pic.Move 0, cm1.Height, Width, Height - cm1.Height
End Sub
 
Private Sub UserControl_Show()
    Dim j$(), id$, indAmb&, o As Object, hW&, py&
    j = Split(Ambient.DisplayName, "(")
 
    If UBound(j) Then
         indAmb = Val(Split(j(1), ")")(0))
        Set Amb = CallByName(Parent, j(0), VbGet, indAmb)
    Else: indAmb = -1
        Set Amb = CallByName(Parent, j(0), VbGet)
    End If
    On Error Resume Next
    If Ambient.UserMode Then
        For Each o In Parent
            id = o.Container.Name 'Если произойдет ошибка, то останеться это id
            id = id & "(" & o.Container.Index & ")"
            If id = Ambient.DisplayName Then
                hW = 0: hW = o.hWnd
                If hW = 0 Then
                    '
                    'Здесь лейбл, значит надо напечатать на PictureBox эту надпись :(
                    '
                Else: SetParent hW, Pic.hWnd
                End If
                
                o.top = o.top - def_cm1_Height
            End If
        Next
        SetParent Pic.hWnd, 0
        SetWindowLong Pic.hWnd, GWL_EXSTYLE, _
        GetWindowLong(Pic.hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW
        WindowPosChaning
        Hook Amb
    Else 'Режим проектирования
        SetParent Pic.hWnd, hWnd
        Pic.Visible = True: Pic.Enabled = 0
        Pic.ZOrder 1
    End If
End Sub
 
Private Sub UserControl_Terminate()
     UnHook
End Sub

модуль .bas

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
Option Explicit
'
Public Const GWL_WNDPROC = -4
' Сообщения windows
Public Const WM_CLOSE = &H10
Private Const WM_MOVE = &H3
 
Const WM_ACTIVATE = &H6
 
Const HTCAPTION = 2
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 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
'
Dim SWL As Long
Dim mTypeName As String
Dim mParent  As Object
Dim mParent_hWnd As Long
 
 
Function Hook(Child As Object) As Long
    On Error GoTo errr
    If Child.Parent.hWnd <> mParent_hWnd Then
        mTypeName = TypeName(Child)
        Set mParent = Child.Parent
        mParent_hWnd = mParent.hWnd
        SWL = SetWindowLong(mParent_hWnd, GWL_WNDPROC, AddressOf WindowProc)
    End If
errr:
End Function
 
Sub UnHook()
    Call CallWindowProc(SWL, mParent_hWnd, WM_CLOSE, 0, 0)
End Sub
 
Public Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim o As Object
   On Error GoTo errr
   Select Case Msg
   Case WM_ACTIVATE
        For Each o In mParent
            If TypeName(o) = mTypeName Then
                Call o.WActivate
            End If
        Next
        Exit Function
    Case WM_MOVE
        For Each o In mParent
            If TypeName(o) = mTypeName Then
                Call o.WindowPosChaning
            End If
        Next
        Exit Function
   End Select
   WindowProc = CallWindowProc(SWL, hWnd, Msg, wParam, lParam)
errr:
End Function

так вот, есть ли нормальный способ чтоб перекинуть лейбл из окна
в контейнер пользовательского контрола

Добавлено через 9 минут
Там проблемное место, это 101-я строчка, в модуле UserControl'а
..Какие будут предложения коллеги ?

Добавлено через 1 час 38 минут
вот как я придумал пока сделать, но это решение меня мало радует

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
Private Sub UserControl_Show()
    Dim j$(), id$, indAmb&, o As Object, hW&, hP&
    Dim lab As Label, col As Collection, f&, v As Object
    j = Split(Ambient.DisplayName, "(")
 
    If UBound(j) Then
         indAmb = Val(Split(j(1), ")")(0))
        Set Amb = CallByName(Parent, j(0), VbGet, indAmb)
    Else: indAmb = -1
        Set Amb = CallByName(Parent, j(0), VbGet)
    End If
    On Error Resume Next
    If Ambient.UserMode Then
        For Each o In Parent
            id = o.Container.Name 'Если произойдет ошибка, то останеться это id
            id = id & "(" & o.Container.Index & ")"
            If id = Ambient.DisplayName Then
                hW = 0: hW = o.hWnd
                hP = GetParent(hW)
                If hW = 0 Then
                    '
                    'Здесь лейбл, значит
                    '
                    Set lab = Controls.Add("vb." & TypeName(o), "lab_" & hWnd, Pic)
                    With lab
                        .Alignment = o.Appearance
                        .Appearance = o.Appearance
                        .AutoSize = o.AutoSize
                        .BackColor = o.BackColor
                        .BorderStyle = o.BorderStyle
                        .Left = o.Left
                        .top = o.top
                        .Width = o.Width
                        .Height = o.Height
                        .Font = o.Font
                        .Caption = o.Caption
                        o.Visible = False
                        .Visible = True
                    End With
 
                ElseIf hP = hWnd Then
                    SetParent hW, Pic.hWnd
                End If
                o.top = o.top - def_cm1_Height
            End If
        Next
        SetParent Pic.hWnd, 0
        SetWindowLong Pic.hWnd, GWL_EXSTYLE, _
        GetWindowLong(Pic.hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW
        WindowPosChaning
        Hook Amb
    Else 'Режим проектирования
        SetParent Pic.hWnd, hWnd
'        Pic.Visible = True: Pic.Enabled = 0
        Pic.ZOrder 1
    End If
End Sub

@The trick · 09.06.2014, 15:00

В чем проблема?

Visual Basic
1
Set Label1.Container = Picture1

@Антихакер32 · 09.06.2014, 20:44 **[ТС]**

Нет, так не получиться, именно в этом исключительном случае контейнер
ссылается на пустое место, если бы так просто было, я бы не использовал SetParent

@The trick · 09.06.2014, 20:52

Сообщение от Антихакер32

Нет, так не получиться, именно в этом исключительном случае контейнер
ссылается на пустое место, если бы так просто было, я бы не использовал SetParent

Объясни нормально задачу, ничего не понятно. Контейнер твой контрол, в чем проблема

Visual Basic
1
Set Label.Container = UserControl

@Антихакер32 · 09.06.2014, 21:28 **[ТС]**

Сообщение от The trick

Объясни нормально задачу

новый контейнер должен быть PictureBox с именем Pic
и это не реализуется

Добавлено через 11 минут

Сообщение от The trick

Set Label.Container = UserControl

и кстате забрасываемые компоненты итак уже в контейнере UserControl'а
эта инструкция не нужна

Добавлено через 1 минуту
свойство у UC стоит ContainerControl = True

Добавлено через 3 минуты
в интернете я тоже находил вопросы, что невозможно изменить контейнер
в модуле пользовательского контрола

Добавлено через 37 секунд
я бы тогда и не спрашивал, сделал бы запрос в гугл да и всё

Добавлено через 17 минут

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
Private Sub UserControl_Show()
    Dim j$(), id$, indAmb&, o As Object, hW&, hP&
    Dim lab As Label, col As Collection, f&, v As Object
    j = Split(Ambient.DisplayName, "(")
 
    If UBound(j) Then
         indAmb = Val(Split(j(1), ")")(0))
        Set Amb = CallByName(Parent, j(0), VbGet, indAmb)
    Else: indAmb = -1
        Set Amb = CallByName(Parent, j(0), VbGet)
    End If
    On Error Resume Next
    If Ambient.UserMode Then
        For Each o In Parent
            id = o.Container.Name 'Если произойдет ошибка, то останеться это id
            id = id & "(" & o.Container.Index & ")"
            If id = Ambient.DisplayName Then
'                SetParent o.hWnd, Pic.hWnd
                Set o.Container = Pic 'Это сделать невозможно !!!!!!!
                o.top = o.top - def_cm1_Height
            End If
        Next
        SetParent Pic.hWnd, 0
        SetWindowLong Pic.hWnd, GWL_EXSTYLE, _
        GetWindowLong(Pic.hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW
        WindowPosChaning
        Hook Amb
    Else 'Режим проектирования
        SetParent Pic.hWnd, hWnd
        Pic.Visible = True: Pic.Enabled = 0
        Pic.ZOrder 1
    End If
End Sub

@The trick · 09.06.2014, 22:06

В твоем проекте неправильная логика. Как пользователь должен работать с твоим контролом? Что тогда должен возвращать Container этих контролов? Код очень плохой. Если ты и делаешь какой-то контрол типа комбобокса, то нужно пользователю задавать этот список в виде свойства.

@Антихакер32 · 09.06.2014, 22:20 **[ТС]**

Я пока намеренно не делаю никаких свойств

Добавлено через 2 минуты
сначало хочу разработать всю визуализацию
потом сделаю все свойства

@Антихакер32 · 10.06.2014, 00:59 **[ТС]**

Понял я как нужно было сделать ...
Pic нужно было инициализировать сначало на форме Parent
затем перебросить туда вест контейнер UC
затем в через setparent опять передать всё UC, очень замутно я понимаю ..
вот код ..

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
Private Sub UserControl_Show()
    Const ram = 0
    Dim j$(), id$, indAmb&, o As Object, hW&, hP&
    Dim lab As Label, col As Collection, f&, v As Object
    j = Split(Ambient.DisplayName, "(")
 
    If UBound(j) Then
         indAmb = Val(Split(j(1), ")")(0))
        Set Amb = CallByName(Parent, j(0), VbGet, indAmb)
    Else: indAmb = -1
        Set Amb = CallByName(Parent, j(0), VbGet)
    End If
    On Error Resume Next
    If Ambient.UserMode Then
        Set Pic = Parent.Controls.Add("vb.PictureBox", "pic_" & hWnd)
        For Each o In Parent
            If o.Container.hWnd = hWnd Then
                Set o.Container = Pic
                o.Move o.Left - ram, o.top - def_cm1_Height - ram
            End If
        Next
        SetWindowLong Pic.hWnd, GWL_EXSTYLE, _
        GetWindowLong(Pic.hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW
        SetParent Pic.hWnd, 0
        WMove
        Hook Amb
'    Else 'Режим проектирования
'        SetParent Pic.hWnd, hWnd
'        Pic.Visible = True
''        Pic.Enabled = 0
''        Pic.ZOrder 1
    End If
End Sub

@Антихакер32 · 10.06.2014, 22:13 **[ТС]**

И еще лучше, теперь этот вариант можно взять за основу
и добавить нужные свойства, и вертикальные отображения спойлеров

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Option Explicit
'
'   © Антихакер32™
'
Private Const def_cm1_Height = 300 'Высота кнопки
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TOOLWINDOW = 128
'
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Dim WithEvents cm1 As CommandButton
Dim WithEvents Pic As PictureBox
Dim WithEvents Shp As Shape
Dim mSpoilerAction As Boolean
 
Public Sub WActivate()
    On Error GoTo errr
    SpoilerAction = False
errr:
End Sub
 
Public Sub WMove()
    On Error GoTo errr
    Const ram = 60
    Static Left&, top&
    Left = Parent.Left - (Parent.ScaleWidth - Parent.Width + ram) + Extender.Left
    top = Parent.top - (Parent.ScaleHeight - Parent.Height + ram) + Extender.top + def_cm1_Height
    Pic.Move Left, top, Width, Height - def_cm1_Height
errr:
End Sub
 
Private Property Get SpoilerAction() As Boolean
    SpoilerAction = mSpoilerAction
End Property
 
Private Property Let SpoilerAction(ByVal vNewValue As Boolean)
    mSpoilerAction = vNewValue
    If vNewValue Then
        SetWindowPos Pic.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
        Pic.Visible = True
    Else
        Pic.Visible = False
    End If
End Property
 
Private Sub cm1_Click()
    SpoilerAction = Not SpoilerAction
End Sub
 
Private Sub UserControl_Initialize()
    Set cm1 = Controls.Add("vb.CommandButton", "cm1_" & hWnd)
    cm1.Visible = 1
End Sub
 
 
Private Sub UserControl_Resize()
    On Error Resume Next
    cm1.Move 0, 0, Width, def_cm1_Height
End Sub
 
Private Sub UserControl_Show()
    Dim o As Object
    On Error Resume Next
    If Ambient.UserMode Then
        Set Pic = Parent.Controls.Add("vb.PictureBox", "pic_" & hWnd)
        For Each o In Parent
            If o.Container.hWnd = hWnd Then
                Set o.Container = Pic
                o.Move o.Left, o.top - def_cm1_Height
                If Err Then 'Если это линия
                    o.Y1 = o.Y1 - def_cm1_Height
                    o.Y2 = o.Y2 - def_cm1_Height
                End If
            End If
        Next
        SetWindowLong Pic.hWnd, GWL_EXSTYLE, _
        GetWindowLong(Pic.hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW
        SetParent Pic.hWnd, 0
        WMove
        Hook Extender
    Else 'Режим проектирования
        Set Shp = Controls.Add("vb.Shape", "Shp_" & hWnd)
        Shp.Move 0, def_cm1_Height, Width, Height - def_cm1_Height
        Shp.Visible = True
    End If
End Sub
 
Private Sub UserControl_Terminate()
     UnHook
End Sub

Добавлено через 1 минуту

Модуль для хуков

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
Option Explicit
'
Public Const GWL_WNDPROC = -4
' Сообщения windows
Public Const WM_CLOSE = &H10
Private Const WM_MOVE = &H3
Const WM_ACTIVATE = &H6
 
Const HTCAPTION = 2
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 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
'
Dim SWL As Long
Dim mTypeName As String
Dim mParent  As Object
Dim mParent_hWnd As Long
 
 
Function Hook(Child As Object) As Long
    On Error GoTo errr
    If Child.Parent.hWnd <> mParent_hWnd Then
        mTypeName = TypeName(Child)
        Set mParent = Child.Parent
        mParent_hWnd = mParent.hWnd
        SWL = SetWindowLong(mParent_hWnd, GWL_WNDPROC, AddressOf WindowProc)
    End If
errr:
End Function
 
Sub UnHook()
    Call CallWindowProc(SWL, mParent_hWnd, WM_CLOSE, 0, 0)
End Sub
 
Public Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim o As Object
   On Error GoTo errr
   Select Case Msg
   Case WM_ACTIVATE
        For Each o In mParent
            If TypeName(o) = mTypeName Then
                Call o.WActivate
            End If
        Next
        Exit Function
    Case WM_MOVE
        For Each o In mParent
            If TypeName(o) = mTypeName Then
                Call o.WMove
            End If
        Next
        Exit Function
   End Select
   WindowProc = CallWindowProc(SWL, hWnd, Msg, wParam, lParam)
errr:
End Function

@Антихакер32 · 10.06.2014, 22:29 **[ТС]**

Всё... админы, пометьте эту тему решенной !
если это возможно добавьте ссылки в готовых решениях

@Антихакер32 · 11.06.2014, 12:12 **[ТС]**

Теперь есть 2 стиля отображения

Измененный код

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
Option Explicit
'
'   © Антихакер32™
'
'
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
'
Public Enum FlagsSpoilerStyle
    [По умолчанию] = 0
    [Кнопка слева] = 1
End Enum
'
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
'
'Default Property Values:
Const m_def_Style = 0
Const def_Exp = 280 'Высота кнопки
Const HWND_TOPMOST = -1
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_TOOLWINDOW = 128
'Property Variables:
Dim m_Style As FlagsSpoilerStyle
Dim WithEvents cm1 As CommandButton
Dim sh1 As Shape
Dim mSpoilerAction As Boolean
Dim oldParRect As RECT, mRect As RECT
Dim ResizeAction As Boolean
 
Public Sub WActivate()
    On Error GoTo errr
    If SpoilerAction Then SpoilerAction = False
errr:
End Sub
 
Public Sub WMove()
    Static Rect1 As RECT, Rect2 As RECT
    On Error GoTo errr
    If mSpoilerAction Then
        GetWindowRect Parent.hWnd, Rect1
        GetWindowRect hWnd, Rect2
        With Rect2
            .Left = .Left + (Rect1.Left - oldParRect.Left)
            .Top = .Top + (Rect1.Top - oldParRect.Top)
            SetWindowPos hWnd, -1, .Left, .Top, 0, 0, SWP_NOSIZE
        End With
        oldParRect = Rect1
    End If
errr:
End Sub
 
Private Property Get SpoilerAction() As Boolean
    SpoilerAction = mSpoilerAction
End Property
 
 
Private Property Let SpoilerAction(ByVal vNewValue As Boolean)
    Static Rect1 As RECT, Rect2 As RECT, Rect3 As RECT, Border&
    On Error GoTo errr
    GetWindowRect Parent.hWnd, Rect1
    GetWindowRect hWnd, Rect2
    ResizeAction = True
    If vNewValue Then
        With Rect2
            .Left = Rect1.Left + (.Left - Rect1.Left)
            .Top = Rect1.Top + (.Top - Rect1.Top)
            SetWindowPos hWnd, 0, .Left, .Top, 0, 0, SWP_NOSIZE
            SetParent hWnd, 0
            oldParRect = Rect1
        End With
        Select Case m_Style
        Case [По умолчанию]: Height = sh1.Height
        Case [Кнопка слева]: Width = sh1.Width
        End Select
    Else
        GetClientRect Parent.hWnd, Rect3
        With Rect2
            .Left = (.Left - (Rect1.Right - Rect3.Right))
            .Left = .Left + (mRect.Left - .Left)
            .Top = (.Top - (Rect1.Bottom - Rect3.Bottom))
            .Top = .Top + (mRect.Top - .Top)
            SetParent hWnd, Parent.hWnd
            SetWindowPos hWnd, 0, .Left, .Top, 0, 0, SWP_NOSIZE
        End With
        Select Case m_Style
        Case [По умолчанию]: Height = def_Exp
        Case [Кнопка слева]: Width = def_Exp
        End Select
    End If
    mSpoilerAction = vNewValue
errr:
    ResizeAction = False
End Property
 
Private Sub cm1_Click()
    SpoilerAction = Not SpoilerAction
End Sub
 
Private Sub UserControl_Initialize()
    Set cm1 = Controls.Add("vb.CommandButton", "cm1_" & hWnd)
    Set sh1 = Controls.Add("vb.Shape", "sh1_" & hWnd)
    sh1.Visible = 1: cm1.Visible = 1
    SetWindowLong hWnd, GWL_EXSTYLE, _
    GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW
End Sub
 
Private Sub UserControl_Resize()
    On Error Resume Next
    If ResizeAction Then Exit Sub
    With mRect
        If Not mSpoilerAction Then
            sh1.Move 0, 0, Width, Height
            .Left = Extender.Left \ Screen.TwipsPerPixelX
            .Top = Extender.Top \ Screen.TwipsPerPixelY
        End If
        Select Case m_Style
        Case [По умолчанию]: cm1.Move 0, 0, sh1.Width, def_Exp
        Case [Кнопка слева]: cm1.Move 0, 0, def_Exp, sh1.Height
        End Select
    End With
End Sub
 
Private Sub UserControl_Show()
    Dim o As Object
    If Ambient.UserMode Then
        SpoilerAction = 1
        Hook Extender
    End If
End Sub
 
Private Sub UserControl_Terminate()
     UnHook
End Sub
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get Style() As FlagsSpoilerStyle
    Style = m_Style
End Property
 
Public Property Let Style(ByVal New_Style As FlagsSpoilerStyle)
    m_Style = New_Style
    PropertyChanged "Style"
    UserControl_Resize
End Property
 
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_Style = m_def_Style
End Sub
 
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Style = PropBag.ReadProperty("Style", m_def_Style)
    UserControl_Resize
End Sub
 
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
 
    Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
End Sub

Добавлено через 1 минуту
Теперь все очень точно и корректно отображается

Новые блоги и статьи Все статьи Все блоги /
Символьное дифференцирование igorrr37 13.02.2026 / * Программа принимает математическое выражение в виде строки и выдаёт его производную в виде строки и вычисляет значение производной при заданном х Логарифм записывается как: (x-2)log(x^2+2) -. . .	Камера 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, то после закрытия окошка. . .

@Антихакер32 1201 / 473 / 46 Регистрация: 06.01.2014 Сообщений: 1,797 Записей в блоге: 19
	09.06.2014, 20:44 [ТС]
	Нет, так не получиться, именно в этом исключительном случае контейнер ссылается на пустое место, если бы так просто было, я бы не использовал SetParent 0

@The trick Модератор 10048 / 3894 / 883 Регистрация: 22.02.2013 Сообщений: 5,847 Записей в блоге: 79
	09.06.2014, 22:06
	В твоем проекте неправильная логика. Как пользователь должен работать с твоим контролом? Что тогда должен возвращать Container этих контролов? Код очень плохой. Если ты и делаешь какой-то контрол типа комбобокса, то нужно пользователю задавать этот список в виде свойства. 0

@Антихакер32 1201 / 473 / 46 Регистрация: 06.01.2014 Сообщений: 1,797 Записей в блоге: 19
	09.06.2014, 22:20 [ТС]
	Я пока намеренно не делаю никаких свойств Добавлено через 2 минуты сначало хочу разработать всю визуализацию потом сделаю все свойства 0