frm_stock.frm

采购信息录入系统,相对来说

    While rs.EOF = False
        Provider_Name.ComboItems.Add , "PN" & rs.Fields("Provider_Code").value, rs.Fields("Provider_Name").value & ""
        rs.MoveNext
    Wend
    Else
        Price.Text = ""
      '  Price.Enabled = False
        Product_Name.Text = ""
    End If
     Product_Name.Locked = Not CheckBox1.value
    Call ChangeColor(Product_Name, CheckBox1.value)
End Sub

Private Sub CheckBox2_Click()
    If CheckBox2.value = True Then
        Provider_Name.ComboItems.Clear
'        Price.Enabled = True
    Else
        Provider_Name.Text = ""
    End If
     Provider_Name.Locked = Not CheckBox2.value
     Call ChangeColor(Provider_Name, CheckBox2.value)
End Sub

Private Sub Command2_Click()
If adoSRs.EOF = True Then Exit Sub
    Dim sure As VbMsgBoxResult
    sure = MsgBox("确定要删除该纪录吗!", vbOKCancel + vbExclamation, App.EXEName)
    On Error GoTo err_produce
    If sure = vbOK Then rs.Delete adAffectCurrent
    Exit Sub
err_produce:
    Alert (ERR.Description)
End Sub

Private Sub Command3_Click()
If adoSRs.EOF = True Then Exit Sub
On Error GoTo err_produce
    DataGrid1.AllowUpdate = True
    Command4.Enabled = True
    Exit Sub
err_produce:
    Alert (ERR.Description)
End Sub

Private Sub Command4_Click()
On Error GoTo err_produce
    DataGrid1.AllowUpdate = False
    Command4.Enabled = False
    rs.Update
    Exit Sub
err_produce:
    Alert (ERR.Description)
End Sub

Private Sub Command5_Click()
   Dim code, name As String
On Error GoTo Resume_Table
    Set rs = New ADODB.Recordset
    Set rs.ActiveConnection = DB
    rs.CursorLocation = adUseClient
    rs.CursorType = adOpenForwardOnly
    rs.LockType = adLockOptimistic
    rs.Open "DELETE * FROM CLASS_TEMP"
'    Set rs = New ADODB.Recordset
'    Set rs.ActiveConnection = DB
'    rs.CursorLocation = adUseClient
'    rs.CursorType = adOpenForwardOnly
'    rs.LockType = adLockOptimistic
'    rs.Open "DROP TABLE CALSS_TEMP"
   For i = 2 To Tree.Nodes.Count
        Set rs = New ADODB.Recordset
        Set rs.ActiveConnection = DB
        rs.CursorLocation = adUseClient
        rs.CursorType = adOpenForwardOnly
        rs.LockType = adLockOptimistic
        code = Right(Tree.Nodes(i).Key, Len(Tree.Nodes(i).Key) - 2)
        name = Tree.Nodes(i).Text
        rs.Open "INSERT INTO CLASS_TEMP ( Class_Code,Class_Name ) VALUES ('" & code & "','" & name & "')"
   Next i
    Set rs = New ADODB.Recordset
    Set rs.ActiveConnection = DB
    rs.CursorLocation = adUseClient
    rs.CursorType = adOpenForwardOnly
    rs.LockType = adLockOptimistic
    rs.Open "DROP TABLE CLASS"
    Set rs = New ADODB.Recordset
    Set rs.ActiveConnection = DB
    rs.CursorLocation = adUseClient
    rs.CursorType = adOpenForwardOnly
    rs.LockType = adLockOptimistic
    rs.Open "SELECT * INTO CLASS FROM CLASS_TEMP"
   Exit Sub
Resume_Table:
   Alert (ERR.Description & "分类更新失败，恢复原来数据")
   Call Init_Tree
End Sub

Private Sub del_Click()
    Dim New_Node As Node
    Set New_Node = Tree.SelectedItem
    Tree.Nodes.Remove (New_Node.Index)
End Sub

Private Sub Edit_Click()
    Tree.StartLabelEdit
End Sub

Private Sub Find_Stock_Click()
   SSTab.Caption = "订单"
   State = 1
   Stock_Info.Visible = True
   Stock_Info.ZOrder (0)
   Stock_Info.Left = 3000
   Find_Info.Visible = False
'
    Dim step As Integer
    step = 10
        While (Stock_Info.Left > 90)
        Stock_Info.Move (Stock_Info.Left - step)
        step = step + 10
        DoEvents
        Wend
        Stock_Info.Left = 90
    
End Sub

Private Sub Form_Load()
    StatusBar.Panels(1).Text = Filiale_Name & "    ::采购信息录入系统DEMO版:: 2002"
   State = 1
   Call Init_Tree
   Tree.Nodes(1).Expanded = True
   Fetch_Date.MinDate = Now
   Stock_Date.MinDate = Now
   
   '**********************************************
    MoveToCenter gMainFormRefer, Me
    
    DTPicker1.value = Format(Date, "yyyy-mm-dd")
    DTPicker2.value = Format(Date, "yyyy-mm-dd")
    Set rs = New ADODB.Recordset
    Set rs.ActiveConnection = DB
    rs.CursorLocation = adUseClient
    rs.CursorType = adOpenForwardOnly
    rs.LockType = adLockOptimistic
    rs.Open "select product_name from product"
    
    Set adoGRs = New ADODB.Recordset
    Set adoGRs.ActiveConnection = DB
    adoGRs.CursorLocation = adUseClient
    adoGRs.CursorType = adOpenForwardOnly
    adoGRs.LockType = adLockOptimistic
    adoGRs.Open "select provider_name from provider"
    
    Set adoZRs = New ADODB.Recordset
    Set adoZRs.ActiveConnection = DB
    adoZRs.CursorLocation = adUseClient
    adoZRs.CursorType = adOpenForwardOnly
    adoZRs.LockType = adLockOptimistic
    adoZRs.Open "select corporation_Name from Filiale"
    
     Set adoSRs = New ADODB.Recordset
    Set adoSRs.ActiveConnection = DB
    adoSRs.CursorLocation = adUseClient
    adoSRs.CursorType = adOpenForwardOnly
    adoSRs.LockType = adLockOptimistic
    adoSRs.Open "select * from stock_info"
   Set DataGrid1.DataSource = adoSRs
    '----------------------------------------------------------------
    '读入产品名称
    Do While Not rs.EOF
        Combo1.AddItem Trim(rs!Product_Name)
        rs.MoveNext
    Loop
    '----------------------------------------------------------------
    '读入供应商名称
    Do While Not adoGRs.EOF
        Combo2.AddItem Trim(adoGRs!Provider_Name) & ""
        adoGRs.MoveNext
    Loop
    
    
    '-----------------------------------------------------------
    '读出在Treeview显示
    ' Call LI_Init_Tree(Treeview)
   '**********************************************
End Sub

Private Sub Init_Tree()
    Dim Pre_LEN As Integer
    Dim Self_LEN As Integer
    Dim Depth As Integer
    Dim New_Node As Node
    Dim Root_Node As Node
    Dim Last_Node As Node
    Dim Father_Node As Node
    Pre_LEN = 0
    Tree.Nodes.Clear
    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenDynamic
    rs.CursorLocation = adUseClient
    rs.LockType = adLockOptimistic
    rs.ActiveConnection = DB
    rs.Open "SELECT * FROM CLASS ORDER BY Class_Code"
    
    Set New_Node = Tree.Nodes.Add(, , "Root", "产品分类", 1)
    Set Root_Node = Tree.Nodes(1)
    Dim num As Integer
    num = 1
    While rs.EOF = False
        num = num + 1
        Set Last_Node = New_Node
        Self_LEN = Len(rs.Fields("Class_Code").value)
        Depth = (Pre_LEN - Self_LEN) / 3
            If Depth > 0 Then
            Set Father_Node = Last_Node
            For i = 0 To Depth
                Set Father_Node = Father_Node.Parent
            Next i
            End If
        If Depth > 0 Then Set New_Node = Tree.Nodes.Add(Father_Node, tvwChild, "AD" & rs.Fields("Class_Code").value, rs.Fields("class_Name").value, 2, 3)
        If Depth = 0 Then Set New_Node = Tree.Nodes.Add(Last_Node, tvwNext, "AD" & rs.Fields("Class_Code").value, rs.Fields("class_Name").value, 2, 3)
        If Depth < 0 Then Set New_Node = Tree.Nodes.Add(Last_Node, tvwChild, "AD" & rs.Fields("Class_Code").value, rs.Fields("class_Name").value, 2, 3)
        Pre_LEN = Self_LEN
        Set Last_Node = New_Node
        rs.MoveNext
    Wend
End Sub

Private Sub Input_Stock_Click()
  SSTab.Caption = "查询"
    State = 2
    Find_Info.Visible = True
    Find_Info.ZOrder (0)
    Find_Info.Left = 3000
    Stock_Info.Visible = False

   Dim step As Integer
   step = 10
        While (Find_Info.Left > 90)
            Find_Info.Move (Find_Info.Left - step)
            step = step + 10
            DoEvents
        Wend
        Find_Info.Left = 90
End Sub

Private Sub OUT_DATABASE_Click()
    Dim sure As VbMsgBoxResult
    sure = MsgBox("确定要导出数据吗？", vbOKCancel + vbExclamation, App.EXEName)
    If sure = vbCancel Then Exit Sub
    DB.Close
    Call ZIP_DATABASE("STOCK.mdb", "UP_LOAD.mdb")
    DB.Open
    Alert ("数据导出完成！")
End Sub



Private Sub Price_Change()
    If Len(Price.Text) = Len("") Or Len(Quantity.Text) = 0 Then
    Total_Price.Caption = "合计："
    Exit Sub
    End If
    pri = Int(Right(Price.Text, Len(Price.Text) - Len("")))
    qua = Int(Quantity.Text)
    Total_Price.Caption = "合计：" & CStr(pri * qua) & "￥"
End Sub

Private Sub Price_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 8 Or KeyCode = 46 Then
     Exit Sub
    End If
    If Len(Price.Text) = Len("") Or Len(Quantity.Text) = 0 Then
    Total_Price.Caption = "合计："
    Exit Sub
    End If
    pri = Int(Right(Price.Text, Len(Price.Text) - Len("")))
    qua = Int(Quantity.Text)
    Total_Price.Caption = "合计：" & CStr(pri * qua) & "￥"
End Sub

Private Sub Price_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
        KeyAscii = 0
        Beep
        Exit Sub
    End If
End Sub

Private Sub Product_Name_Change()
    Price.Text = ""
    check_total_pa
    Provider_Name.ComboItems.Clear
End Sub

Private Sub Product_Name_Click()
    If Product_Name.SelectedItem = Null Then Exit Sub
    
    Dim class_code As String
    Dim Para As String
    Dim pro_code As String
    Para = Right(Product_Name.SelectedItem.Key, Len(Product_Name.SelectedItem.Key) - 2)
    class_code = Right(Para, Len(Para) - 4)
    pro_code = Left(Para, Len(Para) - Len(class_code))
    Stock_Product_Code = pro_code
    Stock_Product_Class = class_code
    
    
'    Dim class_code As String
'    Dim Para As String
'    Dim pro_code As String
    Para = Right(Product_Name.SelectedItem.Key, Len(Product_Name.SelectedItem.Key) - 2)
    class_code = Right(Para, Len(Para) - 4)
    pro_code = Left(Para, Len(Para) - Len(class_code))
    '确定产品单位
    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenForwardOnly
    rs.CursorLocation = adUseClient
    rs.LockType = adLockReadOnly
    rs.ActiveConnection = DB
    rs.Open "select * from PRODUCT where Product_Class='" & class_code & "' and Product_Code='" & pro_code & "'"
    UNIT_Label.Text = rs.Fields("Product_Unit").value
    '确定供应商
    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenForwardOnly
    rs.CursorLocation = adUseClient
    rs.LockType = adLockReadOnly
    rs.ActiveConnection = DB
    Dim sqlstring As String
    sqlstring = "select * from PROVIDER_PRODUCT where Provider_Product_Class='" & class_code & "' and Provider_Product_Code='" & pro_code & "'"
    On Error GoTo ERR
    rs.Open sqlstring
    Provider_Name.ComboItems.Clear
    If rs.EOF = False Then
        Call ChangeColor(Provider_Name, True)
    Else
        Call ChangeColor(Provider_Name, False)
    End If
    While rs.EOF = False
        Set RS_Temp = New ADODB.Recordset
        RS_Temp.CursorType = adOpenForwardOnly
        RS_Temp.CursorLocation = adUseClient
        RS_Temp.LockType = adLockReadOnly
        RS_Temp.ActiveConnection = DB
       ' Para=
        RS_Temp.Open "select * from PROVIDER where Provider_code='" & rs.Fields("Provider_code").value & "'"
        Provider_Name.ComboItems.Add , "PN" & RS_Temp.Fields("Provider_Code").value, RS_Temp.Fields("Provider_Name").value
        rs.MoveNext