frmmaterin1.frm

一个物资管理系统

            cboItem(3).Enabled = True
            cboItem(4).Enabled = True
            cboItem(2).Clear
            cboItem(0).Clear
            cboItem(3).Clear
            cboItem(4).Clear
            
            txtSQL = "select wzid,wzspec,wzkind,wzunit from material where wzname='" & Trim(cboItem(1)) & "'"
            Set mrcc = ExecuteSQL(txtSQL, MsgText)
            
            If Not mrcc.EOF Then
                
                Do While Not mrcc.EOF
                    cboItem(0).AddItem mrcc!wzid
                    cboItem(2).AddItem mrcc!wzspec
                    cboItem(3).AddItem mrcc!wzkind
                    cboItem(4).AddItem mrcc!wzunit
                    mrcc.MoveNext
                Loop
                cboItem(0).Enabled = False
                cboItem(3).Enabled = False
                cboItem(4).Enabled = False
                cboItem(2).ListIndex = 0
                
                cmdSave.Enabled = True
            Else
                MsgBox "请先建立物资档案！", vbOKOnly + vbExclamation, "警告"
                cmdSave.Enabled = False
                Exit Sub
            End If
            mrcc.Close
        ElseIf Index = 2 Then
            cboItem(0).Enabled = True
            cboItem(3).Enabled = True
            cboItem(4).Enabled = True
            With cboItem(2)
                cboItem(0).ListIndex = .ListIndex
                cboItem(3).ListIndex = .ListIndex
                cboItem(4).ListIndex = .ListIndex
            End With
            cboItem(0).Enabled = False
            cboItem(3).Enabled = False
            cboItem(4).Enabled = False
        End If
    End If
    Exit Sub
    
End Sub

Private Sub cboItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
    
End Sub

Private Sub cmdExit_Click()
    If mblChange And cmdSave.Enabled Then
        If MsgBox("保存当前记录的变化吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            '保存
            Call cmdSave_Click
        End If
    End If
    Unload Me
End Sub

Private Sub cmdSave_Click()
    Dim intCount As Integer
    Dim sMeg As String
    Dim mrcc As ADODB.Recordset
    Dim MsgText As String
    
    For intCount = 0 To 5
        If Trim(txtItem(intCount) & " ") = "" Then
            Select Case intCount
                Case 0
                    sMeg = "数量"
                Case 1
                    sMeg = "单价"
                Case 2
                    sMeg = "金额"
                Case 3
                    sMeg = "入库时间"
                Case 4
                    sMeg = "经办人"
                Case 5
                    sMeg = "保管人"
            End Select
            sMeg = sMeg & "不能为空！"
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
            txtItem(intCount).SetFocus
        
            Exit Sub
        End If
    Next intCount
   
    If IsDate(txtItem(3)) Then
        txtItem(3) = Format(txtItem(3), "yyyy-mm-dd")
    Else
        MsgBox "入库时间应输入日期（yyyy-mm-dd）！", vbOKOnly + vbExclamation, "警告"
        txtItem(3).SetFocus
        Exit Sub
    End If
    
    '判断余额库中是否有rkid的记录
    txtSQL = "select * from msurplus where yeid='" & Trim(cboItem(0)) & "' and yebase='" & Trim(txtItem(6) & " ") & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    If mrc.EOF = True Then              '为空
            
         '向余额库加入新记录
        mrc.Close
        txtSQL = "select * from msurplus"
        Set mrcc = ExecuteSQL(txtSQL, MsgText)
        
        mrcc.AddNew
        mrcc.Fields(0) = Trim(cboItem(0))
        
        For intCount = 1 To 4
            If Trim(cboItem(intCount) & " ") = "" Then
                mrcc.Fields(intCount) = Null
            Else
                mrcc.Fields(intCount) = Trim(cboItem(intCount))
            End If
        Next intCount
        
        mrcc.Fields(5) = 0
        mrcc.Fields(6) = 0
        mrcc.Fields(7) = Trim(txtItem(6) & " ")
        mrcc.Fields(8) = Null
        mrcc.Update
        mrcc.Close
        
        
    Else
        mrc.Close
    End If
    
    
    If gintImode = 2 Then
        '先删除已有记录
        txtSQL = "delete from msave where rkno='" & Trim(txtNo) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        txtSQL = "update msurplus set yeaccount=yeaccount-" & Trim(txtAccount) & ",yevalue=yevalue-" & Trim(txtValue) & " where yeid='" & Trim(cboItem(0)) & "' and yebase='" & Trim(txtBase) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
    End If
    
    '再加入新记录
    txtSQL = "select * from msave"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
    mrc.Fields(0) = Trim(txtNo)
    
    For intCount = 0 To 4
        If Trim(cboItem(intCount) & " ") = "" Then
            mrc.Fields(intCount + 1) = Null
        Else
            mrc.Fields(intCount + 1) = Trim(cboItem(intCount))
        End If
    Next intCount
                   
    For intCount = 0 To 7
        If Trim(txtItem(intCount) & " ") = "" Then
            mrc.Fields(intCount + 6) = Null
        Else
            mrc.Fields(intCount + 6) = Trim(txtItem(intCount))
        End If
    Next intCount
    
    mrc.Update
    mrc.Close
    
        '刷新余额库
    txtSQL = "update msurplus set yeaccount=yeaccount+" & Trim(txtItem(0)) & ",yevalue=yevalue+" & Trim(txtItem(2)) & " where yeid='" & Trim(cboItem(0)) & "' and yebase='" & Trim(txtItem(6) & " ") & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
        
    If gintImode = 1 Then
        For intCount = 0 To 7
            txtItem(intCount) = ""
        Next intCount
        txtNo = GetRkno
        mblChange = False
        If flagIedit Then
            Unload frmMaterIn
            frmMaterIn.txtSQL = "select * from msave"
            frmMaterIn.Show
        End If
    ElseIf gintImode = 2 Then
        Unload Me
        If flagIedit Then
            Unload frmMaterIn
        End If
        frmMaterIn.txtSQL = "select * from msave"
        frmMaterIn.Show
        
    End If
    
End Sub

Private Sub Form_Load()
    Dim sSql As String
    Dim intCount As Integer
    Dim MsgText As String
    
    
   
    If gintImode = 1 Then
        Me.Caption = Me.Caption & "添加"
        
        '初始化物资名称
        txtSQL = "select DISTINCT wzname from material"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrc.EOF Then
            
                Do While Not mrc.EOF
                    cboItem(1).AddItem Trim(mrc!wzname)
                    mrc.MoveNext
                Loop
                cboItem(1).ListIndex = 0
            
        Else
            MsgBox "请先进行物资登记！", vbOKOnly + vbExclamation, "警告"
            cmdSave.Enabled = False
            Exit Sub
        End If
        mrc.Close
        
        txtAccount = "0"
        txtValue = "0"
        txtNo = GetRkno
        txtBase = " "
                
    ElseIf gintImode = 2 Then
       
        
        
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If mrc.EOF = False Then
            With mrc
                
                For intCount = 0 To 4
                    cboItem(intCount).AddItem .Fields(intCount + 1)
                    cboItem(intCount).ListIndex = 0
                Next intCount
                
                For intCount = 0 To 7
                    If Not IsNull(.Fields(intCount + 6)) Then
                        txtItem(intCount) = .Fields(intCount + 6)
                    End If
                Next intCount
                
                '保存更改数据
                txtAccount = !rkaccount
                txtValue = !rkvalue
                txtNo = !rkno
                txtBase = !rkbase & " "
                
            End With
            
        End If
        mrc.Close
        Me.Caption = Me.Caption & "修改"
            
        
    End If
    
    mblChange = False
    
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    gintImode = 0
End Sub





Private Sub txtItem_Change(Index As Integer)
    '有变化设置gblchange
    mblChange = True
    If Index = 0 Or Index = 1 Then
        If Trim(txtItem(0) & " ") <> "" And Trim(txtItem(1) & " ") <> "" Then
            txtItem(2) = Format(CDbl(txtItem(0)) * CDbl(txtItem(1)), "#0.00")
        Else
            txtItem(2) = 0
        End If
    End If
End Sub

Private Sub txtItem_GotFocus(Index As Integer)
    txtItem(Index).SelStart = 0
    txtItem(Index).SelLength = Len(txtItem(Index))
    
End Sub

Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
        EnterToTab KeyCode

End Sub


Private Function GetRkno() As String
    GetRkno = Format(Now, "yymmddhhmmss")
    Randomize
    GetRkno = GetRkno & Int((99 - 10 + 1) * Rnd + 10)
End Function

Private Sub txtItem_KeyPress(Index As Integer, KeyAscii As Integer)
    If Index = 0 Or Index = 1 Then
        'MsgBox KeyCode
        '对键入字符进行控制
        'txtQuantity(Index).Locked = False
        '小数点只允许输入一次
        If KeyAscii = 190 Then
            If InStr(Trim(txtItem(Index)), ".") = 0 Then
                If Len(Trim(txtItem(Index))) > 0 Then
                    txtItem(Index).Locked = False
                Else
                    txtItem(Index).Locked = True
                End If
            Else
                txtItem(Index).Locked = True
            End If
            Exit Sub
        End If
        '非数字不能输入
        If KeyAscii > 57 Or KeyAscii < 48 Then
            txtItem(Index).Locked = True
        Else
            txtItem(Index).Locked = False
        End If
        '允许Backspace
        If KeyAscii = 8 Then
            txtItem(Index).Locked = False
        End If
        'Delete键
        If KeyAscii = 46 Then
            txtItem(Index).Locked = False
        End If
    End If
End Sub