frmoutput.frm

用于生产企业设备备件管理系统

    If ConnTemp.State = adStateOpen Then ConnTemp.Close
    Set RSTemp = Nothing
    Set ConnTemp = Nothing
    MsgBox "[显示数据]" & Err.Description, vbOKOnly + vbCritical
End Sub

Private Sub cmdPage_Click(Index As Integer)
On Error Resume Next
    If Image1.Visible = True Then
        Select Case MsgBox("编号为[" & txtInput(0).Text & "]的资料已变更, 是否需要保存", vbYesNoCancel + vbQuestion)
            Case vbYes
                vkCommand2_Click
                If Image1.Visible = True Then Exit Sub
            Case vbCancel
                Exit Sub
        End Select
    End If
    
    Select Case Index
        Case 0
            CurPage = 1
        Case 1
            CurPage = CurPage - 1
        Case 3
            CurPage = CurPage + 1
        Case 4
            CurPage = 10000000
    End Select
    
    Call UpdateShow
End Sub

Private Sub Combo1_Click()
    Combo4.ListIndex = Combo1.ListIndex
    If bEditMode = False Then Exit Sub
    ShowFlag True
End Sub

Private Sub Combo2_Click()
    Combo3.ListIndex = Combo2.ListIndex
    Combo5.ListIndex = Combo2.ListIndex
    If bEditMode = False Then Exit Sub
    ShowFlag True
End Sub

Private Sub Combo3_Click()
    Combo2.ListIndex = Combo3.ListIndex
    Combo5.ListIndex = Combo3.ListIndex
    If bEditMode = False Then Exit Sub
    ShowFlag True
End Sub

Private Sub DataShow_Click()
On Error Resume Next
Dim i As Long, StrTemp As String
    
    If Image1.Visible = True Then
        If MsgBox("内容已变更，是否需要保存", vbYesNo + vbQuestion) = vbYes Then
            vkCommand2_Click
        End If
        ShowFlag False
    End If
    
    bEditMode = False
    With DataShow
        txtID = .TextMatrix(.Row, 0)
        txtInput(0).Text = .TextMatrix(.Row, 1)
        txtInput(1).Text = .TextMatrix(.Row, 2)
        StrTemp = .TextMatrix(.Row, 3)
        For i = 1 To Combo1.ListCount
            If Combo1.List(i - 1) = StrTemp Then
                Combo1.ListIndex = i - 1
                Exit For
            End If
        Next
        
        StrTemp = .TextMatrix(.Row, 4)
        For i = 1 To Combo2.ListCount
            If Combo2.List(i - 1) = StrTemp Then
                Combo2.ListIndex = i - 1
                Exit For
            End If
        Next
        
        txtInput(2).Text = .TextMatrix(.Row, 6)
        lngOldQty = CLng(.TextMatrix(.Row, 6))
        txtInput(3).Text = .TextMatrix(.Row, 7)
        txtInput(4).Text = .TextMatrix(.Row, 8)
    End With
    bEditMode = True
End Sub

Private Sub Form_Load()
On Error GoTo ErrFlag
Dim StrTitle As String
Dim i As Long
    bEditMode = False
    StrTitle = "出库单编号|日期|仓库名称|物品编号|物品名称|数量|签收人|备注"
    strCaption = Split(StrTitle, "|")
    lblCaption(0).Caption = strCaption(0)
    For i = 1 To UBound(strCaption)
        Load lblCaption(i)
        With lblCaption(i)
            .Caption = strCaption(i)
            .Top = lblCaption(i - 1).Top + 355
            .Visible = True
        End With
    Next
        
Dim ConnTemp As New ADODB.Connection
Dim RSTemp As New ADODB.Recordset
Dim strSQL As String

    strSQL = "select * from WH order by ID"
    ConnTemp.Open StrConn
    RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
    
    If RSTemp.RecordCount > 0 Then
        For i = 1 To RSTemp.RecordCount
            Combo1.AddItem RSTemp(1)
            Combo4.AddItem RSTemp(0)
            RSTemp.MoveNext
        Next
        Combo1.ListIndex = 0
        Combo4.ListIndex = 0
    End If
    RSTemp.Close
    
    strSQL = "select * from goods order by ID"
    RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
    
    If RSTemp.RecordCount > 0 Then
        For i = 1 To RSTemp.RecordCount
            Combo2.AddItem RSTemp(1)
            Combo3.AddItem RSTemp(2)
            Combo5.AddItem RSTemp(0)
            RSTemp.MoveNext
        Next
        Combo2.ListIndex = 0
        Combo3.ListIndex = 0
        Combo5.ListIndex = 0
    End If
    RSTemp.Close
    
    ConnTemp.Close
    Set RSTemp = Nothing
    Set ConnTemp = Nothing
    
    txtInput(1).Text = Date
    txtInput(2).Text = "0"
    txtInput(3).Text = MyAppInfo.UserName
    UpdateShow
    vkMouseKeyEvents1.ControlHwnd = DataShow.hWnd
    vkMouseKeyEvents1.LaunchKeyMouseEvents
    Exit Sub
    
ErrFlag:
    If RSTemp.State = adStateOpen Then RSTemp.Close
    If ConnTemp.State = adStateOpen Then ConnTemp.Close
    Set RSTemp = Nothing
    Set ConnTemp = Nothing
    MsgBox Err.Description, vbOKOnly + vbCritical
End Sub

Private Sub txtInput_Change(Index As Integer)
    If bEditMode = False Then Exit Sub
    ShowFlag True
End Sub

Private Sub vkCommand1_Click()
Dim strID As String, strDate As String, StrOP As String, strMemo As String
Dim StrQty As String
    strID = txtInput(0).Text
    strDate = txtInput(1).Text
    StrOP = txtInput(3).Text
    StrQty = txtInput(2).Text
    If CheckData(strID, lblCaption(0)) = False Then Exit Sub
    If CheckData(strDate, lblCaption(1)) = False Then Exit Sub
    If CheckData(StrQty, lblCaption(5)) = False Then Exit Sub
    If CheckData(StrOP, lblCaption(6)) = False Then Exit Sub
    
    If IsDate(strDate) = False Then
        MsgBox "[" & lblCaption(1) & "]栏位日期格式错误", vbOKOnly + vbCritical
        Exit Sub
    End If
    
    If IsNumeric(StrQty) = False Then
        MsgBox "[" & lblCaption(5) & "]栏位必须为数字", vbOKOnly + vbCritical
        Exit Sub
    End If
    
    If Val(StrQty) <= 0 Then
        MsgBox "[" & lblCaption(5) & "]栏位必须为数字且大于0", vbOKOnly + vbCritical
        Exit Sub
    End If
    
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim strSQL As String

    '检查库存大小是否超过设定值
    Call CheckWHQty(StrQty)
    
    ConnTemp.Open StrConn
    strSQL = "insert into OutData ([ID],[InDate],[WHID],[GoodsID],[Qty],[OPName],[memo]) Values('" & strID & "',#"
    strSQL = strSQL & strDate & "#," & Combo4.Text & "," & Combo5.Text & "," & StrQty & ",'" & StrOP & "','" & txtInput(4).Text & "')"
    
    ConnTemp.Execute strSQL
    
    strSQL = "update WHQty set Qty=Qty-" & StrQty & " where WHID=" & Combo4.Text & " AND GoodsID=" & Combo5.Text
    
    ConnTemp.Execute strSQL
    ConnTemp.Close
    Set ConnTemp = Nothing
    Call UpdateShow
    ShowFlag False
    Exit Sub
    
ErrFlag:
    If ConnTemp.State = adStateOpen Then ConnTemp.Close
    Set ConnTemp = Nothing
    MsgBox "[新增]" & Err.Description, vbCritical

End Sub

Private Sub vkCommand2_Click()
Dim strID As String, strDate As String, StrOP As String, strMemo As String
Dim StrQty As String
Dim strUpdateQty As String
    If txtID.Text = "" Then Exit Sub
    strID = txtInput(0).Text
    strDate = txtInput(1).Text
    StrOP = txtInput(3).Text
    StrQty = txtInput(2).Text
    If CheckData(strID, lblCaption(0)) = False Then Exit Sub
    If CheckData(strDate, lblCaption(1)) = False Then Exit Sub
    If CheckData(StrQty, lblCaption(5)) = False Then Exit Sub
    If CheckData(StrOP, lblCaption(6)) = False Then Exit Sub
    
    If IsDate(strDate) = False Then
        MsgBox "[" & lblCaption(1) & "]栏位日期格式错误", vbOKOnly + vbCritical
        Exit Sub
    End If
    
    If IsNumeric(StrQty) = False Then
        MsgBox "[" & lblCaption(5) & "]栏位必须为数字", vbOKOnly + vbCritical
        Exit Sub
    End If
    
    strUpdateQty = ""
    If lngOldQty <> CLng(StrQty) Then
        CheckWHQty (StrQty)
        strUpdateQty = "update WHQty set Qty=Qty-" & (CLng(StrQty) - lngOldQty) & " where WHID=" & Combo4.Text & " AND GoodsID=" & Combo5.Text
    End If
    
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim strSQL As String
Dim i As Long
    
    strSQL = "update OutData set ID='" & strID & "',InDate=#" & strDate & "#,"
    strSQL = strSQL & "WHID=" & Combo4.Text & ",GoodsID=" & Combo5.Text & ",Qty=" & StrQty
    strSQL = strSQL & ",OPName='" & StrOP & "',[Memo]='" & txtInput(4).Text & "'"
    strSQL = strSQL & " where AutoID=" & txtID.Text
    
    ConnTemp.Open StrConn
    ConnTemp.Execute strSQL
    If strUpdateQty <> "" Then ConnTemp.Execute strUpdateQty
    ConnTemp.Close
    Set ConnTemp = Nothing
    Call UpdateShow
    ShowFlag False
    Exit Sub
    
ErrFlag:
    If ConnTemp.State = adStateOpen Then ConnTemp.Close
    Set ConnTemp = Nothing
    If Err.Number = -2147467259 Then
        MsgBox "入库单编号重复", vbOKOnly + vbCritical
    Else
        MsgBox "[保存]" & Err.Description, vbCritical
    End If
End Sub

Private Sub vkCommand3_Click()
    If txtID.Text = "" Then
        MsgBox "请选择要删除的单号", vbOKOnly + vbInformation
        Exit Sub
    End If
    If MsgBox("确定要删除吗", vbQuestion + vbYesNo) = vbNo Then
        Exit Sub
    End If
       
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim strSQL As String

    strSQL = "delete * from OutData where AutoID=" & txtID.Text
    ConnTemp.Open StrConn
    ConnTemp.Execute strSQL
    
    strSQL = "update WHQty set Qty=Qty+" & lngOldQty & " where WHID=" & Combo4.Text & " AND GoodsID=" & Combo5.Text
    ConnTemp.Execute strSQL
    
    ConnTemp.Close
    bEditMode = False
    UpdateShow
    ShowFlag False
    Exit Sub
    
ErrFlag:
    MsgBox "[删除]" & Err.Description, vbCritical
End Sub

Private Sub vkCommand4_Click()
    If Image1.Visible = True Then
        Select Case MsgBox("编号为[" & txtInput(0).Text & "]的资料已变更, 是否需要保存", vbYesNoCancel + vbQuestion)
            Case vbYes
                vkCommand2_Click
                If Image1.Visible = True Then Exit Sub
            Case vbCancel
                Exit Sub
        End Select
    End If
    Unload Me
End Sub

Private Sub vkMouseKeyEvents1_MouseWheel(Sens As vkUserContolsXP.Wheel_Sens)
On Error Resume Next
    If Sens = WHEEL_DOWN Then
        If DataShow.Row = DataShow.Rows - 1 Then Exit Sub
        DataShow.Row = DataShow.Row + 1
    Else
        If DataShow.Row = 1 Then Exit Sub
        DataShow.Row = DataShow.Row - 1
    End If
    DataShow.TopRow = DataShow.Row
End Sub