frmsell.frm

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

Rst.Open SQL, Conn, adOpenDynamic, adLockReadOnly, adCmdText
If IsNull(Rst.Fields(0)) Then
  Number = 1
Else
  Number = Val(Mid(Rst.Fields(0), 8)) + 1
End If
Rst.Close
Set Rst = Nothing

lbl.Caption = Format(Date$, "yymmdd") & "#" & Format(CStr(Number), "0000")

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  If MsgBox("您真的要退出本系统吗？", 32 + vbYesNo) = vbNo Then Cancel = True
End Sub

Private Sub ReSet()
  Grid.Clear
  Grid.Rows = 1
  Grid.FormatString = "序号|^ 商品编号|^ 商品名称|^ 规格|^ 生产企业|^ 单位|^ 单价|^ 数量|^ 折扣|^ 折后单价|^ 合计金额"
  Grid.ColWidth(0) = 500
  Grid.ColWidth(1) = 1600
  Grid.ColWidth(2) = 1800
  Grid.ColWidth(3) = 1000
  Grid.ColWidth(4) = 1200
  Grid.ColWidth(5) = 600
  Grid.ColWidth(6) = 1000
  Grid.ColWidth(7) = 800
  Grid.ColWidth(8) = 600
  Grid.ColWidth(9) = 1000
  Grid.ColWidth(10) = 1600
  lblSum.Caption = "0.00"
  lblSums.Caption = "0.00"
  txtZ.Text = "1"
  ID = ""
  Set IDList = Nothing
  Set IDList = New Collection
  Grid.Enabled = True
  'Grid.SetFocus
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Conn.Close
  Set Conn = Nothing
  Set IDList = Nothing
End Sub



Private Sub Grid_KeyPress(KeyAscii As Integer)
  ID = ID + Chr(KeyAscii)
  tmr.Enabled = False
  tmr.Interval = 100
  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 = Foot(lblSum.Caption, lblSums.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
      
      SQL = "insert into sell_index values ('" & lbl.Caption & "','" _
        & Format(Date$, "yyyy-mm-dd") & "','" & Format(Time$, "hh:mm:ss") & "','" & _
        UserName & "'," & lblSum.Caption & "," & txtZ.Text & "," & lblSums.Caption & ")"
      Cmd.CommandText = SQL
      Cmd.CommandType = adCmdText
      Cmd.Execute
      ' "序号|^ 商品编号|^ 商品名称|^ 规格|^ 生产企业|^ 单位|^ 单价|^ 数量|^ 折扣|^ 折后单价|^ 合计金额"
      For I = 1 To Grid.Rows - 1
        SQL = "execute selling  '" & lbl.Caption & "','" & Grid.TextMatrix(I, 1) & "'," _
            & Grid.TextMatrix(I, 6) & "," & Grid.TextMatrix(I, 8) & "," _
            & Grid.TextMatrix(I, 9) & ",'" & Grid.TextMatrix(I, 5) & "'," & Grid.TextMatrix(I, 7)
        Cmd.CommandText = SQL
        Cmd.CommandType = adCmdText
        Cmd.Execute
      Next
      
      Conn.CommitTrans
      
      Call ReSet
      Number = Number + 1
      lbl.Caption = Format(Date$, "yymmdd") & "#" & Format(CStr(Number), "0000")
    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 vbKeyF8
      If Grid.Rows = 1 Then Exit Sub
      txtZ.Enabled = True
      txtZ.SelStart = 0
      txtZ.SelLength = Len(txtZ.Text)
      txtZ.SetFocus
      Grid.Enabled = False
    Case vbKeyF9
      If Grid.Rows > 1 Then Exit Sub
      frmBack.Show 1
    Case vbKeyDelete, vbKeyBack
      Dim SumCash As Currency
      'Dim I As Integer
      
      If Grid.RowSel = 0 Then Exit Sub
      If Grid.Rows = 2 Then ReSet: Exit Sub
      IDList.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")
      lblSums.Caption = Format(CStr(SumCash) * IIf(Val(txtZ.Text) = 1, 1, Val(txtZ.Text) / 10), ".00")
      
      For I = 1 To Grid.Rows - 1
        Grid.TextMatrix(I, 0) = CStr(I)
      Next
      
  End Select
End Sub

Private Sub tmr_Timer()
Dim I As Integer

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

For I = 1 To IDList.Count
  If ID = IDList(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

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

IDList.Add ID

ee:

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

lblSum.Caption = Format(CStr(SumCash), ".00")
lblSums.Caption = Format(CStr(SumCash) * IIf(Val(txtZ.Text) = 1, 1, Val(txtZ.Text) / 10), ".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")
      lblSums.Caption = Format(CStr(SumCash) * IIf(Val(txtZ.Text) = 1, 1, Val(txtZ.Text) / 10), ".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
            
      SQL = "select 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
      txtName.Text = Rst.Fields("name")
      Rst.Close
      Set Rst = Nothing
      
    Else
      
      Dim SumCash As Currency
      Dim I As Integer
      
      For I = 1 To IDList.Count
        If txtTM.Text = IDList(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")
      
      Rst.Close
      Set Rst = Nothing
      
      IDList.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")
      lblSums.Caption = Format(CStr(SumCash) * IIf(Val(txtZ.Text) = 1, 1, Val(txtZ.Text) / 10), ".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 txtZ_KeyPress(KeyAscii As Integer)
  If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> 46 Then KeyAscii = 0
End Sub

Private Sub txtZ_KeyUp(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
  Case vbKeyReturn
    txtZ.Enabled = False
    lblSums.Caption = Format(CStr(Val(lblSum.Caption) * IIf(Val(txtZ.Text) = 1, 1, Val(txtZ.Text) / 10)), ".00")
    Grid.Enabled = True
    Grid.SetFocus
  Case vbKeyEscape
    txtZ.Text = "1"
    txtZ.Enabled = False
    Grid.Enabled = True
    Grid.SetFocus
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")
      lblSums.Caption = Format(CStr(SumCash) * IIf(Val(txtZ.Text) = 1, 1, Val(txtZ.Text) / 10), ".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