frmmodhuo.frm

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

      TabIndex        =   25
      Top             =   2520
      Width           =   450
   End
End
Attribute VB_Name = "frmmodhuo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Id As String
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim str As String

Private Sub cmdfirst_Click()
    Dim rs As New ADODB.Recordset
    Dim sql As String
    sql = "select * from huopin order by id desc"
    rs.open sql, cn
    If Not rs.BOF Then
        rs.MoveFirst
    cmb(0).Text = IIf(IsNull(rs!hLeibie), "", rs!hLeibie)
    cmb(1).Text = IIf(IsNull(rs!hDanwei), "", rs!hDanwei)
    cmb(2).Text = IIf(IsNull(rs!hPinpai), "", rs!hPinpai)
    txthNo.Text = rs!hNo
    txthName.Text = rs!hName
    txthGuige.Text = rs!hGuige
    txthNum.Text = rs!hNum
    txtRukujia.Text = rs!hRukujia
    txtbak.Text = rs!hbak
        ElseIf rs.BOF Then
        MsgBox "信息已至第一条记录!", 48, "信息提示"
        rs.MoveFirst
    End If


End Sub

Private Sub cmdlast_Click()
    Dim rs As New ADODB.Recordset
    Dim sql As String
    sql = "select * from huopin order by id desc"
    rs.open sql, cn
    If Not rs.EOF Then
        rs.MoveLast
    cmb(0).Text = IIf(IsNull(rs!hLeibie), "", rs!hLeibie)
    cmb(1).Text = IIf(IsNull(rs!hDanwei), "", rs!hDanwei)
    cmb(2).Text = IIf(IsNull(rs!hPinpai), "", rs!hPinpai)
    txthNo.Text = rs!hNo
    txthName.Text = rs!hName
    txthGuige.Text = rs!hGuige
    txthNum.Text = rs!hNum
    txtRukujia.Text = rs!hRukujia
    txtbak.Text = rs!hbak
    ElseIf rs.EOF Then
        rs.MoveLast
        MsgBox "信息已至最后一条记录!", 48, "信息提示"
    End If


End Sub

Private Sub cmdnext_Click()
    Dim rs As New ADODB.Recordset
    Dim sql As String
    sql = "select " & HUOPIN_TABLE_STR & " from huopin order by id desc"
    rs.open sql, cn
    If Not rs.EOF Then
        rs.MoveNext
        
    cmb(0).Text = IIf(IsNull(rs!hLeibie), "", rs!hLeibie)
    cmb(1).Text = IIf(IsNull(rs!hDanwei), "", rs!hDanwei)
    cmb(2).Text = IIf(IsNull(rs!hPinpai), "", rs!hPinpai)
    txthNo.Text = rs!hNo
    txthName.Text = rs!hName
    txthGuige.Text = rs!hGuige
    txthNum.Text = rs!hNum
    txtRukujia.Text = rs!hRukujia
    txtbak.Text = rs!hbak
    ElseIf rs.EOF Then
            MsgBox "信息已至未记录!", 48, "信息提示"
            rs.MoveLast
    End If
End Sub

Private Sub cmdpre_Click()
On Error GoTo 10:
    Dim rs As New ADODB.Recordset
    Dim sql As String
    sql = "select " & HUOPIN_TABLE_STR & " from huopin order by id desc"
    rs.open sql, cn
    If Not rs.BOF Then
        rs.MovePrevious
    cmb(0).Text = IIf(IsNull(rs!hLeibie), "", rs!hLeibie)
    cmb(1).Text = IIf(IsNull(rs!hDanwei), "", rs!hDanwei)
    cmb(2).Text = IIf(IsNull(rs!hPinpai), "", rs!hPinpai)
    txthNo.Text = rs!hNo
    txthName.Text = rs!hName
    txthGuige.Text = rs!hGuige
    txthNum.Text = rs!hNum
    txtRukujia.Text = rs!hRukujia
    txtbak.Text = rs!hbak
        If rs.BOF Then
            MsgBox "信息已至第一条记录!", 48, "信息提示"
            rs.MoveFirst
        End If
    End If
10:
    MsgBox "数据操作有错误,因此造成的不便,请谅解!", vbOKOnly + vbCritical, "错误提示"
End Sub

Private Sub cmdsave_Click() '实现修改按钮功能
    Dim sql As String
    Dim rs As New ADODB.Recordset
    If Id = "" Then
        MsgBox "请查找需要修改的记录。", 48, "提示信息"
        Exit Sub
    End If
     If Trim(cmb(0).Text) = "" Then
        MsgBox "货品类别不能为空!", 48, "信息提示"
        cmb(0).SetFocus
        Exit Sub
    End If
    If Trim(txthNo.Text) = "" Then
        MsgBox "货品编码不能为空!", 48, "信息提示"
        txthNo.SetFocus
        Exit Sub
    End If
    If Trim(cmb(1).Text) = "" Then
        MsgBox "货品单位不能为空!", 48, "信息提示"
        cmb(1).SetFocus
        Exit Sub
    End If
    If Trim(txthName.Text) = "" Then
        MsgBox "货品名称不能为空!", 48, "信息提示"
        txthName.SetFocus
        Exit Sub
    End If
    If Trim(cmb(2).Text) = "" Then
        MsgBox "货品品牌不能为空!", 48, "信息提示"
        cmb(2).SetFocus
        Exit Sub
    End If
    If Trim(txtRukujia.Text) = "" Then
        MsgBox "入库价不能为空!", 48, "信息提示"
        txtRukujia.SetFocus
        Exit Sub
    End If

    If MsgBox("保存将覆盖原来的记录，您确实要保存吗？", 36, "警告") = vbNo Then
        Exit Sub
    End If
    sql = "select " & HUOPIN_TABLE_STR & " from Huopin where ID=" & Id  'HUOPIN_TABLE_STR是字段列表
    rs.open sql, cn, adOpenDynamic, adLockOptimistic
    If rs.RecordCount < 1 Then
        MsgBox "数据库中这条记录已经不存在，无法修改，请重新查找。", 48, "提示信息"
        Exit Sub
    End If
    rs!hNo = Trim(txthNo.Text)
    rs!hName = Trim(txthName.Text)
    rs!hGuige = Trim(txthGuige.Text)
    rs!hNum = Trim(txthNum.Text)
    rs!hRukujia = Trim(txtRukujia.Text)
    rs!hbak = Trim(txtbak.Text)
    rs!hLeibie = Trim(cmb(0).Text)
    rs!hDanwei = Trim(cmb(1).Text)
    rs!hPinpai = Trim(cmb(2).Text)

    If Trim(txtbak.Text) <> "" Then
        rs!hbak = Trim(txtbak.Text)
        Else
        rs!hbak = "有待添加中..."
    End If
    rs.Update
    MsgBox "修改成功！", 48, "提示信息"
End Sub
Private Sub cmdclose_Click()
    Unload Me
End Sub

Private Sub cmdqing_Click()
    txthNo.Text = ""
    txthName.Text = ""
    txthGuige.Text = ""
    txthNum.Text = ""
'    txthRen.Text = ""
    txtRukujia.Text = ""
'    txtXiaojia.Text = ""
    txtbak.Text = ""
    cmb(0).Text = ""
    cmb(1).Text = ""
    cmb(2).Text = ""
End Sub

Private Sub Form_Activate()
    txtCha.Text = frmxiugai.Grid1.TextMatrix(frmxiugai.Grid1.Row, 2)
    cmdcha_Click
End Sub
Private Sub Form_Load() '窗体导入事件
    Dim rs As New ADODB.Recordset
    Dim i As Integer
    
    '给列表赋值
    rs.open "select * from Leibie", cn
    cmb(0).Clear
    Do While Not rs.EOF
        cmb(0).AddItem rs!leibie
        rs.MoveNext
    Loop
    rs.Close
    rs.open "select * from Danwei", cn
    cmb(1).Clear
    Do While Not rs.EOF
        cmb(1).AddItem rs!danwei
        rs.MoveNext
    Loop
    rs.Close
    rs.open "select * from Pinpai", cn
    cmb(2).Clear
    Do While Not rs.EOF
        cmb(2).AddItem rs!pinpai
        rs.MoveNext
    Loop
    rs.Close
    
    cmbSelect.AddItem "按货品编号"
    cmbSelect.ListIndex = 0
    cmdfirst.Visible = False
    cmdpre.Visible = False
    cmdnext.Visible = False
    cmdlast.Visible = False
End Sub

Private Sub txtcha_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And txtCha.Text <> "" Then
        cmdcha_Click
    End If
End Sub
Private Sub cmdcha_Click() '查找记录
    Dim sql As String
    Dim rs As New ADODB.Recordset
    sql = "select * from Huopin where hNo='" & Trim(txtCha.Text) & "'"
    
    rs.open sql, cn
    If rs.RecordCount < 1 Then
        MsgBox "没有找到记录，请重新查找。", 48, "提示信息"
        cmdqing_Click
        Exit Sub
    End If
    cmb(0).Text = IIf(IsNull(rs!hLeibie), "", rs!hLeibie)
    cmb(1).Text = IIf(IsNull(rs!hDanwei), "", rs!hDanwei)
    cmb(2).Text = IIf(IsNull(rs!hPinpai), "", rs!hPinpai)
    txthNo.Text = rs!hNo
    txthName.Text = rs!hName
    txthGuige.Text = rs!hGuige
    txthNum.Text = rs!hNum
    txtRukujia.Text = rs!hRukujia
    txtbak.Text = rs!hbak

End Sub