frminput.frm

公司进销存管理的实例

  If CanAddLog Then
    cmdAddLog.Enabled = True
  Else
    cmdAddLog.Enabled = False
  End If
End Sub

Private Sub cmdAdd_Click()

End Sub

Private Sub cmdCancel_Click()
  Me.Height = 2925
  fraLog.Enabled = True
  cobFactory.Text = ""
  cobProduct.Text = ""
  txtID.SetFocus
End Sub

Private Sub cmdAddFactory_Click()
  On Error GoTo ErrorHandle
  Set rdoRS = rdoConn.OpenResultset("select * from factory", , rdConcurRowver)
  rdoConn.BeginTrans
  With rdoRS
    .AddNew
    .rdoColumns("f_id") = txtFID.Text
    .rdoColumns("f_name") = txtFName.Text
    .rdoColumns("f_manager") = txtFManager.Text
    .rdoColumns("f_addr") = txtFAddr.Text
    .rdoColumns("f_phone") = txtFPhone.Text
    .Update
  End With
  rdoConn.CommitTrans
  rdoRS.Close
  MsgBox "厂商数据已添加到数据库。", vbInformation, "Data Manager"
  If LastTable = "Input" Then
    Me.Height = 2445
    fraLog.Enabled = True
    cobFactory.Text = txtFName.Text
    cmdAddLog.Default = True
  Else
    FillCobPFactory
    Me.Height = 4305
    fraAddProduct.Enabled = True
    cobPFactory.Text = txtFName.Text
    cmdAddProduct.Default = True
  End If
  FillCobFactory
  Exit Sub
ErrorHandle:
  ShowErr
End Sub

Private Sub cmdAddFactoryCancel_Click()
  If LastTable = "Input" Then
    Me.Height = 2445
    fraLog.Enabled = True
    cobFactory.Text = ""
    cobFactory.SetFocus
    cmdAddLog.Default = True
  Else
    Me.Height = 4185
    fraAddProduct.Enabled = True
    cobPFactory.Text = ""
    cobPFactory.SetFocus
    cmdAddProduct.Default = True
  End If
  FillCobProduct (True)
End Sub

Private Sub cmdAddLog_Click()
  
  Dim found As Boolean
  Dim P As String
  Dim M As String
  Dim i As Integer
  Dim Sameprice As Boolean
  Dim Price As Single
  
  found = False
  
  On Error GoTo ErrorHandle
    Price = CSng(txtPrice.Text)
    rdoConn.BeginTrans
    '取商品编号
    Set rdoRS = rdoConn.OpenResultset("Select p_id,p_name,p_model from product")
    While Not found And Not rdoRS.EOF
      i = InStr(cobProduct.Text, " ")
      P = Left(cobProduct.Text, i - 1)
      M = Mid(cobProduct.Text, i + 1)
      If (rdoRS.rdoColumns("p_name").Value = P) And (rdoRS.rdoColumns("p_model") = M) Then
        found = True
        PID = rdoRS.rdoColumns("p_id").Value
      Else
        rdoRS.MoveNext
    End If
    Wend
    rdoRS.Close
    '向进货表格添加记录
    Set rdoRS = rdoConn.OpenResultset("select * from input", , rdConcurRowver)
    With rdoRS
      .AddNew
      .rdoColumns("i_id") = txtInputID.Text
      .rdoColumns("p_id") = PID
      .rdoColumns("i_count") = CLng(txtCount.Text)
      .rdoColumns("i_inprice") = Price
      .rdoColumns("i_date") = CDate(txtYear.Text & "/" & txtMonth.Text & "/" & txtDay.Text)
      .Update
    End With
    rdoRS.Close
    '修改库存,
    '如果商品和进价与库存相同,则在原基础上增加库存量
    '否则添加一条记录
    found = False
    Sameprice = False
    SID = "NULL"
    Set rdoRS = rdoConn.OpenResultset("select count(s_id) c from store")
    RowsInTable = rdoRS.rdoColumns("c")
    rdoRS.Close
    Set rdoRS = rdoConn.OpenResultset("select * from store", rdUseServer, rdConcurRowver)
    While (Not found Or Not Sameprice) And Not rdoRS.EOF
      If PID = rdoRS.rdoColumns("p_id").Value Then
        If rdoRS.rdoColumns("s_inprice").Value = Price Then
          found = True
          Sameprice = True
          SID = rdoRS.rdoColumns("s_id").Value
        Else
          rdoRS.MoveNext
        End If
        
      Else
        rdoRS.MoveNext
      End If
    Wend
    If found And Sameprice Then
      rdoRS.Edit
      rdoRS.rdoColumns("s_count").Value = rdoRS.rdoColumns("s_count").Value + CLng(txtCount.Text)
      rdoRS.Update
    Else
      With rdoRS
        SID = "S" & Format(RowsInTable + 1, "000000000")
        .AddNew
        .rdoColumns("s_id") = SID
        .rdoColumns("p_id") = PID
        .rdoColumns("s_inprice") = Price
        .rdoColumns("s_count") = CLng(txtCount.Text)
        .Update
      End With
    End If
    rdoRS.Close
    rdoConn.CommitTrans '事物处理确保各表格之间数据的平衡
    MsgBox "进货数据已登记到数据库。", vbInformation, "Data Manager"
    InitAddLog
    SetInputID
    Exit Sub
ErrorHandle:
   ShowErr
End Sub

Private Sub cmdAddProduct_Click()
Dim found As Boolean
On Error GoTo ErrorHandle
'查找厂商编号
  Set rdoRS = rdoConn.OpenResultset("select f_id,f_name from factory")
  found = False
  While Not found And Not rdoRS.EOF
    If LCase(cobPFactory.Text) = LCase(rdoRS.rdoColumns("f_name").Value) Then
      found = True
      FID = rdoRS.rdoColumns("f_id").Value
    Else
      rdoRS.MoveNext
    End If
  Wend
  rdoRS.Close
  '向商品数据表添加记录
  rdoConn.BeginTrans
  Set rdoRS = rdoConn.OpenResultset("select * from product", , rdConcurRowver)
  With rdoRS
    .AddNew
    .rdoColumns("p_id") = txtPID.Text
    .rdoColumns("f_id") = FID
    .rdoColumns("p_name") = txtPName.Text
    .rdoColumns("p_model") = txtPModel.Text
    .Update
  End With
  rdoRS.Close
  rdoConn.CommitTrans
  MsgBox "商品数据已添加到数据库。", vbInformation, "Data Manager"
  Me.Height = 2445
  fraLog.Enabled = True
  FillCobProduct (True)
  cmdAddLog.Default = True
  Exit Sub
ErrorHandle:
  ShowErr
End Sub

Private Sub cmdAddProductCancel_Click()
  Me.Height = 2445
  fraLog.Enabled = True
  FillCobProduct (True)
  cobProduct.Text = ""
  cobProduct.SetFocus
  cmdAddLog.Default = True
End Sub

Private Sub cmdLogCancel_Click()
  Unload Me
End Sub

Private Sub cobFactory_Change()
  IfCanAddLog
End Sub

Private Sub cobFactory_Click()
  IfCanAddLog
  
  If cobFactory.Text = "<new>" Then
    cobFactory.Text = ""
    Me.Height = 4515
    fraAddProduct.Top = 8000
    fraAddFactory.Top = 2070
    fraLog.Enabled = False
    LastTable = "Input"
    InitAddFactory
    Set rdoRS = rdoConn.OpenResultset("select count(f_id) c from factory")
    RowsInTable = rdoRS.rdoColumns("c")
    txtFID.Text = "F" & Format(RowsInTable + 1, "000000000")
    rdoRS.Close
    cmdAddFactory.Default = True
  Else
    
    FillCobProduct (True)
  End If
End Sub

Private Sub cobPFactory_Change()
  IfCanAddProduct
End Sub

Private Sub cobPFactory_Click()
  IfCanAddProduct
  If cobPFactory.Text = "<new>" Then
    cobPFactory.Text = ""
    fraAddProduct.Enabled = False
    Me.Height = 6270
    fraAddFactory.Top = 3810
    LastTable = "Product"
    InitAddFactory
    Set rdoRS = rdoConn.OpenResultset("select count(f_id) c from factory")
    RowsInTable = rdoRS.rdoColumns("c")
    txtFID.Text = "F" & Format(RowsInTable + 1, "000000000")
    rdoRS.Close
    cmdAddFactory.Default = True
  End If
End Sub

Private Sub cobProduct_Change()
  IfCanAddLog
End Sub

Private Sub cobProduct_Click()
  IfCanAddLog
  If cobProduct.Text = "<new>" Then
    cobProduct.Text = ""
    Me.Height = 4185
    fraAddFactory.Top = 8000
    fraAddProduct.Top = 2070
    fraLog.Enabled = False
    LastTable = "Input"
    InitAddProduct
    Set rdoRS = rdoConn.OpenResultset("select count(p_id) c from product")
    RowsInTable = rdoRS.rdoColumns("c")
    txtPID.Text = "P" & Format(RowsInTable + 1, "000000000")
    rdoRS.Close
    FillCobPFactory
    txtPName.SetFocus
    cmdAddProduct.Default = True
  End If
End Sub

Private Sub Form_Load()
  Me.Height = 2445
  txtYear.Text = Year(Now)
  txtMonth.Text = Month(Now)
  txtDay.Text = Day(Now)
  ShowStatus ("进货登记")
On Error GoTo ErrorHandle
    
    Set rdoConn = New rdoConnection
    rdoConn.Connect = ConnectID
    rdoConn.EstablishConnection rdDriverNoPrompt, False
    SetInputID
    FillCobFactory
    FillCobProduct (True)
    
 Exit Sub
ErrorHandle:
    ShowErr
End Sub

Private Sub Form_Unload(Cancel As Integer)
  ShowStatus ("")
End Sub

Private Sub txtCount_Change()
  IfCanAddLog
End Sub

Private Sub txtDay_Change()
  IfCanAddLog
End Sub

Private Sub txtFID_Change()
  IfCanAddFactory
End Sub

Private Sub txtFName_Change()
  IfCanAddFactory
End Sub

Private Sub txtModel_Change()
  IfCanAddLog
End Sub

Private Sub txtInputID_Change()
  IfCanAddLog
End Sub

Private Sub txtMonth_Change()
  IfCanAddLog
End Sub

Private Sub txtPID_Change()
  IfCanAddProduct
End Sub

Private Sub txtPName_Change()
  IfCanAddProduct
End Sub

Private Sub txtPPrice_Change()
  IfCanAddProduct
End Sub

Private Sub txtPrice_Change()
  IfCanAddLog
End Sub

Private Sub txtYear_Change()
  IfCanAddLog
End Sub