frmback.frm

< 飞鸿商品>>零售是基于VB+SQL2000开的商品零售管理系统. 开发的很好.可以一看

  tmr.Enabled = True
End Sub

Private Sub Grid_KeyUp(KeyCode As Integer, Shift As Integer)
  Select Case KeyCode
    Case vbKeyReturn
      If Grid.Rows <= 1 Then Exit Sub
      Dim K As Boolean
      K = BackFoot(lblSum.Caption)
      If K = False Then Exit Sub
      
      Dim Cmd As ADODB.Command
      Dim SQL As String
      Dim I As Integer
      
      Conn.BeginTrans
      
      Set Cmd = New ADODB.Command
      Cmd.ActiveConnection = Conn
      For I = 1 To Grid.Rows - 1
        
        SQL = "insert into backsell_list values('" & Grid.TextMatrix(I, 1) & "','" _
            & Format(Date$, "yyyy-mm-dd") & "','" & Format(Time$, "hh:mm:ss") & "','" _
            & Grid.TextMatrix(I, 5) & "'," & Grid.TextMatrix(I, 6) & "," & Grid.TextMatrix(I, 8) & _
            "," & Grid.TextMatrix(I, 9) & "," & Grid.TextMatrix(I, 7) & ",'" & UserName & "'," & _
            BackCost(I) & ")"
        Cmd.CommandText = SQL
        Cmd.CommandType = adCmdText
        Cmd.Execute
        SQL = "update yaopin_num set num=num+" & Grid.TextMatrix(I, 9) & " where id='" & Grid.TextMatrix(I, 1) & "'"
        Cmd.CommandText = SQL
        Cmd.CommandType = adCmdText
        Cmd.Execute
      Next
      
      Conn.CommitTrans
      
      Call ReSet
    Case vbKeyF3
      Call ReSet
    Case vbKeyF4
      If Grid.Rows = 1 Then Exit Sub
      txtNum.Top = Grid.Top + Grid.RowHeight(Grid.RowSel) * Grid.RowSel + 5
      txtNum.Visible = True
      txtNum.SetFocus
      txtNum.Text = Grid.TextMatrix(Grid.RowSel, 7)
      txtNum.SelStart = 0
      txtNum.SelLength = Len(txtNum.Text)
      Grid.Enabled = False
    Case vbKeyF5
      If Grid.Rows = 1 Then Exit Sub
      txtZK.Top = Grid.Top + Grid.RowHeight(Grid.RowSel) * Grid.RowSel + 5
      txtZK.Visible = True
      txtZK.SetFocus
      txtZK.Text = Grid.TextMatrix(Grid.RowSel, 8)
      txtZK.SelStart = 0
      txtZK.SelLength = Len(txtZK.Text)
      Grid.Enabled = False
    Case vbKeyF6
      fra.Visible = True
      Grid.Enabled = False
      txtTM.SetFocus
    Case vbKeyDelete, vbKeyBack
      Dim SumCash As Currency
      
      If Grid.RowSel = 0 Then Exit Sub
      If Grid.Rows = 2 Then ReSet: Exit Sub
      BackDList.Remove Grid.RowSel
      BackCost.Remove Grid.RowSel
      Grid.RemoveItem Grid.RowSel
      For I = 1 To Grid.Rows - 1
        SumCash = SumCash + Val(Grid.TextMatrix(I, 10))
      Next
      lblSum.Caption = Format(CStr(SumCash), ".00")
            
      For I = 1 To Grid.Rows - 1
        Grid.TextMatrix(I, 0) = CStr(I)
      Next
    Case vbKeyF9
      Unload Me
  End Select
End Sub

Private Sub tmr_Timer()
Dim I As Integer

tmr.Enabled = False
If Id = "" Then Exit Sub

For I = 1 To BackDList.Count
  If Id = BackDList(I) Then
    Grid.TextMatrix(I, 7) = CStr(Val(Grid.TextMatrix(I, 7)) + 1)
    Grid.TextMatrix(I, 10) = Format(CStr(Val(Grid.TextMatrix(I, 7)) * Grid.TextMatrix(I, 9)), ".00")
    GoTo ee
  End If
Next

Dim Rst As ADODB.Recordset
Dim CRst As ADODB.Recordset
Dim SQL As String
Dim SumCash As Currency
Dim IDs As String
Dim Cost As String

SQL = "select a.id,a.cost from yaopin_cost as a,yaopin_list as b where a.id=b.id and b.tiaoma='" & Id & "'"
Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Rst.Open SQL, Conn, adOpenDynamic, adLockReadOnly, adCmdText
If Rst.EOF Then Exit Sub
IDs = CStr(Rst.Fields(0))
Cost = CStr(Rst.Fields(1))

SQL = "select id,name,guige,changjia,unit,price from v_yaopin_list where tiaoma='" & Id & "'"
Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Rst.Open SQL, Conn, adOpenStatic, adLockReadOnly, adCmdText
If Rst.EOF Then Id = "": Exit Sub

SQL = "select * from yaopin_cost where id='" & Rst.Fields("id") & "'"
Set CRst = New ADODB.Recordset
CRst.CursorLocation = adUseClient
CRst.Open SQL, Conn, adOpenDynamic, adLockReadOnly, adCmdText
If CRst.EOF Then Exit Sub
Set CRst = Nothing

Grid.Rows = Grid.Rows + 1
Grid.TextMatrix(Grid.Rows - 1, 0) = Grid.Rows - 1
Grid.TextMatrix(Grid.Rows - 1, 1) = Rst.Fields("id")
Grid.TextMatrix(Grid.Rows - 1, 2) = Rst.Fields("name")
Grid.TextMatrix(Grid.Rows - 1, 3) = Rst.Fields("guige")
Grid.TextMatrix(Grid.Rows - 1, 4) = Rst.Fields("changjia")
Grid.TextMatrix(Grid.Rows - 1, 5) = Rst.Fields("unit")
Grid.TextMatrix(Grid.Rows - 1, 6) = Format(Rst.Fields("price"), ".00")
Grid.TextMatrix(Grid.Rows - 1, 7) = "1"
Grid.TextMatrix(Grid.Rows - 1, 8) = "1"
Grid.TextMatrix(Grid.Rows - 1, 9) = Format(Rst.Fields("price"), ".00")
Grid.TextMatrix(Grid.Rows - 1, 10) = Format(Rst.Fields("price"), ".00")

Rst.Close
Set Rst = Nothing

BackCost.Add Cost, IDs
BackDList.Add Id

ee:

For I = 1 To Grid.Rows - 1
  SumCash = SumCash + Val(Grid.TextMatrix(I, 10))
Next

lblSum.Caption = Format(CStr(SumCash), ".00")

Id = ""

End Sub

Private Sub tmrTime_Timer()
  lblTime.Caption = Format(Date$, "yyyy年mm月dd日") & " " & Time$
End Sub


Private Sub txtNum_KeyPress(KeyAscii As Integer)
  If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub

Private Sub txtNum_KeyUp(KeyCode As Integer, Shift As Integer)
  Select Case KeyCode
    Case vbKeyReturn
      
      Dim SumCash As Currency
      Dim I As Integer
      
      If Trim(txtNum.Text) = "" Or Val(txtNum.Text) = 0 Then Exit Sub
      If IsNumeric(txtNum.Text) = False Then Exit Sub
      Grid.TextMatrix(Grid.RowSel, 7) = txtNum.Text
      Grid.TextMatrix(Grid.RowSel, 10) = Format(CStr(Val(Grid.TextMatrix(Grid.RowSel, 9) * Val(txtNum.Text))), ".00")
      For I = 1 To Grid.Rows - 1
        SumCash = SumCash + Val(Grid.TextMatrix(I, 10))
      Next
      lblSum.Caption = Format(CStr(SumCash), ".00")
      
      txtNum.Visible = False
      txtNum.Text = ""
      Grid.Enabled = True
      Grid.SetFocus
      
    Case vbKeyEscape
      
      txtNum.Visible = False
      txtNum.Text = ""
      Grid.Enabled = True
      Grid.SetFocus
  End Select
End Sub

Private Sub txtTM_KeyUp(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
  Case vbKeyReturn
    If txtTM.Text = "" Then Exit Sub
    Dim Rst As ADODB.Recordset
    Dim SQL As String
    
    If txtName.Text = "" Then
      Dim IDs As String
      Dim Names As String
      SQL = "select id, name from v_yaopin_list where tiaoma='" & txtTM.Text & "'"
      Set Rst = New ADODB.Recordset
      Rst.Open SQL, Conn, adOpenDynamic, adLockReadOnly, adCmdText
      If Rst.EOF Then
        txtTM.SelStart = 0
        txtTM.SelLength = Len(txtTM.Text)
        Exit Sub
      End If
      IDs = Rst.Fields(0)
      Names = Rst.Fields(1)
      SQL = "select cost from yaopin_cost where id='" & IDs & "'"
      Set Rst = New ADODB.Recordset
      Rst.CursorLocation = adUseClient
      Rst.Open SQL, Conn, adOpenDynamic, adLockReadOnly, adCmdText
      If Rst.EOF Then
        txtTM.SelStart = 0
        txtTM.SelLength = Len(txtTM.Text)
        Exit Sub
      End If
      txtName.Text = Names
      Rst.Close
      Set Rst = Nothing
      
    Else
      
      Dim SumCash As Currency
      Dim I As Integer
            
      For I = 1 To BackDList.Count
        If txtTM.Text = BackDList(I) Then
          Grid.TextMatrix(I, 7) = CStr(Val(Grid.TextMatrix(I, 7)) + 1)
          Grid.TextMatrix(I, 10) = Format(CStr(Val(Grid.TextMatrix(I, 7)) * Grid.TextMatrix(I, 9)), ".00")
          GoTo ee
        End If
      Next
      
      SQL = "select id,name,guige,changjia,unit,price from v_yaopin_list where tiaoma='" & txtTM.Text & "'"
      Set Rst = New ADODB.Recordset
      Rst.CursorLocation = adUseClient
      Rst.Open SQL, Conn, adOpenStatic, adLockReadOnly, adCmdText
      If Rst.EOF Then Id = "": Exit Sub
      
      Grid.Rows = Grid.Rows + 1
      Grid.TextMatrix(Grid.Rows - 1, 0) = Grid.Rows - 1
      Grid.TextMatrix(Grid.Rows - 1, 1) = Rst.Fields("id")
      Grid.TextMatrix(Grid.Rows - 1, 2) = Rst.Fields("name")
      Grid.TextMatrix(Grid.Rows - 1, 3) = Rst.Fields("guige")
      Grid.TextMatrix(Grid.Rows - 1, 4) = Rst.Fields("changjia")
      Grid.TextMatrix(Grid.Rows - 1, 5) = Rst.Fields("unit")
      Grid.TextMatrix(Grid.Rows - 1, 6) = Format(Rst.Fields("price"), ".00")
      Grid.TextMatrix(Grid.Rows - 1, 7) = "1"
      Grid.TextMatrix(Grid.Rows - 1, 8) = "1"
      Grid.TextMatrix(Grid.Rows - 1, 9) = Format(Rst.Fields("price"), ".00")
      Grid.TextMatrix(Grid.Rows - 1, 10) = Format(Rst.Fields("price"), ".00")
      
      Set Rst = New ADODB.Recordset
      Rst.CursorLocation = adUseClient
      SQL = "select cost from yaopin_cost where id='" & Grid.TextMatrix(Grid.Rows - 1, 1) & "'"
      Rst.Open SQL, Conn, adOpenDynamic, adLockReadOnly, adCmdText
      If Rst.EOF Then Exit Sub
      BackCost.Add CStr(Rst.Fields(0)), Grid.TextMatrix(Grid.Rows - 1, 0)
      
      Rst.Close
      Set Rst = Nothing
      
      BackDList.Add txtTM.Text
      
ee:
      
      For I = 1 To Grid.Rows - 1
        SumCash = SumCash + Val(Grid.TextMatrix(I, 10))
      Next
      
      lblSum.Caption = Format(CStr(SumCash), ".00")
      
      txtTM.Text = ""
      txtName.Text = ""
      fra.Visible = False
      Grid.Enabled = True
      Grid.SetFocus
      
    End If
      
  Case vbKeyEscape
    txtTM.Text = ""
    txtName.Text = ""
    fra.Visible = False
    Grid.Enabled = True
    Grid.SetFocus
  Case vbKeyBack, vbKeyDelete
    txtName.Text = ""
End Select
End Sub


Private Sub txtZK_KeyPress(KeyAscii As Integer)
  If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> 46 Then KeyAscii = 0
End Sub

Private Sub txtZK_KeyUp(KeyCode As Integer, Shift As Integer)
  Select Case KeyCode
    Case vbKeyReturn
      
      Dim SumCash As Currency
      Dim I As Integer
      
      If Trim(txtZK.Text) = "" Or Val(txtZK.Text) = 0 Then Exit Sub
      If IsNumeric(txtZK.Text) = False Then Exit Sub
      Grid.TextMatrix(Grid.RowSel, 8) = txtZK.Text
      Grid.TextMatrix(Grid.RowSel, 9) = Format(CStr(Val(Grid.TextMatrix(Grid.RowSel, 6)) * (Val(txtZK.Text) / 10)), ".00")
      Grid.TextMatrix(Grid.RowSel, 10) = Format(CStr(Val(Grid.TextMatrix(Grid.RowSel, 9) * Val(Grid.TextMatrix(Grid.RowSel, 7)))), ".00")
      For I = 1 To Grid.Rows - 1
        SumCash = SumCash + Val(Grid.TextMatrix(I, 10))
      Next
      lblSum.Caption = Format(CStr(SumCash), ".00")
      
      txtZK.Visible = False
      txtZK.Text = ""
      Grid.Enabled = True
      Grid.SetFocus
      
    Case vbKeyEscape
      
      txtZK.Visible = False
      txtZK.Text = ""
      Grid.Enabled = True
      Grid.SetFocus
  End Select
  
End Sub