📄 frmm_tj.frm
字号:
Private Sub Label2_Click(Index As Integer)
If Index = 51 Then
Option3(1).Value = False
Option3(0).Value = False
End If
End Sub
Private Sub ListView1_DblClick()
If ListView1.ListItems.Count = 0 Then Exit Sub
On Error Resume Next
FrmM_Out.Text1(0).Text = ""
Set FrmM_Out.Rec1 = Nothing
FrmM_Out.Rec1.CursorLocation = adUseClient
Select Case MdlMain.LoginBh
Case "000"
FrmM_Out.Rec1.Open "select pid as 疋号,shjm as [码数(码)],shjf as [实际分(分)],zhm as " & _
"[评分/100直码],pfm as [评分/100平方码],pjbf as 平均布幅,dj as 等级," & _
"lx as 拉斜 from maindb where orderid='" & Trim(Text2(0).Text) & _
"' and pid='" & ListView1.SelectedItem.Text & "' order by pid", FrmM_Out.cn, adOpenDynamic, adLockOptimistic
Case Else
FrmM_Out.Rec1.Open "select pid as 疋号,shjm as [码数(码)],shjf as [实际分(分)],zhm as " & _
"[评分/100直码],pfm as [评分/100平方码],pjbf as 平均布幅,dj as 等级," & _
"lx as 拉斜 from maindb where orderid='" & Trim(Text2(0).Text) & _
"' and pid='" & ListView1.SelectedItem.Text & "' and loginuser='" & MdlMain.LoginBh & _
"' order by pid", FrmM_Out.cn, adOpenDynamic, adLockOptimistic
End Select
Set FrmM_Out.DataGrid1.DataSource = FrmM_Out.Rec1
If Not FrmM_Out.Rec1.EOF And Not FrmM_Out.Rec1.BOF Then FrmM_Out.Rec1.MoveLast
FrmM_Out.OrderId = Trim(Text2(0).Text)
FrmM_Out.Ph = ListView1.SelectedItem.Text
Call FrmM_Out.DataGrid1_SelChange(0)
FrmM_Out.Show vbModal
End Sub
Private Sub Text1_GotFocus(Index As Integer)
Text1(Index).BackColor = &HFFC0C0
Text1(Index).Alignment = 0
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(Index).Text)
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
' On Error Resume Next
ListView1.ListItems.Clear
For i = 0 To 12
Text4(i).Text = ""
Next i
Text2(1).Text = ""
Text5.Text = ""
Option3(0).Value = False
Option3(1).Value = False
Set Rec = Nothing
Select Case MdlMain.LoginBh
Case "000"
If Trim(Text1(0).Text) <> "" And Trim(Text1(1).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text2(0).Text) & _
"' and pid between '" & Trim(Text1(0).Text) & "' and '" & _
Trim(Text1(1).Text) & "' order by pid", cn, adOpenDynamic, adLockOptimistic
ElseIf Trim(Text1(0).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text2(0).Text) & _
"' and pid ='" & Trim(Text1(0).Text) & "' order by pid", cn, adOpenDynamic, adLockOptimistic
ElseIf Trim(Text1(1).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text2(0).Text) & _
"' and pid='" & Trim(Text1(1).Text) & "' order by pid", cn, adOpenDynamic, adLockOptimistic
Else
Exit Sub
End If
Case Else
If Trim(Text1(0).Text) <> "" And Trim(Text1(1).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text2(0).Text) & _
"' and pid between '" & Trim(Text1(0).Text) & "' and '" & _
Trim(Text1(1).Text) & "' and loginuser='" & MdlMain.LoginBh & _
"' order by pid", cn, adOpenDynamic, adLockOptimistic
ElseIf Trim(Text1(0).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text2(0).Text) & _
"' and pid ='" & Trim(Text1(0).Text) & "' and loginuser='" & MdlMain.LoginBh & _
"' order by pid", cn, adOpenDynamic, adLockOptimistic
ElseIf Trim(Text1(1).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text2(0).Text) & _
"' and pid='" & Trim(Text1(1).Text) & "' and loginuser='" & MdlMain.LoginBh & _
"' order by pid", cn, adOpenDynamic, adLockOptimistic
Else
Exit Sub
End If
End Select
Dim T, AAA, AA, a, B As Integer
Dim Tm, Tpjbf, Tshjf, Tzhm, Tpfm As Double
T = 0: AAA = 0: AA = 0: a = 0: B = 0
Tm = 0: Tpjbf = 0: Tshjf = 0: Tzhm = 0: Tpfm = 0
If Not Rec.EOF And Not Rec.BOF Then
Text2(2).Text = Rec.Fields("xh")
Text2(6).Text = Rec.Fields("bf")
Text2(7).Text = Rec.Fields("ys")
Text2(8).Text = Rec.Fields("zhsh")
Text2(9).Text = Rec.Fields("bch")
ListView1.ColumnHeaders(7).Text = "拉斜/" & Rec.Fields("lx")
Do While Not Rec.EOF
If InStr(Text2(1).Text, Rec.Fields("ph")) = 0 Then Text2(1).Text = Text2(1).Text & "," & Rec.Fields("ph")
Tm = Val(Rec.Fields("shjm")) + Tm
Tpjbf = Val(Rec.Fields("pjbf")) + Tpjbf
Tshjf = Val(Rec.Fields("shjf")) + Tshjf
Tzhm = Val(Rec.Fields("zhm")) + Tzhm
Tpfm = Val(Rec.Fields("pfm")) + Tpfm
T = T + 1
Select Case Rec.Fields("dj")
Case "AAA"
AAA = AAA + 1
Case "AA"
AA = AA + 1
Case "A"
a = a + 1
Case "B"
B = B + 1
End Select
With ListView1
.ListItems.Add , "r" & Rec.AbsolutePosition, Rec.Fields("pid")
.ListItems("r" & Rec.AbsolutePosition).SubItems(1) = Rec.Fields("shjm")
.ListItems("r" & Rec.AbsolutePosition).SubItems(2) = Rec.Fields("shjf")
.ListItems("r" & Rec.AbsolutePosition).SubItems(3) = Rec.Fields("zhm")
.ListItems("r" & Rec.AbsolutePosition).SubItems(4) = Rec.Fields("pfm")
.ListItems("r" & Rec.AbsolutePosition).SubItems(5) = Rec.Fields("pjbf")
.ListItems("r" & Rec.AbsolutePosition).SubItems(6) = Rec.Fields("lxzh")
.ListItems("r" & Rec.AbsolutePosition).SubItems(7) = Rec.Fields("dj")
If Rec.Fields("pd") = 0 Then
.ListItems("r" & Rec.AbsolutePosition).SubItems(8) = "不合格"
Else
.ListItems("r" & Rec.AbsolutePosition).SubItems(8) = "合格"
End If
.ListItems("r" & Rec.AbsolutePosition).SubItems(9) = Rec.Fields("day") & "/" & Rec.Fields("month")
.ListItems("r" & Rec.AbsolutePosition).SubItems(10) = GetVal(Rec.Fields("a"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(11) = GetVal(Rec.Fields("b"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(12) = GetVal(Rec.Fields("c"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(13) = GetVal(Rec.Fields("d"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(14) = GetVal(Rec.Fields("e"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(15) = GetVal(Rec.Fields("f"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(16) = GetVal(Rec.Fields("g"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(17) = GetVal(Rec.Fields("h"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(18) = GetVal(Rec.Fields("i"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(19) = GetVal(Rec.Fields("j"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(20) = GetVal(Rec.Fields("k"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(21) = GetVal(Rec.Fields("l"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(22) = GetVal(Rec.Fields("m"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(23) = GetVal(Rec.Fields("n"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(24) = GetVal(Rec.Fields("o"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(25) = GetVal(Rec.Fields("p"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(26) = GetVal(Rec.Fields("q"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(27) = GetVal(Rec.Fields("r"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(28) = GetVal(Rec.Fields("s"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(29) = GetVal(Rec.Fields("t"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(30) = GetVal(Rec.Fields("u"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(31) = GetVal(Rec.Fields("v"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(32) = GetVal(Rec.Fields("w"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(33) = GetVal(Rec.Fields("x"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(34) = GetVal(Rec.Fields("y"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(35) = GetVal(Rec.Fields("z"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(36) = GetVal(Rec.Fields("aa"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(37) = GetVal(Rec.Fields("ab"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(38) = GetVal(Rec.Fields("ac"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(39) = GetVal(Rec.Fields("ad"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(40) = GetVal(Rec.Fields("ae"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(41) = GetVal(Rec.Fields("af"))
.ListItems("r" & Rec.AbsolutePosition).SubItems(42) = GetVal(Rec.Fields("ag"))
End With
Rec.MoveNext
Loop
If Left(Text2(1).Text, 1) = "," Then Text2(1).Text = Right(Text2(1).Text, Len(Text2(1).Text) - 1)
Text4(0).Text = Tm
Text4(1).Text = Format(Tpjbf / T, "####.#")
Text4(2).Text = Format(Tshjf / T, "####.#")
Text4(3).Text = Format(Tzhm / T, "####.#")
Text4(4).Text = Format(Tpfm / T, "####.#")
Text4(5).Text = AAA: Text4(6).Text = Format(100 * AAA / T, "####.#")
Text4(7).Text = AA: Text4(8).Text = Format(100 * AA / T, "####.#")
Text4(9).Text = a: Text4(10).Text = Format(100 * a / T, "####.#")
Text4(11).Text = B: Text4(12).Text = Format(100 * B / T, "####.#")
End If
End If
End Sub
Private Sub Text1_LostFocus(Index As Integer)
Text1(Index).BackColor = RGB(255, 255, 255) ' &H8000000F
Text1(Index).Alignment = 2
Call Text1_KeyPress(Index, vbKeyReturn)
End Sub
Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyPageUp
Text4(0).SetFocus
Case vbKeyPageDown
Text2(0).SetFocus
Case vbKeyUp
If Index = 0 Then
Text1(1).SetFocus
Else
Text1(Index - 1).SetFocus
End If
Case vbKeyDown
If Index = 1 Then
Text1(0).SetFocus
Else
Text1(Index + 1).SetFocus
End If
End Select
End Sub
Private Sub Text2_GotFocus(Index As Integer)
Text2(Index).BackColor = &HFFFFC0
Text2(Index).Alignment = 0
Text2(Index).SelStart = 0
Text2(Index).SelLength = Len(Text2(Index).Text)
Select Case Index
Case 3
If Trim(Text2(Index).Text) = "" Then Text2(Index).Text = Year(Date)
Case 4
If Trim(Text2(Index).Text) = "" Then Text2(Index).Text = Month(Date)
Case 5
If Trim(Text2(Index).Text) = "" Then Text2(Index).Text = Day(Date)
End Select
End Sub
Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
Case 0
If KeyAscii = vbKeyReturn Then
On Error Resume Next
Text2(1).Text = ""
Text2(2).Text = ""
Text2(6).Text = ""
Text2(7).Text = ""
Text2(8).Text = ""
Text2(9).Text = ""
Set Rec = Nothing
Rec.CursorLocation = adUseClient
Select Case MdlMain.LoginBh
Case "000"
Rec.Open "select * from maindb where orderid='" & Trim(Text2(0).Text) _
& "' order by pid", cn, adOpenDynamic, adLockOptimistic
Case Else
Rec.Open "select * from maindb where orderid='" & Trim(Text2(0).Text) _
& "' and loginuser='" & MdlMain.LoginBh & "' order by pid", cn, _
adOpenDynamic, adLockOptimistic
End Select
If Not Rec.EOF And Not Rec.BOF Then
Text2(2).Text = Rec.Fields("xh")
Text2(6).Text = Rec.Fields("bf")
Text2(7).Text = Rec.Fields("ys")
Text2(8).Text = Rec.Fields("zhsh")
Text2(9).Text = Rec.Fields("bch")
End If
Call Text1_KeyPress(Index, vbKeyReturn)
End If
Case 1
If KeyAscii = vbKeyReturn Then
On Error Resume Next
Text2(2).Text = ""
Text2(6).Text = ""
Text2(7).Text = ""
Text2(8).Text = ""
Text2(9).Text = ""
Dim T, AAA, AA, a, B As Integer
Dim Tm, Tpjbf, Tshjf, Tzhm, Tpfm As Double
T = 0: AAA = 0: AA = 0: a = 0: B = 0
Tm = 0: Tpjbf = 0: Tshjf = 0: Tzhm = 0: Tpfm = 0
ListView1.ListItems.Clear
For i = 0 To 12
Text4(i).Text = ""
Next i
Text5.Text = ""
Option3(0).Value = False
Option3(1).Value = False
Set Rec = Nothing
Rec.CursorLocation = adUseClient
Select Case MdlMain.LoginBh
Case "000"
Rec.Open "select * from maindb where orderid='" & Trim(Text2(0).Text) _
& "' and ph='" & Trim(Text2(1).Text) & "' order by pid", cn, adOpenDynamic, adLockOptimistic
Case Else
Rec.Open "select * from maindb where orderid='" & Trim(Text2(0).Text) _
& "' and ph='" & Trim(Text2(1).Text) & "' and loginuser='" & MdlMain.LoginBh _
& "' order by pid", cn, adOpenDynamic, adLockOptimistic
End Select
If Not Rec.EOF And Not Rec.BOF Then
Text2(2).Text = Rec.Fields("xh")
Text2(6).Text = Rec.Fields("bf")
Text2(7).Text = Rec.Fields("ys")
Text2(8).Text = Rec.Fields("zhsh")
Text2(9).Text = Rec.Fields("bch")
Do While Not Rec.EOF
Tm = Val(Rec.Fields("shjm")) + Tm
Tpjbf = Val(Rec.Fields("pjbf")) + Tpjbf
Tshjf = Val(Rec.Fields("shjf")) + Tshjf
Tzhm = Val(Rec.Fields("zhm")) + Tzhm
Tpfm = Val(Rec.Fields("pfm")) + Tpfm
T = T + 1
Select Case Rec.Fields("dj")
Case "AAA"
AAA = AAA + 1
Case "AA"
AA = AA + 1
Case "A"
a = a + 1
Case "B"
B = B + 1
End Select
With ListView1
.ListItems.Add , "r" & Rec.AbsolutePosition, Rec.Fields("pid")
.ListItems("r" & Rec.AbsolutePosition).SubItems(1) = Rec.Fields("shjm")
.ListItems("r" & Rec.AbsolutePosition).SubItems(2) = Rec.Fields("shjf")
.ListItems("r" & Rec.AbsolutePosition).SubItems(3) = Rec.Fields("zhm")
.ListItems("r" & Rec.AbsolutePosition).SubItems(4) = Rec.Fields("pfm")
.ListItems("r" & Rec.AbsolutePosition).SubItems(5) = Rec.Fields("pjbf")
.ListItems("r" & Rec.AbsolutePosition).SubItems(6) = Rec.Fields("lx")
.ListItems("r" & Rec.AbsolutePosition).SubItems(7) = Rec.Fields("dj")
If Rec.Fields("pd") = 0 Then
.ListItems("r" & Rec.AbsolutePosition).SubItems(8) = "不合格"
El⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -