frmbarcode.frm

对于一个产品

    cmdOK.Enabled = False
    cmdCancel.Enabled = False
End Sub

Private Sub cmdQuit_Click()
    Unload Me
End Sub

Private Sub cmdStart_Click()
    If LstLabel.SelCount = 0 Then
        MsgBox "请选择要开始检查的 [批次]!", vbInformation, "系统提示"
        LstLabel.SetFocus
        Exit Sub
    End If
    
    txtBarcode.Enabled = True
    txtBarcode.SetFocus
    
    cmdAdd.Enabled = False
    cmdEdit.Enabled = False
    cmdDele.Enabled = False
    chkShowAll.Enabled = False
    
    cmdStart.Enabled = False
    cmdStart.Visible = False
    cmdDone.Visible = True
    cmdDone.Enabled = True
    
    LstLabel.Enabled = False
    LstBarCode.Enabled = False
    
    cmdExcel.Enabled = False
    cmdQuit.Enabled = False
    
    LstLabelF.Enabled = False
    cmdTransfer.Enabled = False
    cmdContinue.Visible = False
End Sub

Private Sub cmdTransfer_Click()
    If LstLabel.SelCount = 0 Then
        MsgBox "请选择要移出的记录!", vbInformation, "系统提示"
        LstLabel.SetFocus
        Exit Sub
    End If

    If ChkPass.Value = 1 Then
        MsgBox "此记录 检查通过, 不可移出!", vbExclamation, "系统提示"
        Exit Sub
    End If
    
    tmprep = MsgBox("此操作不可倒回, 确认移出么?", vbYesNo + vbQuestion, "系统提示")
    If tmprep = 6 Then
        strFilter = " where SNo = '" & selSNo & "'"
        cn.BeginTrans
            strSQL = "insert into QALabelF select * from QALabel" & strFilter
            cn.Execute strSQL
            strSQL = "insert into QABarCodeF select * from QABarCode" & strFilter
            cn.Execute strSQL
    
            strSQL = "delete from QALabel" & strFilter
            cn.Execute strSQL
            strSQL = "delete from QABarCode" & strFilter
            cn.Execute strSQL
    
        cn.CommitTrans
    
        FillLstLabel
        FillLstLabelF
        
        LblRec1.Caption = "0"
        LstBarCode.Clear
    End If
End Sub

Private Sub Form_Load()
    '如果未连接
    If cn.State = 0 Then
        SQL_ADO
        If cn.Errors.Count > 0 Then
            MsgBox "无法连接服务器! 程序将退出", vbExclamation, "错误!"
            Unload Me
        End If
    End If
    
    LblUserID.Caption = pubUserID
    
    Init
    
    cmdStart.Enabled = False
    LblList.Caption = "   序号      来货日期    物料编码           机型            来货数量       NG数量           担当       通过    备注 "
    LblDet.Caption = "已检查条码                    检查时间"
    FTog = ""
    FillLstLabel
    FillLstLabelF
End Sub

Private Sub Init()
    DTPicker1.Value = Date
    DTPicker1.Enabled = False
    
    txtPartNo.Enabled = False
    txtModel.Enabled = False
    MaskQtyIn.Enabled = False
    
    ChkPass.Enabled = False
    MaskQtyNg.Enabled = False
    TxtRemark.Enabled = False
    
    cmdAdd.Enabled = True
    cmdEdit.Enabled = True
    cmdDele.Enabled = True
    
    cmdOK.Enabled = False
    cmdCancel.Enabled = False
    
    txtBarcode.Enabled = False
    
    chkShowAll.Enabled = True
    cmdStart.Visible = True
    cmdStart.Enabled = True
    cmdDone.Visible = False
    cmdDone.Enabled = False
    
    LstLabel.Enabled = True
    LstLabelF.Enabled = True
    cmdTransfer.Enabled = True
    LstBarCode.Enabled = True
    
    LstLabel.ListIndex = -1
    
    cmdExcel.Enabled = True
    cmdQuit.Enabled = True
    
    cmdRecheck.Visible = False
    cmdContinue.Visible = False
End Sub

Private Sub ClearF()
    LblSNo.Caption = ""
    txtPartNo.Text = ""
    txtModel.Text = ""
    MaskQtyIn.Text = ""
    ChkPass.Value = 0
    MaskQtyNg.Text = ""
    TxtRemark.Text = ""
    
    LstBarCode.Clear
    LblRec1.Caption = "0"
End Sub

Private Sub FillLstLabel()
    LstLabel.Clear
    '显示所有[批次]
    strSQL = "select count(*) from QALabel"
    Set rs1 = cn.Execute(strSQL)
    LblRecord.Caption = CStr(rs1(0))
    
    If rs1(0) = 0 Then
        chkShowAll.Enabled = False
        rs1.Close
        Exit Sub
    End If
    rs1.Close
    
    strSQL = "select * from QALabel order by SNo desc"
    Set rs1 = cn.Execute(strSQL)
    
    While Not rs1.EOF
        strSNo = rs1("SNo")
        
        tmpSpace = 0
        strDateIn = CStr(rs1("DateIn"))
        tmpSpace = 10 - Len(strDateIn)
        strDateIn = strDateIn & Space$(tmpSpace)
        
        strPartNo = rs1("PartNo")
        strModel = rs1("Model")
        
        tmpSpace = 0
        strQtyIn = Trim(rs1("QtyIn"))
        strQtyIn = Format(strQtyIn, "###,###,##0")
        tmpSpace = 11 - Len(strQtyIn)
        strQtyIn = Space$(tmpSpace) & strQtyIn
        
        tmpSpace = 0
        strQtyNg = Trim(rs1("QtyNg"))
        strQtyNg = Format(strQtyNg, "###,###,##0")
        tmpSpace = 11 - Len(strQtyNg)
        strQtyNg = Space$(tmpSpace) & strQtyNg
        
        strUserID = rs1("UserID")
        
        strPass = rs1("Pass")
        If strPass = "True" Then
            strPass = "√"
        Else
            strPass = "  "
        End If
        
        strRemark = rs1("Remark")
    
        strItem = strSNo & " | " & strDateIn & " | " & strPartNo & " | " & strModel & " | " & strQtyIn
        strItem = strItem & " | " & strQtyNg & " | " & strUserID & " | " & strPass & " | " & strRemark
        
        LstLabel.AddItem strItem
        
        rs1.MoveNext
    Wend
    
    rs1.Close
End Sub

Private Sub FillLstLabelF()
    LstLabelF.Clear
    '显示所有[批次]
    strSQL = "select count(*) from QALabelF"
    Set rs1 = cn.Execute(strSQL)
    LblRecordF.Caption = CStr(rs1(0))
    
    If rs1(0) = 0 Then
        chkShowAll.Enabled = False
        rs1.Close
        Exit Sub
    End If
    rs1.Close
    
    strSQL = "select * from QALabelF order by SNo desc"
    Set rs1 = cn.Execute(strSQL)
    
    While Not rs1.EOF
        strSNo = rs1("SNo")
        
        tmpSpace = 0
        strDateIn = CStr(rs1("DateIn"))
        tmpSpace = 10 - Len(strDateIn)
        strDateIn = strDateIn & Space$(tmpSpace)
        
        strPartNo = rs1("PartNo")
        strModel = rs1("Model")
        
        tmpSpace = 0
        strQtyIn = Trim(rs1("QtyIn"))
        strQtyIn = Format(strQtyIn, "###,###,##0")
        tmpSpace = 11 - Len(strQtyIn)
        strQtyIn = Space$(tmpSpace) & strQtyIn
        
        tmpSpace = 0
        strQtyNg = Trim(rs1("QtyNg"))
        strQtyNg = Format(strQtyNg, "###,###,##0")
        tmpSpace = 11 - Len(strQtyNg)
        strQtyNg = Space$(tmpSpace) & strQtyNg
        
        strUserID = rs1("UserID")
        
        strPass = rs1("Pass")
        If strPass = "True" Then
            strPass = "√"
        Else
            strPass = "  "
        End If
        
        strRemark = rs1("Remark")
    
        strItem = strSNo & " | " & strDateIn & " | " & strPartNo & " | " & strModel & " | " & strQtyIn
        strItem = strItem & " | " & strQtyNg & " | " & strUserID & " | " & strPass & " | " & strRemark
        
        LstLabelF.AddItem strItem
        
        rs1.MoveNext
    Wend
    
    rs1.Close
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    tmprep = MsgBox("确认退出么?", vbYesNo + vbQuestion, "系统提示")
    If tmprep = 6 Then
        Unload Me
    Else
        Cancel = True
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set rs = Nothing
    Set rs1 = Nothing
    If cn.State = 1 Then cn.Close
    Set cn = Nothing
End Sub

Private Sub LstLabel_Click()
    If LstLabelF.ListIndex > -1 Then
        tmpSel = LstLabel.ListIndex
        LstLabelF.ListIndex = -1
        LstLabel.ListIndex = tmpSel
        LstLabel.SetFocus
    End If
    
    chkShowAll.Value = 0
    cmdStart.Enabled = True
    cmdAdd.Enabled = True
    cmdEdit.Enabled = True
    
    selSNoF = ""
    selSNo = ""
    selSNo = Left(LstLabel.Text, 8)
    If selSNo = "" Then Exit Sub
    
    '刷新录入区
    strSQL = "select * from QALabel where SNo = '" & selSNo & "'"
    Set rs1 = cn.Execute(strSQL)
    If rs1.EOF And rs1.BOF Then
        rs1.Close
        Exit Sub
    End If
    
    LblSNo.Caption = selSNo
    DTPicker1.Value = rs1("DateIn")
    txtPartNo.Text = Trim(rs1("PartNo"))
    txtModel.Text = Trim(rs1("Model"))
    MaskQtyIn.Text = rs1("QtyIn")
    MaskQtyNg.Text = rs1("QtyNg")
    
    If rs1("Pass") = "True" Then
        ChkPass.Value = 1
    Else
        ChkPass.Value = 0
    End If
    TxtRemark.Text = Trim(rs1("Remark"))
    rs1.Close
    
    FillLstBarCode
End Sub

Private Sub FillLstBarCode()
    '刷新子条码列表
    LstBarCode.Clear
    LblRec1.Caption = "0"
    
    If selSNo > "" Then
        If FTog = "ShowAll" Then
            strSQL = "select * from QABarCode order by SNo, BarCode"
        Else
            strSQL = "select * from QABarCode where SNo = '" & selSNo & "' order by BarCode"
        End If
    End If
    
    If selSNoF > "" Then
        If FTog = "ShowAll" Then
            strSQL = "select * from QABarCodeF order by SNo, BarCode"
        Else
            strSQL = "select * from QABarCodeF where SNo = '" & selSNoF & "' order by BarCode"
        End If
    End If
    
    Set rs1 = cn.Execute(strSQL)
    If rs1.EOF And rs1.BOF Then
        rs1.Close
        Exit Sub
    End If
    tmprec = 0
    While Not rs1.EOF
      strBarCode = rs1("Model") & " | " & rs1("BarCode") & " | " & rs1("DateDet")
      LstBarCode.AddItem strBarCode
      tmprec = tmprec + 1
      rs1.MoveNext
    Wend
    
    LblRec1.Caption = CStr(tmprec)
End Sub

Private Sub LstLabelF_Click()
    chkShowAll.Value = 0
    cmdStart.Enabled = False
    txtBarcode.Enabled = False
    cmdAdd.Enabled = False
    cmdEdit.Enabled = False
    
    If LstLabel.ListIndex > -1 Then
        tmpSel = LstLabelF.ListIndex
        LstLabel.ListIndex = -1
        LstLabelF.ListIndex = tmpSel
        LstLabelF.SetFocus
    End If
    selSNo = ""
    selSNoF = ""
    selSNoF = Left(LstLabelF.Text, 8)
    If selSNoF = "" Then Exit Sub
    
    ClearF
    FillLstBarCode
End Sub

Private Sub txtBarcode_KeyPress(KeyAscii As Integer)
    '回车输入结束
    If KeyAscii = 13 Then
        strBarCode = Trim(txtBarcode.Text)
        If strBarCode = "" Then
            txtBarcode.Text = ""
            Exit Sub
        End If
        
        '判断重复, 所有扫过的条码, Update on 2007-8-3 根据机型+条码
        strModel = Trim(txtModel.Text)
        strFilter = " where BarCode = '" & strBarCode & "' and Model = '" & strModel & "'"
        
        strSQL = "select count(*) from QABarCode" & strFilter
        Set rs1 = cn.Execute(strSQL)
        If rs1(0) > 0 Then
            txtBarcode.BackColor = vbRed
            txtBarcode.ForeColor = vbWhite
            PlaySound App.Path & "\alert.wav"
            tmprep = MsgBox("条码重复!", vbExclamation, "警告")
                
            cmdDone.Enabled = False
            txtBarcode.Enabled = False
                
            cmdRecheck.Visible = True
            cmdContinue.Visible = True
            rs1.Close
            Exit Sub
        End If
        rs1.Close
        
        strSQL = "insert into QABarCode(SNo, BarCode, DateDet, Model)"
        strSQL = strSQL & " values('" & selSNo & "', '" & strBarCode & "', convert(smalldatetime, '" & Now & "'), '" & strModel & "')"
        cn.Execute strSQL
        
        tmpSpace = 0
        tmpSpace = 20 - Len(strBarCode)
        strBarCode = strBarCode & Space$(tmpSpace)
        tmpSpace = 20 - Len(strModel)
        strModel = strModel & Space$(tmpSpace)
        LstBarCode.AddItem strModel & " | " & strBarCode & " | " & Now()
        LstBarCode.Selected(LstBarCode.NewIndex) = True
        
        LblRec1.Caption = CStr(LblRec1.Caption + 1)
    
        txtBarcode.Text = ""
    End If
End Sub