frmgoods.frm

用于生产企业设备备件管理系统

Dim lngID As Long
    strSQL = "SELECT Max(AutoID) AS MAXID from goods"
    ConnTemp.Open StrConn
    RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
    lngID = RSTemp(0).Value
    RSTemp.Close
    
    strSQL = "select * from WH"
    RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
    If RSTemp.RecordCount > 0 Then
        For i = 1 To RSTemp.RecordCount
            strSQL = "insert into WHQty (WHID,GoodsID) values(" & RSTemp(0).Value & "," & lngID & ")"
            ConnTemp.Execute strSQL
            RSTemp.MoveNext
        Next
    End If
    RSTemp.Close
    ConnTemp.Close
    Set RSTemp = Nothing
    Set ConnTemp = Nothing
    AddWHRecorder = True
    Exit Function
    
ErrFlag:
    If RSTemp.State = adStateOpen Then RSTemp.Close
    If ConnTemp.State = adStateOpen Then ConnTemp.Close
    Set RSTemp = Nothing
    Set ConnTemp = Nothing
    MsgBox Err.Description, vbOKOnly + vbCritical
End Function


Sub UpdateShow()
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim RSTemp As New ADODB.Recordset
Dim strSQL As String, i As Long
    strSQL = "select * from goods order by AutoID DESC"
    ConnTemp.Open StrConn
    RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
    With DataShow
            .Redraw = False
            .Clear
            .Cols = 3
            .Rows = 1
            .ColWidth(0) = 0
            .ColWidth(1) = 4200
            .ColWidth(2) = 4200
            .ColAlignment(1) = 1
            .ColAlignment(2) = 1
            .Col = 1
            .Row = 0
            .CellAlignment = 4
            .Col = 2
            .CellAlignment = 4
            .TextMatrix(0, 1) = "物品编号"
            .TextMatrix(0, 2) = "物品名称"
            .Redraw = True
        End With
    
    If RSTemp.RecordCount > 0 Then
        With DataShow
            .Redraw = False
            .Rows = RSTemp.RecordCount + 1
            For i = 1 To RSTemp.RecordCount
                .TextMatrix(i, 0) = RSTemp(0).Value
                .TextMatrix(i, 1) = RSTemp(1).Value
                .TextMatrix(i, 2) = RSTemp(2).Value
                RSTemp.MoveNext
            Next
            .Redraw = True
        End With
    End If
    RSTemp.Close
    ConnTemp.Close
    Set RSTemp = Nothing
    Set ConnTemp = Nothing
    Exit Sub
    
ErrFlag:
    If RSTemp.State = adStateOpen Then RSTemp.Close
    If ConnTemp.State = adStateOpen Then ConnTemp.Close
    Set RSTemp = Nothing
    Set ConnTemp = Nothing
    MsgBox Err.Description, vbOKOnly + vbCritical
    DataShow.Redraw = True
    
End Sub

Private Sub DataShow_Click()
On Error GoTo ErrFlag
    If Image1.Visible = True Then
        If MsgBox("内容已变更，是否需要保存", vbYesNo + vbQuestion) = vbYes Then
            vkCommand3_Click
        End If
        Image1.Visible = False
        Label3.Visible = False
    End If
    bEditMode = False
    If DataShow.Row = 0 Then Exit Sub
    txtID.Text = DataShow.TextMatrix(DataShow.Row, 0)
    txtGoodsID.Text = DataShow.TextMatrix(DataShow.Row, 1)
    txtGoodsName.Text = DataShow.TextMatrix(DataShow.Row, 2)
    strGoodsOldID = txtGoodsID.Text
    strGoodsOldName = txtGoodsName.Text
    bEditMode = True
    Exit Sub
    
ErrFlag:
    MsgBox Err.Description, vbOKOnly + vbCritical
End Sub

Private Sub Form_Load()
    UpdateShow
    bEditMode = False
    vkMouseKeyEvents1.ControlHwnd = DataShow.hWnd
    vkMouseKeyEvents1.LaunchKeyMouseEvents
End Sub

Private Sub txtGoodsID_Change()
    If bEditMode = False Then Exit Sub
    
    If txtGoodsName.Text <> strGoodsOldName Or txtGoodsID.Text <> strGoodsOldID Then
        Label3.Visible = True
        Image1.Visible = True
    Else
        Label3.Visible = False
        Image1.Visible = False
    End If
End Sub

Private Sub txtGoodsName_Change()
    If bEditMode = False Then Exit Sub
    
    If txtGoodsName.Text <> strGoodsOldName Or txtGoodsID.Text <> strGoodsOldID Then
        Label3.Visible = True
        Image1.Visible = True
    Else
        Label3.Visible = False
        Image1.Visible = False
    End If
End Sub

Private Sub vkCommand1_Click()
    Unload Me
End Sub

Private Sub vkCommand2_Click()
Dim strID As String
Dim strName As String
    bEditMode = False
    strID = txtGoodsID.Text
    strName = txtGoodsName.Text
    If CheckData(strID, Label1.Caption) = False Then Exit Sub
    If CheckData(strName, Label2.Caption) = False Then Exit Sub
    
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim strSQL As String

    strSQL = "insert into goods (ID,GoodsName) values('" + strID + "','" + strName + "')"
    ConnTemp.Open StrConn
    ConnTemp.Execute strSQL
    ConnTemp.Close
    Image1.Visible = False
    Label3.Visible = False
    If AddWHRecorder = True Then UpdateShow
    Exit Sub
    
ErrFlag:
    If Err.Number = -2147467259 Then
        MsgBox "物品编号重复", vbOKOnly + vbCritical
    Else
        MsgBox "[新增]" & Err.Description, vbCritical
    End If
End Sub

Private Sub vkCommand3_Click()
Dim strName As String
Dim strID As String
    If txtID.Text = "" Then
        MsgBox "请选择要修改的物品", vbOKOnly + vbCritical
        Exit Sub
    End If
    
    strID = txtGoodsID.Text
    If CheckData(strID, Label1.Caption) = False Then Exit Sub
    
    strName = txtGoodsName.Text
    If CheckData(strName, Label2.Caption) = False Then Exit Sub
    
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim strSQL As String

    strSQL = "update goods set ID='" & strID & "',GoodsName='" + strName + "' where AutoID=" & txtID.Text
    ConnTemp.Open StrConn
    ConnTemp.Execute strSQL
    ConnTemp.Close
    Image1.Visible = False
    Label3.Visible = False
    UpdateShow
    Exit Sub
    
ErrFlag:
    If Err.Number = -2147467259 Then
        MsgBox "物品编号重复", vbOKOnly + vbCritical
    Else
        MsgBox "[保存]" & Err.Description, vbCritical
    End If
End Sub

Private Sub vkCommand4_Click()
    If txtID.Text = "" Then
        MsgBox "请选择要删除的物品", vbOKOnly + vbInformation
        Exit Sub
    End If
    If MsgBox("确定要删除吗,该物品的所有相关记录均会被删除", vbQuestion + vbYesNo) = vbNo Then
        Exit Sub
    End If
    
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim strSQL As String

    strSQL = "delete * from goods where AutoID=" & txtID.Text
    ConnTemp.Open StrConn
    ConnTemp.Execute strSQL
    
    strSQL = "delete * from WHQty where GoodsID=" & txtID.Text
    ConnTemp.Execute strSQL
    
    strSQL = "delete * from WHSetting where GoodsID=" & txtID.Text
    ConnTemp.Execute strSQL
    
    strSQL = "delete * from InData where GoodsID=" & txtID.Text
    ConnTemp.Execute strSQL
    
    strSQL = "delete * from OutData where GoodsID=" & txtID.Text
    ConnTemp.Execute strSQL
    
    ConnTemp.Close
    bEditMode = False
    UpdateShow
    MsgBox "删除成功", vbOKOnly + vbInformation
    Exit Sub
    
ErrFlag:
    MsgBox "[删除]" & Err.Description, vbCritical
End Sub

Private Sub vkMouseKeyEvents1_MouseWheel(Sens As vkUserContolsXP.Wheel_Sens)
On Error Resume Next
    If Sens = WHEEL_DOWN Then
        If DataShow.Row = DataShow.Rows - 1 Then Exit Sub
        DataShow.Row = DataShow.Row + 1
    Else
        If DataShow.Row = 1 Then Exit Sub
        DataShow.Row = DataShow.Row - 1
    End If
    DataShow.TopRow = DataShow.Row
End Sub