-- 作者：sanny
-- 发布时间：2019/8/7 22:04:00
-- [求助] 程度进度显示
请问一下，要在如下代码中增加个Progress bar该如何加入以显示这个程序执行的进度吗？ 谢谢。
Dim cmd As New SQLCommand
Dim dte As DataTable
DataTables("Orderlist").datarows.clear
cmd.C
Dim Cols1s() As String = {"Fshortname","FHeadSelfS0150","FNumber","F_105","FEntrySelfS0168","FAdviceConsignDate","FStockQtyOnlyForShow","FEntrySelfS0176","FInterID","FEntryID","Fauxqty","FName1","FEntrySelfS0173","FEntrySelfS0177","FEntrySelfS0179","FDate1","FAuxTaxPrice","FAllAmount","Fnumber1","FEntrySelfS0170","FEntrySelfS0169","FcommitQty","FHeadSelfS0149","Fnumber2"}
Dim Cols2s() As String = {"Endcustomer","CustomerPO","PartNo","Part","Pickupdate","ETD","stock","pos","InerId","EnterID","OrderQty","shippingterms","requestETA","confirmedETA","ETA","Orderdate","UnitPrice","OrderVolume","Currency","Project","Remark","FcommitQty","GSSAGPO","DeliveryAddress"}
cmd.CommandText = "Se lect {t_ICItemCore}.FNumber,{t_Organization}.FName,[F_105],FShortName,FHeadSelfS0150,{SEOrder}.FInterID,{SEOrderEntry}.*,{t_SubMessage}.FName,{SEOrder}.FDate,{t_Currency}.FNumber,{t_Item_3005}.*,FHeadSelfS0149 From (((((({SEOrderEntry} Inner JOIN {SEOrder} ON {SEOrder}.[FInterID] = {SEOrderEntry}.[FInterID]) Inner JOIN {t_ICItemCore} ON {t_ICItemCore}.[FItemID] = {SEOrderEntry}.[FItemID]) Inner JOIN {t_Organization} ON {t_Organization}.[FItemID] = {SEOrder}.[FHeadSelfS0151]) Inner JOIN {t_ICItemCustom} ON {t_ICItemCustom}.[FItemID] = {t_ICItemCore}.[FItemID]) Inner JOIN {t_SubMessage} ON {t_SubMessage}.[FInterID] = {SEOrderEntry}.[FEntrySelfS0175]) Inner JOIN {t_Currency} ON {t_Currency}.[FCurrencyID] = {SEOrder}.[FCurrencyID]) Left JOIN {t_Item_3005} ON {t_Item_3005}.[FItemID] = {SEOrderEntry}.[FEntrySelfS0178] Where Fcancellation = 0 and FMrpclosed = 0"
dte = cmd.ExecuteReader()
For Each dr1 As DataRow In dte.DataRows
Dim dr2 As DataRow = DataTables("Orderlist").AddNew()
For i As Integer = 0 To Cols1s.Length -1
dr2(Cols2s(i)) = dr1(Cols1s(i))
dr2 ("company") = "Manuf"
dr2("批号") ="M"& dr2("InerID") & "_" & dr2("EnterId")
Next
Next
cmd.C
Dim Cols111() As String = {"FFullNumber","FQty"}
Dim Cols222() As String = {"FFullNumber","FQty"}
cmd.CommandText ="Se lect FFullNumber,FName,FQty,FBillNo,FStatus From ({ICStockBillEntry} Inner JOIN {t_Item} ON {t_Item}.[FItemID] = {ICStockBillEntry}.[FItemID]) Inner JOIN {ICStockBill} ON {ICStockBill}.[FInterID] = {ICStockBillEntry}.[FInterID] Where {ICStockBill}.[FBillNo] like \'%WIN%\'and fstatus = 0"
dt = cmd.ExecuteReader()
For Each dr1 As DataRow In dt.DataRows
Dim dr2 As DataRow = DataTables("TempStock").AddNew()
For i As Integer = 0 To Cols111.Length -1
dr2(Cols222(i)) = dr1(Cols111(i))
Next
Next
Tables("TempStock").ResumeRedraw()
\'DataTables.save
\'Dim cmd As New SQLCommand
Dim dtt As DataTable
DataTables("TempQC").datarows.clear
cmd.C
Dim Cols1A() As String = {"FFullNumber","FQty","FQcheckQty"}
Dim Cols2A() As String = {"FFullNumber","FQty","FcheckedQty"}
cmd.CommandText = "Se lect FFullNumber,FName,FQty,FQCheckQty From ({POInStockEntry} Inner JOIN {t_Item} ON {t_Item}.[FItemID] = {POInStockEntry}.[FItemID]) Inner JOIN {POInStock} ON {POInStock}.[FInterID] = {POInStockEntry}.[FInterID] Where FbillNo like \'%DD%\'and FStatus <> 3"
dtt = cmd.ExecuteReader()
For Each dr1 As DataRow In dtt.DataRows
Dim dr2 As DataRow = DataTables("TempQC").AddNew()
For i As Integer = 0 To Cols1A.Length -1
dr2(Cols2A(i)) = dr1(Cols1A(i))
dr2("OpenQty") = dr2("Fqty")-dr2("fcheckedQty")
Next
Next
Dim drsr As List(Of DataRow) = DataTables("库存表").Select("Qty > 0") \'库存表中的负库存转移到待检产品中
For Each drd As DataRow In drsr
Dim dr2d As DataRow = DataTables("TempQC").AddNew()
For Each dcd As DataCol In DataTables("库存表").DataCols
dr2d("ffullnumber") = drd("part")
dr2d("Fqty") = drd("Qty")
dr2d("fcheckedQty") = 0
dr2d("OpenQty") = dr2d("Fqty") + dr2d("fcheckedQty")
Next
drd.Delete
Next
Tables("TempQC").ResumeRedraw()
DataTables("物料需求").datarows.clear
Dim dic1 As new Dictionary(of String, Double)
For Each dr As DataRow In DataTables("库存表").Select("part is not null")
dic1.add(dr("part"), dr("qty"))
Next
vars("dic1") = dic1
Dim dic2 As new Dictionary(of String, Double)
For Each dr As DataRow In DataTables("待检产品").Select("part is not null")
dic2.add(dr("part"), dr("qty"))
Next
vars("dic2") = dic2
Dim dic3 As new Dictionary(of String, Double)
For Each dr As DataRow In DataTables("采购订单").Select("part is not null")
dic3.add(dr("part"), dr("qty"))
Next
vars("dic3") = dic3
Dim dic4 As new Dictionary(of String, Double)
vars("dic4") = dic4
For Each Ary As String() In DataTables("OrderList").GetValues("PartNo|ETD|批号|company","PartNo is not null","ETD,优先等级 DESC")
Dim dr As DataRow = DataTables("物料需求").AddNew
dr("PartNo") = ary(0)
If ary(1) > ""
dr("ETD") = cdate(ary(1))
End If
\' dr("ETD") = ary(1)
dr("批号") = ary(2)
dr("company") = ary(3)
dr("BOM") = ary(0)
Dim qty As Decimal = DataTables("OrderList").Compute("sum(Qty)","PartNo=\'" & ary(0) & "\' And " & IIf(ary(1) > "","ETD=\'" & ary(1) & "\'","ETD is null") & " and 批号 =\'" & ary(2) & "\'")
dr("Demand") = qty
Dim flag As Boolean = True
If dic1.ContainsKey(dr("PartNo")) Then
If dic1(dr("PartNo")) >= qty Then
dr("Stock") = qty
dic1(dr("PartNo")) -= dr("Stock")
flag = False
ElseIf dic1(dr("PartNo")) > 0 Then
dr("Stock") = dic1(dr("PartNo"))
dic1(dr("PartNo")) -= dr("Stock")
End If
dr("库存剩余数量") = dic1(dr("PartNo"))
End If
If dic2.ContainsKey(dr("PartNo")) Then
Dim qty1 = dr("Demand") - dr("stock")
If qty1 > 0 Then
If dic2(dr("PartNo")) >= qty1 Then
dr("QC") = qty1
dic2(dr("PartNo")) -= dr("QC")
ElseIf dic2(dr("PartNo")) > 0 Then
dr("QC") = dic2(dr("PartNo"))
dic2(dr("PartNo")) -= dr("QC")
End If
End If
dr("QC剩余数量") = dic2(dr("PartNo"))
End If
Dim drr As DataRow = DataTables("BOM").find("Fnumber =" &"\'"& dr("PartNo")&"\'")
If drr IsNot Nothing
dr("层次") = "父层"
Else
dr("层次") = "单件出货"
End If
Functions.Execute("sumChild",ary(0),qty,ary(0),ary(1),ary(2),flag,dr("Stock"),dr("QC"),1,dr("Stock")+dr("QC")-qty,ary(3))
If dic3.ContainsKey(dr("PartNo")) Then
If dic3(dr("PartNo")) >= qty Then
dr("purchasingorder") = qty
dic3(dr("PartNo")) -= dr("purchasingorder")
ElseIf dic3(dr("PartNo")) > 0 Then
dr("purchasingorder") = dic3(dr("PartNo"))
dic3(dr("PartNo")) -= dr("purchasingorder")
End If
End If
If flag = True Then
dr("MissingQty") = dr("Stock")+dr("QC") -dr("Demand")
Else
dr("MissingQty") = Nothing
End If
If dic4.ContainsKey(dr("PartNo")) = False Then
dic4.add(dr("PartNo"), dr("MissingQty"))
Else
dic4(dr("PartNo")) += dr("MissingQty")
End If
dr("SumMissing") = dic4(dr("partno"))
Next
For Each xm As String In DataTables("物料需求").GetValues("批号", "批号 is not null")
Dim fdr As DataRow = DataTables("Orderlist").find("批号=\'" & xm & "\'")
If fdr Is Nothing Then fdr = DataTables("Orderlist").addnew
fdr("零件总库存数量") = DataTables("物料需求").compute("sum(stock)", "批号=\'" & xm & "\' and 层次 not in (\'父层\')")
fdr("零件总QC数量") = DataTables("物料需求").compute("sum(QC)", "批号=\'" & xm & "\' and 层次 not in (\'父层\')")
fdr("零件总需数量") = DataTables("物料需求").compute("sum(demand)", "批号=\'" & xm & "\' and 层次 not in (\'父层\')")
fdr("零件总缺数量") = DataTables("物料需求").compute("sum(missingqty)", "批号=\'" & xm & "\' and 层次 not in (\'父层\')")
fdr("物料齐全程度") = 1 + fdr("零件总缺数量")/fdr("零件总需数量")
fdr("零件总库存数量占比") =fdr("零件总库存数量")/fdr("零件总需数量")
fdr("零件总QC数量占比") =fdr("零件总QC数量")/fdr("零件总需数量")
fdr("零件总缺数量占比") =fdr("零件总缺数量")/fdr("零件总需数量") * -1
For Each dr As DataRow In DataTables("Orderlist").DataRows
Dim ds As DataRow = DataTables("物料需求").Find("PartNo=\'" & dr("PartNo") & "\'And 层次=\'单件出货\'")
If ds IsNot Nothing Then
If dr("零件总缺数量") < 0
dr("颜色状态") = Color.red.Toargb \'有缺料
ElseIf dr("零件总QC数量") = 0 AndAlso dr("零件总缺数量") = 0
dr("颜色状态") = Color.MediumSpringGreen.Toargb \'有库存,可出货
ElseIf dr("零件总QC数量") > 0 AndAlso dr("零件总缺数量") = 0
dr("颜色状态") = Color.yellow.Toargb \'需QC检验
End If
Else
If dr("零件总缺数量") < 0
dr("颜色状态") = Color.red.Toargb \'有缺料
ElseIf dr("零件总库存数量") = 0 AndAlso dr("零件总QC数量") = 0 AndAlso dr("零件总缺数量") = 0
dr("颜色状态") = Color.MediumSpringGreen.Toargb \'有库存,可出货
ElseIf dr("零件总QC数量") > 0 AndAlso dr("零件总缺数量") = 0
dr("颜色状态") = Color.yellow.Toargb \'需QC检验
ElseIf dr("零件总QC数量") = 0 AndAlso dr("零件总缺数量") = 0
dr("颜色状态") = Color.Orange.Toargb \'可安排装配
End If
End If
Next
Next
Tables("Orderlist").grid.cols("物料齐全程度").style.forecolor = color.red
For Each rr As Row In Tables("物料需求").Rows
Dim dr As DataRow = DataTables("Remark").Find("Inner_BatchNo=\'" & rr("Inner_BatchNo") & "\'","sysDate desc")
Dim drr As DataRow = DataTables("库存表").Find("Part=\'" & rr("PartNo") & "\'")
Dim drrr As DataRow = DataTables("待检产品").Find("Part=\'" & rr("PartNo") & "\'")
Dim drrrr As DataRow = DataTables("unqualifiedQty").Find("FFullnumber=\'" & rr("PartNo") & "\'")
If dr IsNot Nothing Then
rr("remark_1") = dr("remark_1")
End If
If drr IsNot Nothing Then
rr("库存数量") = drr("Qty")
End If
If drrr IsNot Nothing Then
rr("QC数量") = drrr("Qty")
End If
If drrr IsNot Nothing Then
rr("unqualifiedQty") = drrrr("unqualifiedQty")
End If
Next
msgbox("Updated !!!")
|
-- 作者：有点蓝
-- 发布时间：2019/8/8 15:22:00
--
Dim p As WinForm.ProgressBar p = e.Form.Controls("ProgressBar1") p.Maximum = 1000 \'设置最大值 p.Minimum = 0 \'设置最小值 p.Value = 0 \'设置当前值
代码段1 p.Value = 10 Application.doevents Dim cmd As New SQLCommand
Dim dte As DataTable
DataTables("Orderlist").datarows.clear
cmd.C
Dim Cols1s() As String = {"Fshortname","FHeadSelfS0150","FNumber","F_105","FEntrySelfS0168","FAdviceConsignDate","FStockQtyOnlyForShow","FEntrySelfS0176","FInterID","FEntryID","Fauxqty","FName1","FEntrySelfS0173","FEntrySelfS0177","FEntrySelfS0179","FDate1","FAuxTaxPrice","FAllAmount","Fnumber1","FEntrySelfS0170","FEntrySelfS0169","FcommitQty","FHeadSelfS0149","Fnumber2"}
Dim Cols2s() As String = {"Endcustomer","CustomerPO","PartNo","Part","Pickupdate","ETD","stock","pos","InerId","EnterID","OrderQty","shippingterms","requestETA","confirmedETA","ETA","Orderdate","UnitPrice","OrderVolume","Currency","Project","Remark","FcommitQty","GSSAGPO","DeliveryAddress"}
cmd.CommandText = "Se lect {t_ICItemCore}.FNumber,{t_Organization}.FName,[F_105],FShortName,FHeadSelfS0150,{SEOrder}.FInterID,{SEOrderEntry}.*,{t_SubMessage}.FName,{SEOrder}.FDate,{t_Currency}.FNumber,{t_Item_3005}.*,FHeadSelfS0149 From (((((({SEOrderEntry} Inner JOIN {SEOrder} ON {SEOrder}.[FInterID] = {SEOrderEntry}.[FInterID]) Inner JOIN {t_ICItemCore} ON {t_ICItemCore}.[FItemID] = {SEOrderEntry}.[FItemID]) Inner JOIN {t_Organization} ON {t_Organization}.[FItemID] = {SEOrder}.[FHeadSelfS0151]) Inner JOIN {t_ICItemCustom} ON {t_ICItemCustom}.[FItemID] = {t_ICItemCore}.[FItemID]) Inner JOIN {t_SubMessage} ON {t_SubMessage}.[FInterID] = {SEOrderEntry}.[FEntrySelfS0175]) Inner JOIN {t_Currency} ON {t_Currency}.[FCurrencyID] = {SEOrder}.[FCurrencyID]) Left JOIN {t_Item_3005} ON {t_Item_3005}.[FItemID] = {SEOrderEntry}.[FEntrySelfS0178] Where Fcancellation = 0 and FMrpclosed = 0"
dte = cmd.ExecuteReader()
代码段2 p.Value = 200 Application.doevents
For Each dr1 As DataRow In dte.DataRows
Dim dr2 As DataRow = DataTables("Orderlist").AddNew()
For i As Integer = 0 To Cols1s.Length -1
dr2(Cols2s(i)) = dr1(Cols1s(i))
dr2 ("company") = "Manuf"
dr2("批号") ="M"& dr2("InerID") & "_" & dr2("EnterId")
Next
Next cmd.C
Dim Cols111() As String = {"FFullNumber","FQty"}
Dim Cols222() As String = {"FFullNumber","FQty"}
cmd.CommandText ="Se lect FFullNumber,FName,FQty,FBillNo,FStatus From ({ICStockBillEntry} Inner JOIN {t_Item} ON {t_Item}.[FItemID] = {ICStockBillEntry}.[FItemID]) Inner JOIN {ICStockBill} ON {ICStockBill}.[FInterID] = {ICStockBillEntry}.[FInterID] Where {ICStockBill}.[FBillNo] like \'%WIN%\'and fstatus = 0"
dt = cmd.ExecuteReader()
For Each dr1 As DataRow In dt.DataRows
Dim dr2 As DataRow = DataTables("TempStock").AddNew()
For i As Integer = 0 To Cols111.Length -1
dr2(Cols222(i)) = dr1(Cols111(i))
Next
Next Tables("TempStock").ResumeRedraw()
\'DataTables.save
代码段3 .........................
|