ModuleMaster/app_code/powertableclass.vb - main - ivan/ModMas

ModuleMaster/app_code/powertableclass.vb
206 строк7 KB
i.krivokon
Initial commit
13 мар 2026, 13:49
13 мар 2026, 13:4900d9fb6
Imports System
Imports System.Data
Imports Microsoft.VisualBasic
Imports System.Web.UI.WebControls
Imports System.Web.UI

Public Class powerTable
    Public Property pt As Table
    Public Property hLinkTemplate As String = ""

    Public TemplateFields() As String
    Public TemplateIndexes() As Integer
    Public TemplateValues() As String
    Public TemplateMode() As String
    Public HiddenColumn() As String
    Public Property TemplateColNumber As Integer

    Public Property Width() As Web.UI.WebControls.Unit
        Get
            Return pt.Width
        End Get
        Set(ByVal value As Web.UI.WebControls.Unit)
            pt.Width = value
        End Set
    End Property

    Public Property CellPadding() As Integer
        Get
            Return pt.CellPadding
        End Get
        Set(ByVal value As Integer)
            pt.CellPadding = value
        End Set
    End Property

    Public Property CellSpacing() As Integer
        Get
            Return pt.CellSpacing
        End Get
        Set(ByVal value As Integer)
            pt.CellSpacing = value
        End Set
    End Property

    Public Property myPage As Page
    Public Property TableStyle As Style
    Public Property HeaderStyle As Style
    Private Property howerColor As String = "#B5C6FF"

    Public Sub New(ByVal tb As Table)
        pt = tb
        TableStyle = New Style
        HeaderStyle = New Style
        pt.Width = Width
        pt.CellPadding = CellPadding
        pt.CellSpacing = CellSpacing
    End Sub

    Public Sub New()
        pt = Nothing
        TableStyle = New Style
        HeaderStyle = New Style
    End Sub

    Public Sub DrawTable(ByVal dt As DataTable, Optional ByVal mode As String = "text", Optional ByVal enableRowHower As Boolean = True)
        Dim dr As DataRow
        Dim tr As TableRow
        Dim bColorFlag As Boolean = False
        Dim i As Integer = 0
        If enableRowHower Then
            RegisterJava(myPage)
        End If
        tr = CreateHeaderRow(dt)
        tr.ApplyStyle(HeaderStyle)
        pt.Rows.Add(tr)
        For Each dr In dt.Rows
            Select Case mode
                Case "text" : tr = CreateTextRow(dr)
                Case "hLink" : tr = CreatehLinkRow(dr, hLinkTemplate, 1, TemplateMode)
                Case Else : tr = CreateTextRow(dr)
            End Select
            If enableRowHower Then
                If bColorFlag Then
                    SetRowColor(tr, "EEEEEE")
                Else
                    SetRowColor(tr, "FFFFFF")
                End If
            End If
            pt.Rows.Add(tr)
            bColorFlag = Not bColorFlag
        Next
        pt.ApplyStyle(TableStyle)
    End Sub

    Private Function CreateTextRow(ByVal dr As DataRow) As TableRow
        Dim dt As DataTable = dr.Table
        Dim tr As TableRow
        tr = CreateRowTemplate(dt)
        For i As Integer = 0 To dr.ItemArray.Length - 1
            tr.Cells(i).Text = dr.ItemArray(i).ToString
        Next
        Return tr
    End Function

    Private Function CreatehLinkRow(ByVal dr As DataRow, ByVal hLinkTemplate As String, ByVal hLinkStartCell As Integer, Optional ByVal mode() As String = Nothing) As TableRow
        Dim dt As DataTable = dr.Table
        Dim tr As TableRow
        Dim s As String = hLinkTemplate
        tr = CreateRowTemplate(dt)
        For i As Integer = 0 To dr.ItemArray.Length - 1
            If i >= hLinkStartCell Then
                SetTemplateValues(TemplateValues, dr, mode, TemplateColNumber, i)
                tr.Cells(i).Controls.Add(CreateHLink(dr.ItemArray(i).ToString, PreparehLinkFromTemplate(s, TemplateFields, TemplateValues, TemplateIndexes, dr)))
            Else
                tr.Cells(i).Text = dr.ItemArray(i).ToString
            End If
        Next
        Return tr
    End Function

    Private Function PreparehLinkFromTemplate(ByVal hlinkTemplate As String, ByVal params() As String, _
                                            Optional ByVal paramsValues() As String = Nothing, _
                                            Optional ByVal indexes() As Integer = Nothing, _
                                            Optional ByVal dr As DataRow = Nothing) As String
        Dim i As Integer
        If IsNothing(paramsValues) Then
            For i = 0 To params.Length - 1
                hlinkTemplate = hlinkTemplate.Replace(params(i), dr.Item(indexes(i)))
            Next
        Else
            For i = 0 To params.Length - 1
                hlinkTemplate = hlinkTemplate.Replace(params(i), paramsValues(i))
            Next
        End If
        Return hlinkTemplate
    End Function

    Private Sub SetTemplateValues(ByRef templateValues() As String, ByVal dr As DataRow, ByVal mode() As String, Optional ByVal colNumber As Integer = 0, Optional ByVal colOfset As Integer = 0)
        Dim i As Integer
        For i = 0 To mode.Length - 1
            Select Case mode(i)
                Case "c" : templateValues(i) = dr.Table.Columns(colOfset).ColumnName
                Case "r" : templateValues(i) = dr.ItemArray(i).ToString
                Case "f" : templateValues(i) = dr.ItemArray(colNumber).ToString
            End Select
        Next
    End Sub

    Private Function CreateRowTemplate(ByVal dt As DataTable) As TableRow
        Dim dc As DataColumn
        Dim tr As New TableRow
        For Each dc In dt.Columns
            Dim tc As New TableCell
            tr.Cells.Add(tc)
        Next
        Return tr
    End Function

    Private Function CreateHLink(ByVal txt As String, ByVal hlinkUrl As String) As HyperLink
        Dim hlink As New HyperLink
        hlink.NavigateUrl = hlinkUrl
        hlink.Text = txt
        Return hlink
    End Function

    Private Function CreateHLinkCell(ByVal txt As String, ByVal hlinkUrl As String) As TableCell
        Dim hlink As New HyperLink
        hlink.NavigateUrl = hlinkUrl
        hlink.Text = txt
        Dim c As New TableCell
        c.Controls.Add(hlink)
        Return c
    End Function

    Private Function CreateHeaderRow(ByVal dt As DataTable) As TableRow
        Dim dc As DataColumn
        Dim tr As New TableRow
        For Each dc In dt.Columns
            Dim tc As New TableCell
            tc.Text = dc.ColumnName
            tr.Cells.Add(tc)
        Next
        Return tr
    End Function

    Public Sub RegisterJava(ByVal p As Page)
        Dim csname As String = "rowHowerScript"
        Dim cstype As Type = Me.GetType()
        Dim cs As ClientScriptManager = p.ClientScript
        If (Not cs.IsClientScriptBlockRegistered(cstype, csname)) Then
            Dim cstext2 As New StringBuilder()
            cstext2.Append("<script type=""text/javascript"">")
            cstext2.Append("function MOver(MySrc,MyColor) { MySrc.style.cursor=""auto""; MySrc.bgColor=MyColor; }")
            cstext2.Append("function MOut (MySrc,MyColor) { MySrc.style.cursor=""auto""; MySrc.bgColor=MyColor; }")
            cstext2.Append("</script>")
            cs.RegisterClientScriptBlock(cstype, csname, cstext2.ToString(), False)
        End If
    End Sub

    Private Sub SetRowColor(ByRef tr As TableRow, Optional ByVal color As String = "")
        tr.Attributes("bgColor") = color
        tr.Attributes("onMouseOut") = "MOut(this,'#" & color & "')"
        tr.Attributes("onMouseOver") = "MOver(this,'" & howerColor & "')"
    End Sub

End Class