frmsale.frm

通用书店管理系统

'
'    strKey = "software\" & App.CompanyName & "\" & App.ProductName & "\库存管理"
'
'    If Registry.GetKeyValue(HKEY_LOCAL_MACHINE, strKey, "最近库区名称", strtemp) Then
'        strStorage = Trim(strtemp)
'    End If
     
     strStorage = GetLastInfo("software\" & App.CompanyName & "\" & App.ProductName & "\库存管理", "最近库区名称")
     
  Me.FrameMember.Visible = False
  
  With TdbSale
       .FetchRowStyle = False
       .Columns(4).FetchStyle = True
  End With
  frmLogin.Move 8600, 5300
  frmLogin.Show

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

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


  X.ReDim 0, -1, 0, 6
  Set TdbSale.Array = X
  
  TdbSale.Columns(0).Button = True
'
'  TdbSale.Columns(3).ForeColor = vbBlue
'  If TdbSale.Columns(4).Text = "1" Then TdbSale.Columns(4).ForeColor = vbRed
'  TdbSale.Columns(5).ForeColor = vbRed
'  TdbSale.Columns(6).ForeColor = vbBlue
  
  SetTdbGridStatus 3, 1, True, gColor_LockedText
  SetTdbGridStatus 4, 1
  SetTdbGridStatus 5
  SetTdbGridStatus 6, 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
        SaveLastInfo "software\" & App.CompanyName & "\" & App.ProductName & "\库存管理", "最近库区名称", Trim(cmbFields(0))
    End If
'    Dim strKey As String, strTemp As String
'    strTemp = Trim(cmbFields(0))
'    If strTemp <> "" Then
'        strKey = "Software\" & App.CompanyName & "\" & App.ProductName & "\库存管理"
'        Call Registry.UpdateKey(HKEY_LOCAL_MACHINE, strKey, "最近库区名称", strTemp)
'    End If
  
  
'  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

    ' 为了解决多个条码相同，用户进行选择后，选择内容跑到了下一行的情况。
    ' 或者重复记录处理后，位置出现了变化
    Dim FirstRow1, FirstRow3, Row1, Row3
    
    FirstRow1 = TdbSale.FirstRow
    Row1 = TdbSale.row
'            bk1 = TdbSale.GetBookmark(0)


   Select Case ColIndex
     Case 0
        SetZK
        
        sqlstring = "select chrBookNo,chrBookName,chrproducetype,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
            
            
            'Debug.Print "bk1=" & bk1
           Debug.Print "11111111 firstrow1,row1=" & FirstRow1 & " " & Row1
             Call g_CommonSelect("  书号  |  书名  | 制品类型 |  单价  |  折扣  |  数量 |  供货商  |  出版社  |  出版日期  ", "select t1.chrBookNo,t1.chrBookName,t1.chrproducetype,t1.DecPrice,t1.DecAgio,t2.IntAmount," & _
                               "t1.ChrGHS,t1.Chrbookconcern,t1.DatPublishDate from BookData t1 left join bookstorage t2 ON t1.chrbookno = t2.chrbookno and t1.chrbookname=t2.chrbookname where t1.chrBookNo like '%" & TdbSale.Columns(0).Text & "%'", "0,1,2,3,4,7", , , , -1, arrQuery)
'            bk2 = TdbSale.GetBookmark(0)
            'Debug.Print "bk2=" & bk2
           
           
           FirstRow3 = TdbSale.FirstRow
           Row3 = TdbSale.row
            
            TdbSale.Update
            
           Debug.Print "222222 firstrow3,row3=" & FirstRow3 & " " & Row3
           
            If FirstRow1 = "" Then
                TdbSale.FirstRow = 0
                TdbSale.row = 0
            Else
                TdbSale.FirstRow = FirstRow1
                TdbSale.row = Row1
            End If
            
            
            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(3) = arrQuery(0, 3)
               'TdbSale.Columns(4) = "3"
               TdbSale.Columns(6) = arrQuery(0, 3) * CDbl(txtFields(9).Text)
               If chkDefault.Value = 1 Then
                 TdbSale.Columns(4) = 1
            End If
               
                If CheckRepeatData(TdbSale.Columns(0), TdbSale.Columns(1)) Then
                        If Row3 > 0 Then Row3 = Row3 - 1
                End If
                
                   If FirstRow3 = "" Then
                        TdbSale.FirstRow = 0
                        TdbSale.row = 1
                    Else
                        TdbSale.FirstRow = FirstRow3
                        TdbSale.row = Row3
                    End If
        
                   End If
                
                
           Else
             TdbSale.Columns(0) = rstmp.Fields("chrBookNo").Value
             TdbSale.Columns(1) = rstmp.Fields("chrBookName").Value
             TdbSale.Columns(2) = rstmp.Fields("chrproducetype").Value
             TdbSale.Columns(3) = rstmp.Fields("decPrice").Value
'             SetZK
             'TdbSale.Columns(4) = "4"
             TdbSale.Columns(6) = rstmp.Fields("decPrice").Value * CDbl(txtFields(9).Text)
             If chkDefault.Value = 1 Then
                 TdbSale.Columns(4) = 1
             End If
                
            If CheckRepeatData(TdbSale.Columns(0), TdbSale.Columns(1)) Then
                If Row1 > 0 Then Row1 = Row1 - 1
            End If
            If FirstRow1 <> "" Then
                        TdbSale.FirstRow = FirstRow1
                        TdbSale.row = Row1
            End If
        
            'End If  ' checkrepeatdat

           End If       ' record count>1
           
        End If          ' not eof

   End Select
   TdbSale.Update                 ' lzw remark
   SendKeys "{HOME}{DOWN}"
   
      
'   lzw 2002-06-19
'If IsVacancy(TdbSale.Columns(0).Text) Then Exit Sub

    UpdateTotal
    
    
    
    
'   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
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, 4) + dblTotal
       dblTotalMoney = X(i, 3) * X(i, 4) + dblTotalMoney
       dblTotalFactMoney = X(i, 3) * X(i, 4) * CDbl(Format(X(i, 5), "#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"

   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 4, 5  '数量、折扣
       If TdbSale.Columns(3).Text <> "" And TdbSale.Columns(4).Text <> "" And TdbSale.Columns(5).Text <> "" Then
        TdbSale.Columns(6).Text = CStr(CInt(TdbSale.Columns(4).Text) * CDbl(TdbSale.Columns(3).Text) * CDbl(Format(TdbSale.Columns(5).Text, "#0.00")))
        For i = 0 To X.UpperBound(1)
            dblTotal = X(i, 4) + dblTotal
            dblTotalMoney = X(i, 3) * X(i, 4) + dblTotalMoney
            dblTotalFactMoney = X(i, 3) * X(i, 4) * CDbl(Format(X(i, 5), "#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(6).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_FetchCellStyle(ByVal Condition As Integer, ByVal Split As Integer, Bookmark As Variant, ByVal Col As Integer, ByVal CellStyle As TrueOleDBGrid70.StyleDisp)
Dim sqlstring As String
Dim rsNewTmp As New ADODB.Recordset

'    If TdbSale.Col = 4 Then
        sqlstring = "select IntAmount from BookStorage where chrBookNo ='" & TdbSale.Columns(0).CellText(Bookmark) & "' "
        Set rsNewTmp = New ADODB.Recordset
        rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If rsNewTmp.EOF Then Exit Sub
        Debug.Print rsNewTmp("IntAmount").Value
        If rsNewTmp("IntAmount").Value <= 1 Then
         
           'TdbSale.Columns(4).c = vbRed
           'CellStyle.BackColor = vbRed
           CellStyle.ForeColor = vbRed
        End If
'    End If

End Sub


Private Sub TdbSale_KeyDown(KeyCode As Integer, Shift As Integer)
  On Error Resume Next
  Dim strQuery As String
  Dim arrQuery
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  
  Dim i As Integer
  Dim dblTotal As Double '总数量
  Dim dblTotalMoney As Double '总码洋
  Dim dblTotalFactMoney As Double '总实洋
   
  If KeyCode = vbKeyReturn Then
    Debug.Print "keyreturn"
    If TdbSale.Col = 0 Then
    
'    SetZK
    
        If TdbSale.Text = "" Then
            TdbSale.Columns("书名").Text = ""
            txtFields(7).Text = txtFields(14).Text  ' 默认金额
            Me.txtFields(7).SetFocus
           
            Exit Sub
        End If
        
        
        SendKeys "{HOME}{