frm_stock.frm

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

    Wend
    Exit Sub
ERR:
 MsgBox ERR.Description, vbOKOnly, App.EXEName
    
End Sub

Private Sub Product_Name_KeyUp(KeyCode As Integer, Shift As Integer)
Stock_Product_Class = ""
Stock_Product_Code = ""
'Is_New = True
End Sub

Private Sub Provider_Name_Change()
    Price.Text = ""
    check_total_pa
'    Is_New = True
End Sub

Private Sub Provider_Name_Click()
    Dim Provider_Code As String
    Provider_Code = Right(Provider_Name.SelectedItem.Key, Len(Provider_Name.SelectedItem.Key) - 2)
    Stock_Provider_Code = Provider_Code

    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenDynamic
    rs.CursorLocation = adUseClient
    rs.LockType = adLockOptimistic
    rs.ActiveConnection = DB
    Dim Product_Code As String
    Dim Product_Class As String
'    Dim Provider_Code As String
    Provider_Code = Right(Provider_Name.SelectedItem.Key, Len(Provider_Name.SelectedItem.Key) - 2)
    Product_Class = Right(Product_Name.SelectedItem.Key, Len(Product_Name.SelectedItem.Key) - 6)
    Product_Code = Left(Product_Name.SelectedItem.Key, Len(Product_Name.SelectedItem.Key) - Len(Product_Class))
    Product_Code = Right(Product_Code, 4)
    rs.Open "select * from PROVIDER_PRODUCT where Provider_Product_Code='" & Product_Code & "' and Provider_code='" & Provider_Code & "' and Provider_Product_Class='" & Product_Class & "'"
'    If rs.EOF = False Then Price.Text = " " & rs.Fields("Provider_Product_Price").value & "￥"
End Sub

Private Sub Provider_Name_KeyUp(KeyCode As Integer, Shift As Integer)
    Stock_Provider_Code = ""
End Sub

Private Sub Quantity_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 Quantity_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
        KeyAscii = 0
        Beep
        Exit Sub
    End If
    Dim pri As Integer
    Dim qua As Integer

End Sub

Private Sub quit_Click()
 Dim sure As VbMsgBoxResult
    sure = MsgBox("确定退出程序吗？", vbOKCancel + vbExclamation, App.EXEName)
    If sure = vbCancel Then Exit Sub
    End
End Sub

Private Sub Submit_Click()
    Dim sure As VbMsgBoxResult
    sure = MsgBox("确定添加吗？", vbOKCancel + vbExclamation, App.EXEName)
    If sure = vbCancel Then Exit Sub
    Call Check_Para
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.ToolTipText
    Case "新建订单"
        Call Find_Stock_Click
    Case "查找"
        Call Input_Stock_Click
    Case "关闭"
        End
    End Select
    
End Sub

Private Sub Tree_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'    If Button = vbRightButton Then
'    Me.PopupMenu Tree_Menu, vbPopupMenuLeftButton
'    End If
End Sub

Private Sub Tree_NodeClick(ByVal Node As MSComctlLib.Node)
If State = 1 Then
   If CheckBox1.value = True Then Exit Sub
   If CheckBox2.value = True Then Exit Sub
   Provider_Name.ComboItems.Clear
   Product_Name.ComboItems.Clear
    If Node.Children = 0 Then
        Set rs = New ADODB.Recordset
        rs.CursorType = adOpenDynamic
        rs.CursorLocation = adUseClient
        rs.LockType = adLockOptimistic
        rs.ActiveConnection = DB
        Dim Para As String
        Para = Right(Node.Key, Len(Node.Key) - 2)
        rs.Open "SELECT Product_Name,Product_Code,Product_Class FROM PRODUCT where Product_Class='" & Para & "'"
        Product_Name.ComboItems.Clear
        While rs.EOF = False
            Product_Name.ComboItems.Add , "PN" & rs.Fields("Product_Code").value & rs.Fields("Product_Class").value, rs.Fields("Product_Name").value
            rs.MoveNext
        Wend
        Call ChangeColor(Product_Name, True)
        Exit Sub
    End If
    Call ChangeColor(Product_Name, False)
    Call ChangeColor(Provider_Name, False)
End If

If State = 2 Then
    Dim strKey As String
    Dim strSQL As String
    Set rs = New ADODB.Recordset
    Set rs.ActiveConnection = DB
    rs.CursorLocation = adUseClient
    rs.CursorType = adOpenForwardOnly
    rs.LockType = adLockOptimistic
    If (Node.Key = "Root") Then
    strSQL = "select * from stock_info"
    Else
    strKey = Right(Node.Key, Len(Node.Key) - 2)
    strSQL = "select * from stock_info where left(stock_product_class,'" & Len(strKey) & "')='" & strKey & "'"
    End If
    rs.Open strSQL
    Set DataGrid1.DataSource = rs
End If
End Sub

Private Sub Check_Para()
    If Len(Provider_Name.Text) = 0 Or Len(Product_Name.Text) = 0 Or Len(Quantity.Text) = 0 Then
        MsgBox "：：产品参数不完整，修改后请重试！：：", vbOKOnly, App.EXEName
        Exit Sub
    End If
    If Fetch_Date.value < Stock_Date.value Then
        MsgBox "：：时间设置错误，订货日期不能比取货日期早！修改后请重试！：：", vbOKOnly, App.EXEName
        Exit Sub
    End If
    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenDynamic
    rs.CursorLocation = adUseClient
    rs.LockType = adLockOptimistic
    rs.ActiveConnection = DB
    
'    If CheckBox1.value = True Then
'        Stock_Product_Code = ""
'        Stock_Product_Class = ""
'    Else
'        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
'    End If
    Stock_Product_Name = Product_Name.Text
        
'    If CheckBox2.value = True Then
'        Stock_Provider_Code = " "
'    Else
'        Dim Provider_Code As String
'        Provider_Code = Right(Provider_Name.SelectedItem.Key, Len(Provider_Name.SelectedItem.Key) - 2)
'        Stock_Provider_Code = Provider_Code
'    End If
    Stock_Provider_Name = Provider_Name.Text
    
    S_Fetch_Date = Format(Fetch_Date.value, "yyyy-mm-dd")
    S_Stock_Date = Format(Stock_Date.value, "yyyy-mm-dd")
    Stock_Filiale_Name = Filiale_Name
    Stock_Filiale_Code = Filiale_Code
    Stock_Product_MEMO = MEMO.Text
    If Len(Stock_Product_Code) = 0 Or Len(Stock_Provider_Code) = 0 Then
        Is_New = True
    Else
        Is_New = False
    End If
    Stock_Quantity = Quantity.Text
    Stock_Product_Price = Price.Text
    rs.Open "INSERT INTO STOCK_INFO (Stock_Product_Code,Stock_Product_Class,Stock_Product_Name,Stock_Provider_Code,Stock_Provider_Name,Stock_Quantity,Stock_Date,Stock_Filiale_Code,Fetch_Date,Is_New,Stock_Filiale_Name,Stock_Product_MEMO,Stock_Product_Price )" & "VALUES ('" & Stock_Product_Code & "','" & Stock_Product_Class & "','" & Stock_Product_Name & "','" & Stock_Provider_Code & "','" & Stock_Provider_Name & "'," & Stock_Quantity & ",'" & Stock_Date & "','" & Stock_Filiale_Code & "','" & Fetch_Date & "'," & Is_New & ",'" & Stock_Filiale_Name & "','" & Stock_Product_MEMO & "','" & Stock_Product_Price & "')"
End Sub

Private Sub check_total_pa()
    If Len(Price.Text) = Len("") Then Quantity.Text = ""
    If Len(Price.Text) = Len("") Or Len(Quantity.Text) = 0 Then
        Total_Price.Caption = "合计："
    Exit Sub
    End If
End Sub




















'************************************************************


Private Sub Combo1_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub Combo2_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub



Private Sub Command1_Click()
    Dim strSQL As String
'    If Trim(Combo1.Text) = "" And Trim(Combo2.Text) = "" Then
'        MsgBox "请输入或选择项目！", vbExclamation, "上海华盟电讯科技公司"
'        Combo1.SetFocus
'        Exit Sub
'    End If
    
    If Trim(txtStart.Text) <> "" And Trim(txtEnd.Text) <> "" Then
        strSQL = "select * from stock_info where stock_product_name like '%" & Trim(Combo1.Text) & "%' and stock_provider_name like '%" & Trim(Me.Combo2.Text) & "%'  and stock_date >=#" & Format(Trim(txtStart.Text), "yyyy-mm-dd") & "# and stock_date<=#" & Format(Trim(Me.txtEnd.Text), "yyyy-mm-dd") & "#"
    ElseIf Trim(txtStart.Text) = "" And Trim(txtEnd.Text) = "" Then
        strSQL = "select * from stock_info where stock_product_name like '%" & Trim(Combo1.Text) & "%' and stock_provider_name like '%" & Trim(Me.Combo2.Text) & "%'"
    End If
     Set adoSRs = New ADODB.Recordset
    Set adoSRs.ActiveConnection = DB
    adoSRs.CursorLocation = adUseClient
    adoSRs.CursorType = adOpenForwardOnly
    adoSRs.LockType = adLockOptimistic
    adoSRs.Open strSQL
    Set DataGrid1.DataSource = adoSRs
End Sub



Private Sub DTPicker1_CloseUp()
    txtStart.Text = Format(DTPicker1.value, "yyyy-mm-dd")
End Sub

Private Sub DTPicker2_CloseUp()
    txtEnd.Text = Format(DTPicker2.value, "yyyy-mm-dd")
End Sub





Private Sub TabStrip1_Click()

End Sub

Private Sub TreeView_Collapse(ByVal Node As ComctlLib.Node)
  
  If Node.Tag = "FileManager" Then Node.Image = "Closed"
  If Node.Tag = "File" Then Node.Image = "SClosed"

End Sub

Private Sub TreeView_Expand(ByVal Node As ComctlLib.Node)
  
  If Node.Tag = "FileManager" Then Node.Image = "Open"
  If Node.Tag = "File" Then Node.Image = "SOpen"
  
End Sub

Private Sub TreeView_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

  If Button = 2 Then
     PopupMenu MnuControl
  End If
  
End Sub

Private Sub LI_Init_Tree(ByRef Tree As ComctlLib.TreeView)
    Dim Pre_LEN As Integer
    Dim Self_LEN As Integer
    Dim Depth As Integer
    Dim New_Node As ComctlLib.Node
    Dim Root_Node As ComctlLib.Node
    Dim Last_Node As ComctlLib.Node
    Dim Father_Node As ComctlLib.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", "产品信息", "Closed")
    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, "SClosed")
        If Depth = 0 Then Set New_Node = Tree.Nodes.Add(Last_Node, tvwNext, "AD" & rs.Fields("Class_Code").value, rs.Fields("class_Name").value, "SClosed")
        If Depth < 0 Then Set New_Node = Tree.Nodes.Add(Last_Node, tvwChild, "AD" & rs.Fields("Class_Code").value, rs.Fields("class_Name").value, "SClosed")
        Pre_LEN = Self_LEN
        Set Last_Node = New_Node
        rs.MoveNext
    Wend
End Sub

Private Sub txtEnd_GotFocus()
    Call AutoSelectText(txtEnd)
End Sub

Private Sub txtStart_GotFocus()
    Call AutoSelectText(txtStart)
End Sub