ModuleMaster/fi/scrap_pivot.aspx.vb - main - ivan/ModMas

ModuleMaster/fi/scrap_pivot.aspx.vb
287 строк12 KB
i.krivokon
Initial commit
13 мар 2026, 13:49
13 мар 2026, 13:4900d9fb6
Imports System.Data
Imports System.IO
Imports System.Data.SqlClient
Imports sharedClasses.dbFunctions

Partial Class r
    Inherits System.Web.UI.Page
    Private collection As New Dictionary(Of Integer, String)
    Private sqlf As New SqlFunctions
    Private ExcelDownload As Boolean = False
    Private flag As Boolean = False

    Public Shared Sub ApplyGridViewHeader(ParentId As String, ByRef gv As GridView, ByRef a As Collection)
        'процедура написана таким образом, что в нее всегда должны передаваться индексы с учетом только фактически отображаемых колонок
        'т.е. при вычислении индекса объединяемой колонки (передаваемой в качестве параметра в процедуру) считается,
        'что колонок со свойством Visible = false в таблице как бы нет.
        'индексы (передаваемые в качестве параметров в процедуру) указываются по исходному порядку необъединенных колонок

        Dim AllowSorting As Boolean = gv.AllowSorting
        If gv.Rows.Count > 0 Then
            Dim row = New GridViewRow(-1, -1, DataControlRowType.Header, DataControlRowState.Normal)
            Dim r = gv.HeaderRow
            Dim cell As TableHeaderCell

            Dim i, j As Integer

            Dim invisibleColsCount As Integer = 0
            Dim cnt As Integer = 0

            'i = 1

            For Each rcell As TableCell In r.Cells
                cell = New TableHeaderCell
                If AllowSorting Then
                    Dim lb As New HyperLink
                    Try
                        lb.Style("color") = "White"
                        lb.Text = CType(rcell.Controls(0), LinkButton).Text
                        lb.NavigateUrl = "javascript:__doPostBack('" & ParentId & "$" & gv.ID & "','Sort$" & CType(rcell.Controls(0), LinkButton).CommandArgument & "')"
                        cell.Controls.Add(lb)
                    Catch ex As Exception
                        cell.Text = rcell.Text
                    End Try
                Else
                    cell.Text = rcell.Text
                End If
                cell.Style("text-align") = "center"
                cell.Visible = rcell.Visible

                'If cnt > a(i)(1) And cnt < a(i)(1) + a(i)(2) Then
                ' If Not rcell.Visible Then
                ' invisibleColsCount += 1
                ' End If
                'End If

                cnt += 1

                row.Cells.Add(cell)
                'End If
            Next

            'для нужных ячеек в верхней строке, прописываем тексты объединяющих ячеек и их ColumnSpan
            For i = 1 To a.Count
                row.Cells(a(i)(1)).Text = a(i)(0)
                row.Cells(a(i)(1)).ColumnSpan = a(i)(2) - invisibleColsCount
            Next

            'идем по верхней строке у оставшихся ячеек (не задействованных) в предыдущем цикле ставим им RowSpan = 2
            'одновременно ячееки с таким же индексом в нижней строке помечаем на удаление
            For i = 0 To row.Cells.Count - 1
                If row.Cells(i).Visible Then
                    If row.Cells(i).ColumnSpan < 2 Then
                        row.Cells(i).RowSpan = 2
                        r.Cells(i).ColumnSpan = 100
                    Else
                        'пропускаем ячейки на которые распространяется ColumnSpan
                        i = i + row.Cells(i).ColumnSpan - 1 + invisibleColsCount
                    End If
                End If
            Next

            'удаляем помеченные ячейки в нижней строке
            i = 0
            While i < r.Cells.Count
                If r.Cells(i).ColumnSpan = 100 Then
                    r.Cells.RemoveAt(i)
                Else : i = i + 1
                End If
            End While

            'идем по верхней строке удаляем соответствующее ColumnSpan количество ячеек после ячеек имеющих ColumnSpan > 1 
            i = 0
            While i < row.Cells.Count
                If row.Cells(i).ColumnSpan > 1 Then
                    For j = 1 To row.Cells(i).ColumnSpan - 1 + invisibleColsCount
                        row.Cells.RemoveAt(i + 1)
                    Next
                End If
                i = i + 1
            End While

            CType(gv.Controls(0), Table).Rows.AddAt(0, row)
        End If
    End Sub

    Public Sub CollectHeaderColumn(ByRef gv As GridView, colNumber As Integer, Optional referenceColNumber As Integer = -1)
        Dim curCell As New TableCell With {.Text = "."}
        Dim rowSpan As Integer = 1

        Dim ColNumberToCheckText As Integer
        If referenceColNumber = -1 Then
            ColNumberToCheckText = colNumber
        Else
            ColNumberToCheckText = referenceColNumber
        End If

        Dim curText As String = "."

        For Each dr As GridViewRow In gv.Rows
            If dr.Cells(ColNumberToCheckText).Text <> curText Then 'curCell.Text Then
                If rowSpan > 1 Then
                    curCell.RowSpan = rowSpan
                End If
                curCell = dr.Cells(colNumber)
                curText = dr.Cells(ColNumberToCheckText).Text
                rowSpan = 1
            Else
                dr.Cells(colNumber).Visible = False
                rowSpan += 1
            End If
        Next
        If rowSpan > 1 Then
            curCell.RowSpan = rowSpan
        End If
    End Sub

    Private Sub r_Load(sender As Object, e As EventArgs) Handles Me.Load
        lblPeriod.Text = ""
        Dim sql As New StringBuilder
        sql.AppendLine("UPDATE usermodules.[user].[SCRAPREPORT] ")
        sql.AppendLine("SET QTY = '-' + QTY                     ")
        sql.AppendLine("where mvttext like 'RE %'               ")
        sql.AppendLine("and qty not like '-%'                   ")
        sql.AppendLine("UPDATE usermodules.[user].[SCRAPREPORT] ")
        sql.AppendLine("SET AMOUNT = '-' + AMOUNT               ")
        sql.AppendLine("where mvttext like 'RE %'               ")
        sql.AppendLine("and amount not like '-%'                ")
        sql.AppendLine("UPDATE usermodules.[user].[SCRAPREPORT] ")
        sql.AppendLine("SET USD_AMOUNT = '-' + USD_AMOUNT       ")
        sql.AppendLine("where mvttext like 'RE %'               ")
        sql.AppendLine("and usd_amount not like '-%'            ")
        sqlf.NonQuery(sql.ToString)

        If Not IsPostBack Then
            date_input.Value = System.DateTime.Now.ToString("yyyy-MM-dd")
        End If

        Dim sqld As New StringBuilder
        sql.Clear()
        sql.AppendLine("declare @start as date ")
        sql.AppendLine("declare @end as date ")

        sql.AppendLine("declare @date as date ")
        sql.AppendLine("set @date = getdate() ")

        sqld.AppendLine("declare @start as date ")
        sqld.AppendLine("declare @end as date ")

        sqld.AppendLine("declare @date as date ")
        sqld.AppendLine("set @date = getdate() ")

        If date_input.Value <> "" Then
            sql.AppendLine("set @date = '" + date_input.Value + "'")
            sqld.AppendLine("set @date = '" + date_input.Value + "'")
        End If

        sql.AppendLine("--@start и @end устанавливаются в скрипте в зависимости от выбора пользователя (Таблица за месяц, за неделю, за день) ")
        If dayly.Checked Then
            sql.AppendLine("--День ")
            sql.AppendLine("set @start = @date ")
            sql.AppendLine("set @end = @date ")

            sqld.AppendLine("set @start = @date ")
            sqld.AppendLine("set @end = @date ")

        End If
        If weekly.Checked Then
            sql.AppendLine("--Начало и конец недели ")
            sql.AppendLine("set @start = DATEADD(day, - (DATEPART(weekday, @date) + @@DATEFIRST - 2) % 7, @date) ")
            sql.AppendLine("set @end = DATEADD(day, 6 - (DATEPART(weekday, @date) + @@DATEFIRST -2) % 7, @date) ")

            sqld.AppendLine("set @start = DATEADD(day, - (DATEPART(weekday, @date) + @@DATEFIRST - 2) % 7, @date) ")
            sqld.AppendLine("set @end = DATEADD(day, 6 - (DATEPART(weekday, @date) + @@DATEFIRST -2) % 7, @date) ")

        End If
        If monthly.Checked Then
            sql.AppendLine("--Начало и конец месяца ")
            sql.AppendLine("set @start = DATEADD(month, DATEDIFF(month, 0, @date), 0) ")
            sql.AppendLine("set @end = dateadd(day,-1,dateadd(month, 1, DATEADD(month, DATEDIFF(month, 0, @date), 0))) ")

            sqld.AppendLine("set @start = DATEADD(month, DATEDIFF(month, 0, @date), 0) ")
            sqld.AppendLine("set @end = dateadd(day,-1,dateadd(month, 1, DATEADD(month, DATEDIFF(month, 0, @date), 0))) ")
        End If
        If yearly.Checked Then
            sql.AppendLine("--Начало и конец года ")
            sql.AppendLine("set @start =  DATEADD(year, DATEDIFF(year, 0, @date), 0) ")
            sql.AppendLine("set @end =  DATEADD(year, DATEDIFF(year, 0, @date) + 1, -1)")

            sqld.AppendLine("set @start =  DATEADD(year, DATEDIFF(year, 0, @date), 0) ")
            sqld.AppendLine("set @end =  DATEADD(year, DATEDIFF(year, 0, @date) + 1, -1)")
        End If

        sqld.AppendLine("SELECT convert(char(10), @start ,120) as START_DATE, convert(char(10), @end ,120) as END_DATE")
        Dim dr As DataRow = sqlf.GetRow(sqld.ToString)
        Try
            lblPeriod.Text = "Selected period: " & dr("START_DATE").ToString & " - " & dr("END_DATE")
        Catch ex As Exception
            lblPeriod.Text = ex.Message
        End Try

        sql.AppendLine("select DEPARTMENT ")
        sql.AppendLine(",STUFF(( ")
        sql.AppendLine("select distinct ',' + cost_center ")
        sql.AppendLine("from [UserModules].[user].[SCRAPREPORT] ")
        sql.AppendLine("where department = t.department ")
        sql.AppendLine("for xml path('') ")
        sql.AppendLine("),1,1,'') as CC ")
        sql.AppendLine(",cast(round(sum (cast(usd_amount as decimal(20,6))),2) as  decimal(20,2))  as USD ")
        sql.AppendLine("from [UserModules].[user].[SCRAPREPORT] t ")

        sql.AppendLine("where cast(ENTRY_DATE as date) between @start and @end ")
        sql.AppendLine("and DEPARTMENT is not null and DEPARTMENT <> '' ")

        sql.AppendLine("group by DEPARTMENT ")
        sql.AppendLine("order by usd ")

        Queue.SelectCommand = sql.ToString
        'lblPeriod.Text = sql.ToString
        report.DataSource = Queue
    End Sub

    Private Sub SqlDataSource_Selecting(sender As Object, e As SqlDataSourceSelectingEventArgs) Handles queue.Selecting
        e.Command.CommandTimeout = 3600
    End Sub

    Protected Sub ibExcelDownload_Click(sender As Object, e As ImageClickEventArgs) Handles ibExcelDownload.Click
        ExcelDownload = True
    End Sub

    Sub ExcelDownloadSub(ByVal gv As GridView, ByVal filename As String)
        Response.Clear()
        Response.AddHeader("content-disposition", "attachment;filename=" & filename & ".xls")
        Response.ContentType = "application/vnd.xls"
        Response.ContentEncoding = System.Text.Encoding.GetEncoding("UTF-8")
        EnableViewState = False
        Response.Charset = "utf-8"
        Dim myCItrad As System.Globalization.CultureInfo = New System.Globalization.CultureInfo("en-US", True)

        gv.AllowSorting = False
        gv.AllowPaging = False
        gv.DataBind()

        Dim sw As StringWriter = New StringWriter(myCItrad)
        Dim hw As HtmlTextWriter = New HtmlTextWriter(sw)

        gv.RenderControl(hw)
        Response.Write(sw.ToString)

        Response.End()
    End Sub

    Private Sub r_PreRender(sender As Object, e As EventArgs) Handles Me.PreRender
        Dim history_dt As DataTable = New DataTable()
        Try
            If ExcelDownload Then
                ExcelDownloadSub(report, "scrap_pivot")
            Else
                report.DataBind()
            End If
        Catch ex As Exception
        End Try

    End Sub
    Public Overrides Sub VerifyRenderingInServerForm(ByVal control As Control)

    End Sub
End Class