frmxiaoshou.frm

一个用VB写的服装进销存源码

   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "营业计算"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   21.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   4200
      TabIndex        =   18
      Top             =   120
      Width           =   1800
   End
End
Attribute VB_Name = "frmxiaoshou"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As New ADODB.Recordset
Dim sql As String
Public Id As String
Dim strsql As String
Dim r As Integer
Public f As Integer


Private Sub cmdclose_Click()
    Unload Me
End Sub

Private Sub cmdcun_Click() '实现存储数据按钮功能
'On Error GoTo 10
    Dim rs As New ADODB.Recordset
    Dim rs1 As New ADODB.Recordset

    Dim sql As String
    Dim sql1 As String
    Dim sql2 As String

    If Trim(txt(0).Text) = "" Then
        MsgBox "无可存信息!", 48, "信息提示"
        Exit Sub
    End If
    If lblshengliang.Caption = "" Then
        MsgBox "请计算后再存储!", 48, "信息提示"
        Exit Sub
    End If
    If Trim(txt(4).Text) = "" Then
        MsgBox "销售数量不能为空!", 48, "信息提示"
        txt(4).SetFocus
        Exit Sub
    End If
    If Trim(txt(3).Text) = "" Then
        MsgBox "销售单价不能为空!", 48, "信息提示"
        txt(3).SetFocus
        Exit Sub
    End If
    sql = "select * from xiaoshoujilu"
    rs.open sql, cn, adOpenDynamic, adLockOptimistic
    rs.AddNew
    rs!xNum = Trim(txt(4).Text)
    rs!xshijian = dt.Value
    rs!xNo = Trim(txt(0).Text)
    rs!xName = Trim(txt(1).Text)
    rs!xLeibie = Trim(cmbleibie.Text)
    rs!xRukujia = Trim(txt(2).Text)
    rs!xXiaojia = Trim(txt(3).Text)
    rs!xDanwei = Trim(cmbdanwei.Text)
    rs!xLirun = lbllirun.Caption
    rs.Update
    rs.Close


    sql1 = "select " & HUOPIN_TABLE_STR1 & " from Huopin where hNo='" & Trim(txt(0).Text) & "' "
    rs.open sql1, cn, adOpenDynamic, adLockOptimistic
    rs!hNum = lblshengliang.Caption
    rs.Update
    rs.Close

    sql2 = "select " & HUOPIN_TABLE_STR1 & " from Huopin where hNo='" & Trim(txt(0).Text) & "' "
    rs1.open sql2, cn, adOpenDynamic, adLockOptimistic
    rs1!jiecun = lbljiecun.Caption
    rs1.Update
    cmdrefresh_Click

    '10:
'    MsgBox Err.Description
    MsgBox "保存成功!", 48, "信息提示"
    txt(4).Text = ""
    txt(5).Text = ""
End Sub

Private Sub cmdjisuan_Click() '计算按钮功能
Dim rs As New ADODB.Recordset
    Dim a As Double '付值
    Dim b As Double
    Dim c As Double
    Dim d As Double
    Dim e As Double
    Dim f As Double
    Dim g As Double
    Dim hNum As Long

    a = Val(Trim(txt(1).Text))
    b = Val(Trim(txt(2).Text))
    c = Val(Trim(txt(3).Text))
    d = Val(Trim(txt(4).Text))
    If Trim(txt(0).Text) = "" Then
        MsgBox "请输入编号信息!", 48, "信息提示"
        txt(0).SetFocus
        Exit Sub
    End If
    sql = "select hNum from Huopin where hNo='" & Trim(txt(0).Text) & "'"
    rs.open sql, cn
    If Val(Trim(txt(4).Text)) > rs!hNum Then
        MsgBox "超过库存最大限额!", 48, "信息提示"
        txt(4).SetFocus
        Exit Sub
    End If
    e = rs!hNum - Val(Trim(txt(4).Text))
    f = (c - b) * d
    g = (rs!hNum - d) * b
    lblshengliang.Caption = e
    lbllirun.Caption = f
    lbljiecun.Caption = g
End Sub
Private Sub cmdqingkong_Click()
    Dim i As Integer
    For i = 0 To 5
        txt(i).Text = ""
    Next i
    cmbleibie.Text = ""
    cmbdanwei.Text = ""
End Sub

Private Sub cmdrefresh_Click() '实现刷新功能
    Dim rs As New ADODB.Recordset
    Select Case cmbCha.ListIndex
     Case 0
        strsql = "select " & sqlZiduan & " from Huopin where hNo like '%" & Trim(txtcha.Text) & "%' order by hNo"
     Case 1
        strsql = "select " & sqlZiduan & " from Huopin where hLeibie like '%" & Trim(txtcha.Text) & "%' order by hLeibie"
     Case 2
        strsql = "select " & sqlZiduan & " from Huopin where hPinpai like '%" & Trim(txtcha.Text) & "%' order by hPinpai"
     Case 3
        strsql = "select " & sqlZiduan & " from Huopin where hName like '%" & Trim(txtcha.Text) & "%' order by hName"
     Case 4
        strsql = "select " & sqlZiduan & " from Huopin where hGuige like '%" & Trim(txtcha.Text) & "%' order by hGuige"
     Case 5
        strsql = "select " & sqlZiduan & " from Huopin where hRukujia like '%" & Trim(txtcha.Text) & "%' order by hRukujia"
    End Select
    rs.open strsql, cn
    fuzhi Grid1, rs
End Sub


Private Sub dt_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        txt(0).SetFocus
    End If
End Sub

Private Sub Form_Load()
    If ifmana = False Then
        cmdDel.Enabled = False
    End If
    Dim rs As New ADODB.Recordset
    Dim sql1 As String
    Dim i As Integer
    rs.open "select * from leibie", cn
    cmbleibie.Clear
    Do While Not rs.EOF
       cmbleibie.AddItem rs!leibie
        rs.MoveNext
    Loop
    rs.Close

    rs.open "select * from danwei", cn
    cmbdanwei.Clear
    Do While Not rs.EOF
        cmbdanwei.AddItem rs!danwei
        rs.MoveNext
    Loop
    rs.Close
    sql1 = "select * from Huopin"
    rs.open sql1, cn
    rs.Close

    For i = 0 To UBound(ChahuoStr)
         cmbCha.AddItem ChahuoStr(i, 0)
    Next i
    cmbCha.ListIndex = 0
    strsql = "select " & sqlZiduan & " from Huopin where hNo=''"
    rs.open strsql, cn
    fuzhi Grid1, rs
    dt.Value = Format(Date, "yyyy-mm-dd")
    cmdcha_Click
End Sub

Private Sub Grid1_Click()
Dim rs As New ADODB.Recordset
r = Grid1.Row
rs.open "select * from Huopin", cn, adOpenDynamic, adLockOptimistic
If rs.RecordCount = 0 Then
    'MsgBox "sdaf"
    rs.Close
    Exit Sub
    'Call cmdClose_Click
Else
    rs.Close
End If

rs.open "select * from Huopin", cn
rs.Move r - 1
txt(0).Text = rs!hNo
txt(1).Text = rs!hName
txt(2).Text = rs!hRukujia
cmbleibie.Text = rs!hLeibie
txt(5).Text = rs!hNum
If IsNull(rs!hDanwei) = True Then
    cmbdanwei.Text = ""
    Else
    cmbdanwei.Text = rs!hDanwei
End If
txt(3).SetFocus
rs.Close
End Sub

Private Sub txt_KeyPress(Index As Integer, KeyAscii As Integer)
    Dim rs As New ADODB.Recordset
'    If Trim(txt(3).Text) <> "" And KeyAscii = 13 Then
'            txt(4).SetFocus
'        End If
'    If Trim(txt(4).Text) <> "" And KeyAscii = 13 Then
'            cmdjisuan.SetFocus
'    End If
    If Trim(txt(0).Text) <> "" And KeyAscii = 13 Then
        sql = "select * from Huopin where hNo='" & Trim(txt(0).Text) & "'"
        rs.open sql, cn
        If rs.RecordCount < 1 Then
            MsgBox "查无此编号!", 48, "信息提示"
            cmdqingkong_Click
            Exit Sub
        End If
        txt(2).Text = rs!hRukujia
        txt(1).Text = rs!hName
        cmbleibie.Text = rs!hLeibie
        cmbdanwei.Text = rs!hDanwei
        txt(5).Text = rs!hNum
        txt(3).SetFocus
    End If
    If Trim(txt(3).Text) <> "" And KeyAscii = 13 Then
        txt(4).SetFocus
    End If
    If Trim(txt(4).Text) <> "" And KeyAscii = 13 Then
        cmdjisuan.SetFocus
    End If
    
End Sub
Private Sub cmdcha_Click() '查询按钮
    Dim rs As New ADODB.Recordset

    Grid1.Refresh
    Select Case cmbCha.ListIndex
     Case 0
        strsql = "select " & sqlZiduan & " from Huopin where hNo like '%" & Trim(txtcha.Text) & "%' order by hNo"
     Case 1
        strsql = "select " & sqlZiduan & " from Huopin where hLeibie like '%" & Trim(txtcha.Text) & "%' order by hLeibie"
     Case 2
        strsql = "select " & sqlZiduan & " from Huopin where hPinpai like '%" & Trim(txtcha.Text) & "%' order by hPinpai"
     Case 3
        strsql = "select " & sqlZiduan & " from Huopin where hName like '%" & Trim(txtcha.Text) & "%' order by hName"
     Case 4
        strsql = "select " & sqlZiduan & " from Huopin where hGuige like '%" & Trim(txtcha.Text) & "%' order by hGuige"
     Case 5
        strsql = "select " & sqlZiduan & " from Huopin where hRukujia like '%" & Trim(txtcha.Text) & "%' order by hRukujia"
    End Select
    rs.open strsql, cn
    fuzhi Grid1, rs
End Sub
Private Sub txtcha_KeyPress(KeyAscii As Integer)
    If Trim(txtcha.Text) <> "" And KeyAscii = 13 Then
        cmdcha_Click
        Exit Sub
    End If
End Sub
Private Sub cmddel_Click() '删除表内信息
    If Grid1.TextMatrix(Grid1.Row, 0) = "" Then
        MsgBox "没有可以删除的记录。", 48, "提示信息"
        Exit Sub
    End If
    If MsgBox("您确实要删除这条记录吗？", 36, "提示信息") = vbNo Then
        Exit Sub
    End If
    cn.Execute "delete from Huopin where ID=" & Grid1.TextMatrix(Grid1.Row, 0)
    If Grid1.rows = 2 Then
        Grid1.rows = 1
        Grid1.rows = 2
    Else
        Grid1.RemoveItem Grid1.Row
    End If
End Sub