frmpsedit.frm

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

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

            Case 3

                If rsPsAdd.RecordCount <> 0 Then
                    rsPsAdd.Delete
                End If

                If rsPsAdd.RecordCount <> 0 Then
                    rsPsAdd.MoveFirst
                    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 strsql As String
    
    Dim intNum As Integer
    Select Case Index
        Case 0
            AddOrEdit = True
            
            Call AddNew

        Case 1
            AddOrEdit = False
            Call IsEdit(True)
            Me.txtps_date.SetFocus
            With rsPsAdd
                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 rsPsEdit
                    strsql = "delete from 库存表_tmp where 入库编号='" & Me.txtps_id.Text & "'"
                    cmdPsEdit.CommandText = strsql
                    cmdPsEdit.Execute
                    .Delete
                    .UpdateBatch
                    If .RecordCount <> 0 Then
                        .MoveFirst
                    End If
                    rsPsAdd.Filter = "入库编号='" & Me.txtps_id.Text & "'"
                    
                End With
            End If
        Case 4
        
        Case 5
            Unload Me
    End Select
'-----------------------------------------------------------------------------
    
End Sub


Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    rsPsAdd.Filter = "入库编号='" & Me.txtps_id.Text & "'"
    
End Sub

Private Sub DataGrid2_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    If CmdDep(2).Enabled = True Then
        LblStatus.Caption = Product_Status(DataGrid2.Columns(1).Text)
    End If
End Sub



Private Sub Form_Load()
    
    Set rsPsEdit = DEaccp.rsCom订购入库信息
    Set rsPsAdd = DEaccp.rsCom库存
    Set rsRparame = New Recordset
    Set cmdPsEdit = New Command
    cmdPsEdit.ActiveConnection = DEaccp.Conaccp
    cmdPsEdit.CommandType = adCmdText
    
    Me.LblStatus.Caption = "提示:当增加商品时按下[F2]查询商品编号"
    
    rsPsAdd.Filter = "入库编号='" & Me.txtps_id.Text & "'"
'    rsPsAdd.Filter = "仓库编号='" & Me.DCStorage.BoundText & "'"
'    rsPsAdd.Filter = "货架编号='" & Me.DCShelf.Text & "'"
    Call IsEdit(False)
    

    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If CmdDep(5).Enabled = False Then
        MsgBox "请先退出编辑状态后再退出该程序!", , "提示"
        Cancel = True
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)

    rsPsEdit.Close
    Set rsPsEdit = Nothing

    rsPsAdd.Close
    Set rsPsAdd = Nothing

    Set rsRparame = Nothing
    Set cmdPsEdit = Nothing
    
    
End Sub

Private Sub AddNew()
    Dim sql As String
    sql = "select psnumber from 系统启动表"


    With rsPsEdit
        .AddNew
        Set rsRparame = ExecuteSQL(sql)
        With rsRparame
            .MoveFirst
             lngPsNum = CLng(!psnumber) + 1
        End With
        Me.txtps_id.Text = "CR" & Format(lngPsNum, "0######")
        rsRparame.Close
        rsPsAdd.Filter = "入库编号='" & Me.txtps_id.Text & "'"
        
        Call IsEdit(True)

        Me.txtps_date = CStr(dteSysDate)
        
        
        Me.txtname.Text = user
        Me.txtps_date.SetFocus
        
    End With
End Sub



Private Function Save() As Boolean
'--------------------------------------------入库信息添加开始----------------------
    If Trim(Me.txtps_id.Text) = "" Then
        MsgBox "入库编号不能为空!", vbOKOnly + vbCritical, "错误"
        Me.txtps_id.SetFocus
        Save = False
        Exit Function
    End If
    
    If Me.txtps_date.Text = "" Or (Not IsDate(Me.txtps_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 rsPsAdd.RecordCount = 0 Then
        MsgBox "单据明细项不能为空!", vbOKOnly + vbCritical, "错误"
        Me.txtps_date.SetFocus
        Save = False
        Exit Function
    End If
    Save = True
End Function

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 rsPsAdd
        If Not .BOF Then
            .MovePrevious
        End If
        If .BOF Then .MoveNext
    End With
End Sub

Private Sub RowToDown()
    With rsPsAdd
        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))
        Else
            .Columns(.Col).Text = Txtgrid2.Text

        End If
    End With
End Sub