frmoutput.frm

系统主要以一电脑公司进销存管理为基本要求

         TabStop         =   0   'False
         Top             =   540
         Width           =   2025
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "添加客户"
         Height          =   180
         Left            =   450
         TabIndex        =   36
         Top             =   240
         Width           =   720
      End
      Begin VB.Label lblCName 
         AutoSize        =   -1  'True
         Caption         =   "名称:"
         Height          =   180
         Left            =   3630
         TabIndex        =   33
         Top             =   570
         Width           =   450
      End
      Begin VB.Label lblCPhone 
         AutoSize        =   -1  'True
         Caption         =   "电话:"
         Height          =   180
         Left            =   450
         TabIndex        =   32
         Top             =   1230
         Width           =   450
      End
      Begin VB.Label lblCaddr 
         AutoSize        =   -1  'True
         Caption         =   "地址:"
         Height          =   180
         Left            =   450
         TabIndex        =   31
         Top             =   900
         Width           =   450
      End
      Begin VB.Label lblCID 
         AutoSize        =   -1  'True
         Caption         =   "编号:"
         Height          =   180
         Left            =   450
         TabIndex        =   30
         Top             =   570
         Width           =   450
      End
   End
End
Attribute VB_Name = "frmOutput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Public Sub InitOutput()
  txtOID.Text = ""
  txtCount.Text = ""
  txtStoreCount.Text = ""
  txtPrice.Text = ""
  cobCustomer.Text = ""
  cobProduct.Text = ""
  cobBusinessman.Text = ""
End Sub
Public Sub InitAddCustomer()
  txtCID.Text = ""
  txtCName.Text = ""
  txtCAddr.Text = ""
  txtCPhone.Text = ""
End Sub
Private Sub SetCustomerID()
  Set rdoRS = rdoConn.OpenResultset("select count(*) c from customer")
    RowsInTable = rdoRS.rdoColumns("c")
    CID = "C" & Format(RowsInTable + 1, "000000000")
    txtCID.Text = CID
    rdoRS.Close
End Sub
Private Sub SetOutputID()
    Set rdoRS = rdoConn.OpenResultset("select count(o_id) c from output")
    RowsInTable = rdoRS.rdoColumns("c")
    OID = "O" & Format(RowsInTable + 1, "000000000")
    txtOID.Text = OID
    rdoRS.Close
End Sub
Public Sub IfCanAddOutput()
Dim CanAddOutput As Boolean
  CanAddOutput = (cobCustomer.Text <> "") And (cobProduct.Text <> "") _
               And (cobBusinessman.Text <> "") And (txtCount.Text <> "") _
               And txtOID.Text <> "" _
               And (txtYear.Text <> "") And (txtMonth.Text <> "") _
               And (txtDay.Text <> "") And (txtPrice.Text <> "") _

  If CanAddOutput Then
    cmdAddOutput.Enabled = True
  Else
    cmdAddOutput.Enabled = False
  End If
  
End Sub
Public Sub IfCanAddCustomer()
Dim CanAddCustomer As Boolean
  CanAddCustomer = (txtCID.Text <> "") And (txtCName.Text <> "")
  If CanAddCustomer Then
    cmdAddCustomer.Enabled = True
  Else
    cmdAddCustomer.Enabled = False
  End If
End Sub

Public Sub FillCustomer()
On Error GoTo ErrorHandle
    With cobCustomer
      .Clear
      .AddItem "<new>"
      Set rdoRS = rdoConn.OpenResultset("select c_name from customer")
      While Not rdoRS.EOF
        .AddItem rdoRS.rdoColumns("c_name").Value
        rdoRS.MoveNext
      Wend
      rdoRS.Close
    End With
Exit Sub
ErrorHandle:
  ShowErr
End Sub
Public Sub FillProduct()
  On Error GoTo ErrorHandle
    With cobProduct
      .Clear
      Set rdoRS = rdoConn.OpenResultset("select p_name,p_model from product")
      While Not rdoRS.EOF
        .AddItem rdoRS.rdoColumns("p_name").Value & " " & _
                 rdoRS.rdoColumns("p_model").Value
        rdoRS.MoveNext
      Wend
      rdoRS.Close
    End With
Exit Sub
ErrorHandle:
  ShowErr
End Sub
Public Sub FillBusinessman()
  On Error GoTo ErrorHandle
    With cobBusinessman
      .Clear
      Set rdoRS = rdoConn.OpenResultset("select b_name from businessman")
      While Not rdoRS.EOF
        .AddItem rdoRS.rdoColumns("b_name").Value
        rdoRS.MoveNext
      Wend
      rdoRS.Close
    End With
Exit Sub
ErrorHandle:
  ShowErr
End Sub

Private Sub cmdAddCustomer_Click()
  On Error GoTo ErrorHandle
    rdoConn.BeginTrans
    Set rdoRS = rdoConn.OpenResultset("select * from customer", rdUseServer, rdConcurRowver)
    With rdoRS
      .AddNew
      .rdoColumns("c_id") = txtCID.Text
      .rdoColumns("c_name") = txtCName.Text
      .rdoColumns("c_addr") = txtCAddr.Text
      .rdoColumns("c_phone") = txtCPhone.Text
      .Update
    End With
    rdoRS.Close
    rdoConn.CommitTrans
    MsgBox "客户资料已添加到数据库。", vbInformation, "Data Manager"
    Me.Height = 2520
    FillCustomer
    fraOutput.Enabled = True
    cmdAddOutput.Default = True
Exit Sub
ErrorHandle:
  ShowErr
End Sub

Private Sub cmdAddCustomerCancel_Click()
  Me.Height = 2520
  fraOutput.Enabled = True
  cobCustomer.SetFocus
  cmdAddOutput.Default = True
End Sub

Private Sub cmdAddOutput_Click()
Dim i As Integer
Dim M As String
Dim P As String
Dim found As Boolean

  found = False
  On Error GoTo ErrorHandle
    '查找商品编号
    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
    '查找客户编号
    found = False
    Set rdoRS = rdoConn.OpenResultset("select c_id,c_name from customer")
    While Not found And Not rdoRS.EOF
      If rdoRS.rdoColumns("c_name").Value = cobCustomer.Text Then
        found = True
        CID = rdoRS.rdoColumns("c_id").Value
      Else
        rdoRS.MoveNext
      End If
    Wend
    rdoRS.Close
    '查找业务员编号
    found = False
    Set rdoRS = rdoConn.OpenResultset("select b_id,b_name from businessman where b_name='" & cobBusinessman.Text & "'")
    While Not found And Not rdoRS.EOF
      If rdoRS.rdoColumns("b_name").Value = cobBusinessman.Text Then
        found = True
        BID = rdoRS.rdoColumns("b_id").Value
      Else
        rdoRS.MoveNext
      End If
    Wend
    rdoRS.Close
    '以上语句也可已通过一句select查询实现,但为了显示每一步的思路,故分步进行
    '修改库存
    found = False
    rdoConn.BeginTrans
    Set rdoRS = rdoConn.OpenResultset("select s_id,p_id,s_count from store", rdUseServer, rdConcurRowver)
    With rdoRS
      While Not found And Not .EOF
        If .rdoColumns("p_id") = PID Then
          found = True
          SID = .rdoColumns("s_id").Value
        Else
          .MoveNext
        End If
      Wend
      .Edit
      .rdoColumns("s_count").Value = .rdoColumns("s_count").Value - CLng(txtCount.Text)
      .Update
    End With
    rdoRS.Close
    '修改业务员业绩
    Set rdoRS = rdoConn.OpenResultset("select b_trades,b_name from businessman where b_name='" & cobBusinessman.Text & "'", rdUseServer, rdConcurRowver)
    rdoRS.Edit
    rdoRS.rdoColumns("b_trades") = rdoRS.rdoColumns("b_trades") + CLng(txtCount.Text) * CLng(txtPrice.Text)
    rdoRS.Update
    rdoRS.Close
    '向销售表格添加记录
    Set rdoRS = rdoConn.OpenResultset("select * from output", rdUseServer, rdConcurRowver)
    With rdoRS
      .AddNew
      .rdoColumns("o_id").Value = txtOID.Text
      .rdoColumns("p_id").Value = PID
      .rdoColumns("b_id").Value = BID
      .rdoColumns("c_id").Value = CID
      .rdoColumns("o_count").Value = CLng(txtCount.Text)
      .rdoColumns("o_price").Value = CSng(txtPrice.Text)
      .rdoColumns("o_date").Value = CDate(txtYear.Text & "/" & txtMonth.Text & "/" & txtDay.Text)
      .Update
    End With
    rdoRS.Close
    rdoConn.CommitTrans '事物处理确保表格之间数据的平衡
    MsgBox "出货数据已登记到数据库。", vbInformation, "Data Manager"
    InitOutput
    SetOutputID
Exit Sub
ErrorHandle:
  ShowErr
End Sub

Private Sub cmdCancelAddOutput_Click()
  Unload Me
End Sub

Private Sub cobBusinessman_Change()
  IfCanAddOutput
End Sub

Private Sub cobBusinessman_Click()
  IfCanAddOutput
End Sub

Private Sub cobCustomer_Change()
  IfCanAddOutput
End Sub

Private Sub cobCustomer_Click()
  IfCanAddOutput
  If cobCustomer.Text = "<new>" Then
    cobCustomer.Text = ""
    fraOutput.Enabled = False
    Me.Height = 4455
    InitAddCustomer
    SetCustomerID
    cmdAddCustomer.Default = True
  End If
End Sub

Private Sub cobProduct_Change()
  IfCanAddOutput
End Sub

Private Sub cobProduct_Click()
Dim found As Boolean
Dim StoreCount As Integer
  IfCanAddOutput
  On Error GoTo ErrorHandle
    found = False
    Set rdoRS = rdoConn.OpenResultset("select p_id,p_name,p_model from product")
    While Not found And Not rdoRS.EOF
      If rdoRS.rdoColumns("p_name").Value & " " & _
         rdoRS.rdoColumns("p_model").Value = cobProduct.Text Then
         found = True
         PID = rdoRS.rdoColumns("p_id").Value
      Else
        rdoRS.MoveNext
      End If
    Wend
    StoreCount = 0
    Set rdoRS = rdoConn.OpenResultset("select s_count from store where p_id='" & PID & "'")
    While Not rdoRS.EOF
      StoreCount = StoreCount + rdoRS.rdoColumns("s_count").Value
      rdoRS.MoveNext
    Wend
    txtStoreCount.Text = StoreCount
Exit Sub
ErrorHandle:
  ShowErr
End Sub

Private Sub Form_Load()
  
  Me.Height = 2520
  cmdAddOutput.Enabled = False
  txtYear.Text = Year(Now)
  txtMonth.Text = Month(Now)
  txtDay.Text = Day(Now)
  ShowStatus ("销售登记")
  Set rdoConn = New rdoConnection
  On Error GoTo ErrorHandle
    rdoConn.Connect = ConnectID
    rdoConn.EstablishConnection rdDriverNoPrompt, False
    FillCustomer
    FillProduct
    FillBusinessman
    SetOutputID
  Exit Sub
ErrorHandle:
  ShowErr
End Sub

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

Private Sub txtCID_Change()
  IfCanAddCustomer
End Sub

Private Sub txtCName_Change()
  IfCanAddCustomer
End Sub

Private Sub txtCount_Change()
  On Error GoTo ErrorHandle
  If (txtStoreCount.Text <> "") And (txtCount.Text <> "") Then
    If (CLng(txtCount.Text) > CLng(txtStoreCount.Text)) Then
      
      Err.Description = "交易数目大于库存量!"
      Err.Number = 3000
      Err.Raise 3000
    End If
  End If
  IfCanAddOutput
Exit Sub
ErrorHandle:
  ShowErr
  txtCount.Text = ""
End Sub

Private Sub txtDay_Change()
  IfCanAddOutput
End Sub

Private Sub txtMonth_Change()
  IfCanAddOutput
End Sub

Private Sub txtOID_Change()
  IfCanAddOutput
End Sub

Private Sub txtPrice_Change()
  IfCanAddOutput
End Sub

Private Sub txtYear_Change()
  IfCanAddOutput
End Sub