@@ -32,183 +32,183 @@ Private m_blnResizing As Boolean
3232Public WithEvents ResizeHandle As MSForms .Label
3333Attribute ResizeHandle.VB_VarHelpID = -1
3434 Public Property Set AddCntrl(ByRef RHS As MSForms .control)
35- 23 : Dim clsTemp As CAnchor
36- 24 : Set clsTemp = New CAnchor
37- 25 : Set clsTemp.cnt = RHS
38- 26 : With clsTemp
39- 27 : .AnchorStyle = enumAnchorStyleLeft Or enumAnchorStyleTop
40- 28 : .MinimumWidth = .cnt.Width
41- 29 : .MinimumHeight = .cnt.Height
42- 30 : .OrigLeft = .cnt.Left
43- 31 : .OrigTop = .cnt.top
44- 32 : .OrigWidth = .cnt.Width
45- 33 : .OrigHeight = .cnt.Height
46- 34 : End With
47- 35 : m_colAnchors.Add clsTemp, clsTemp.cnt.Name
48- 36 : End Property
35+ 25 : Dim clsTemp As CAnchor
36+ 26 : Set clsTemp = New CAnchor
37+ 27 : Set clsTemp.cnt = RHS
38+ 28 : With clsTemp
39+ 29 : .AnchorStyle = enumAnchorStyleLeft Or enumAnchorStyleTop
40+ 30 : .MinimumWidth = .cnt.Width
41+ 31 : .MinimumHeight = .cnt.Height
42+ 32 : .OrigLeft = .cnt.Left
43+ 33 : .OrigTop = .cnt.top
44+ 34 : .OrigWidth = .cnt.Width
45+ 35 : .OrigHeight = .cnt.Height
46+ 36 : End With
47+ 37 : m_colAnchors.Add clsTemp, clsTemp.cnt.Name
48+ 38 : End Property
4949 Public Sub RemoveCntrl (ByRef varIndex As Variant )
50- 38 : On Error Resume Next
51- 39 : m_colAnchors.Remove varIndex
52- 40 : End Sub
50+ 40 : On Error Resume Next
51+ 41 : m_colAnchors.Remove varIndex
52+ 42 : End Sub
5353 Private Sub m_AddResizer (ByRef objParent As Object )
54- 42 : '
55- 43 : ' add resizing control to bottom righthand corner of userform
565444 : '
57- 45 : Set ResizeHandle = objParent.Controls.Add("Forms.label.1" , MRESIZEHANDLE, True )
58- 46 : With ResizeHandle
59- 47 : With .Font
60- 48 : .Name = "Marlett"
61- 49 : .Charset = 2
62- 50 : .Size = 14
63- 51 : .Bold = True
64- 52 : End With
65- 53 : .BackStyle = fmBackStyleTransparent
66- 54 : .AutoSize = True
67- 55 : .BorderStyle = fmBorderStyleNone
68- 56 : .Caption = "o"
69- 57 : .MousePointer = fmMousePointerSizeNWSE
70- 58 : .ForeColor = &H8000000D
71- 59 : .ZOrder
72- 60 : .top = objParent.InsideHeight - .Height
73- 61 : .Left = objParent.InsideWidth - .Width
74- 62 : End With
75- 63 : End Sub
55+ 45 : ' add resizing control to bottom righthand corner of userform
56+ 46 : '
57+ 47 : Set ResizeHandle = objParent.Controls.Add("Forms.label.1" , MRESIZEHANDLE, True )
58+ 48 : With ResizeHandle
59+ 49 : With .Font
60+ 50 : .Name = "Marlett"
61+ 51 : .Charset = 2
62+ 52 : .Size = 14
63+ 53 : .Bold = True
64+ 54 : End With
65+ 55 : .BackStyle = fmBackStyleTransparent
66+ 56 : .AutoSize = True
67+ 57 : .BorderStyle = fmBorderStyleNone
68+ 58 : .Caption = "o"
69+ 59 : .MousePointer = fmMousePointerSizeNWSE
70+ 60 : .ForeColor = &H8000000D
71+ 61 : .ZOrder
72+ 62 : .top = objParent.InsideHeight - .Height
73+ 63 : .Left = objParent.InsideWidth - .Width
74+ 64 : End With
75+ 65 : End Sub
7676 Private Sub ResizeHandle_MouseDown (ByVal Button As Integer , ByVal Shift As Integer , ByVal X As Single , ByVal Y As Single )
77- 65 : If Button = 1 Then
78- 66 : m_sngLeftResizePos = X
79- 67 : m_sngTopResizePos = Y
80- 68 : m_blnResizing = True
81- 69 : End If
82- 70 : End Sub
77+ 67 : If Button = 1 Then
78+ 68 : m_sngLeftResizePos = X
79+ 69 : m_sngTopResizePos = Y
80+ 70 : m_blnResizing = True
81+ 71 : End If
82+ 72 : End Sub
8383 Private Sub ResizeHandle_MouseMove (ByVal Button As Integer , ByVal Shift As Integer , ByVal X As Single , ByVal Y As Single )
84- 72 : Dim sngSize As Single
85- 73 : If Button = 1 Then
86- 74 : With ResizeHandle
87- 75 : .MOVE .Left + X - m_sngLeftResizePos, .top + Y - m_sngTopResizePos
88- 76 : sngSize = m_frmParent.Width + X - m_sngLeftResizePos
89- 77 : If sngSize < Me.MinimumWidth Then sngSize = MinimumWidth
90- 78 : m_frmParent.Width = sngSize
91- 79 : sngSize = m_frmParent.Height + Y - m_sngTopResizePos
92- 80 : If sngSize < MinimumHeight Then sngSize = MinimumHeight
93- 81 : m_frmParent.Height = sngSize
94- 82 : .Left = m_frmParent.InsideWidth - .Width
95- 83 : .top = m_frmParent.InsideHeight - .Height
96- 84 : If UpdateWhilstDragging Then
97- 85 : m_UpdateControls
98- 86 : End If
99- 87 : End With
100- 88 : End If
101- 89 : End Sub
84+ 74 : Dim sngSize As Single
85+ 75 : If Button = 1 Then
86+ 76 : With ResizeHandle
87+ 77 : .MOVE .Left + X - m_sngLeftResizePos, .top + Y - m_sngTopResizePos
88+ 78 : sngSize = m_frmParent.Width + X - m_sngLeftResizePos
89+ 79 : If sngSize < Me.MinimumWidth Then sngSize = MinimumWidth
90+ 80 : m_frmParent.Width = sngSize
91+ 81 : sngSize = m_frmParent.Height + Y - m_sngTopResizePos
92+ 82 : If sngSize < MinimumHeight Then sngSize = MinimumHeight
93+ 83 : m_frmParent.Height = sngSize
94+ 84 : .Left = m_frmParent.InsideWidth - .Width
95+ 85 : .top = m_frmParent.InsideHeight - .Height
96+ 86 : If UpdateWhilstDragging Then
97+ 87 : m_UpdateControls
98+ 88 : End If
99+ 89 : End With
100+ 90 : End If
101+ 91 : End Sub
102102 Private Sub ResizeHandle_MouseUp (ByVal Button As Integer , ByVal Shift As Integer , ByVal X As Single , ByVal Y As Single )
103- 91 : If Button = 1 Then
104- 92 : If Not UpdateWhilstDragging Then
105- 93 : m_UpdateControls
106- 94 : End If
107- 95 : m_blnResizing = False
108- 96 : End If
109- 97 : End Sub
103+ 93 : If Button = 1 Then
104+ 94 : If Not UpdateWhilstDragging Then
105+ 95 : m_UpdateControls
106+ 96 : End If
107+ 97 : m_blnResizing = False
108+ 98 : End If
109+ 99 : End Sub
110110 Public Function funAnchor (ByRef varIndex As Variant ) As CAnchor
111- 99 : ' access to specific anchored control
112- 100 : On Error Resume Next
113- 101 : Set funAnchor = m_colAnchors(varIndex)
114- 102 : End Function
111+ 101 : ' access to specific anchored control
112+ 102 : On Error Resume Next
113+ 103 : Set funAnchor = m_colAnchors(varIndex)
114+ 104 : End Function
115115 Public Function Anchors () As Collection
116- 104 : ' access to the collection of anchored controls
117- 105 : Set Anchors = m_colAnchors
118- 106 : End Function
116+ 106 : ' access to the collection of anchored controls
117+ 107 : Set Anchors = m_colAnchors
118+ 108 : End Function
119119 Public Property Set objParent(ByRef RHS As Object )
120- 108 : '
121- 109 : ' Use this to assign all default properties
122120110 : '
123- 111 : Dim clsTemp As CAnchor
124- 112 : Dim cntTemp As MSForms .control
125- 113 : Set m_frmParent = RHS
126- 114 : UpdateWhilstDragging = True '!!
127- 115 : With RHS
128- 116 : MinimumWidth = .Width
129- 117 : MinimumHeight = .Height
130- 118 : OrigLeft = 1
131- 119 : OrigTop = 1
132- 120 : OrigWidth = .InsideWidth
133- 121 : OrigHeight = .InsideHeight
134- 122 : End With
135- 123 : For Each cntTemp In m_frmParent.Controls
136- 124 : Set clsTemp = New CAnchor
137- 125 : Set clsTemp.cnt = cntTemp
138- 126 : With clsTemp
139- 127 : .AnchorStyle = enumAnchorStyleLeft Or enumAnchorStyleTop
140- 128 : .MinimumWidth = cntTemp.Width
141- 129 : .MinimumHeight = cntTemp.Height
142- 130 : .OrigLeft = cntTemp.Left
143- 131 : .OrigTop = cntTemp.top
144- 132 : .OrigWidth = cntTemp.Width
145- 133 : .OrigHeight = cntTemp.Height
146- 134 : End With
147- 135 : m_colAnchors.Add clsTemp, clsTemp.cnt.Name
148- 136 : Next
149- 137 : m_AddResizer RHS
150- 138 : End Property
121+ 111 : ' Use this to assign all default properties
122+ 112 : '
123+ 113 : Dim clsTemp As CAnchor
124+ 114 : Dim cntTemp As MSForms .control
125+ 115 : Set m_frmParent = RHS
126+ 116 : UpdateWhilstDragging = True '!!
127+ 117 : With RHS
128+ 118 : MinimumWidth = .Width
129+ 119 : MinimumHeight = .Height
130+ 120 : OrigLeft = 1
131+ 121 : OrigTop = 1
132+ 122 : OrigWidth = .InsideWidth
133+ 123 : OrigHeight = .InsideHeight
134+ 124 : End With
135+ 125 : For Each cntTemp In m_frmParent.Controls
136+ 126 : Set clsTemp = New CAnchor
137+ 127 : Set clsTemp.cnt = cntTemp
138+ 128 : With clsTemp
139+ 129 : .AnchorStyle = enumAnchorStyleLeft Or enumAnchorStyleTop
140+ 130 : .MinimumWidth = cntTemp.Width
141+ 131 : .MinimumHeight = cntTemp.Height
142+ 132 : .OrigLeft = cntTemp.Left
143+ 133 : .OrigTop = cntTemp.top
144+ 134 : .OrigWidth = cntTemp.Width
145+ 135 : .OrigHeight = cntTemp.Height
146+ 136 : End With
147+ 137 : m_colAnchors.Add clsTemp, clsTemp.cnt.Name
148+ 138 : Next
149+ 139 : m_AddResizer RHS
150+ 140 : End Property
151151 Private Sub Class_Initialize ()
152- 140 : Set m_colAnchors = New Collection
153- 141 : End Sub
152+ 142 : Set m_colAnchors = New Collection
153+ 143 : End Sub
154154 Private Sub Class_Terminate ()
155- 143 : Do While m_colAnchors.Count > 0
156- 144 : m_colAnchors.Remove m_colAnchors.Count
157- 145 : Loop
158- 146 : Set m_colAnchors = Nothing
159- 147 : m_frmParent.Controls.Remove MRESIZEHANDLE
160- 148 : Set ResizeHandle = Nothing
161- 149 : End Sub
162- Private Sub m_UpdateControls ()
163- 151 : '
164- 152 : ' Calculate New position of all controls
155+ 145 : Do While m_colAnchors.Count > 0
156+ 146 : m_colAnchors.Remove m_colAnchors.Count
157+ 147 : Loop
158+ 148 : Set m_colAnchors = Nothing
159+ 149 : m_frmParent.Controls.Remove MRESIZEHANDLE
160+ 150 : Set ResizeHandle = Nothing
161+ 151 : End Sub
162+ Private Sub m_UpdateControls ()
165163153 : '
166- 154 : Dim clsAnchor As CAnchor
167- 155 : Dim cntTemp As MSForms .control
168- 156 : Dim sngLeft As Single
169- 157 : Dim sngTop As Single
170- 158 : Dim sngHeight As Single
171- 159 : Dim sngWidth As Single
172- 160 : For Each clsAnchor In m_colAnchors
173- 161 : Set cntTemp = clsAnchor.cnt
174- 162 : If clsAnchor.AnchorStyle = enumAnchorStyleNone Then
175- 163 : ' do nothing with this control
176- 164 : Else
177- 165 : If ((clsAnchor.AnchorStyle And enumAnchorStyleTop) = enumAnchorStyleTop) And _
178- ((clsAnchor.AnchorStyle And enumAnchorStyleBottom) = enumAnchorStyleBottom) Then
179- 167 : ' maintain gap between top and bottom edges by adjusting height
180- 168 : sngHeight = m_frmParent.InsideHeight - (OrigHeight - clsAnchor.OrigTop - clsAnchor.OrigHeight) - clsAnchor.OrigTop
181- 169 : If sngHeight < clsAnchor.MinimumHeight Then sngHeight = clsAnchor.MinimumHeight
182- 170 : If sngHeight < 0 Then sngHeight = 0
183- 171 : cntTemp.Height = sngHeight
184- 172 : ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleTop) = enumAnchorStyleTop Then
185- 173 : ' maintain gap between top leave height alone
186- 174 : ' does not require code
187- 175 : ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleBottom) = enumAnchorStyleBottom Then
188- 176 : ' maintain gap between bottom leave height alone
189- 177 : sngTop = m_frmParent.InsideHeight - (OrigHeight - clsAnchor.OrigTop - clsAnchor.OrigHeight) - clsAnchor.OrigHeight
190- 178 : If sngTop < clsAnchor.MinimumTop Then sngTop = clsAnchor.MinimumTop
191- 179 : If sngTop < 0 Then sngTop = 0
192- 180 : cntTemp.top = sngTop
193- 181 : End If
194- 182 : If ((clsAnchor.AnchorStyle And enumAnchorStyleLeft) = enumAnchorStyleLeft) And _
195- ((clsAnchor.AnchorStyle And enumAnchorStyleRight) = enumAnchorStyleRight) Then
196- 184 : ' maintain gap between left and right edges by adjusting Width
197- 185 : sngWidth = m_frmParent.InsideWidth - (OrigWidth - clsAnchor.OrigLeft - clsAnchor.OrigWidth) - clsAnchor.OrigLeft
198- 186 : If sngWidth < clsAnchor.MinimumWidth Then sngWidth = clsAnchor.MinimumWidth
199- 187 : If sngWidth < 0 Then sngWidth = 0
200- 188 : cntTemp.Width = sngWidth
201- 189 : ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleLeft) = enumAnchorStyleLeft Then
202- 190 : ' maintain gap between left leave Width alone
203- 191 : ' does not require code
204- 192 : ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleRight) = enumAnchorStyleRight Then
205- 193 : ' maintain gap between Right leave Width alone
206- 194 : sngLeft = m_frmParent.InsideWidth - (OrigWidth - clsAnchor.OrigLeft - clsAnchor.OrigWidth) - clsAnchor.OrigWidth
207- 195 : If sngLeft < clsAnchor.MinimumLeft Then sngLeft = clsAnchor.MinimumLeft
208- 196 : If sngLeft < 0 Then sngLeft = 0
209- 197 : cntTemp.Left = sngLeft
210- 198 : End If
211- 199 : End If
212- 200 : Next
213- 201 : DoEvents
214- 202 : End Sub
164+ 154 : ' Calculate New position of all controls
165+ 155 : '
166+ 156 : Dim clsAnchor As CAnchor
167+ 157 : Dim cntTemp As MSForms .control
168+ 158 : Dim sngLeft As Single
169+ 159 : Dim sngTop As Single
170+ 160 : Dim sngHeight As Single
171+ 161 : Dim sngWidth As Single
172+ 162 : For Each clsAnchor In m_colAnchors
173+ 163 : Set cntTemp = clsAnchor.cnt
174+ 164 : If clsAnchor.AnchorStyle = enumAnchorStyleNone Then
175+ 165 : ' do nothing with this control
176+ 166 : Else
177+ 167 : If ((clsAnchor.AnchorStyle And enumAnchorStyleTop) = enumAnchorStyleTop) And _
178+ ((clsAnchor.AnchorStyle And enumAnchorStyleBottom) = enumAnchorStyleBottom) Then
179+ 169 : ' maintain gap between top and bottom edges by adjusting height
180+ 170 : sngHeight = m_frmParent.InsideHeight - (OrigHeight - clsAnchor.OrigTop - clsAnchor.OrigHeight) - clsAnchor.OrigTop
181+ 171 : If sngHeight < clsAnchor.MinimumHeight Then sngHeight = clsAnchor.MinimumHeight
182+ 172 : If sngHeight < 0 Then sngHeight = 0
183+ 173 : cntTemp.Height = sngHeight
184+ 174 : ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleTop) = enumAnchorStyleTop Then
185+ 175 : ' maintain gap between top leave height alone
186+ 176 : ' does not require code
187+ 177 : ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleBottom) = enumAnchorStyleBottom Then
188+ 178 : ' maintain gap between bottom leave height alone
189+ 179 : sngTop = m_frmParent.InsideHeight - (OrigHeight - clsAnchor.OrigTop - clsAnchor.OrigHeight) - clsAnchor.OrigHeight
190+ 180 : If sngTop < clsAnchor.MinimumTop Then sngTop = clsAnchor.MinimumTop
191+ 181 : If sngTop < 0 Then sngTop = 0
192+ 182 : cntTemp.top = sngTop
193+ 183 : End If
194+ 184 : If ((clsAnchor.AnchorStyle And enumAnchorStyleLeft) = enumAnchorStyleLeft) And _
195+ ((clsAnchor.AnchorStyle And enumAnchorStyleRight) = enumAnchorStyleRight) Then
196+ 186 : ' maintain gap between left and right edges by adjusting Width
197+ 187 : sngWidth = m_frmParent.InsideWidth - (OrigWidth - clsAnchor.OrigLeft - clsAnchor.OrigWidth) - clsAnchor.OrigLeft
198+ 188 : If sngWidth < clsAnchor.MinimumWidth Then sngWidth = clsAnchor.MinimumWidth
199+ 189 : If sngWidth < 0 Then sngWidth = 0
200+ 190 : cntTemp.Width = sngWidth
201+ 191 : ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleLeft) = enumAnchorStyleLeft Then
202+ 192 : ' maintain gap between left leave Width alone
203+ 193 : ' does not require code
204+ 194 : ElseIf (clsAnchor.AnchorStyle And enumAnchorStyleRight) = enumAnchorStyleRight Then
205+ 195 : ' maintain gap between Right leave Width alone
206+ 196 : sngLeft = m_frmParent.InsideWidth - (OrigWidth - clsAnchor.OrigLeft - clsAnchor.OrigWidth) - clsAnchor.OrigWidth
207+ 197 : If sngLeft < clsAnchor.MinimumLeft Then sngLeft = clsAnchor.MinimumLeft
208+ 198 : If sngLeft < 0 Then sngLeft = 0
209+ 199 : cntTemp.Left = sngLeft
210+ 200 : End If
211+ 201 : End If
212+ 202 : Next
213+ 203 : DoEvents
214+ End Sub
0 commit comments