frmmaterout1.frm

一个物资管理系统

Private Sub cboItem_Click(Index As Integer)
    Dim sSql As String
    Dim mrcc As ADODB.Recordset
      
  
    If gintOmode = 1 Then
        '初始化员工名称和ID
        If Index = 1 Then
            cboItem(0).Enabled = True
            cboItem(3).Enabled = True
            cboItem(4).Enabled = True
            cboItem(2).Clear
            cboItem(0).Clear
            cboItem(3).Clear
            cboItem(4).Clear
            
            txtSQL = "select yeid,yespec,yekind,yeunit from msurplus where yename='" & Trim(cboItem(1)) & "'"
            Set mrcc = ExecuteSQL(txtSQL, MsgText)
            
            If Not mrcc.EOF Then
                
                Do While Not mrcc.EOF
                    cboItem(0).AddItem mrcc!yeid
                    cboItem(2).AddItem mrcc!yespec
                    cboItem(3).AddItem mrcc!yekind
                    cboItem(4).AddItem mrcc!yeunit
                    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
    
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 sSql As String
    Dim mrc As ADODB.Recordset
    
  
    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
   
    '判断余额库中是否有足够数量的物资可取
    txtSQL = "select yeaccount from msurplus where yeid='" & Trim(cboItem(0)) & "' and yebase='" & Trim(txtItem(6) & " ") & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = True Then
        MsgBox "该仓库没有该种物资可取！", vbOKOnly + vbExclamation, "警告"
        txtItem(0).SetFocus
        Exit Sub
    Else
        If mrc!yeaccount - CDbl(txtItem(0)) < 0 Then
            MsgBox "该仓库没有足够数量的物资可取！", vbOKOnly + vbExclamation, "警告"
            txtItem(0).SetFocus
            Exit Sub
        End If
    End If
            
    mrc.Close
    
    If gintOmode = 2 Then
        '先删除已有记录
        txtSQL = "delete from muse where lyno='" & 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 muse"
    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 gintOmode = 1 Then
        For intCount = 0 To 7
            txtItem(intCount) = ""
        Next intCount
        txtNo = GetRkno
        mblChange = False
        
        If flagOedit Then
            Unload frmMaterOut
            frmMaterOut.txtSQL = "select * from muse"
            frmMaterOut.Show
        End If
        
        
    ElseIf gintOmode = 2 Then
        Unload Me
        If flagOedit Then
            Unload frmMaterOut
        End If
        frmMaterOut.txtSQL = "select * from muse"
        frmMaterOut.Show
    End If
    
End Sub

Private Sub Form_Load()
    Dim sSql As String
    Dim intCount As Integer
    Dim mrc As ADODB.Recordset
  
    
   
    If gintOmode = 1 Then
        Me.Caption = Me.Caption & "添加"
        
        '初始化物资名称
        txtSQL = "select DISTINCT yename from msurplus where yeaccount<>0"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrc.EOF Then
            
                Do While Not mrc.EOF
                    cboItem(1).AddItem Trim(mrc!yename)
                    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 gintOmode = 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 = !lyaccount
                txtValue = !lyvalue
                txtNo = !lyno
                txtBase = !lybase & " "
                
            End With
            
        End If
        mrc.Close
        Me.Caption = Me.Caption & "修改"
    End If
    
    mblChange = False
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    gintOmode = 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