frmspzl.frm

一个小型的进销存管理软件,数据采用ACCE

    Grid.Clear
    Grid.Rows = 1
    Grid.FormatString = "商品编码|^ 类 别 码 |^      商  品  名  称 |^      货   号  |^ 规 格 |^ 单  位 |^   产         地 "
End Sub
Sub FillGrid() '商品列表
    Set Rst = New Recordset
    If SQLTJ <> "" Then
        SQL = "select * from SP " & SQLTJ & " order by spmc"
    Else
        SQL = "select * from SP order by spmc"
    End If
    Rst.Open SQL, db, 1, 3
    
    If Rst.EOF Then Exit Sub
    
    Do While Not Rst.EOF
        Grid.Rows = Grid.Rows + 1
        Grid.TextMatrix(Grid.Rows - 1, 0) = Rst.Fields(0)
        Grid.TextMatrix(Grid.Rows - 1, 1) = Rst.Fields(1)
        Grid.TextMatrix(Grid.Rows - 1, 2) = Rst.Fields(2)
        Grid.TextMatrix(Grid.Rows - 1, 3) = Rst.Fields(3)
        Grid.TextMatrix(Grid.Rows - 1, 4) = Rst.Fields(4)
        Grid.TextMatrix(Grid.Rows - 1, 5) = Rst.Fields(5)
        Grid.TextMatrix(Grid.Rows - 1, 6) = Rst.Fields(6)
        Rst.MoveNext
    Loop
    
    SQLTJ = ""
End Sub
Private Sub Form_Unload(Cancel As Integer)
    SPFlag = 0
    Unload Me
End Sub

Private Sub Grid_DblClick()
    If SPFlag = 2 Then
    Dim SumNum, I As Integer
    Dim SumJE As Double
    
        Dim OpenSPRs As ADODB.Recordset
        If Grid.TextMatrix(Grid.RowSel, 0) <> "" Then
            SQL = "select * from SP where spid=" & Grid.TextMatrix(Grid.RowSel, 0)
        Set OpenSPRs = New ADODB.Recordset
            OpenSPRs.Open SQL, db, 1, 3
            
            If OpenSPRs.EOF Then GoTo Move2:
            
            For I = 1 To IDlist.Count
                If OpenSPRs.Fields(0).Value = IDlist(I) Then GoTo Move2:
            Next
            
            
            FrmRKD.Grid.Rows = FrmRKD.Grid.Rows + 1
            FrmRKD.Grid.TextMatrix(FrmRKD.Grid.Rows - 1, 0) = FrmRKD.Grid.Rows - 1
            FrmRKD.Grid.TextMatrix(FrmRKD.Grid.Rows - 1, 1) = OpenSPRs.Fields("spmc")
            FrmRKD.Grid.TextMatrix(FrmRKD.Grid.Rows - 1, 2) = OpenSPRs.Fields("hh")
            FrmRKD.Grid.TextMatrix(FrmRKD.Grid.Rows - 1, 3) = OpenSPRs.Fields("gg")
            FrmRKD.Grid.TextMatrix(FrmRKD.Grid.Rows - 1, 4) = OpenSPRs.Fields("dw")
            FrmRKD.Grid.TextMatrix(FrmRKD.Grid.Rows - 1, 5) = 0
            FrmRKD.Grid.TextMatrix(FrmRKD.Grid.Rows - 1, 6) = Format(0, "0.00")
            FrmRKD.Grid.TextMatrix(FrmRKD.Grid.Rows - 1, 7) = FrmRKD.Grid.TextMatrix(FrmRKD.Grid.Rows - 1, 5) * FrmRKD.Grid.TextMatrix(FrmRKD.Grid.Rows - 1, 6)
            FrmRKD.Grid.TextMatrix(FrmRKD.Grid.Rows - 1, 8) = OpenSPRs.Fields("spid")
            IDlist.Add OpenSPRs.Fields(0).Value
               
            For I = 1 To FrmRKD.Grid.Rows - 1
              SumNum = SumNum + Val(FrmRKD.Grid.TextMatrix(I, 5))
              SumJE = SumJE + Val(FrmRKD.Grid.TextMatrix(I, 7))
            Next
            
            FrmRKD.lblSL.Caption = SumNum
            FrmRKD.lblJE.Caption = Format(CStr(SumJE), "0.00")
        
    
Move2:
        OpenSPRs.Close
        Set OpenSPRs = Nothing
    
        End If
        
        Unload Me
    End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case Is = "AddNode"
            Call AddNode
        Case Is = "DelNode"
            Call DelNode
        Case Is = "AddSP"
            Call AddSP
        Case Is = "DelSP"
            Call DelSP
        Case Is = "ModifySP"
            Call ModifySP
        Case Is = "Exit"
            Unload Me
            
    End Select
End Sub
Private Sub TVLB_Bind()
    Dim Pid As Integer
    Dim nod As Node
    Dim I As Integer
    
    TVLB.Nodes.Clear
    TVLB.Nodes.Add , , , "所有类别", 1
    Pid = TVLB.Nodes(1).index
    
    
    Set BindRs = New ADODB.Recordset
        BindRs.Open "select * from SP_LB", db, 1, 3
    If BindRs.EOF Then GoTo move1:
    
    
    For I = 1 To BindRs.RecordCount
        Set nod = TVLB.Nodes.Add
        nod.Text = BindRs.Fields("SPLBMC")
        nod.Image = 1
        Set nod.Parent = TVLB.Nodes(1)
        
        BindRs.MoveNext
    Next
    
move1:
    BindRs.Close
    Set BindRs = Nothing
    
End Sub

Sub AddNode()
    Dim LBBM As Integer
    On Error GoTo HandleError:
    
    Frame1.Enabled = False
    Grid.Visible = False
    Frame2.Caption = ""
    Toolbar1.Enabled = False
    Frame3.Visible = True
    
    Set Rst = New Recordset
        SQL = "select * from SP_LB"
        Rst.Open SQL, db, 1, 3
    If IsNull(Rst.Fields(0)) Then
        LBBM = 1
    Else
        Rst.MoveLast
        LBBM = Rst.Fields(0) + 1
    End If
    Rst.AddNew
    TxtLBBM = LBBM
    TxtLBMC = ""
    TxtLBMC.SetFocus
    
    Exit Sub
HandleError:
    MsgBox Err.Description, vbOKOnly + vbCritical
End Sub
Sub DelNode()
    Dim LBMC As String
    Dim SPLBID As Integer
    
    On Error GoTo HandleError:
    
    LBMC = TVLB.Nodes.Item(index).Text
    
    Set Rst = New Recordset
        SQL = "select SPLB_ID from SP_LB where SPLBMC='" & LBMC & "'"
        Rst.Open SQL, db, 1, 3
        
        SPLBID = Rst.Fields(0)
    
    Set CheckRs = New ADODB.Recordset
        CheckRs.Open "select * from SP where splb=" & SPLBID, db, 1, 3
    
    If Not CheckRs.EOF Then
        MsgBox "该分类中有相关的商品，不能删除此商品类别！", vbOKOnly + 48, "警告"
    Else
        Set DelRs = New ADODB.Recordset
            DelRs.Open "delete * from SP_LB where SPLBMC='" & LBMC & "'", db, 1, 3
            
        Call TVLB_Bind
        
        MsgBox "成功删除此商品类别！", vbOKOnly + vbInformation, "提示"
        
        
    End If

    
    Exit Sub
HandleError:
    MsgBox Err.Description, vbOKOnly + vbCritical
End Sub
Sub AddSP()
    Dim SPBM As Integer
    On Error GoTo HandleError:
    
    Frame1.Enabled = False
    Grid.Visible = False
    Frame2.Caption = ""
    Toolbar1.Enabled = False
    Frame4.Visible = True
    ModifyFlag = 1 '设置Frame3中确定按键的值
    
    Set Rst = New Recordset
        SQL = "select * from SP"
        Rst.Open SQL, db, 1, 3
        
        If Rst.EOF Then
            SPBM = 1
        Else
            Rst.MoveLast
            SPBM = Rst.Fields(0) + 1
        End If
        Rst.AddNew
        
        Call Cleartxt
        
        TxtSPBM = SPBM
        TxtSPMC.SetFocus
    
    Call FillCombo1
    Call FillCombo2
    Call FillCombo3
    
    Exit Sub
HandleError:
    MsgBox Err.Description, vbOKOnly + vbCritical
End Sub
Sub DelSP()
    Dim LBMC As String
    
    On Error GoTo HandleError:
    
    SPID = Grid.TextMatrix(Grid.RowSel, 0)
    
    Call Check_SPKC '检测此商品存库是否为0
    
    If Flag = False Then
        Set Rst = New Recordset
            SQL = "delete * from SP where spid=" & SPID
            Rst.Open SQL, db, 1, 3
        
        Call ReSet
        Call FillGrid
        
    End If
    
    
    Exit Sub
HandleError:
    MsgBox Err.Description, vbOKOnly + vbCritical
End Sub
Sub ModifySP()
    Dim SPBM As Integer
    On Error GoTo HandleError:
    
    ModifyFlag = 2
    
   
    If Grid.TextMatrix(Grid.RowSel, 0) <> "" Then
        Set Rst = New Recordset
            SQL = "select * from SP where spid=" & Grid.TextMatrix(Grid.RowSel, 0)
            Rst.Open SQL, db, 1, 3
    Else
        Exit Sub
    End If
    
    Frame1.Enabled = False
    Grid.Visible = False
    Frame2.Caption = ""
    Toolbar1.Enabled = False
    Frame4.Visible = True
    
    Call FillCombo1
    Call FillCombo2
    Call FillCombo3
    
    TxtSPBM = Rst.Fields(0)
    TxtSPMC = Rst.Fields(2)
    TxtHH = Rst.Fields(3)
    TxtCD = Rst.Fields(6)
    
    Exit Sub
HandleError:
    MsgBox Err.Description, vbOKOnly + vbCritical
End Sub
Sub Check_LBMC()

    
    On Error GoTo HandleError:
    
    Flag = False   '判别类别名称是否重复
    
    Set CheckRs = New ADODB.Recordset
        CheckRs.Open "select * from SP_LB where SPLBMC='" & TxtLBMC & "'", db, 1, 3
    If Not CheckRs.EOF Then
        MsgBox "类别名称重复，请重新输入！", vbOKOnly + 48, "警告"
        Flag = True
    End If
        
    Exit Sub
HandleError:
    MsgBox Err.Description, vbOKOnly + vbCritical
End Sub
Sub Check_SPKC()
    On Error GoTo HandleError:
    
    Flag = False   '判别库存中此商品库存数量是否为0
    
    Set CheckRs = New ADODB.Recordset
        CheckRs.Open "select * from KCDTB where  SL<>0 and SPid=" & SPID, db, 1, 3
    If Not CheckRs.EOF Then
        MsgBox "仓库中该商品库存不为零，不能删除！", vbOKOnly + 48, "警告"
        Flag = True
    End If
        
    Exit Sub
HandleError:
    MsgBox Err.Description, vbOKOnly + vbCritical
End Sub

Private Sub TVLB_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim LBMC, SPLBID As String
    
    If Node.index = 1 Then
        SQLTJ = ""
        Call ReSet
        Call FillGrid
        Exit Sub
    End If
    
    index = TVLB.SelectedItem.index
    
    LBMC = TVLB.Nodes.Item(index).Text
    
    Set Rst = New Recordset
        SQL = "select SPLB_ID from SP_LB where SPLBMC='" & LBMC & "'"
        Rst.Open SQL, db, 1, 3
        
        SPLBID = Rst.Fields(0)
          
        SQLTJ = " where splb=" & SPLBID
        
        Call ReSet
        Call FillGrid
End Sub

Private Sub txthh_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        TxtGG.SetFocus
    End If
End Sub

Private Sub txtspmc_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Combo1.SetFocus
    End If
End Sub
Private Sub Combo1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        TxtHH.SetFocus
    End If
End Sub
Private Sub txtcd_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Command3.SetFocus
    End If
End Sub
Sub FillCombo1()
    Set BindRs = New ADODB.Recordset
        BindRs.Open "select * from SP_LB", db, 1, 3
    
    Combo1.Clear
    
    Do While Not BindRs.EOF
        Combo1.AddItem BindRs.Fields(1).Value
        BindRs.MoveNext
    Loop
End Sub
Sub FillCombo3()
    Set BindRs = New ADODB.Recordset
        BindRs.Open "select * from CS_GG", db, 1, 3
    
    Combo3.Clear
    
    Do While Not BindRs.EOF
        Combo3.AddItem BindRs.Fields(1).Value
        BindRs.MoveNext
    Loop
End Sub
Sub FillCombo2()
    Set BindRs = New ADODB.Recordset
        BindRs.Open "select * from CS_DW", db, 1, 3
    
    Combo2.Clear
    
    Do While Not BindRs.EOF
        Combo2.AddItem BindRs.Fields(1).Value
        BindRs.MoveNext
    Loop
End Sub
Sub Cleartxt()
    TxtSPBM = ""
    TxtSPMC = ""
    TxtHH = ""
    TxtGG = ""
    TxtDW = ""
    TxtCD = ""
End Sub