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 [sUrlBranchClose]() As String
 86         Get
 87             Return CType(ViewState("sUrlBranchClose"), String)
 88         End Get
 89         Set(ByVal Value As String)
 90             ViewState("sUrlBranchClose") = 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 [sUrlLeaf]() As String
 99         Get
100             Return CType(ViewState("sUrlLeaf"), String)
101         End Get
102         Set(ByVal Value As String)
103             ViewState("sUrlLeaf") = Value
104         End Set
105     End Property
106     ''' <summary>
107     ''' URL картинки с ошибкой.
108     ''' </summary>
109     '''     ''' <returns>По умолчанию берётся из Интернета.</returns>
110     <Bindable(True), Category("Data"), DefaultValue(""), Description("URL картинки с ошибкой.")> _
111     Public Property [sUrlError]() As String
112         Get
113             Return CType(ViewState("sUrlError"), String)
114         End Get
115         Set(ByVal Value As String)
116             ViewState("sUrlError") = Value
117         End Set
118     End Property
119     REM Конструктор
120     Public Sub New()
121         Dim iArray(-1) As Integer
122         ViewState("iArrayIdTrue") = iArray 'массив чисел Int32, представляющих отмеченные Id.
123         ViewState("sConnectionString") = "" 'строка соединения с SQL-сервером
124         ViewState("sStoredProcedure") = "" 'хранимая процедура, выдающая таблицу из трёх колонок - номер листа (Int32), номер ветки (Int32) и наименование (String). Ствол должен равняться 0 или Null.
125         ViewState("sUrlTrunk") = "" 'URL картинки со стволом.
126         ViewState("sUrlBranch") = "" 'URL картинки с открытой веткой.
127         ViewState("sUrlBranchClose") = "" 'URL картинки с закрытой веткой.
128         ViewState("sUrlLeaf") = "" 'URL картинки с листом.
129         ViewState("sUrlError") = "" 'URL картинки с ошибкой.
130     End Sub
131     REM Добавление дочерних элементов управления
132     Protected Overrides Sub CreateChildControls()
133         'var
134         Dim b As Boolean 'есть ли хоть один чекбокс
135         Dim i As Integer
136         Dim iMax As Integer 'число чекбоксов -1
137         Dim sUrlOpen As String
138         Dim oNode(3, -1) 'возвращаемый по ссылке массив(x,y), содержащий информацию о дереве. x0=число пробелов перед названием уровня (0 или больше), x1=url картинки, x2=код текущего уровня, x3=наименование уровня.
139         Dim oLiteralControl As New LiteralControl
140         'end var
141         If ViewState("sUrlBranch") = "" Then
142             sUrlOpen = "http://okno.mos.ru/images/gif/Image-014.gif"
143         Else
144             sUrlOpen = ViewState("sUrlBranch") 'картинка открытой ветки
145         End If
146         If IsNothing(Page.Session("oNode")) Then
147             zapConnection = New SqlConnection
148             zapConnectString = ViewState("sConnectionString")
149             zapConnection.ConnectionString = zapConnectString
150             Try
151                 zapConnection.Open()
152                 b = bInTree(oNode, 0, -1, "")
153             Catch ex As Exception
154                 b = True
155                 oLiteralControl.Text = "Ошибка открытия соединения с SQL-сервером: " & ex.Message
156             Finally
157                 If Not (IsNothing(zapConnection)) Then
158                     zapConnection.Close()
159                     zapConnection = Nothing
160                 End If
161             End Try
162             Page.Session("oNode") = oNode
163         Else
164             oNode = Page.Session("oNode")
165         End If
166         If b = False Then
167             iMax = UBound(oNode, 2)
168             For i = 0 To iMax
169                 'var
170                 Dim i2 As Integer
171                 Dim oImageNull(oNode(0, i)) As WebControls.Image
172                 Dim oImage As New WebControls.Image
173                 Dim oCheckBox As New WebControls.CheckBox
174                 'end var
175                 Controls.Add(New LiteralControl("<div id=""" & oNode(2, i) & """>"))
176                 For i2 = 1 To oNode(0, i)
177                     oImageNull(i2) = New WebControls.Image
178                     oImageNull(i2).ImageUrl = "http://okno.mos.ru/images/gif/Image-081.gif" 'пустая картинка 16х16
179                     Controls.Add(oImageNull(i2))
180                 Next i2
181                 oImage.ImageUrl = oNode(1, i)
182                 oImage.ID = "oImg" & oNode(2, i)
183                 If oNode(1, i) = sUrlOpen Then
184                     oImage.Attributes.Add("onclick", "fInLevel(this)")
185                     oImage.Attributes.Add("title", "Нажмите для закрытия")
186                     oImage.Attributes.Add("style", "cursor:pointer")
187                 End If
188                 Controls.Add(oImage)
189                 'если попали не на лист, то делаем чекбокс пассивным
190                 '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
191                 '    oCheckBox.Enabled = False
192                 'End If
193                 oCheckBox.ID = "oChBox" & oNode(2, i)
194                 oCheckBox.Text = oNode(3, i)
195                 Controls.Add(oCheckBox)
196                 Controls.Add(New LiteralControl("</div>"))
197             Next i
198         Else
199             If oLiteralControl.Text = "" Then oLiteralControl.Text = "Нет ни одного элемента."
200             Controls.Add(oLiteralControl)
201         End If
202     End Sub
203     ''' <summary>
204     ''' Функция заполнения дерева (вызывает саму себя) = true если нет внутренней структуры.
205     ''' </summary>
206     ''' <param name="oNode">Возвращаемый по ссылке массив(x,y), содержащий информацию о дереве. x0=число пробелов перед названием уровня (0 или больше), x1=url картинки, x2=код текущего уровня, x3=наименование уровня.</param>
207     ''' <param name="iNum">Код предыдущего уровня. Для начального уровня рекомендуется задавать 0, а в хранимой процедуре ставить проверку не только на 0, но и на null.</param>
208     ''' <param name="iSpace">Число отступов перед текущим уровнем. Для начального уровня рекомендуется задавать -1, так как при вызове функции сразу идёт увеличение на единицу.</param>
209     ''' <param name="sNum">Коды предыдущих уровней через знак подчёркивания. Знаки подчёркивания лежат между кодами уровней. Для начального уровня ожидается пустая строка.</param>
210     ''' <returns>true если нет внутренней структуры и запрос на выборку ничего не вернул.</returns>
211     Private Function bInTree(ByRef oNode(,) As Object, ByVal iNum As Integer, ByVal iSpace As Integer, ByVal sNum As String) As Boolean
212         'var
213         Dim b As Boolean
214         Dim i As Integer
215         Dim iMax As Integer
216         Dim sErr As String
217         Dim oZap
218         'end var
219         iNum = iZap(ViewState("sStoredProcedure"), iNum, sErr, oZap)
220         If iNum = 0 Then
221             bInTree = True
222             Exit Function
223         End If
224         iSpace += 1
225         If iNum < 0 Then
226             'var
227             Dim iCount = UBound(oNode, 2) + 1
228             'end var
229             ReDim Preserve oNode(3, iCount) 'увеличение на 1
230             oNode(0, iCount) = iSpace 'число отступов
231             If ViewState("sUrlError") = "" Then
232                 oNode(1, iCount) = "http://okno.mos.ru/images/gif/Image-080.gif"
233             Else
234                 oNode(1, iCount) = ViewState("sUrlError") 'картинка ошибки
235             End If
236             If sNum = "" Then oNode(2, iCount) = 0 Else oNode(2, iCount) = sNum & "_0" 'код
237             oNode(3, iCount) = "Ошибка: " & sErr 'наименование
238             Exit Function
239         End If
240         iMax = iNum - 1
241         For i = 0 To iMax
242             'var
243             Dim iCount = UBound(oNode, 2) + 1
244             'end var
245             ReDim Preserve oNode(3, iCount) 'увеличение на 1
246             oNode(0, iCount) = iSpace 'число отступов
247             If sNum = "" Then oNode(2, iCount) = oZap(0, i) Else oNode(2, iCount) = sNum & "_" & oZap(0, i) 'код
248             oNode(3, iCount) = oZap(2, i) 'наименование
249             'картинка зависит от наличия внутренней структуры, поэтому сначала вызываем функцию-саму себя
250             b = bInTree(oNode, oZap(0, i), iSpace, oNode(2, iCount))
251             If iSpace = 0 Then
252                 If ViewState("sUrlTrunk") = "" Then
253                     oNode(1, iCount) = "http://okno.mos.ru/images/gif/Image-012.gif"
254                 Else
255                     oNode(1, iCount) = ViewState("sUrlTrunk") 'картинка ствола
256                 End If
257             ElseIf b = False Then
258                 If ViewState("sUrlBranch") = "" Then
259                     oNode(1, iCount) = "http://okno.mos.ru/images/gif/Image-014.gif"
260                 Else
261                     oNode(1, iCount) = ViewState("sUrlBranch") 'картинка ветки
262                 End If
263             Else
264                 If ViewState("sUrlLeaf") = "" Then
265                     oNode(1, iCount) = "http://okno.mos.ru/images/gif/Image-011.gif"
266                 Else
267                     oNode(1, iCount) = ViewState("sUrlLeaf") 'картинка листа
268                 End If
269             End If
270         Next i
271     End Function
272     ''' <summary>
273     ''' Функция взятия запроса как хранимой процедуры с одним параметром, представляющим код предыдущего уровня. Ожидается @iTrunk как число Int32, по умолчанию равное null.
274     ''' </summary>
275     ''' <param name="sConnectString">Строка подключения к SQL-серверу.</param>
276     ''' <param name="sSql">Название хранимой процедуры.</param>
277     ''' <param name="iNum">Параметр для хранимой процедуры, представляющий код предыдущего уровня. Ожидается @iTrunk как число Int32, по умолчанию равное null.</param>
278     ''' <param name="sErr">Сообщение об ошибке выполнения хранимой процедуры.</param>
279     ''' <param name="oZap">Двумерный массив, содержащий таблицу - результат запроса (x,y).</param>
280     ''' <returns>Число возвращаемых записей. Если 0, то ноль, если меньше нуля, то ошибка.</returns>
281     Public Overloads Function iZap(ByVal sSql As String, ByVal iNum As Integer, ByRef sErr As String, ByRef oZap(,) As Object) As Integer
282         'var
283         Dim zapBconnect As Boolean
284         Dim zapCommand As SqlCommand
285         Dim zapReader As SqlDataReader
286         Dim zapX As Long
287         Dim zapY As Long
288         Dim i1 As Integer
289         'end var
290         zapCommand = New SqlCommand
291         zapBconnect = False
292         iZap = -2
293         Try
294             zapBconnect = zapConnection.State
295             If zapBconnect Then iZap = -1
296             'zapCommand.CommandTimeout = 10
297             zapCommand.CommandType = CommandType.StoredProcedure
298             zapCommand.Parameters.Add("@iTrunk", iNum)
299             zapCommand.Connection = zapConnection
300             zapCommand.CommandText = sSql
301             zapReader = zapCommand.ExecuteReader()
302             iZap = 0
303             zapX = zapReader.FieldCount
304             If zapX < 0 Then zapX = 0
305             If zapX > 0 Then zapX = zapX - 1
306             zapY = -1
307             ReDim oZap(zapX, 0)
308             While zapReader.Read()
309                 zapY += 1
310                 If zapY < 2147483647 Then
311                     iZap = zapY + 1
312                     ReDim Preserve oZap(zapX, zapY)
313                     For i1 = 0 To zapX
314                         If IsNothing(zapReader(i1)) Or IsDBNull(zapReader(i1)) Then oZap(i1, zapY) = 0 Else oZap(i1, zapY) = zapReader(i1)
315                     Next
316                 Else : sErr = zapY & " строк (>=2 147 483 647)"
317                 End If
318             End While
319             zapReader.Close()
320             zapReader = Nothing
321             zapCommand = Nothing
322         Catch err As Exception
323             sErr = err.Message
324         End Try
325     End Function
326     ''' <summary>
327     ''' Функция поиска кода по Id чекбокса.
328     ''' </summary>
329     ''' <param name="sId">Строковый Id чекбокса.</param>
330     ''' <returns>Код уровня. Если ничего не найдено, то ноль.</returns>
331     Private Function iCodeFromId(ByVal sId As String) As Integer
332         'var
333         Dim i As Integer
334         Dim iMax As Integer = Len(sId)
335         'end var
336         For i = iMax To 1 Step -1
337             If IsNumeric(Mid(sId, i)) Then iCodeFromId = Mid(sId, i) Else i = 1
338         Next i
339     End Function
340     REM Здесь можно считывать данные из HTML
341     Public Function LoadPostData(ByVal postDataKey As String, ByVal postCollection As System.Collections.Specialized.NameValueCollection) As Boolean Implements System.Web.UI.IPostBackDataHandler.LoadPostData
342         REM Функция не используется, но её наличия требует компилятор.
343     End Function
344     REM Отлов отмеченных кодов текущих уровней
345     Public Sub RaisePostDataChangedEvent() Implements System.Web.UI.IPostBackDataHandler.RaisePostDataChangedEvent
346         'var
347         Dim i As Integer
348         Dim iMax As Integer = Controls.Count - 1
349         Dim iEnd As Integer 'увеличенный на один последний номер элемента массива
350         Dim sId As String
351         'end var
352         For i = 0 To iMax
353             If IsNothing(Controls(i).ID) Then sId = "" Else sId = Controls(i).ID
354             If Left(sId, 6) = "oChBox" Then
355                 If CType(Controls(i), WebControls.CheckBox).Checked Then
356                     iEnd = UBound(_iArrayIdTrue) + 1
357                     ReDim Preserve _iArrayIdTrue(iEnd) 'увеличение на единицу
358                     _iArrayIdTrue(iEnd) = iCodeFromId(Controls(i).ID)
359                 End If
360             End If
361         Next i
362     End Sub
363     REM Добавление JavaScript-а
364     Protected Overrides Sub OnPreRender(ByVal e As System.EventArgs)
365         'var
366         Dim sJavaScript As String
367         Dim sEnter As String = Chr(13) & Chr(10)
368         Dim sUrlOpen As String
369         Dim sUrlClose As String
370         'end var
371         'выполнение операций по умолчанию
372         MyBase.OnPreRender(e)
373         'выполняем работу по добавлению яваскрипта
374         If ViewState("sUrlBranch") = "" Then
375             sUrlOpen = "http://okno.mos.ru/images/gif/Image-014.gif"
376         Else
377             sUrlOpen = ViewState("sUrlBranch") 'картинка открытой ветки
378         End If
379         If ViewState("sUrlBranchClose") = "" Then
380             sUrlClose = "http://okno.mos.ru/images/gif/Image-013.gif"
381         Else
382             sUrlClose = ViewState("sUrlBranchClose") 'картинка закрытой ветки
383         End If
384         sJavaScript = "<script language=""javascript"" type=""text/javascript"">" & sEnter
385         sJavaScript += "    // Функция скрытия или показа вложенных уровней." & sEnter
386         sJavaScript += "    function fInLevel(oWhat)" & sEnter
387         sJavaScript += "    {" & sEnter
388         sJavaScript += "        var i,oDiv,oImg,iDivMax,iImgMax,oSearch;" & sEnter
389         sJavaScript += "        oDiv=document.getElementsByTagName('div');" & sEnter
390         sJavaScript += "        oImg=document.getElementsByTagName('img');" & sEnter
391         sJavaScript += "        iDivMax=oDiv.length-1;" & sEnter
392         sJavaScript += "        iImgMax=oImg.length-1;" & sEnter
393         sJavaScript += "        oSearch=oWhat.id.substring(oWhat.id.indexOf('oImg')+4)+'_';" & sEnter
394         sJavaScript += "        if(oWhat.src=='" & sUrlOpen & "')" & sEnter
395         sJavaScript += "        {" & sEnter
396         sJavaScript += "            oWhat.src='" & sUrlClose & "';" & sEnter
397         sJavaScript += "            oWhat.title='Нажмите для открытия';" & sEnter
398         sJavaScript += "            for(i=0;i<=iDivMax;i++)" & sEnter
399         sJavaScript += "            {" & sEnter
400         sJavaScript += "                if(oDiv[i].id.indexOf(oSearch)!=-1)" & sEnter
401         sJavaScript += "                {" & sEnter
402         sJavaScript += "                    oDiv[i].style.display='none';" & sEnter
403         sJavaScript += "                }" & sEnter
404         sJavaScript += "            }" & sEnter
405         sJavaScript += "        }" & sEnter
406         sJavaScript += "        else" & sEnter
407         sJavaScript += "        {" & sEnter
408         sJavaScript += "            oWhat.src='" & sUrlOpen & "';" & sEnter
409         sJavaScript += "            oWhat.title='Нажмите для закрытия';" & sEnter
410         sJavaScript += "            for(i=0;i<=iDivMax;i++)" & sEnter
411         sJavaScript += "            {" & sEnter
412         sJavaScript += "                if(oDiv[i].id.indexOf(oSearch)!=-1)" & sEnter
413         sJavaScript += "                {" & sEnter
414         sJavaScript += "                    oDiv[i].style.display='';" & sEnter
415         sJavaScript += "                }" & sEnter
416         sJavaScript += "            }" & sEnter
417         sJavaScript += "            for(i=0;i<=iImgMax;i++)" & sEnter
418         sJavaScript += "            {" & sEnter
419         sJavaScript += "                if(oImg[i].id.indexOf(oSearch)!=-1 && oImg[i].src=='" & sUrlClose & "')" & sEnter
420         sJavaScript += "                {" & sEnter
421         sJavaScript += "                    oImg[i].src='" & sUrlOpen & "';" & sEnter
422         sJavaScript += "                    oImg[i].title='Нажмите для закрытия';" & sEnter
423         sJavaScript += "                }" & sEnter
424         sJavaScript += "            }" & sEnter
425         sJavaScript += "        }" & sEnter
426         sJavaScript += "    }" & sEnter
427         sJavaScript += "</script>"
428         If Page.IsClientScriptBlockRegistered("WebCustomPanelTrCh") = False Then Page.RegisterClientScriptBlock("WebCustomPanelTrCh", sJavaScript)
429     End Sub
430 End Class
431