frmsale_old.frm

通用书店管理系统

   On Error Resume Next
   Cancel = True

   Select Case ColIndex
     Case 0 '书号
       sqlstring = "select * from BookData where chrBookNo ='" & TdbSale.Columns(ColIndex).Text & "'"
     Case 1 '书名
       sqlstring = "select * from BookData where chrBookName ='" & TdbSale.Columns(ColIndex).Text & "'"
     Case 3, 4  '数量、折扣
       If TdbSale.Columns(2).Text <> "" And TdbSale.Columns(3).Text <> "" And TdbSale.Columns(4).Text <> "" Then
        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
     Else
        TdbSale.Columns(5).Text = 0
     End If
     Cancel = False
     Exit Sub
   End Select
   
   Set rsNewTmp = New ADODB.Recordset
   rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   If rsNewTmp.Recordcount = 0 Then
      MsgBox "图书资料表中没有该书的记录，请确认录入是否有误！", vbInformation
      Cancel = True
      SendKeys "%{Up}"
      Exit Sub
   End If
   Cancel = False
End Sub


Private Sub TdbSale_ButtonClick(ByVal ColIndex As Integer)
 Call TdbSale_KeyDown(vbKeyF2, 0)   '
End Sub

Private Sub TdbSale_KeyDown(KeyCode As Integer, Shift As Integer)
  On Error Resume Next
  Dim strQuery As String
  Dim arrQuery
  
  Dim i As Integer
  Dim dblTotal As Double '总数量
  Dim dblTotalMoney As Double '总码洋
  Dim dblTotalFactMoney As Double '总实洋
   
  If KeyCode = vbKeyReturn Then
    If TdbSale.Col = 0 Then
        If TdbSale.Text = "" Then
            TdbSale.Columns("书名").Text = ""
            Me.Txtfields(7).SetFocus
            Exit Sub
        End If
        TdbSale.Col = 2
        TdbSale.SetFocus
        Exit Sub
    End If
    If TdbSale.Col = 4 Then
        SendKeys "{HOME}{DOWN}"
        'SendKeys "{DOWN}"
'        TdbSale.row = TdbSale.row + 1
'        TdbSale.Col = 0
'        TdbSale.Text = "test"
        Exit Sub
    End If
  End If
  
  If chkIfMember.Value = 1 And Trim(Txtfields(3).Text) = "" Then
     MsgBox "请先录入会员卡号！", , "警告"
     Exit Sub
  End If
  
  '按F2键弹出选择框
  If KeyCode = vbKeyF2 Then
     Select Case TdbSale.Col
       Case 0
           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
       Case 1
           Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookName like '%" & TdbSale.Columns(1).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
       Case Else
         Exit Sub
     End Select
  End If
  
'  tdbSale.Update
'   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_KeyPress(KeyAscii As Integer)
   '限制输入条件必须为数字或某些特殊字符
    If TdbSale.Col = 0 Then
       KeyAscii = ValiText(KeyAscii, vbExpChar, "0123456789", TdbSale.Columns(TdbSale.Col).Text, 13)
    ElseIf TdbSale.Col = 3 Or TdbSale.Col = 4 Then
       KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", TdbSale.Columns(TdbSale.Col).Text)
    End If
    
    
End Sub


Private Sub tdbSale_BeforeUpdate(Cancel As Integer)

    Dim i As Integer

Debug.Print Now & "beforeupdate"

    If Not TdbSale.DataChanged Then
        Exit Sub
    End If
       '------------判断一行是否为空,如果是则自动删除-------------------
    Dim intRowCount As Integer

    If intFormState = modadd Or intFormState = modEdit Then
        intRowCount = 0
        For i = 0 To x.UpperBound(2) - 1                         '检验每一列数据,该Max_x_col是 X的最大列值,而(Max_x_col-1)是Grddetail控件的最大列值
            If Not IsVacancy(TdbSale.Columns(i).Value) Then
               Exit For
            End If
            intRowCount = intRowCount + 1
        Next i
        If intRowCount = x.UpperBound(2) Then
            TdbSale.ReBind
            Exit Sub
        End If
    End If
End Sub

Private Sub tdbSale_Change()
    Debug.Print Now & "change"
    blnIsModified = True
End Sub

Private Sub tdbSale_Error(ByVal DataError As Integer, response As Integer)
    response = 0
End Sub

Private Sub tdbSale_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    '在这里，防止光标停留在被锁定的列上

    'Exit Sub
Debug.Print Now & "rowcolchange"
Debug.Print "begin col=" & TdbSale.Col



    Select Case TdbSale.Col
    Case 2, 5

        If LastCol = -1 Then Exit Sub

        If TdbSale.Col = 0 Then
            TdbSale.Col = LastCol
            Exit Sub
        End If

        If TdbSale.Col = TdbSale.Columns.Count - 1 Then
            TdbSale.Col = LastCol
            Exit Sub
        End If

        If TdbSale.Col > LastCol Then
            If TdbSale.Col < TdbSale.Columns.Count - 1 Then TdbSale.Col = TdbSale.Col + 1
        Else
            If TdbSale.Col > 0 Then TdbSale.Col = TdbSale.Col - 1
        End If
    End Select
Debug.Print "col=" & TdbSale.Col
End Sub




Private Sub TxtFields_Change(Index As Integer)
   On Error Resume Next
   Select Case Index
     Case 6 '支票
        Txtfields(8).Text = Format(CDbl(Txtfields(7)) + CDbl(Txtfields(6)) - CDbl(Txtfields(5)), "#,##0.00")
     Case 7 '现金
            Txtfields(8).Text = Format(CDbl(Txtfields(7)) + CDbl(Txtfields(6)) - CDbl(Txtfields(5)), "#,##0.00")
   End Select
End Sub

Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
    End If
End Sub

Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
  If Index = 0 Then
     KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", Txtfields(Index).Text)
  ElseIf Index = 3 Then
     KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", Txtfields(Index).Text, 6)
  ElseIf Index = 9 Then
     KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", Txtfields(Index).Text)
  End If
End Sub


'--------------------------------------------------------------------------------
'功能：    设置TDBGRID列的属性 如对齐方式、是否锁定、背景色等

'参数说明：

'          intCol           列号
'          intAlignment     对齐方式  0 左对齐    1 右对齐    2 居中（默认为2）
'          blnLock          是否锁定列  TRUE 锁定  FALSE 可编辑 （默认为FALSE）
'          strBackColor     列背景色  默认为白色
'          blnVisible       是否可见

'返回值：  ()
'--------------------------------------------------------------------------------
Private Sub SetTdbGridStatus(ByVal intCol As Integer, Optional intAlignment = 2, _
                            Optional blnlock = False, Optional strBackColor = vbWhite, Optional blnVisible = True)
  On Error Resume Next

    
  TdbSale.Columns(intCol).Locked = blnlock
  TdbSale.Columns(intCol).Alignment = intAlignment
  TdbSale.Columns(intCol).BackColor = strBackColor
  TdbSale.Columns(intCol).Visible = blnVisible
End Sub



Private Sub setFormState(intState As Integer)   '设置窗体的不同状态
    
    intFormState = intState
    Select Case intState
        Case ModNormal
            Me.Caption = "图书零售"
            setTxtWritable ("1000000000000")
    
            TdbSale.AllowAddNew = False
            TdbSale.AllowUpdate = False
            TdbSale.AllowDelete = False
            SetToolBar ("1000X10X111X111X1")
    
    
        Case modBrowsing
            Me.Caption = "图书零售----浏览"
            setTxtWritable ("1000000000000")
    
            TdbSale.AllowAddNew = False
            TdbSale.AllowUpdate = False
            TdbSale.AllowDelete = False
            SetToolBar ("1000X10X111X111X1")
        Case modadd
            Me.Caption = "图书零售----新增"
    
            setTxtWritable ("00010011010010")
    
            TdbSale.AllowAddNew = True
            TdbSale.AllowUpdate = True
            TdbSale.AllowDelete = True
            SetToolBar ("0011X00X001X111X1")
        Case modEdit
            Me.Caption = "图书零售----修改"
            setTxtWritable ("00010001010010")
    
            TdbSale.AllowAddNew = False
            TdbSale.AllowUpdate = True
            TdbSale.AllowDelete = True
            SetToolBar ("0011X00X001X111X1")
    End Select

End Sub

Private Sub clearAll()          '清除所有可填数据的位置
    Dim i As Integer
    
    For i = 0 To Txtfields.UBound
        Select Case i
          Case 1 '总数量
              Txtfields(i).Text = "0"
          Case 1, 2, 5, 8 '总码洋、实收、找零
              Txtfields(i).Text = "0.00"
           Case 6, 7 '支票、现金
              Txtfields(i).Text = "0"
          Case 9 '折扣
              Txtfields(i).Text = "1.00"
          Case Else
              Txtfields(i).Text = ""
        End Select
    Next i
    
    x.ReDim 0, -1, 0, 5
    TdbSale.ReBind
    
    cmbFields(0).Text = ""
    
    frmLogin.txtTotal(0).Text = "0"
    frmLogin.txtTotal(1).Text = "0.00"
    frmLogin.txtTotal(2).Text = "0.00"
    
End Sub

Private Sub setTxtWritable(strIn As String)     '设置各文本框的可写属性
    Dim i As Integer
    
    For i = 0 To Txtfields.UBound
        If Mid(strIn, i + 1, 1) = 1 Then
            Txtfields(i).Locked = False
            Txtfields(i).BackColor = RGB(255, 255, 255)
        Else
            Txtfields(i).Locked = True
            Txtfields(i).BackColor = gColor_LockedText
        End If
    Next i
End Sub


'保存新增的记录
Private Fu