frmsale_old.frm

通用书店管理系统

   '删除从表
   sqlstring = "delete from SellTable_List where chrSellNo='" & Txtfields(0).Text & "'"
   cN.Execute sqlstring
   
   cN.CommitTrans
   
   setFormState (ModNormal)
   Call clearAll
   Exit Sub
DelErr:
   cN.RollbackTrans
   MsgBox "删除记录失败：" & Err.Description, vbInformation
End Sub

Public Sub cmdEdit_Click()
    setFormState (modEdit)
    blnIsModified = False           '初始状态，没做任何修改
End Sub

Public Sub cmdQuery_Click()
  On Error GoTo Err
  Dim sqlstring As String
  Dim rsNewTmp As New ADODB.Recordset
  
  If Txtfields(0).Text = "" Then
     MsgBox "请输入要查询的销售单号！", vbInformation
  Else
     If ShowMainRecorder Then
        Call ShowSubRecorder
     Else
        MsgBox "没有要查询的销售单信息，输入是否有误？"
        Exit Sub
     End If
  End If
  Exit Sub
Err:
   MsgBox "查询数据失败：" & Err.Description, vbInformation
End Sub


Private Sub chkIfMember_Click()

'  If chkIfMember.Value = 1 Then
'     Label1(3).Visible = True
'     Label1(4).Visible = True
'     txtFields(3).Visible = True
'     txtFields(4).Visible = True
'
'  Else
'     Label1(3).Visible = False
'     Label1(4).Visible = False
'     txtFields(3).Visible = False
'     txtFields(4).Visible = False
'
'  End If
End Sub

Public Sub cmdcancel_Click()
   Unload Me
End Sub

Public Sub cmdSave_Click()
      On Error GoTo SaveErr
    Dim i As Integer
    Dim intIsCancel As Integer
    Dim sqlstring As String
    Dim rsNewTmp As New ADODB.Recordset
    Dim strNull
    
    If Trim(Txtfields(6)) = "" Then Txtfields(6) = "0"
    If Trim(Txtfields(7)) = "" Then Txtfields(7) = "0"
    
    strNull = Null
    
    tdbSale_BeforeUpdate intIsCancel                        '检查从表一
    If intIsCancel = True Then
        TdbSale.SetFocus
        Exit Sub
    End If

    TdbSale.Update
    If x.UpperBound(1) < 0 Then
        MsgBox "销售单明细数据不能为空", vbOKOnly, "警告"
        Exit Sub
    End If
    
    '检查供应商号和销售单号是否为空
    If Trim(Txtfields(0).Text) = "" Then
          MsgBox "销售单号不能为空！", , "警告"
          Exit Sub
    ElseIf Trim(Txtfields(9).Text) = "" Then
          MsgBox "折扣不能为空！", , "警告"
          Exit Sub
    End If
    
    '是会员
    If chkIfMember.Value = 1 Then
       If Txtfields(13).Text = "" Then
          MsgBox "客户编码不能为空！", , "警告"
          Exit Sub
       ElseIf Txtfields(3).Text = "" Then
          MsgBox "会员卡号不能为空！", , "警告"
          Exit Sub
       End If
    End If
    
    '检查库区号、销售类型、销售方式和付款方式是否为空
    If cmbFields(0).Text = "" Then
          MsgBox "库区号不能为空！", , "警告"
          Exit Sub
    End If
    
    If Trim(Txtfields(7).Text) = "0.00" Or Trim(Txtfields(7).Text) = "0" Then
         MsgBox "现金金额不能为空！", , "警告"
         Exit Sub
    End If
    
    Select Case intFormState
        Case modadd
            If SaveAddingNew Then
                strStorage = cmbFields(0).Text
                setFormState modBrowsing       '如果保存成功
                blnIsModified = False
            Else
                Exit Sub
            End If
'        Case modEdit
'            If SaveUpdate Then
'                setFormState modBrowsing         '如果更新成功
'                blnIsModified = False
'            Else
'                Exit Sub
'            End If
        Case Else
            Exit Sub
    End Select
    
    Call clearAll
    blnIsModified = False
    Exit Sub
SaveErr:
'    cN.RollbackTrans
    MsgBox "保存记录出错：" & Err.Description, vbInformation
End Sub

Private Sub cmdSearch_Click(Index As Integer)
  Dim strQuery As String
  Dim arrQuery
  
  Select Case Index
    Case 0
        strQuery = g_CommonSelect("   销售单号   |    库区号   |   销售数量  |  码洋  |  应收  |  现金  |  找零  |  销售日期  |  业务员  |  客户编码  |  会员号  ", "select ChrSellNo,ChrStorageNo,IntTotal,DecZMY,DecYS," & _
                                     "DecCash,DecZL,DatDate,ChrMissionary,ChrClientNo,IntMemberNo from SellTable where ChrSellType='零售'")
        Txtfields(0).Text = strQuery
    Case 1
        strQuery = g_CommonSelect("   客户编码   |    客户名称   |   联系人  |  地址  ", "select chrClientNo,chrClientName,chrLinkman,chrAddress from ClientData where intFlag=1 order by chrClientNo", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
             Txtfields(13).Text = arrQuery(0, 0)
             Txtfields(12).Text = arrQuery(0, 1)
        End If
        
        
    Case 2
        strQuery = g_CommonSelect("   会员卡号   |    客户编码   |   姓名  |  级别  ", "select IntMemberNo,chrClientNo,ChrName,ChrLevel from MemberData where ChrState='正常' order by IntMemberNo", "0,3", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
             Txtfields(3).Text = arrQuery(0, 0)
             Txtfields(4).Text = arrQuery(0, 1)
        End If
  End Select
End Sub

Public Sub cmdUndo_Click()
   '询问是否放弃当前内容
    If blnIsModified Then
        If MsgBox("当前修改的内容会丢失。确认要取消吗？", vbOKCancel, "询问") <> vbOK Then Exit Sub
    End If
    clearAll
    setFormState (ModNormal)
    blnIsModified = False
End Sub

Private Sub Form_Activate()
    frmLogin.Show
   SetToolBar ("1000X10X111X111X1")
   Me.SetFocus
   
   
   
End Sub

Private Sub Form_Deactivate()
    frmLogin.Hide
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyA And Shift = 2 Then
     If intFormState = modBrowsing Or intFormState = ModNormal Then
        Call cmdAddNew_Click
     End If
  ElseIf KeyCode = vbKeyS And Shift = 2 Then
     If intFormState = modadd Or intFormState = modEdit Then
        Call cmdSave_Click
     End If
  End If
End Sub

Private Sub Form_Load()
  Dim sqlstring As String
  Dim rsNewTmp As New ADODB.Recordset
  
  On Error GoTo Err
  
  frmLogin.Move 8600, 5300
  frmLogin.Show

  '初始化变量
  intFormState = ModNormal
  blnIsModified = False

  '初始化控件状态
  Me.WindowState = vbMaximized
  strDate = Format(Date, "yyyymmdd")
  
  setFormState (ModNormal)


  x.ReDim 0, -1, 0, 5
  Set TdbSale.Array = x
  
  TdbSale.Columns(0).Button = True

    

  SetTdbGridStatus 2, 1, True, gColor_LockedText
  SetTdbGridStatus 3, 1
  SetTdbGridStatus 4
  SetTdbGridStatus 5, 1, True, gColor_LockedText
  
  
   '库区名称
  sqlstring = "select * from StorageSection order by ChrStorageNo"
  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  cmbFields(0).Clear
  Do While Not rsNewTmp.EOF
    cmbFields(0).AddItem Trim(rsNewTmp("ChrStorageName").Value)
    rsNewTmp.MoveNext
  Loop
  
  Exit Sub
Err:
  MsgBox "打开记录集失败：" & Err.Description, vbInformation
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If Trim(cmbFields(0)) <> "" Then
    strStorage = cmbFields(0)
  End If
  Unload frmLogin
  SetToolBar ("0000X00X001X111X1")
End Sub




Private Sub tdbSale_AfterColUpdate(ByVal ColIndex As Integer)
   Dim i As Integer
   Dim dblTotal As Double '总数量
   Dim dblTotalMoney As Double '总码洋
   Dim dblTotalFactMoney As Double '总实洋
   Dim rstmp As New ADODB.Recordset
   Dim sqlstring As String
   Dim arrQuery
   
   Debug.Print "aftercolupdate"
   
   On Error Resume Next

   Select Case ColIndex
     Case 0
        sqlstring = "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                    " from BookData where chrBookNo='" & TdbSale.Columns(0).Value & "'"
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If Not rstmp.EOF Then
           If rstmp.Recordcount > 1 Then
             Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookNo like '%" & TdbSale.Columns(0).Text & "%'", "0,1,2,3,6", , , , -1, arrQuery)
             If TypeName(arrQuery) = "Variant()" Then
               TdbSale.Columns(0) = arrQuery(0, 0)
               TdbSale.Columns(1) = arrQuery(0, 1)
               TdbSale.Columns(2) = arrQuery(0, 2)
               TdbSale.Columns(4) = Txtfields(9).Text
               TdbSale.Columns(5) = arrQuery(0, 2) * CDbl(Txtfields(9).Text)
               If chkDefault.Value = 1 Then
                 TdbSale.Columns(3) = 1
               End If
             End If
           Else
             TdbSale.Columns(0) = rstmp.Fields("chrBookNo").Value
             TdbSale.Columns(1) = rstmp.Fields("chrBookName").Value
             TdbSale.Columns(2) = rstmp.Fields("decPrice").Value
             TdbSale.Columns(4) = Txtfields(9).Text
             TdbSale.Columns(5) = rstmp.Fields("decPrice").Value * CDbl(Txtfields(9).Text)
             If chkDefault.Value = 1 Then
                 TdbSale.Columns(3) = 1
             End If
           End If
        End If

   End Select
   TdbSale.Update

   If IsVacancy(TdbSale.Columns(0).Text) Then Exit Sub


   TdbSale.Columns(5).Text = CStr(CInt(TdbSale.Columns(3).Text) * CDbl(TdbSale.Columns(2).Text) * CDbl(Format(TdbSale.Columns(4).Text, "#0.00")))
   
   For i = 0 To x.UpperBound(1)
       dblTotal = x(i, 3) + dblTotal
       dblTotalMoney = x(i, 2) * x(i, 3) + dblTotalMoney
       dblTotalFactMoney = x(i, 2) * x(i, 3) * CDbl(Format(x(i, 4), "#0.00")) + dblTotalFactMoney
   Next
   Txtfields(1).Text = Format(dblTotal, "#,##0")
   Txtfields(2).Text = Format(dblTotalMoney, "#,##0.00")
   Txtfields(5).Text = Format(dblTotalFactMoney, "#,##0.00")

   frmLogin.txtTotal(0).Text = Txtfields(1).Text
   frmLogin.txtTotal(1).Text = Txtfields(2).Text
   frmLogin.txtTotal(2).Text = Txtfields(5).Text
End Sub

Private Sub tdbSale_AfterDelete()
   Dim i As Integer
   Dim dblTotal As Double '总数量
   Dim dblTotalMoney As Double '总码洋
   Dim dblTotalFactMoney As Double '总实洋
   On Error Resume Next


   For i = 0 To x.UpperBound(1)
       dblTotal = x(i, 3) + dblTotal
       dblTotalMoney = x(i, 2) * x(i, 3) + dblTotalMoney
       dblTotalFactMoney = x(i, 2) * x(i, 3) * CDbl(Format(x(i, 4), "#0.00")) + dblTotalFactMoney
   Next
   Txtfields(1).Text = Format(dblTotal, "#,##0")
   Txtfields(2).Text = Format(dblTotalMoney, "#,##0.00")
   Txtfields(5).Text = Format(dblTotalFactMoney, "#,##0.00")

   frmLogin.txtTotal(0).Text = Txtfields(1).Text
   frmLogin.txtTotal(1).Text = Txtfields(2).Text
   frmLogin.txtTotal(2).Text = Txtfields(5).Text
End Sub

Private Sub tdbSale_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
   Dim i As Integer
   Dim dblTotal As Double '总数量
   Dim dblTotalMoney As Double '总码洋
   Dim dblTotalFactMoney As Double '总实洋
   Dim sqlstring As String
   Dim rsNewTmp As New ADODB.Recordset

Debug.Print "beforecolupdate"