frminput.frm

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

            Weight          =   400
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   3450
         TabIndex        =   1
         Top             =   150
         Width           =   2400
      End
   End
End
Attribute VB_Name = "frmInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdAdd_Click()
Dim I As Integer

If cmdAdd.Caption = "添  加" Then
    For I = 0 To 12
      txt(I).Text = ""
      txt(I).Enabled = True
    Next
    Grid.Enabled = False
    cmdAdd.Caption = "保  存"
    cmdDel.Caption = "取  消"
    dtpEna.Visible = True
    txt(10).Text = Format(dtpEna.Value, "yyyy-mm-dd")
Else
    If txt(0).Text = "" Or txt(1).Text = "" Or txt(3).Text = "" Or _
      txt(4).Text = "" Or txt(6).Text = "" Then _
      MsgBox "请填写完整入库信息！", 64: Exit Sub
    If IsNumeric(txt(4).Text) = False Or IsNumeric(txt(6).Text) = False Then _
      MsgBox "您所填写的商品价格或数量无效！请重新填写。", 64: Exit Sub
    For I = 0 To Grid.Rows - 1
      If txt(0).Text = Grid.TextMatrix(I, 0) Then MsgBox "入库商品有重复！", 64: Exit Sub
    Next
    Grid.Rows = Grid.Rows + 1
    Grid.TextMatrix(Grid.Rows - 1, 0) = txt(0).Text
    Grid.TextMatrix(Grid.Rows - 1, 1) = txt(1).Text
    Grid.TextMatrix(Grid.Rows - 1, 2) = txt(3).Text
    Grid.TextMatrix(Grid.Rows - 1, 3) = txt(4).Text
    Grid.TextMatrix(Grid.Rows - 1, 4) = txt(6).Text
    Grid.TextMatrix(Grid.Rows - 1, 5) = txt(7).Text
    Grid.TextMatrix(Grid.Rows - 1, 6) = txt(9).Text
    Grid.TextMatrix(Grid.Rows - 1, 7) = txt(10).Text
    Grid.TextMatrix(Grid.Rows - 1, 8) = txt(12).Text
    lblSum.Caption = Format(Val(lblSum.Caption) + Val(Grid.TextMatrix(Grid.Rows - 1, 5)), "0.00")
    cmdAdd.Caption = "添  加"
    cmdDel.Caption = "删  除"
    Grid.Enabled = True
    dtpEna.Visible = False
End If

End Sub

Private Sub cmdCancel_Click()
  Unload Me
End Sub

Private Sub cmdDel_Click()
Dim I As Integer

If cmdDel.Caption = "取  消" Then
  cmdAdd.Caption = "添  加"
  cmdDel.Caption = "删  除"
  cmdAdd.Enabled = True
  dtpEna.Visible = False
  For I = 0 To txt.Count - 1
    txt(I).Enabled = False
  Next
Else
  If Grid.Text = "" Then Exit Sub
  lblSum.Caption = Format(Val(lblSum.Caption) - Val(Grid.TextMatrix(Grid.RowSel, 5)), "0.00")
  If Grid.Rows = 2 Then
    Grid.Clear
    Grid.Rows = 1
    Grid.FormatString = " 商品编码|^ 商品名称|^ 单  位|^ 进  价|^ 数  量|^ 金    额|^ 货   位|^ 有效期截止|^ 发  票  号"
  Else
    Grid.RemoveItem Grid.RowSel
  End If
  
End If

  For I = 0 To 12
    txt(I).Text = ""
  Next
End Sub

Private Sub cmdSave_Click()
Dim Cmd As ADODB.Command
Dim SQL As String
Dim I As Integer

If Grid.Rows = 1 Then MsgBox "不能保存空的入库单！", 64: Exit Sub
If Trim(txtSF.Text) = "" Then MsgBox "请填写实付款金额！", 64: Exit Sub
If IsNumeric(txtSF.Text) = False Then MsgBox "您填写的实付金额不是有效的数字！", 64: Exit Sub
If Val(txtSF.Text) > Val(lblSum.Caption) Then MsgBox "实付金额大于应付金额！", 64: Exit Sub

For I = 0 To 4
  If txtRK(0).Text = "" Then MsgBox "请将入库单表头信息填写完整！", 64: Exit Sub
Next

SQL = "insert into ruku_index values('"
For I = 0 To 5
  SQL = SQL + txtRK(I).Text + "','"
Next
SQL = Mid(SQL, 1, Len(SQL) - 1) + lblSum.Caption + ")"
Conn.BeginTrans
Set Cmd = New ADODB.Command
Cmd.ActiveConnection = Conn
Cmd.CommandType = adCmdText
Cmd.CommandText = SQL
Cmd.Execute

For I = 1 To Grid.Rows - 1
  SQL = "execute insertstock '" & txtRK(0).Text & "','" & _
    Grid.TextMatrix(I, 0) & "','" & Grid.TextMatrix(I, 2) & _
    "'," & Grid.TextMatrix(I, 4) & "," & Grid.TextMatrix(I, 3) _
    & ",'" & Grid.TextMatrix(I, 8) & "'"
  Cmd.CommandText = SQL
  Cmd.CommandType = adCmdText
  Cmd.Execute
Next

If Val(txtSF.Text) - Val(lblSum.Caption) <> 0 Then
  SQL = "insert into yingfu_list values('" & txtRK(0).Text & "','" & txtRK(3).Text & "'," _
      & CStr(Abs(Val(txtSF.Text) - Val(lblSum.Caption))) & "," & txtSF.Text & ")"
  Cmd.CommandText = SQL
  Cmd.CommandType = adCmdText
  Cmd.Execute
End If
Set Cmd = Nothing
Conn.CommitTrans

Unload Me
End Sub

Private Sub cmdSearch_Click()
Dim Rst As ADODB.Recordset
Dim I As Integer
Dim H As Long

Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Rst.Open "select name from client_list", Conn, adOpenStatic, adLockReadOnly, adCmdText
If Rst.EOF Then MsgBox "您还没有添加客户资料！", 64: Exit Sub

GridClient.Clear
GridClient.Rows = 0
For I = 1 To Rst.RecordCount
  GridClient.Rows = GridClient.Rows + 1
  GridClient.TextMatrix(GridClient.Rows - 1, 0) = Rst.Fields(0)
  Rst.MoveNext
Next

GridClient.ColWidth(0) = GridClient.Width - 10

H = 260 * GridClient.Rows
If H > 4000 Then H = 4000
GridClient.Height = H
GridClient.Visible = True
GridClient.SetFocus
pic.Enabled = False
End Sub

Private Sub dtpEna_CloseUp()
  txt(10).Text = Format(dtpEna.Value, "yyyy-mm-dd")
End Sub

Private Sub dtpEna_LostFocus()
  dtpEna_CloseUp
End Sub

Private Sub dtpIn_CloseUp()
  txtRK(2).Text = Format(dtpIn.Value, "yyyy-mm-dd")
End Sub

Private Sub dtpIn_LostFocus()
  dtpIn_CloseUp
End Sub

Private Sub dtpOut_CloseUp()
  txtRK(4).Text = Format(dtpOut.Value, "yyyy-mm-dd")
End Sub

Private Sub dtpOut_LostFocus()
  dtpOut_CloseUp
End Sub

Private Sub Form_Load()
Dim Rst As ADODB.Recordset
Dim SQL As String
Dim I As Integer
  Me.Height = 8115
  Me.Width = 9855
  Grid.Clear
  Grid.Rows = 1
  Grid.FormatString = " 商品编码|^ 商品名称|^ 单  位|^ 进  价|^ 数  量|^ 金    额|^ 货   位|^ 有效期截止|^ 发  票  号"
  lvwBM.Left = txt(0).Left
  lvwBM.Top = txt(0).Top + txt(0).Height + 30
  lvwBM.Visible = False
  For I = 0 To 12
    txt(I).Enabled = False
  Next
Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
SQL = "select max(id) from ruku_index where id like 'rk" & Format(Date$, "yymmdd") & "%'"
Rst.Open SQL, Conn, adOpenDynamic, adLockReadOnly, adCmdText
If IsNull(Rst.Fields(0)) Then
  txtRK(0).Text = "rk" & Format(Date$, "yymmdd") & "001"
Else
  txtRK(0).Text = "rk" & Format(Date$, "yymmdd") & Format(CStr(Val(Mid(Rst.Fields(0), 9)) + 1), "000")
End If

Rst.Close
Set Rst = Nothing
txtRK(2).Text = Format(Date$, "yyyy-mm-dd")
txtRK(4).Text = Format(Date$, "yyyy-mm-dd")
dtpIn.Value = Date$
dtpOut.Value = Date$
dtpEna.Value = Date$
dtpEna.Visible = False
GridClient.Visible = False
GridClient.Left = txtRK(3).Left
GridClient.Top = 1530
End Sub

Private Sub GridClient_Click()
  txtRK(3).Text = GridClient.TextMatrix(GridClient.RowSel, 0)
  GridClient.Clear
  GridClient.Visible = False
  pic.Enabled = True
  txtRK(3).SetFocus
End Sub

Private Sub lvwBM_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
    Case 27
      lvwBM.ListItems.Clear
      lvwBM.Visible = False
      txt(0).SelStart = 0
      txt(0).SelLength = Len(txt(0).Text)
    Case 13
      If lvwBM.SelectedItem Is Nothing Then lvwBM.Visible = False: Exit Sub
      
      Dim Rst As ADODB.Recordset
      Dim SQL As String
      Dim KeyTypes As Integer
      Dim KeyIn As Integer
      
      KeyIn = Asc(Mid(lvwBM.SelectedItem.Text, 1, 1))
      If KeyIn >= 48 And KeyIn <= 57 Then KeyTypes = 1
      If KeyIn >= 65 And KeyIn <= 122 Then KeyTypes = 2
      If KeyTypes = 0 Then lvwBM.Visible = False: Exit Sub
      
      If KeyTypes = 1 Then
        SQL = "select id,name,guige,unit,price,pihao,changjia from v_yaopin_list where id='" _
            & lvwBM.SelectedItem.Text & "' and unit='" & lvwBM.SelectedItem.SubItems(2) & "'"
      Else
        SQL = "select id,name,guige,unit,price,pihao,changjia from v_yaopin_list where pinyin='" _
            & lvwBM.SelectedItem.Text & " ' and unit='" & lvwBM.SelectedItem.SubItems(2) & "'"
      End If
      
      Set Rst = New ADODB.Recordset
      Rst.CursorLocation = adUseClient
      Rst.Open SQL, Conn, adOpenDynamic, adLockReadOnly, adCmdText
      If Rst.EOF Then MsgBox "查询出错": Exit Sub
      txt(0).Text = Rst.Fields(0)
      txt(1).Text = Rst.Fields(1)
      txt(2).Text = Rst.Fields(2)
      txt(3).Text = Rst.Fields(3)
      txt(5).Text = Rst.Fields(4)
      txt(8).Text = Rst.Fields(5)
      txt(11).Text = Rst.Fields(6)
      Rst.Close
      Set Rst = Nothing
      
      txt(0).Locked = True
      txt(1).Locked = True
      txt(2).Locked = True
      txt(3).Locked = True
      txt(5).Locked = True
      txt(8).Locked = True
      txt(11).Locked = True
      lvwBM.ListItems.Clear
      lvwBM.Visible = False
      txt(4).SetFocus
  End Select
End Sub

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

Private Sub lvwBM_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Not lvwBM.SelectedItem Is Nothing Then lvwBM_KeyPress (13)
End Sub

Private Sub txt_KeyPress(Index As Integer, KeyAscii As Integer)

Select Case Index
  Case 0
        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(txt(0).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(txt(0).Text) < 5 Then Exit Sub
            SQL = "select id,pinyin,name,unit,price,changjia from v_yaopin_list where id like '" _
                & txt(0).Text & Chr(KeyAscii) & "%'"
            QueryList SQL, KeyTypes
          Else
            SQL = "select id,pinyin,name,unit,price,changjia from v_yaopin_list where pinyin like '" _
                & txt(0).Text & Chr(KeyAscii) & "%'"
            QueryList SQL, KeyTypes
          End If
        End If
  Case 4, 6
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> 46 Then KeyAscii = 0
End Select


End Sub

Private Sub QueryList(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("pinyin")
  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")
  Rst.MoveNext
Next

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

End Sub

Private Sub txt_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
If Index <> 0 Then Exit Sub
If KeyCode = vbKeyDown Then lvwBM.SetFocus
If KeyCode = vbKeyEscape And lvwBM.Visible = True Then lvwBM.Visible = False: txt(0).SelStart = 0: txt(0).SelLength = Len(txt(0).Text)
End Sub

Private Sub txt_LostFocus(Index As Integer)
  If txt(4).Text = "" Or txt(6) = "" Then Exit Sub
  txt(7).Text = CStr(Val(txt(4).Text) * Val(txt(6).Text))
End Sub

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