1 'В проекте используется библиотека элементов управления
  2 'Microsoft.Web.UI.WebControls, которую можно скачать здесь:
  3 'http://www.aspnetmania.com/Forums/ForumMessage/file.aspx?ID=319
  4 
  5 'Структура 1-го запроса SQL:
  6 'Код кнопки, Название кнопки.
  7 'Струкрура 2-го запроса SQL:
  8 'Код нажатой кнопки = Код ветки предыдущего уровня,
  9 'Коды ветвей следующего уровня,
 10 'Наименование ветки
 11 'URL ветки
 12 'Логическое поле (есть или нет подветви)
 13 'URL картинки-иконки для ветки дерева (не обязательное поле)
 14 'Желаю приятной работы
 15 
 16 Imports System
 17 Imports System.ComponentModel
 18 Imports System.Web.UI
 19 Imports System.Web.UI.WebControls
 20 Imports System.Web.UI.HtmlControls
 21 Imports Microsoft
 22 Imports Microsoft.Web
 23 Imports Microsoft.Web.UI
 24 Imports Microsoft.Web.UI.WebControls
 25 Imports System.Data
 26 Imports System.Data.SqlClient
 27 Imports System.Drawing
 28 
 29 <ToolboxBitmap(GetType(Bitmap))> _
 30 Public Class SMenuMax
 31     Inherits WebControl
 32     Implements IPostBackEventHandler
 33     REM Переменные уровня модуля
 34     Private _GroupStyle As New SMenuMaxTree 'дерево
 35     Private _ItemStyle As New Style 'кнопки
 36     Private _ItemSelectStyle As New Style 'кнопки при селекции
 37     Private _ItemMouseStyle As New Style 'кнопки при наведении мыши
 38     Private _LeftCellStyle As New Style 'левая ячейка
 39     Private _RightCellStyle As New Style  'правая ячейка
 40     Private _SqlErrorLeft As String 'ошибка взятия левого запроса
 41     Private _SqlErrorRight As String 'ошибка взятия правого запроса
 42     Private _Wrap As Boolean = True
 43     REM Конструктор
 44     Public Sub New()
 45         REM Переменные Viewstate
 46         SqlConnectString = "packet size=4096;user id=prohorov;data source=""KELT1\POWER1"";persist security info=True;initial catalog=SHARE;password=2005_01" 'строка соединения
 47         SqlCommandLeft = "exec sys_menu_groups" 'левый SQL
 48         SqlCommandRight = "exec sys_menu_group_items" 'правый SQL
 49         SqlParamName1 = "@group_id" 'наименование параметра
 50         FirstGroupId = 0 'первое значение @group_id
 51         REM Не Viewstate
 52         'дерево
 53         _GroupStyle.BorderColor = Color.Empty
 54         _GroupStyle.BorderStyle = BorderStyle.None
 55         _GroupStyle.BorderWidth = Unit.Empty
 56         _GroupStyle.PicChosenUrl = "/img/folder4.gif"
 57         _GroupStyle.PicFolderOpenedUrl = "/img/folder3.gif"
 58         _GroupStyle.PicFolderUrl = "/img/folder2.gif"
 59         _GroupStyle.PicRootUrl = "/img/folder1.gif"
 60         _GroupStyle.PicFileUrl = "/img/file(txt).gif"
 61         'кнопки
 62         _ItemStyle.BackColor = Color.Gainsboro
 63         _ItemStyle.BorderColor = Color.Gray
 64         _ItemStyle.BorderStyle = BorderStyle.Solid
 65         _ItemStyle.BorderWidth = Unit.Pixel(1)
 66         _ItemStyle.Font.Name = "Arial"
 67         _ItemStyle.ForeColor = Color.Black
 68         _ItemStyle.Width = Unit.Pixel(200)
 69         'выделенная кнопка
 70         _ItemSelectStyle.BackColor = Color.Silver
 71         _ItemSelectStyle.BorderColor = Color.Gray
 72         _ItemSelectStyle.BorderStyle = BorderStyle.Solid
 73         _ItemSelectStyle.BorderWidth = Unit.Pixel(1)
 74         _ItemSelectStyle.Font.Name = "Arial"
 75         _ItemSelectStyle.ForeColor = Color.White
 76         'наведённая мышью кнопка
 77         _ItemMouseStyle.BackColor = Color.Blue
 78         _ItemMouseStyle.ForeColor = Color.White
 79         'таблица и внешний стиль
 80         Me.BorderColor = Color.Gray
 81         Me.BorderStyle = BorderStyle.Solid
 82         Me.BorderWidth = Unit.Pixel(1)
 83         Me.Height = Unit.Pixel(400)
 84         Me.Width = Unit.Pixel(400)
 85         _Wrap = True
 86         'левая ячейка
 87         _LeftCellStyle.BackColor = Color.WhiteSmoke
 88         _LeftCellStyle.BorderColor = Color.Gray
 89         _LeftCellStyle.BorderStyle = BorderStyle.Solid
 90         _LeftCellStyle.BorderWidth = Unit.Pixel(1)
 91         _LeftCellStyle.Width = Unit.Percentage(30)
 92         'правая ячейка
 93         _RightCellStyle.BackColor = Color.White
 94         _RightCellStyle.BorderColor = Color.Gray
 95         _RightCellStyle.BorderStyle = BorderStyle.Solid
 96         _RightCellStyle.BorderWidth = Unit.Pixel(1)
 97     End Sub
 98     REM Группировка свойств дерева
 99     <Category("SMenuMaxStyle"), _
100     System.ComponentModel.DesignerSerializationVisibility(DesignerSerializationVisibility.Content), _
101     PersistenceMode(PersistenceMode.InnerProperty)> _
102     Public ReadOnly Property GroupStyle() As SMenuMaxTree
103         Get
104             If _GroupStyle Is Nothing Then
105                 _GroupStyle = New Style
106             End If
107             Return _GroupStyle
108         End Get
109     End Property
110     REM Группировка свойств кнопок
111     <Category("SMenuMaxStyle"), _
112     System.ComponentModel.DesignerSerializationVisibility(DesignerSerializationVisibility.Content), _
113     PersistenceMode(PersistenceMode.InnerProperty)> _
114     Public ReadOnly Property ItemStyle() As Style
115         Get
116             If _ItemStyle Is Nothing Then
117                 _ItemStyle = New Style
118             End If
119             Return _ItemStyle
120         End Get
121     End Property
122     REM Группировка свойств выделенной кнопки
123     <Category("SMenuMaxStyle"), _
124     System.ComponentModel.DesignerSerializationVisibility(DesignerSerializationVisibility.Content), _
125     PersistenceMode(PersistenceMode.InnerProperty)> _
126     Public ReadOnly Property ItemSelectStyle() As Style
127         Get
128             If _ItemSelectStyle Is Nothing Then
129                 _ItemSelectStyle = New Style
130             End If
131             Return _ItemSelectStyle
132         End Get
133     End Property
134     REM Группировка свойств кнопки при наведении мыши
135     <Category("SMenuMaxStyle"), _
136     System.ComponentModel.DesignerSerializationVisibility(DesignerSerializationVisibility.Content), _
137     PersistenceMode(PersistenceMode.InnerProperty)> _
138     Public ReadOnly Property ItemMouseStyle() As Style
139         Get
140             If _ItemMouseStyle Is Nothing Then
141                 _ItemMouseStyle = New Style
142             End If
143             Return _ItemMouseStyle
144         End Get
145     End Property
146     REM Группировка свойств левой ячейки
147     <Category("SMenuMaxStyle"), _
148     System.ComponentModel.DesignerSerializationVisibility(DesignerSerializationVisibility.Content), _
149     PersistenceMode(PersistenceMode.InnerProperty)> _
150     Public ReadOnly Property LeftCellStyle() As Style
151         Get
152             If _LeftCellStyle Is Nothing Then
153                 _LeftCellStyle = New Style
154             End If
155             Return _LeftCellStyle
156         End Get
157     End Property
158     REM Группировка свойств правой ячейки
159     <Category("SMenuMaxStyle"), _
160     System.ComponentModel.DesignerSerializationVisibility(DesignerSerializationVisibility.Content), _
161     PersistenceMode(PersistenceMode.InnerProperty)> _
162     Public ReadOnly Property RightCellStyle() As Style
163         Get
164             If _RightCellStyle Is Nothing Then
165                 _RightCellStyle = New Style
166             End If
167             Return _RightCellStyle
168         End Get
169     End Property
170     REM Строка соединения
171     <Category("Data")> _
172     Public Property SqlConnectString() As String
173         Get
174             Return Viewstate("SqlConnectString")
175         End Get
176         Set(ByVal Value As String)
177             Viewstate("SqlConnectString") = Value
178         End Set
179     End Property
180     REM Команда для заполнения строк вложенной таблицы
181     <Category("Data")> _
182     Public Property SqlCommandLeft() As String
183         Get
184             Return CType(Viewstate("SqlCommandLeft"), String)
185         End Get
186         Set(ByVal Value As String)
187             Viewstate("SqlCommandLeft") = Value
188         End Set
189     End Property
190     REM Команда для заполнения дерева
191     <Category("Data")> _
192     Public Property SqlCommandRight() As String
193         Get
194             Return CType(Viewstate("SqlCommandRight"), String)
195         End Get
196         Set(ByVal Value As String)
197             Viewstate("SqlCommandRight") = Value
198         End Set
199     End Property
200     REM Параметр1
201     <Category("Data")> _
202     Public Property SqlParamName1() As String
203         Get
204             Return CType(Viewstate("SqlParamName1"), String)
205         End Get
206         Set(ByVal Value As String)
207             'If Left(Viewstate("SqlParamName1"), 1) = "@" Then Viewstate("SqlParamName1") = Value
208             Viewstate("SqlParamName1") = Value
209         End Set
210     End Property
211     REM Первая ссылка
212     <Category("Data")> _
213     Public Property FirstGroupId() As Integer
214         Get
215             Return CType(Viewstate("FirstGroupId"), Integer)
216         End Get
217         Set(ByVal Value As Integer)
218             Viewstate("FirstGroupId") = Value
219         End Set
220     End Property
221     REM Ошибка запроса на заполнение строк вложенной таблицы
222     <Category("Data")> _
223     Public ReadOnly Property SqlErrorLeft() As String
224         Get
225             Return _SqlErrorLeft
226         End Get
227     End Property
228     REM Ошибка запроса на заполнение дерева
229     <Category("Data")> _
230     Public ReadOnly Property SqlErrorRight() As String
231         Get
232             Return _SqlErrorRight
233         End Get
234     End Property
235     REM Разрешение или запрет увеличения размеров
236     <Category("Layout")> _
237     Public Property Wrap() As Boolean
238         Get
239             Return _Wrap
240         End Get
241         Set(ByVal Value As Boolean)
242             _Wrap = Value
243         End Set
244     End Property
245     REM Динамическое создание вложенных элементов управления
246     Protected Overrides Sub CreateChildControls()
247         'общие
248         Dim i As Integer
249         Dim j As Integer
250         Dim k As Integer
251         Dim b As Boolean
252         'переменные для запросов
253         Dim iNum As Integer
254         Dim sNum(0) As String
255         Dim oZap
256         Dim iNum1 As Integer
257         Dim sParam1 As String = SqlParamName1
258         'создание внешней таблицы
259         Dim oTable1 As New Table
260         Dim oRow1_0 As New TableRow
261         Dim oCell1_0 As New TableCell
262         Dim oCell1_1 As New TableCell
263         Dim oTable2 As New Table
264         Dim oTreeView As New TreeView
265         Dim oPanel As New Panel
266         Dim oNode As New TreeNode
267         iNum = FirstGroupId
268         iNum1 = iZap(SqlConnectString, SqlCommandLeft, _SqlErrorLeft, oZap)
269         For i = 0 To iNum1 - 1
270             Dim oRow2 As New TableRow
271             Dim oCell2 As New TableCell
272             Dim oCell2Mouse As New TableCell
273             Dim oLabel As New Label
274             Dim sColor As String
275             Dim sBackgroundColor As String
276             Dim sMouse As String
277             Dim sBackgroundMouse As String
278             If UBound(sNum) < oZap(0, i) Then ReDim Preserve sNum(oZap(0, i))
279             sNum(oZap(0, i)) = oZap(1, i)
280             oCell2.ID = "row" & oZap(0, i)
281             If oZap(0, i) = iNum Then
282                 oCell2.ApplyStyle(_ItemSelectStyle)
283                 oCell2.CssClass = "SMenuMaxItemSelectStyle"
284             Else
285                 'ячейка простая
286                 oCell2.ApplyStyle(_ItemStyle)
287                 oCell2.CssClass = "SMenuMaxItemStyle"
288                 'ячейка при наведении мыши
289                 oCell2Mouse.CssClass = "SMenuMaxItemMouseStyle"
290                 'яваскрипт при наведении мыши
291                 oCell2.Attributes.Add("onmouseover", "javascript:document.getElementById('" & oCell2.ClientID & "').style.color = '" & _ItemMouseStyle.ForeColor.Name & "'; document.getElementById('" & oCell2.ClientID & "').style.backgroundColor = '" & _ItemMouseStyle.BackColor.Name & "'")
292                 oCell2.Attributes.Add("onmouseout", "javascript:document.getElementById('" & oCell2.ClientID & "').style.color = '" & _ItemStyle.ForeColor.Name & "'; document.getElementById('" & oCell2.ClientID & "').style.backgroundColor = '" & _ItemStyle.BackColor.Name & "'")
293                 oCell2.Attributes("onclick") = Page.GetPostBackEventReference(Me, oCell2.ID) 'формирование постбека
294             End If
295             oLabel.Text = sNum(oZap(0, i))
296             oCell2.Controls.Add(oLabel)
297             oRow2.Cells.Add(oCell2) 'добавление кнопки
298             oTable2.Rows.Add(oRow2) 'добавление строки
299         Next i
300         oCell1_0.HorizontalAlign = HorizontalAlign.Left
301         oCell1_0.VerticalAlign = VerticalAlign.Top
302         oCell1_0.Controls.Add(oTable2)
303         'стили левой ячейки
304         oCell1_0.ApplyStyle(LeftCellStyle)
305         oCell1_0.CssClass = "SMenuMaxLeftCellStyle"
306         oRow1_0.Cells.Add(oCell1_0) 'добавление левой ячейки
307         If iNum Then
308             oNode.Text = sNum(iNum)
309             oNode.ExpandedImageUrl = _GroupStyle.PicRootUrl
310             oNode.ImageUrl = _GroupStyle.PicRootUrl
311             oNode.SelectedImageUrl = _GroupStyle.PicRootUrl
312             b = bInTree(oNode, iNum, oZap)
313             oNode.Expanded = True
314             oTreeView.Nodes.Add(oNode)
315             oTreeView.SelectExpands = True
316             'oTreeView.ExpandedImageUrl = _GroupStyle.PicFolderOpenedUrl 'закомментарь для повышения устойчивости к сбоям
317             oTreeView.ImageUrl = _GroupStyle.PicFileUrl
318             oTreeView.SelectedImageUrl = _GroupStyle.PicChosenUrl
319         End If
320         oCell1_1.HorizontalAlign = HorizontalAlign.Left
321         oCell1_1.VerticalAlign = VerticalAlign.Top
322         oTreeView.BackColor = _GroupStyle.BackColor
323         oTreeView.BorderColor = _GroupStyle.BorderColor
324         oTreeView.BorderStyle = _GroupStyle.BorderStyle
325         oTreeView.BorderWidth = _GroupStyle.BorderWidth
326         oTreeView.Font.Name = _GroupStyle.Font.Name
327         oTreeView.Font.Size = _GroupStyle.Font.Size
328         oTreeView.Font.Bold = _GroupStyle.Font.Bold
329         oTreeView.Font.Italic = _GroupStyle.Font.Italic
330         oTreeView.ForeColor = _GroupStyle.ForeColor
331         oCell1_1.Controls.Add(oTreeView) 'добавление дерева
332         'стили правой ячейки
333         oCell1_1.ApplyStyle(RightCellStyle)
334         oCell1_1.CssClass = "SMenuMaxRightCellStyle"
335         oCell1_1.Wrap = False
336         oRow1_0.Cells.Add(oCell1_1) 'добавление правой ячейки
337         oTable1.Rows.Add(oRow1_0) 'добавление строки
338         'стили внешн окантовки
339         oTable1.BorderColor = Color.Empty
340         oTable1.CssClass = "SMenuMaxTableStyle"
341         oTable1.BorderStyle = BorderStyle.None
342         oTable1.BorderWidth = Unit.Empty
343         oTable1.Height = Unit.Empty
344         oTable1.Width = Unit.Empty
345         'oPanel.Attributes.Add("style", "overflow:auto")
346         If _Wrap = False Then oPanel.Style.Add("overflow", "auto")
347         oPanel.Width = Me.Width
348         oPanel.Height = Me.Height
349         oPanel.Controls.Add(oTable1)
350         Me.Controls.Add(oPanel) 'добавление таблицы
351     End Sub
352     REM Процедура заполнения дерева (вызывает саму себя) = true если нет внутренней структуры
353     Private Function bInTree(ByRef oNode As TreeNode, ByVal iNum As Integer, ByVal oZap(,) As Object) As Boolean
354 
355         'For Each n As TreeNode In oNode.Nodes
356         '    If n.Nodes.Count > 0 Then
357         '        ' folder (has children)
358         '        bInTree(n)
359         '    Else
360         '        ' this is terminal item (no children)
361         '    End If
362         'Next
363 
364         Dim i As Integer
365         Dim b As Boolean
366         iNum = iZap(SqlConnectString, SqlCommandRight, SqlParamName1, iNum, _SqlErrorRight, oZap)
367         If iNum <= 0 Then
368             bInTree = True
369             Exit Function
370         End If
371         For i = 0 To iNum - 1
372             Dim oNode1 As New TreeNode
373             Dim oNode2 As New TreeNode
374             Dim iNum1 As Integer = oZap(1, i)
375             Dim oZap1
376             oNode1.Text = oZap(2, i)
377             If oZap(3, i) <> 0 Then oNode1.NavigateUrl = oZap(3, i)
378             oNode.Nodes.Add(oNode1)
379             oNode2 = oNode.Nodes(i)
380             b = bInTree(oNode2, iNum1, oZap1)
381             If b = False Then oNode2.ImageUrl = _GroupStyle.PicFolderUrl
382             If UBound(oZap) > 4 Then
383                 If oZap(5, i) <> 0 Then oNode2.ImageUrl = oZap(5, i)
384             End If
385         Next i
386     End Function
387     REM Событие GridClick
388     Event GridClick(ByVal ButtonName As String)
389     REM Процедура обработки постбека
390     Public Overridable Overloads Sub RaisePostBackEvent(ByVal eventArgument As String) Implements IPostBackEventHandler.RaisePostBackEvent
391         Dim s As String = Mid(eventArgument, 4, Len(eventArgument) - 3)
392         If IsNumeric(s) Then FirstGroupId = s
393         RaiseEvent GridClick(s)
394     End Sub
395     REM 1-я перегрузка процедуры взятия запроса, без параметров
396     Public Overloads Function iZap(ByVal sConnectString As String, ByVal sSql As String, ByRef sErr As String, ByRef oZap(,) As Object) As Integer
397         Dim zapConnection As SqlConnection
398         Dim zapConnectString As String
399         Dim zapBconnect As Boolean
400         Dim zapCommand As SqlCommand
401         Dim zapReader As SqlDataReader
402         Dim zapX As Long
403         Dim zapY As Long
404         Dim i1 As Integer
405         zapConnection = New SqlConnection
406         zapCommand = New SqlCommand
407         zapBconnect = False
408         iZap = -1
409         zapConnectString = sConnectString
410         zapConnection.ConnectionString = zapConnectString
411         Try
412             zapConnection.Open()
413             zapBconnect = zapConnection.State
414             If zapBconnect Then iZap = 0
415             'zapCommand.CommandTimeout = 10
416             zapCommand.Connection = zapConnection
417             zapCommand.CommandText = sSql
418             zapReader = zapCommand.ExecuteReader()
419             zapX = zapReader.FieldCount
420             If zapX < 0 Then zapX = 0
421             If zapX > 0 Then zapX = zapX - 1
422             zapY = -1
423             ReDim oZap(zapX, 0)
424             While zapReader.Read()
425                 zapY += 1
426                 If zapY < 2147483647 Then
427                     iZap = zapY + 1
428                     ReDim Preserve oZap(zapX, zapY)
429                     For i1 = 0 To zapX
430                         If IsNothing(zapReader(i1)) Or IsDBNull(zapReader(i1)) Then oZap(i1, zapY) = 0 Else oZap(i1, zapY) = zapReader(i1)
431                     Next
432                 Else : sErr = zapY & " строк (>=2 147 483 647)"
433                 End If
434             End While
435             zapReader.Close()
436             zapReader = Nothing
437             zapCommand = Nothing
438         Catch err As Exception
439             sErr = err.Message
440         Finally
441             If Not (zapConnection Is Nothing) Then
442                 zapConnection.Close()
443                 zapConnection = Nothing
444             End If
445         End Try
446     End Function
447     REM 2-я перегрузка процедуры взятия запроса, один параметр
448     Public Overloads Function iZap(ByVal sConnectString As String, ByVal sSql As String, ByVal sParam1 As String, ByVal oParam1 As Object, ByRef sErr As String, ByRef oZap(,) As Object) As Integer
449         Dim zapConnection As SqlConnection
450         Dim zapConnectString As String
451         Dim zapBconnect As Boolean
452         Dim zapCommand As SqlCommand
453         Dim zapReader As SqlDataReader
454         Dim zapX As Long
455         Dim zapY As Long
456         Dim i1 As Integer
457         sSql &= " " & sParam1
458         zapConnection = New SqlConnection
459         zapCommand = New SqlCommand
460         zapBconnect = False
461         iZap = -1
462         zapConnectString = sConnectString
463         zapConnection.ConnectionString = zapConnectString
464         Try
465             zapConnection.Open()
466             zapBconnect = zapConnection.State
467             If zapBconnect Then iZap = 0
468             'zapCommand.CommandTimeout = 10
469             zapCommand.Connection = zapConnection
470             zapCommand.CommandText = sSql
471             zapCommand.Parameters.Add(sParam1, oParam1)
472             zapReader = zapCommand.ExecuteReader()
473             zapX = zapReader.FieldCount
474             If zapX < 0 Then zapX = 0
475             If zapX > 0 Then zapX = zapX - 1
476             zapY = -1
477             ReDim oZap(zapX, 0)
478             While zapReader.Read()
479                 zapY += 1
480                 If zapY < 2147483647 Then
481                     iZap = zapY + 1
482                     ReDim Preserve oZap(zapX, zapY)
483                     For i1 = 0 To zapX
484                         If IsNothing(zapReader(i1)) Or IsDBNull(zapReader(i1)) Then oZap(i1, zapY) = 0 Else oZap(i1, zapY) = zapReader(i1)
485                     Next
486                 Else : sErr = zapY & " строк (>=2 147 483 647)"
487                 End If
488             End While
489             zapReader.Close()
490             zapReader = Nothing
491             zapCommand = Nothing
492         Catch err As Exception
493             sErr = err.Message
494         Finally
495             If Not (zapConnection Is Nothing) Then
496                 zapConnection.Close()
497                 zapConnection = Nothing
498             End If
499         End Try
500     End Function
501     REM Процедура инициализации модуля
502     Private Sub WebCustomControl2_Init(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Init
503         'Page.Response.Write("<LINK href=""SMenuMax.css"" type=""text/css"" rel=""stylesheet"">")
504     End Sub
505 End Class
506