frmsell.frm

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

            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00C00000&
         Height          =   240
         Index           =   1
         Left            =   11130
         TabIndex        =   12
         Top             =   5820
         Width           =   255
      End
      Begin VB.Label lblSum 
         Alignment       =   1  'Right Justify
         BackStyle       =   0  'Transparent
         Caption         =   "0.00"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00C00000&
         Height          =   240
         Left            =   8640
         TabIndex        =   11
         Top             =   5820
         Width           =   2385
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "合计："
         Height          =   240
         Index           =   0
         Left            =   7740
         TabIndex        =   10
         Top             =   5820
         Width           =   720
      End
      Begin VB.Label lblTime 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "13:48:57"
         Height          =   240
         Left            =   2520
         TabIndex        =   8
         Top             =   150
         Width           =   960
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "张皓"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   10500
         TabIndex        =   7
         Top             =   180
         Width           =   510
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "收银员："
         Height          =   240
         Left            =   9510
         TabIndex        =   6
         Top             =   180
         Width           =   960
      End
      Begin VB.Label lblDay 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "2003年03月03日"
         Height          =   240
         Left            =   570
         TabIndex        =   5
         Top             =   150
         Width           =   1680
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "生产厂家"
         Height          =   240
         Left            =   420
         TabIndex        =   4
         Top             =   7560
         Width           =   960
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "商品名称"
         Height          =   240
         Left            =   420
         TabIndex        =   3
         Top             =   6825
         Width           =   960
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "商品编码"
         Height          =   240
         Index           =   0
         Left            =   420
         TabIndex        =   1
         Top             =   6450
         Width           =   960
      End
   End
End
Attribute VB_Name = "frmSell"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim SellTypes As Integer

Private Sub Form_Load()
Dim I As Integer

For I = 0 To 6
  lbl(I).Caption = ""
Next

lvwBM.Visible = False
lvwBM.Left = txtBM.Left
lvwBM.Top = txtBM.Top + txtBM.Height + 30

tmrTime.Interval = 1000
tmrTime.Enabled = True
lblTime.Caption = Time$
lblDay.Caption = Format(Date$, "yyyy年mm月dd日")

SellTypes = 1

Me.Height = 8970
Me.Width = 12000

End Sub

Private Sub Form_Resize()
  If Me.Height < 8970 Then Me.Height = 8970
  If Me.Width < 12000 Then Me.Width = 12000
End Sub

Private Sub lblSellTypes_Click()
If lvw.ListItems.Count <> 0 And lbl(3).Caption <> "" Then Exit Sub

  If SellTypes = 1 Then
    SellTypes = 2
    lblSellTypes.Caption = "批发"
  Else
    SellTypes = 1
    lblSellTypes.Caption = "零售"
  End If

End Sub

Private Sub lvwBM_KeyPress(KeyAscii As Integer)
If KeyAscii <> 13 Or lvwBM.SelectedItem Is Nothing Then Exit Sub
  
Dim Rst As ADODB.Recordset
Dim SQL As String
Dim I As Integer

SQL = "select id,name,leibie,guige,unit,pifa,price,changjia,stock from v_stock where unit='" _
    & lvwBM.SelectedItem.SubItems(2) & "'"

Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Rst.Open SQL, Conn, adOpenStatic, adLockReadOnly, adCmdText
If Rst.EOF Then Exit Sub

txtBM.Text = Rst.Fields("id")
lbl(0).Caption = Rst.Fields("name")
lbl(1).Caption = Rst.Fields("leibie")
lbl(2).Caption = Rst.Fields("guige")
lbl(3).Caption = Rst.Fields("unit")
lbl(4).Caption = Rst.Fields("changjia")
lbl(5).Caption = Rst.Fields("price")
lbl(6).Caption = Rst.Fields("pifa")

Rst.Close
Set Rst = Nothing

lvwBM.ListItems.Clear
lvwBM.Visible = False
txtNum.SetFocus

For I = 1 To lvw.ListItems.Count
  If txtBM.Text = lvw.ListItems(I).Text And lbl(3).Caption = lvw.ListItems(I).SubItems(3) Then
    txtNum.Text = lvw.ListItems(I).SubItems(5)
    txtNum.SelStart = 0
    txtNum.SelLength = Len(txtNum.Text)
  End If
Next

End Sub

Private Sub lvwBM_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyEscape Then
    lvwBM.ListItems.Clear
    lvwBM.Visible = False
    txtBM.SelStart = 0
    txtBM.SelLength = Len(txtBM.Text)
  End If
End Sub

Private Sub lvwBM_LostFocus()
  lvwBM.ListItems.Clear
  lvwBM.Visible = False
End Sub

Private Sub tmrTime_Timer()
  lblTime.Caption = Time$
End Sub

Private Sub txtBM_KeyPress(KeyAscii As Integer)
Dim KeyTypes As Integer
Dim KeyIn As Integer
Dim SQL As String

If (KeyAscii < 48 Or KeyAscii > 57) And (KeyAscii < 65 Or KeyAscii > 122) And KeyAscii <> 8 Then KeyAscii = 0

KeyIn = Asc(Mid(txtBM.Text & Chr(KeyAscii), 1, 1))

If KeyIn > 47 And KeyIn < 58 Then KeyTypes = 1
If KeyIn > 64 And KeyIn < 123 Then KeyTypes = 2
If KeyTypes = 0 Then Exit Sub

If KeyAscii <> 0 Then
  lvwBM.ListItems.Clear
  If KeyTypes = 1 Then
    If Len(txtBM.Text) < 5 Then Exit Sub
    FillinList "select id,fuma,name,unit,price,changjia,stock from v_stock where id like '" _
      & txtBM.Text & "%'", KeyTypes
  Else
    FillinList "select id,fuma,name,unit,price,changjia,stock from v_stock where fuma like '" _
      & txtBM.Text & "%'", KeyTypes
  End If
End If
End Sub

Private Sub txtBM_KeyUp(KeyCode As Integer, Shift As Integer)

Select Case KeyCode
  Case vbKeyDown
    If lvwBM.Visible = True Then lvwBM.SetFocus
  Case vbKeyUp
    If lvw.ListItems.Count > 0 Then lvw.SetFocus
End Select
If txtBM.Text = "" Then lvwBM.ListItems.Clear: lvwBM.Visible = False

End Sub

Private Sub FillinList(SQL As String, Types As Integer)
Dim Rst As ADODB.Recordset
Dim LItem As ListItem
Dim I As Integer

Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Rst.Open SQL, Conn, adOpenStatic, adLockReadOnly, adCmdText

If Rst.EOF Then Exit Sub
For I = 1 To Rst.RecordCount
  Set LItem = lvwBM.ListItems.Add
  If Types = 1 Then
    LItem.Text = Rst.Fields("id")
  Else
    LItem.Text = Rst.Fields("fuma")
  End If
  LItem.ListSubItems.Add , , Rst.Fields("name")
  LItem.ListSubItems.Add , , Rst.Fields("unit")
  LItem.ListSubItems.Add , , Rst.Fields("price")
  LItem.ListSubItems.Add , , Rst.Fields("changjia")
  LItem.ListSubItems.Add , , Rst.Fields("stock")
  Rst.MoveNext
Next

Rst.Close
Set Rst = Nothing
lvwBM.Visible = True

End Sub

Private Sub txtNum_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeyLeft And txtNum.SelStart = 0 Then
  txtBM.SelStart = 0
  txtBM.SelLength = Len(txtBM.Text)
  txtBM.SetFocus
End If

If KeyCode <> vbKeyReturn Then Exit Sub

Dim LItem As ListItem
Dim I As Integer
Dim sums As Currency

For I = 1 To lvw.ListItems.Count
  If txtBM.Text = lvw.ListItems(I).Text And lbl(3).Caption = lvw.ListItems(I).SubItems(3) Then
    lvw.ListItems(I).SubItems(5) = txtNum.Text
    GoTo Clear
  End If
Next
  
  Set LItem = lvw.ListItems.Add(, , txtBM.Text)
  LItem.ListSubItems.Add , , lbl(0).Caption
  LItem.ListSubItems.Add , , lbl(2).Caption
  LItem.ListSubItems.Add , , lbl(3).Caption
  
  If SellTypes = 1 Then
    LItem.ListSubItems.Add , , lbl(5).Caption
  Else
    LItem.ListSubItems.Add , , lbl(6).Caption
  End If
  
  LItem.ListSubItems.Add , , txtNum.Text
  LItem.ListSubItems.Add , , lbl(4).Caption

Clear:

For I = 0 To 6
  lbl(I).Caption = ""
Next

txtNum.Text = ""
txtBM.Text = ""
txtBM.SetFocus

For I = 1 To lvw.ListItems.Count
  sums = sums + Val(lvw.ListItems(I).SubItems(4)) * Val(lvw.ListItems(I).SubItems(5))
Next
lblSum = Format(sums, ".00")

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)
Dim Rst As ADODB.Recordset
Dim SQL As String

If txtNum.Text = "" Or KeyCode = vbKeyReturn Then Exit Sub

Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
SQL = "select stock from v_stock where id='" & txtBM.Text & "' and unit='" & lbl(3).Caption & "'"
Rst.Open SQL, Conn, adOpenDynamic, adLockReadOnly, adCmdText
If Rst.EOF Then MsgBox "查询出错！": txtNum.Text = "": Exit Sub
If Val(Rst.Fields(0)) < Val(txtNum.Text) Then txtNum.Text = CStr(Rst.Fields(0))

Rst.Close
Set Rst = Nothing

End Sub


Private Sub CaseKey(KeyCode As Integer)

Select Case KeyCode
  Case vbKeyF2
  
  Case vbKeyF3
  
  Case vbKeyF4
  
  Case vbKeyF5


End Select

End Sub