/
ivan
/
ModMas
Обзор
Документация
Войти
/
ivan
/
ModMas
Код
Запросы
0
Задачи
Вики
Пакеты
0
Релизы
0
Аналитика
Безопасность
main
ModuleMaster/pc/outstatus_l.aspx.vb
320 строк
13 KB
i.krivokon
Initial commit
13 мар 2026, 13:49
13 мар 2026, 13:49
00d9fb6
Код
Авторство
О чём код?
Imports System.Data Imports System.IO Partial Class PC_outstatus Inherits System.Web.UI.Page Private ReworkInProgress As DataTable = Nothing Private ReworkDone As DataTable = Nothing Private RepairDetails As DataTable = Nothing Private sqlf As New sharedClasses.dbFunctions.SqlFunctions Protected Sub ListView1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ListView1.SelectedIndexChanged End Sub Private Sub ListView2_ItemDataBound(sender As Object, e As ListViewItemEventArgs) Handles ListView2.ItemDataBound Dim i As ListViewItem = e.Item For Each collectionItem As Object In i.Controls ' Perform desired processing on each item. 'Prepare tooltip for Rework Done If collectionItem.id = "tooltip_rework_in_progress" Then If Not IsNothing(ReworkInProgress) Then Try ReworkInProgress.DefaultView.RowFilter = "LINE='" & CType(i.Controls(1), Label).Text & "'" Dim toolTip As String = PrepareTooltip(ReworkInProgress) If toolTip = "" Then CType(collectionItem.controls(0), LiteralControl).Text = "" Else CType(collectionItem.controls(0), LiteralControl).Text = CType(collectionItem.controls(0), LiteralControl).Text.Replace("@TEMPLATE", toolTip) End If Catch ex As Exception End Try End If End If 'Prepare tooltip for Rework Done If collectionItem.id = "tooltip_rework_done" Then If Not IsNothing(ReworkDone) Then Try ReworkDone.DefaultView.RowFilter = "LINE='" & CType(i.Controls(1), Label).Text & "'" Dim toolTip As String = PrepareTooltip(ReworkDone) If toolTip = "" Then CType(collectionItem.controls(0), LiteralControl).Text = "" Else CType(collectionItem.controls(0), LiteralControl).Text = CType(collectionItem.controls(0), LiteralControl).Text.Replace("@TEMPLATE", toolTip) End If Catch ex As Exception End Try End If End If 'Prepare tooltip Repair Details If collectionItem.id = "Repair_Diff_TD" Then If Not IsNothing(RepairDetails) Then Try RepairDetails.DefaultView.RowFilter = "LINE='" & CType(i.Controls(1), Label).Text & "'" Dim toolTip As String = PrepareTooltip(RepairDetails) If toolTip = "" Then CType(collectionItem.controls(0), LiteralControl).Text = CType(collectionItem.controls(0), LiteralControl).Text.Replace("@TEMPLATE", toolTip) Else CType(collectionItem.controls(0), LiteralControl).Text = CType(collectionItem.controls(0), LiteralControl).Text.Replace("@TEMPLATE", toolTip) End If Catch ex As Exception End Try End If End If Next collectionItem End Sub Private Sub PC_outstatus_Load(sender As Object, e As EventArgs) Handles Me.Load Chart1.Titles(0).Text = "Line " & Request.QueryString("l") ReworkInProgress = GetReworkInProgress() ReworkDone = GetReworkDone() RepairDetails = GetRepairDetails() ListView1.DataSource = sdsPlanStatus ListView2.DataSource = SqlDataSource1 Try ListView1.DataBind() ListView2.DataBind() Catch ex As Exception End Try End Sub Protected Function ProcessMyDataItem(myValue1 As Object, myValue2 As Object) As String Dim V1, V2 As Integer If IsDBNull(myValue1) Or myValue1.ToString = "" Then V1 = 0 Else V1 = Integer.Parse(myValue1.ToString) End If If IsDBNull(myValue2) Or myValue2.ToString = "" Then V2 = 0 Else V2 = Integer.Parse(myValue2.ToString) End If If (V1 + V2) = 0 Then Return "" Else Return (V1 + V2).ToString End If End Function Protected Sub gv_RowDataBound(sender As Object, e As System.Web.UI.WebControls.GridViewRowEventArgs) If e.Row.RowType = DataControlRowType.DataRow Then End If End Sub 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 Function PrepareTooltip(dt As DataTable, Optional headerGRoups As Collection = Nothing, Optional removeLastColumn As Boolean = False, Optional collectHeaders As Collection = Nothing, Optional showfooter As Boolean = False, Optional TTL_In_Track As Integer = 0) As String Dim result As String = "" Dim gv As New GridView gv.ShowFooter = showfooter AddHandler gv.RowDataBound, AddressOf gv_RowDataBound gv.DataSource = dt gv.DataBind() If Not IsNothing(headerGRoups) Then ApplyGridViewHeader(ID.ToString, gv, headerGRoups) End If If gv.Rows.Count > 0 Or TTL_In_Track > 0 Then If Not IsNothing(collectHeaders) Then For Each c In collectHeaders CollectHeaderColumn(gv, c) Next Else CollectHeaderColumn(gv, 0) CollectHeaderColumn(gv, 1) End If Dim myCItrad As System.Globalization.CultureInfo = New System.Globalization.CultureInfo("EN-US", True) Dim sw As StringWriter = New StringWriter(myCItrad) Dim hw As HtmlTextWriter = New HtmlTextWriter(sw) gv.CssClass = "detailTable" gv.RenderControl(hw) result = sw.ToString.Replace("""", "'") End If gv.Dispose() Return result End Function Private Function GetReworkInProgress() As DataTable Dim sqlf As New sharedClasses.dbFunctions.SqlFunctions Return sqlf.GetData("select Line,Model, Qty, Reason, Detection_date from [UserModules].[user].[REWORK] where rework_date = ''") End Function Private Function GetReworkDone() As DataTable Dim sqlf As New sharedClasses.dbFunctions.SqlFunctions Return sqlf.GetData("select Line, Model, Qty, Reason, Detection_date from [UserModules].[user].[REWORK] where rework_date = cast(getdate() as date)") End Function Private Function GetRepairDetails() As DataTable Dim sqlf As New sharedClasses.dbFunctions.SqlFunctions Dim sql As New StringBuilder sql.Append("select ") sql.Append("line as Line ") sql.Append(",MODEL_NUMBER as Model ") sql.Append(", count (MODEL_NUMBER) as [Plan] ") sql.Append(", SUM(case when REPAIR_FLAG = 'Y' then 1 else 0 end ) as Done ") sql.Append(", SUM(case when REPAIR_FLAG = 'Y' then 0 else 1 end ) as Diff ") sql.Append(", remark as Reason ") sql.Append(", dstn_nm as Destination ") sql.Append("from GMESData.[dbo].[TB_VWP_QMS_QUALITY] ") sql.Append("left join [GMESData].[dbo].[VI_CURRENT_PRODUCTION_STATUS_3] ") sql.Append("on GMESData.[dbo].[TB_VWP_QMS_QUALITY].PO_NUMBER = [GMESData].[dbo].[VI_CURRENT_PRODUCTION_STATUS_3].PO_NO ") sql.Append("where DEFECT_DATE = cast(getdate() as date) ") sql.Append("group by model_number, remark, line, dstn_nm, PO_NUMBER ") Return sqlf.GetData(sql.ToString) End Function End Class