form43.frm

我用VB开发的饲料经营进销存管理程序,包含购入、售出管理

                rs2.MoveFirst
                While Not rs2.EOF
                    S2 = S2 & rs2.Fields(0)
                    rs2.MoveNext
                Wend
            End If
            If Round(t_SumBuy, 2) = Round(rs1.Fields(5), 2) And S1 = S2 Then
                rs1.MoveNext
                GoTo exit_load_form_while
            End If
        End If
        S = ""
        For i = 0 To rs1.Fields.Count - 1
            Select Case i
                Case 1
                    tt_len = Len(rs1.Fields(i).Value)
                    t_len = 0
                    For t = 1 To tt_len
                        If Asc((Mid((rs1.Fields(i).Value), t, 1))) < 0 Then
                            t_len = t_len + 2
                        Else
                            t_len = t_len + 1
                        End If
                    Next
                    t_len = 16 - t_len
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & rs1.Fields(i).Value & S1
            End Select
            f_reckoning_table(j, i) = rs1.Fields(i).Value
        Next
        List1.AddItem S, j
        j = j + 1
        rs1.MoveNext
exit_load_form_while:
    Wend
    If j = 0 And g_query_method = 3 Then
        MsgBox ("没有查到错误数据!")
        GoTo exit_form_load
    End If
    List1.ListIndex = 0
    f_current_row = 0
    SQL = "select 编号,品种 from 购入帐单品种表 where 帐单号 = " & _
    "'" & f_reckoning_table(f_current_row, 1) & "'" & " order by 品种"
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    j = 0
    List2.Clear
    If Not rs1.EOF Then
        rs1.MoveFirst
    End If
    While Not rs1.EOF
        S = ""
        For i = 0 To rs1.Fields.Count - 1
            Select Case i
                Case 1
                    tt_len = Len(rs1.Fields(i).Value)
                    t_len = 0
                    For t = 1 To tt_len
                        If Asc((Mid((rs1.Fields(i).Value), t, 1))) < 0 Then
                            t_len = t_len + 2
                        Else
                            t_len = t_len + 1
                        End If
                    Next
                    t_len = 18 - t_len
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & rs1.Fields(i).Value & S1
            End Select
        Next
        List2.AddItem S, j
        f_arr_number1(j) = rs1.Fields(0)
        j = j + 1
        rs1.MoveNext
        List2.ListIndex = 0
    Wend
    List3.Clear
    SQL = "select 品种,购入斤数,购入单价,购入金额,编号 from 品种购入表 where 单号 = " & _
    "'" & f_reckoning_table(f_current_row, 1) & "'"
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    Text1.Text = 0
    Text2.Text = f_reckoning_table(f_current_row, 5)
    Text3.Text = f_reckoning_table(f_current_row, 6)
    j = 0
    If Not rs1.EOF Then
        rs1.MoveFirst
    End If
    While Not rs1.EOF
        S = ""
        For i = 0 To rs1.Fields.Count - 1
            Select Case i
                Case 0
                    tt_len = Len(rs1.Fields(i).Value)
                    t_len = 0
                    For t = 1 To tt_len
                        If Asc((Mid((rs1.Fields(i).Value), t, 1))) < 0 Then
                            t_len = t_len + 2
                        Else
                            t_len = t_len + 1
                        End If
                    Next
                    t_len = 18 - t_len
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & rs1.Fields(i).Value & S1
                 Case 2
                    t_len = 0
                    t_value = Round(rs1.Fields(i).Value, 3)
                    t_len = 11 - Len(t_value)
                    S1 = ""
                    If t_value = Int(t_value) Then
                        S1 = S1 & ".000"
                        t_len = t_len - 4
                    Else
                        If (t_value * 10) = Int(t_value * 10) Then
                            S1 = S1 & "00"
                            t_len = t_len - 2
                        Else
                            If (t_value * 100) = Int(t_value * 100) Then
                                S1 = S1 & "0"
                                t_len = t_len - 1
                            End If
                            
                        End If
                    End If
                    If t_value < 1 And t_value > 0 Then
                        S = S & "0"
                        t_len = t_len - 1
                    End If

                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    
                    S = S & t_value & S1
                Case 3
                    t_len = 0
                    t_value = Round(rs1.Fields(i).Value, 2)
                    t_len = 11 - Len(t_value)
                    S1 = ""
                    If t_value = Int(t_value) Then
                        S1 = S1 & ".00"
                        t_len = t_len - 3
                    Else
                        If (t_value * 10) = Int(t_value * 10) Then
                            S1 = S1 & "0"
                            t_len = t_len - 1
                        End If
                    End If
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & t_value & S1
                    Case 4
                Case Else
                    t_len = 0
                    t_len = 11 - Len(rs1.Fields(i).Value)
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & rs1.Fields(i).Value & S1
            End Select
        Next
        List3.AddItem S, j
        f_arr_number(j) = rs1.Fields(4)
        Text1.Text = Text1.Text + rs1.Fields(3)
        j = j + 1
        List3.ListIndex = 0
        rs1.MoveNext
    Wend
    Text1.Text = Round(Text1.Text, 2)
    cnn1.Close
    Set cnn1 = Nothing
exit_form_load:
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If f_formshow = "OK" Then
        g_form = g_previous_form
        Select Case g_form
            Case "form5"
                Form5.Show
            Case "form44"
                Form44.Show
        End Select
    End If
End Sub

Private Sub List1_Click()
    Dim cnn1 As ADODB.Connection
    Dim cmd1 As ADODB.Command
    Dim rs1 As ADODB.Recordset
    Set cnn1 = New ADODB.Connection
    cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=C:\Documents and Settings\jujumao\My Documents\粤丰饲料\粤丰饲料经营情况.mdb;"
    Set cmd1 = New ADODB.Command
    j = List1.ListIndex
    If f_current_row = j Then
        GoTo exit_list1_click
    End If
    f_current_row = j
    
    List2.Clear
    SQL = "select 编号,品种 from 购入帐单品种表 where 帐单号 = " & _
    "'" & f_reckoning_table(f_current_row, 1) & "'" & " order by 品种 "
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    j = 0
    If Not rs1.EOF Then
        rs1.MoveFirst
    End If
    While Not rs1.EOF
        S = ""
        For i = 0 To rs1.Fields.Count - 1
            Select Case i
                Case 1
                    tt_len = Len(rs1.Fields(i).Value)
                    t_len = 0
                    For t = 1 To tt_len
                        If Asc((Mid((rs1.Fields(i).Value), t, 1))) < 0 Then
                            t_len = t_len + 2
                        Else
                            t_len = t_len + 1
                        End If
                    Next
                    t_len = 18 - t_len
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & rs1.Fields(i).Value & S1
            End Select
        Next
        List2.AddItem S, j
        f_arr_number1(j) = rs1.Fields(0)
        j = j + 1
        List2.ListIndex = 0
        rs1.MoveNext
    Wend
    List3.Clear
    SQL = "select 品种,购入斤数,购入单价,购入金额,编号 from 品种购入表 where 单号 = " & _
    "'" & f_reckoning_table(f_current_row, 1) & "'" & " order by 品种"
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    Text1.Text = 0
    Text2.Text = f_reckoning_table(f_current_row, 5)
    Text3.Text = f_reckoning_table(f_current_row, 6)
    j = 0
    If Not rs1.EOF Then
        rs1.MoveFirst
    End If
    While Not rs1.EOF
        S = ""
        For i = 0 To rs1.Fields.Count - 1
            Select Case i
                Case 0
                    tt_len = Len(rs1.Fields(i).Value)
                    t_len = 0
                    For t = 1 To tt_len
                        If Asc((Mid((rs1.Fields(i).Value), t, 1))) < 0 Then
                            t_len = t_len + 2
                        Else
                            t_len = t_len + 1
                        End If
                    Next
                    t_len = 18 - t_len
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & rs1.Fields(i).Value & S1
                Case 2
                    t_len = 0
                    t_value = Round(rs1.Fields(i).Value, 3)
                    t_len = 11 - Len(t_value)
                    S1 = ""
                    If t_value = Int(t_value) Then
                        S1 = S1 & ".000"
                        t_len = t_len - 4
                    Else
                        If (t_value * 10) = Int(t_value * 10) Then
                            S1 = S1 & "00"
                            t_len = t_len - 2
                        Else
                            If (t_value * 100) = Int(t_value * 100) Then
                                S1 = S1 & "0"
                                t_len = t_len - 1
                            End If
                        End If
                    End If
                    If t_value < 1 And t_value > 0 Then
                        S = S & "0"
                        t_len = t_len - 1
                    End If
                    
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    
                    S = S & t_value & S1
                Case 3
                    t_len = 0
                    t_value = Round(rs1.Fields(i).Value, 2)
                    t_len = 11 - Len(t_value)
                    S1 = ""
                    If t_value = Int(t_value) Then
                        S1 = S1 & ".00"
                        t_len = t_len - 3
                    Else
                        If (t_value * 10) = Int(t_value * 10) Then
                            S1 = S1 & "0"
                            t_len = t_len - 1
                        End If
                    End If
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & t_value & S1
                Case 4
                Case Else
                    t_len = 0
                    t_len = 11 - Len(rs1.Fields(i).Value)
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & rs1.Fields(i).Value & S1
            End Select
        Next
        List3.AddItem S, j
        Text1.Text = Text1.Text + rs1.Fields(3)
        f_arr_number(j) = rs1.Fields(4)
        j = j + 1
        rs1.MoveNext
        List3.ListIndex = 0
    Wend
    Text1.Text = Round(Text1.Text, 2)
    cnn1.Close
    Set cnn1 = Nothing
exit_list1_click:
End Sub

Private Sub List2_Click()
    If List2.ListCount > 0 And List3.ListCount > 0 Then
        List3.ListIndex = List2.ListIndex
    End If
End Sub

Private Sub Text1_GotFocus()
    List3.SetFocus
End Sub

Private Sub Text2_GotFocus()
    List3.SetFocus
End Sub