1 REM Панель с раскрытым деревом чекбоксов, заполняется рекурсивно.
  2 Option Compare Text
  3 Imports System.ComponentModel
  4 Imports System.Web.UI
  5 Imports System.Drawing
  6 Imports System.Data.SqlClient
  7 ''' <summary>
  8 ''' Элемент управления, выдающий раскрытое дерево чекбоксов рекурсивно.
  9 ''' ''' </summary>
 10 <DefaultProperty("iArrayIdTrue"), ToolboxData("<{0}:WebCustomPanelTrCh runat=server></{0}:WebCustomPanelTrCh>"), ToolboxBitmap(GetType(Bitmap))> _
 11 Public Class WebCustomPanelTrCh
 12     Inherits System.Web.UI.WebControls.Panel
 13     Implements INamingContainer, IPostBackDataHandler
 14     Private _iArrayIdTrue(-1) As Integer 'массив чисел Int32, представляющих отмеченные коды текущих уровней.
 15     Private zapConnection As SqlConnection
 16     Private zapConnectString As String
 17     ''' <summary>
 18     ''' Массив чисел Int32, представляющих отмеченные коды текущих уровней. Работает только для чтения.
 19     ''' </summary>
 20     '''     ''' <returns>По умолчанию выдаёт пустой массив.</returns>
 21     <Bindable(True), Category("Data"), DefaultValue(""), Description("Массив чисел Int32, представляющих отмеченные коды текущих уровней. Работает только для чтения.")> _
 22     Public ReadOnly Property [iArrayIdTrue]() As Integer()
 23         Get
 24             If UBound(_iArrayIdTrue) = -1 Then RaisePostDataChangedEvent()
 25             Return _iArrayIdTrue
 26         End Get
 27     End Property
 28     ''' <summary>
 29     ''' Строка соединения с базой данных SQL-сервер.
 30     ''' </summary>
 31     '''     ''' <returns></returns>
 32     <Bindable(True), Category("Data"), DefaultValue(""), Description("Строка соединения с базой данных SQL-сервер.")> _
 33     Public Property [sConnectionString]() As String
 34         Get
 35             Return CType(ViewState("sConnectionString"), String)
 36         End Get
 37         Set(ByVal Value As String)
 38             ViewState("sConnectionString") = Value
 39         End Set
 40     End Property
 41     ''' <summary>
 42     ''' Хранимая процедура, выдающая таблицу из трёх колонок - номер листа (Int32), номер ветки (Int32) и наименование (String). Стволы должны равняться 0 или null. Процедура принимает один параметр - начальный код предыдущего уровня - код ствола. Ожидается параметр @iTrunk как число Int32, по умолчанию равное null.
 43     ''' </summary>
 44     '''     ''' <returns></returns>
 45     <Bindable(True), Category("Data"), DefaultValue(""), Description("Хранимая процедура, выдающая таблицу из трёх колонок - номер листа (Int32), номер ветки (Int32) и наименование (String). Стволы должны равняться 0 или null. Процедура принимает один параметр - начальный код предыдущего уровня - код ствола. Ожидается параметр @iTrunk как число Int32, по умолчанию равное null.")> _
 46     Public Property [sStoredProcedure]() As String
 47         Get
 48             Return CType(ViewState("sStoredProcedure"), String)
 49         End Get
 50         Set(ByVal Value As String)
 51             ViewState("sStoredProcedure") = Value
 52         End Set
 53     End Property
 54     ''' <summary>
 55     ''' URL картинки со стволом.
 56     ''' </summary>
 57     '''     ''' <returns>По умолчанию берётся из Интернета.</returns>
 58     <Bindable(True), Category("Data"), DefaultValue(""), Description("URL картинки со стволом.")> _
 59     Public Property [sUrlTrunk]() As String
 60         Get
 61             Return CType(ViewState("sUrlTrunk"), String)
 62         End Get
 63         Set(ByVal Value As String)
 64             ViewState("sUrlTrunk") = Value
 65         End Set
 66     End Property
 67     ''' <summary>
 68     ''' URL картинки с веткой.
 69     ''' </summary>
 70     '''     ''' <returns>По умолчанию берётся из Интернета.</returns>
 71     <Bindable(True), Category("Data"), DefaultValue(""), Description("URL картинки с веткой.")> _
 72     Public Property [sUrlBranch]() As String
 73         Get
 74             Return CType(ViewState("sUrlBranch"), String)
 75         End Get
 76         Set(ByVal Value As String)
 77             ViewState("sUrlBranch") = Value
 78         End Set
 79     End Property
 80     ''' <summary>
 81     ''' URL картинки с листом.
 82     ''' </summary>
 83     '''     ''' <returns>По умолчанию берётся из Интернета.</returns>
 84     <Bindable(True), Category("Data"), DefaultValue(""), Description("URL картинки с листом.")> _
 85     Public Property [sUrlLeaf]() As String
 86         Get
 87             Return CType(ViewState("sUrlLeaf"), String)
 88         End Get
 89         Set(ByVal Value As String)
 90             ViewState("sUrlLeaf") = Value
 91         End Set
 92     End Property
 93     ''' <summary>
 94     ''' URL картинки с ошибкой.
 95     ''' </summary>
 96     '''     ''' <returns>По умолчанию берётся из Интернета.</returns>
 97     <Bindable(True), Category("Data"), DefaultValue(""), Description("URL картинки с ошибкой.")> _
 98     Public Property [sUrlError]() As String
 99         Get
100             Return CType(ViewState("sUrlError"), String)
101         End Get
102         Set(ByVal Value As String)
103             ViewState("sUrlError") = Value
104         End Set
105     End Property
106     REM Конструктор
107     Public Sub New()
108         Dim iArray(-1) As Integer
109         ViewState("iArrayIdTrue") = iArray 'массив чисел Int32, представляющих отмеченные Id.
110         ViewState("sConnectionString") = "" 'строка соединения с SQL-сервером
111         ViewState("sStoredProcedure") = "" 'хранимая процедура, выдающая таблицу из трёх колонок - номер листа (Int32), номер ветки (Int32) и наименование (String). Ствол должен равняться 0 или Null.
112         ViewState("sUrlTrunk") = "" 'URL картинки со стволом.
113         ViewState("sUrlBranch") = "" 'URL картинки с веткой.
114         ViewState("sUrlLeaf") = "" 'URL картинки с листом.
115         ViewState("sUrlError") = "" 'URL картинки с ошибкой.
116     End Sub
117     REM Добавление дочерних элементов управления
118     Protected Overrides Sub CreateChildControls()
119         'var
120         Dim b As Boolean 'есть ли хоть один чекбокс
121         Dim i As Integer
122         Dim iMax As Integer 'число чекбоксов -1
123         Dim oNode(3, -1) 'возвращаемый по ссылке массив(x,y), содержащий информацию о дереве. x0=число пробелов перед названием уровня (0 или больше), x1=url картинки, x2=код текущего уровня, x3=наименование уровня.
124         Dim oLiteralControl As New LiteralControl
125         'end var
126         If IsNothing(Page.Session("oNode")) Then
127             zapConnection = New SqlConnection
128             zapConnectString = ViewState("sConnectionString")
129             zapConnection.ConnectionString = zapConnectString
130             Try
131                 zapConnection.Open()
132                 b = bInTree(oNode, 0, -1)
133             Catch ex As Exception
134                 b = True
135                 oLiteralControl.Text = "Ошибка открытия соединения с SQL-сервером: " & ex.Message
136             Finally
137                 If Not (IsNothing(zapConnection)) Then
138                     zapConnection.Close()
139                     zapConnection = Nothing
140                 End If
141             End Try
142             Page.Session("oNode") = oNode
143         Else
144             oNode = Page.Session("oNode")
145         End If
146         If b = False Then
147             iMax = UBound(oNode, 2)
148             For i = 0 To iMax
149                 'var
150                 Dim i2 As Integer
151                 Dim oImageNull(oNode(0, i)) As WebControls.Image
152                 Dim oImage As New WebControls.Image
153                 Dim oCheckBox As New WebControls.CheckBox
154                 'end var
155                 For i2 = 1 To oNode(0, i)
156                     oImageNull(i2) = New WebControls.Image
157                     oImageNull(i2).ImageUrl = "http://okno.mos.ru/images/gif/Image-081.gif" 'пустая картинка 16х16
158                     Controls.Add(oImageNull(i2))
159                 Next i2
160                 oImage.ImageUrl = oNode(1, i)
161                 Controls.Add(oImage)
162                 'если попали не на лист, то делаем чекбокс пассивным
163                 If Not (oNode(1, i) = ViewState("sUrlLeaf") And ViewState("sUrlLeaf") <> "" Or oNode(1, i) = "http://okno.mos.ru/images/gif/Image-011.gif" And ViewState("sUrlLeaf") = "") Then
164                     oCheckBox.Enabled = False
165                 End If
166                 oCheckBox.ID = "oChBox" & oNode(2, i)
167                 oCheckBox.Text = oNode(3, i)
168                 Controls.Add(oCheckBox)
169                 If i < iMax Then Controls.Add(New LiteralControl("<br>"))
170             Next i
171         Else
172             If oLiteralControl.Text = "" Then oLiteralControl.Text = "Нет ни одного элемента."
173             Controls.Add(oLiteralControl)
174         End If
175     End Sub
176     ''' <summary>
177     ''' Функция заполнения дерева (вызывает саму себя) = true если нет внутренней структуры.
178     ''' </summary>
179     ''' <param name="oNode">Возвращаемый по ссылке массив(x,y), содержащий информацию о дереве. x0=число пробелов перед названием уровня (0 или больше), x1=url картинки, x2=код текущего уровня, x3=наименование уровня.</param>
180     ''' <param name="iNum">Код предыдущего уровня. Для начального уровня рекомендуется задавать 0, а в хранимой процедуре ставить проверку не только на 0, но и на null.</param>
181     ''' <param name="iSpace">Число отступов перед текущим уровнем. Для начального уровня рекомендуется задавать -1, так как при вызове функции сразу идёт увеличение на единицу.</param>
182     ''' <returns>true если нет внутренней структуры и запрос на выборку ничего не вернул.</returns>
183     Private Function bInTree(ByRef oNode(,) As Object, ByVal iNum As Integer, ByVal iSpace As Integer) As Boolean
184         'var
185         Dim b As Boolean
186         Dim i As Integer
187         Dim iMax As Integer
188         Dim sErr As String
189         Dim oZap
190         'end var
191         iNum = iZap(ViewState("sStoredProcedure"), iNum, sErr, oZap)
192         If iNum = 0 Then
193             bInTree = True
194             Exit Function
195         End If
196         iSpace += 1
197         If iNum < 0 Then
198             'var
199             Dim iCount = UBound(oNode, 2) + 1
200             'end var
201             ReDim Preserve oNode(3, iCount) 'увеличение на 1
202             oNode(0, iCount) = iSpace 'число отступов
203             If ViewState("sUrlError") = "" Then
204                 oNode(1, iCount) = "http://okno.mos.ru/images/gif/Image-080.gif"
205             Else
206                 oNode(1, iCount) = ViewState("sUrlError") 'картинка ошибки
207             End If
208             oNode(2, iCount) = 0 'код
209             oNode(3, iCount) = "Ошибка: " & sErr 'наименование
210             Exit Function
211         End If
212         iMax = iNum - 1
213         For i = 0 To iMax
214             'var
215             Dim iCount = UBound(oNode, 2) + 1
216             'end var
217             ReDim Preserve oNode(3, iCount) 'увеличение на 1
218             oNode(0, iCount) = iSpace 'число отступов
219             b = bInTree(oNode, oZap(0, i), iSpace)
220             If iSpace = 0 Then
221                 If ViewState("sUrlTrunk") = "" Then
222                     oNode(1, iCount) = "http://okno.mos.ru/images/gif/Image-012.gif"
223                 Else
224                     oNode(1, iCount) = ViewState("sUrlTrunk") 'картинка ствола
225                 End If
226             ElseIf b = False Then
227                 If ViewState("sUrlBranch") = "" Then
228                     oNode(1, iCount) = "http://okno.mos.ru/images/gif/Image-014.gif"
229                 Else
230                     oNode(1, iCount) = ViewState("sUrlBranch") 'картинка ветки
231                 End If
232             Else
233                 If ViewState("sUrlLeaf") = "" Then
234                     oNode(1, iCount) = "http://okno.mos.ru/images/gif/Image-011.gif"
235                 Else
236                     oNode(1, iCount) = ViewState("sUrlLeaf") 'картинка листа
237                 End If
238             End If
239             oNode(2, iCount) = oZap(0, i) 'код
240             oNode(3, iCount) = oZap(2, i) 'наименование
241         Next i
242     End Function
243     ''' <summary>
244     ''' Функция взятия запроса как хранимой процедуры с одним параметром, представляющим код предыдущего уровня. Ожидается @iTrunk как число Int32, по умолчанию равное null.
245     ''' </summary>
246     ''' <param name="sConnectString">Строка подключения к SQL-серверу.</param>
247     ''' <param name="sSql">Название хранимой процедуры.</param>
248     ''' <param name="iNum">Параметр для хранимой процедуры, представляющий код предыдущего уровня. Ожидается @iTrunk как число Int32, по умолчанию равное null.</param>
249     ''' <param name="sErr">Сообщение об ошибке выполнения хранимой процедуры.</param>
250     ''' <param name="oZap">Двумерный массив, содержащий таблицу - результат запроса (x,y).</param>
251     ''' <returns>Число возвращаемых записей. Если 0, то ноль, если меньше нуля, то ошибка.</returns>
252     Public Overloads Function iZap(ByVal sSql As String, ByVal iNum As Integer, ByRef sErr As String, ByRef oZap(,) As Object) As Integer
253         'var
254         Dim zapBconnect As Boolean
255         Dim zapCommand As SqlCommand
256         Dim zapReader As SqlDataReader
257         Dim zapX As Long
258         Dim zapY As Long
259         Dim i1 As Integer
260         'end var
261         zapCommand = New SqlCommand
262         zapBconnect = False
263         iZap = -2
264         Try
265             zapBconnect = zapConnection.State
266             If zapBconnect Then iZap = -1
267             'zapCommand.CommandTimeout = 10
268             zapCommand.CommandType = CommandType.StoredProcedure
269             zapCommand.Parameters.Add("@iTrunk", iNum)
270             zapCommand.Connection = zapConnection
271             zapCommand.CommandText = sSql
272             zapReader = zapCommand.ExecuteReader()
273             iZap = 0
274             zapX = zapReader.FieldCount
275             If zapX < 0 Then zapX = 0
276             If zapX > 0 Then zapX = zapX - 1
277             zapY = -1
278             ReDim oZap(zapX, 0)
279             While zapReader.Read()
280                 zapY += 1
281                 If zapY < 2147483647 Then
282                     iZap = zapY + 1
283                     ReDim Preserve oZap(zapX, zapY)
284                     For i1 = 0 To zapX
285                         If IsNothing(zapReader(i1)) Or IsDBNull(zapReader(i1)) Then oZap(i1, zapY) = 0 Else oZap(i1, zapY) = zapReader(i1)
286                     Next
287                 Else : sErr = zapY & " строк (>=2 147 483 647)"
288                 End If
289             End While
290             zapReader.Close()
291             zapReader = Nothing
292             zapCommand = Nothing
293         Catch err As Exception
294             sErr = err.Message
295         End Try
296     End Function
297     REM Здесь можно считывать данные из HTML
298     Public Function LoadPostData(ByVal postDataKey As String, ByVal postCollection As System.Collections.Specialized.NameValueCollection) As Boolean Implements System.Web.UI.IPostBackDataHandler.LoadPostData
299         REM Функция не используется, но её наличия требует компилятор.
300     End Function
301     REM Отлов отмеченных кодов текущих уровней
302     Public Sub RaisePostDataChangedEvent() Implements System.Web.UI.IPostBackDataHandler.RaisePostDataChangedEvent
303         'var
304         Dim i As Integer
305         Dim iMax As Integer = Controls.Count - 1
306         Dim iEnd As Integer 'увеличенный на один последний номер элемента массива
307         Dim sId As String
308         'end var
309         For i = 0 To iMax
310             If IsNothing(Controls(i).ID) Then sId = "" Else sId = Controls(i).ID
311             If Left(sId, 6) = "oChBox" Then
312                 If CType(Controls(i), WebControls.CheckBox).Checked Then
313                     iEnd = UBound(_iArrayIdTrue) + 1
314                     ReDim Preserve _iArrayIdTrue(iEnd) 'увеличение на единицу
315                     _iArrayIdTrue(iEnd) = Mid(Controls(i).ID, 7)
316                 End If
317             End If
318         Next i
319     End Sub
320 End Class
321