frmsale.frm

通用书店管理系统

         Index           =   5
         Left            =   2940
         TabIndex        =   16
         Top             =   240
         Width           =   945
      End
   End
End
Attribute VB_Name = "frmSale"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim rstmp As New ADODB.Recordset

Dim X As New XArrayDB          '从表1

Dim intFormState As Integer     '标示窗体的状态，“正常/浏览/新增/编辑”
Dim arrTemp() As Variant
Dim strDate As String

Dim blnIsModified As Boolean   '是否有输入或修改数据     True for changed
Dim blnSaveOk As Boolean       ' 是否保存数据成功



Public Sub cmdAddNew_Click()
    Dim i As Integer
    
    If Not checkpermission("书店管理系统", strUserName, , "销售管理.零售管理.图书零售.新增") Then
       Exit Sub
    End If
    If blnIsModified And intFormState = modEdit Then
        If MsgBox("当前内容有修改，要放弃吗？", vbOKCancel, "警告") <> vbOK Then
            Exit Sub
        End If
    End If
    
    setFormState (modadd)
  
     
    clearAll
    '获取最大单号
    txtFields(0).Text = GetMaxNo("chrSellNo", "SellTable", strDate)
    txtFields(10).Text = strUserName
    txtFields(11).Text = Format(Date, "yyyy-MM-dd")
    cmbFields(0).Text = strStorage
    TdbSale.SetFocus
    TdbSale.row = 0
    
    blnIsModified = False
    
    txtFields(13).SetFocus
End Sub

Public Sub CmdDelete_Click()
   On Error GoTo DelErr
   Dim sqlstring As String
   Dim rstmp As New ADODB.Recordset
   Dim rsNewTmp As New ADODB.Recordset
   
   If InStr(1, Me.Caption, "新增") > 0 Then
        Me.TdbSale.Delete
        Exit Sub
   End If
   
   If Not checkpermission("书店管理系统", strUserName, , "销售管理.零售管理.图书零售.删除") Then
       Exit Sub
   End If
   
   If txtFields(0).Text = "" Then
     MsgBox "请录入要删除的销售单号！", vbInformation
     Exit Sub
   End If
    
   cN.BeginTrans
  
   
   sqlstring = "select t1.*,chrStorageNo from SellTable_List t1 left join SellTable t2 on " & _
               " t1.chrSellNo=t2.chrSellNo  where t1.chrSellNo='" & txtFields(0).Text & "'"
   Set rsNewTmp = New ADODB.Recordset
   rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   
   Do While Not rsNewTmp.EOF
      sqlstring = "select * from BookStorage where chrBookNo='" & rsNewTmp.Fields("chrBookNo") & _
                "' and chrBookName='" & rsNewTmp.Fields("chrBookName") & "' and chrStorageNo='" & _
                rsNewTmp.Fields("chrStorageNo").Value & "'"
      Set rstmp = New ADODB.Recordset
      rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
      '库存中没有该图书的记录
      If rstmp.EOF Then
         MsgBox "库存表中没有图书" & rsNewTmp.Fields("chrBookNo") & " " & rsNewTmp.Fields("chrBookName") & _
                "的记录", , "警告"
         cN.RollbackTrans
         Exit Sub
      Else
         sqlstring = "Update BookStorage set IntAmount=" & rstmp.Fields("IntAmount") + rsNewTmp.Fields("intAmount") & _
                           " " & rstmp.Fields("DecCKSY") + rsNewTmp.Fields("DecCKSY") & " where chrBookNo='" & rstmp.Fields("chrBookNo") & "' and chrBookName='" & rstmp.Fields("chrBookName") & _
                           "' and chrStorageNo='" & rstmp.Fields("chrStorageNo") & "'"
         cN.Execute (sqlstring)
      End If
      rsNewTmp.MoveNext
   Loop
   
    '删除主表
   sqlstring = "delete from SellTable where chrSellNo='" & txtFields(0).Text & "'"
   cN.Execute sqlstring
   
   '删除从表
   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
    
    blnSaveOk = False
    
    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 "现金金额不能为空！", , "警告"
         txtFields(7).SetFocus
         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
    blnSaveOk = True            ' 保存成功
    Exit Sub
SaveErr:
'    cN.RollbackTrans
    MsgBox "保存记录出错：" & Err.Description, vbInformation
End Sub

Private Sub cmdSearch_Click(Index As Integer)
  Dim strQuery As String
  Dim arrQuery
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  
  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 t1.chrClientNo,t1.chrClientName,t1.chrLinkman,t1.chrAddress from ClientData t1 left join memberdata t2 ON " & _
                   "t1.chrClientNo=t2.chrClientNo where intFlag=1 and t2.ChrState='正常' order by t1.chrClientNo", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
            txtFields(13).Text = arrQuery(0, 0)
            
            sqlstring = "SELECT IntMemberNo, chrClientNo, ChrName, DatLoginDate, DatDQDate From MemberData where chrClientNo='" & txtFields(13).Text & "'"
            Set rstmp = New ADODB.Recordset
            rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
            If Not rstmp.EOF Then

                If DateDiff("d", Date, rstmp.Fields("DatDQDate")) <= 0 Then
                    MsgBox "会员卡已过期！", vbInformation
                    
                    txtFields(13).Text = ""
                    txtFields(13).SetFocus
                    Exit Sub
                Else

                    txtFields(12).Text = arrQuery(0, 1)
                    txtFields(13).SetFocus         ' 为了触发 validate 事件
                    SendKeys "{TAB}"
                End If
            End If

        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")
      
    If intFormState = modadd Then
        SetToolBar ("0011X00X001X111X1")
    End If
    
    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
  
    ' 读取最近使用的库区名称
'    Dim strtemp As String * 300, strKey As String