frmotheredit.frm

一个简单但功能强大的进货系统,同样适合用于毕业论文的设计

                End If
                .CancelBatch
                Call IsEdit(False)
                rsOtAdd.Filter = "入库编号='" & Me.txtOther_id.Text & "'"
            Case 2
                rsOtAdd.AddNew "入库编号", Me.txtOther_id.Text
                rsOtAdd.Filter = "入库编号='" & Me.txtOther_id.Text & "'"
                rsOtAdd.MoveLast
                Me.DataGrid2.Col = 1
                Call IsEdit(True)
                Call Txtgrid2_Leave
            Case 3
                
                If rsOtAdd.RecordCount <> 0 Then
                    rsOtAdd.Delete
                End If
                
                If rsOtAdd.RecordCount <> 0 Then
                        rsOtAdd.Delete
                        rsOtAdd.MoveLast
                        Me.DataGrid2.Col = 1
                        Call IsEdit(True)
                        Call Txtgrid2_Leave
                End If


            End Select
        End With

End Sub

Private Sub CmdDep_Click(Index As Integer)
    
    Dim intNum As Integer
    Dim strsql As String
    
    Select Case Index
        Case 0
            Call AddNew
            
        Case 1
            Call IsEdit(True)
            Me.txtOther_id.SetFocus
            With rsOtAdd
                If .RecordCount <> 0 Then
                    .MoveFirst
                    Me.DataGrid2.Col = 1
                    Call Txtgrid2_Leave
                End If
            End With
        Case 2
            
        Case 3
            intNum = MsgBox("确认删除当前记录吗?", vbYesNo + vbQuestion, "删除确认")
            If intNum = vbYes Then
                With rsOtherEdit
                    strsql = "delete from 库存表_tmp where 入库编号='" & Me.txtOther_id.Text & "'"
                    cmdOtherEdit.CommandText = strsql
                    cmdOtherEdit.Execute
                    .Delete
                    .UpdateBatch
                    If .RecordCount <> 0 Then
                        .MoveFirst
                    End If
                    rsOtAdd.Filter = "入库编号='" & Me.txtOther_id.Text & "'"
                    
                End With
            End If
        Case 4
            
        Case 5
            Unload Me
            
    End Select
        
    
End Sub



Private Sub Form_Load()
    Dim sql As String
    Set rsOtherEdit = DEaccp.rsComOtherEdit
'    sql = "select * from 其它入库表_tmp order by 入库编号"
'    Set rsOtherEdit = New Recordset
'    Set rs = ExecuteSQL(sql)
    
    Set rsOtAdd = DEaccp.rsCom库存
    Set cmdOtherEdit = New Command
    cmdOtherEdit.ActiveConnection = DEaccp.Conaccp
    cmdOtherEdit.CommandType = adCmdText
    
    rsOtAdd.Filter = "入库编号='" & Me.txtOther_id.Text & "'"
    Me.LblStatus.Caption = "提示:当增加商品时按下[F2]查询商品编号"
    Call IsEdit(False)
    
End Sub

Private Sub IsEdit(blnIsEdit As Boolean)
    
    Dim intNum As Integer
    
    Me.DCOther_type.Enabled = blnIsEdit
    Me.txtOther_id.Enabled = blnIsEdit
    Me.txtother_date.Enabled = blnIsEdit
    Me.DCserve.Enabled = blnIsEdit
    Me.DCstorage.Enabled = blnIsEdit
    Me.txtinfo.Enabled = blnIsEdit
    If rsOtAdd.RecordCount <> 0 Then
        Me.Txtgrid2.Visible = blnIsEdit
    Else
        Me.Txtgrid2.Visible = False
    End If
    For intNum = 0 To 3
        Me.CmdAct(intNum).Enabled = blnIsEdit
    Next
    For intNum = 0 To 5
        Me.CmdDep(intNum).Enabled = Not blnIsEdit
    Next
'    If Me.txtOther_id.Text = "" Then
'        For intNum = 2 To 3
'            Me.CmdAct(intNum).Enabled = False
'        Next
'    End If
    If rsOtherEdit.RecordCount = 0 Then
        For intNum = 1 To 4
            Me.CmdDep(intNum).Enabled = False
        Next
    End If
   

    
    
End Sub

Private Sub AddNew()
    
    Dim strsql As String
    With rsOtherEdit
        .AddNew
        rsOtAdd.Filter = "入库编号='" & Me.txtOther_id.Text & "'"
        Call IsEdit(True)
        Me.txtother_date = CStr(dteSysDate)
        Me.txtname.Text = user
        Me.DCOther_type.SetFocus
    End With
    
        
    
    
End Sub


Private Sub Txtgrid2_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF2
            If DataGrid2.Col = 1 Then
                frmFindPro.SQLFindPro = Txtgrid2.Text
                frmFindPro.Show vbModal
                If frmFindPro.SQLFindPro <> "" Then
                    Txtgrid2.Text = frmFindPro.SQLFindPro
                    DataGrid2.Columns(1).Text = Txtgrid2.Text
                End If
            End If
        Case vbKeyReturn
            Call Column_value
            Call Cal_Price
            Call ColToRight
            Call Txtgrid2_Leave
        Case vbKeyLeft
            Call Column_value
            Call Cal_Price
            Call ColToLeft
            Call Txtgrid2_Leave
        Case vbKeyRight
            Call Column_value
            Call Cal_Price
            Call ColToRight
            Call Txtgrid2_Leave
        Case vbKeyUp
            Call Column_value
            Call Cal_Price
            Call RowToUp
            Call Txtgrid2_Leave
        Case vbKeyDown
            Call Column_value
            Call Cal_Price
            Call RowToDown
            Call Txtgrid2_Leave
    End Select
    
End Sub

Private Sub Txtgrid2_KeyPress(KeyAscii As Integer)
    Dim strValid As String
    If DataGrid2.Col = 2 Or DataGrid2.Col = 3 Then
        strValid = "0123456789."
        If KeyAscii > 26 Then
            If InStr(strValid, Chr(KeyAscii)) = 0 Then
                KeyAscii = 0
            End If
        End If
    End If
End Sub
Private Sub Txtgrid2_Leave()
    Txtgrid2.Text = DataGrid2.Columns(DataGrid2.Col).Text
    If DataGrid2.Columns(1).Text <> "" Then
        LblStatus.Caption = Product_Status(DataGrid2.Columns(1).Text)
    Else
        LblStatus.Caption = ""
    End If
    Txtgrid2.SelStart = 0
    Txtgrid2.SelLength = Len(Txtgrid2.Text)
    Txtgrid2.Width = DataGrid2.Columns(DataGrid2.Col).Width
    Txtgrid2.Left = DataGrid2.Left + DataGrid2.Columns(DataGrid2.Col).Left
    Txtgrid2.Top = DataGrid2.Top + DataGrid2.Row * DataGrid2.RowHeight + 225
    Txtgrid2.SetFocus
End Sub

Private Sub ColToRight()
    If DataGrid2.Col < DataGrid2.Columns.Count - 2 Then
        DataGrid2.Col = DataGrid2.Col + 1
    Else
        Call RowToDown
        DataGrid2.Col = 1
    End If
End Sub

Private Sub ColToLeft()
    If DataGrid2.Col > 1 Then
        DataGrid2.Col = DataGrid2.Col - 1
    End If
End Sub

Private Sub RowToUp()
    With rsOtAdd
        If Not .BOF Then
            .MovePrevious
        End If
        If .BOF Then .MoveNext
    End With
End Sub

Private Sub RowToDown()
    With rsOtAdd
        If Not .EOF Then
            .MoveNext
        End If
        If .EOF Then .MovePrevious
    End With
End Sub

Private Sub Cal_Price()
    With DataGrid2
        If .Columns(2).Text <> "" And .Columns(3).Text <> "" Then
            .Columns(4).Value = Round(CCur(.Columns(2).Value * .Columns(3).Value), 2)
        End If
    End With
End Sub
Private Sub Column_value()
    With DataGrid2
        If .Col = 2 Then
            If Txtgrid2.Text <> "" Then .Columns(.Col).Text = CStr(Round(CSng(Txtgrid2.Text), 4))
        ElseIf .Col = 3 Then
            If Txtgrid2.Text <> "" Then .Columns(.Col).Text = CStr(Round(CCur(Txtgrid2.Text), 2))
            For i = 2 To 3
                Me.CmdAct(i).Enabled = True
            Next
        Else
            .Columns(.Col).Text = Txtgrid2.Text
        End If
    End With
End Sub


Private Function Save() As Boolean

    If IsNull(Me.DCOther_type.SelectedItem) Or Trim(Me.DCOther_type.Text) = "" Then
        MsgBox "请选择入库类型!", vbOKOnly + vbCritical, "错误"
        Me.DCOther_type.SetFocus
        Save = False
        Exit Function
    End If
    
    If Trim(Me.txtOther_id.Text) = "" Then
        MsgBox "入库编号不能为空!", vbOKOnly + vbCritical, "错误"
        Me.txtOther_id.SetFocus
        Save = False
        Exit Function
    End If
    
    If Me.txtother_date.Text = "" Or (Not IsDate(Me.txtother_date.Text)) Then
        MsgBox "日期格式错误!", vbOKOnly + vbCritical, "错误"
        txtother_date.SetFocus
        SaveValid = False
        Exit Function
    End If
    
    If IsNull(Me.DCserve.SelectedItem) Then
        MsgBox "请选择供应商!", vbOKOnly + vbCritical, "错误"
        Me.DCserve.SetFocus
        Save = False
        Exit Function
    End If
    
    If IsNull(Me.DCstorage.SelectedItem) Then
        MsgBox "请选择存放仓库!", vbOKOnly + vbCritical, "错误"
        Me.DCstorage.SetFocus
        Save = False
        Exit Function
    End If
    
    If rsOtAdd.RecordCount = 0 Then
        MsgBox "单据明细项不能为空!", vbOKOnly + vbCritical, "错误"
        Save = False
        Exit Function
    End If
    Save = True
    
        
        
    

End Function