frmsetting.frm

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

Attribute VB_Exposed = False
Option Explicit
Dim bEditMode As Boolean

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, j As Long
    
    strSQL = "SELECT WHSetting.ID, WH.WHName, goods.ID, goods.GoodsName, WHSetting.MinValue, WHSetting.MaxValue, WHSetting.memo "
    strSQL = strSQL & "FROM (WHSetting LEFT JOIN WH ON WHSetting.WHID = WH.ID) LEFT JOIN goods ON WHSetting.GoodsID = goods.AutoID"
    strSQL = strSQL & " order by WHSetting.ID DESC"

    ConnTemp.Open StrConn
    RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
    With DataShow
            .Redraw = False
            .Clear
            .Cols = 7
            .Rows = 1
            .ColWidth(0) = 0
           
            For i = 1 To 6
                .ColWidth(i) = 1400
                .ColAlignment(i) = 1
            Next
            
            .TextMatrix(0, 1) = "仓库名称"
            .TextMatrix(0, 2) = "物品编号"
            .TextMatrix(0, 3) = "物品名称"
            .TextMatrix(0, 4) = "最小库存"
            .TextMatrix(0, 5) = "最大库存"
            .TextMatrix(0, 6) = "备注"
            .Redraw = True
        End With
    
    If RSTemp.RecordCount > 0 Then
        With DataShow
            .Redraw = False
            .Rows = RSTemp.RecordCount + 1
            For i = 1 To RSTemp.RecordCount
                For j = 1 To RSTemp.Fields.Count
                    If IsNull(RSTemp(j - 1).Value) = False Then .TextMatrix(i, j - 1) = RSTemp(j - 1).Value
                Next
                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 Combo1_Click()
    Combo4.ListIndex = Combo1.ListIndex
    If bEditMode = False Then Exit Sub
    Label3.Visible = True
    Image1.Visible = True
End Sub

Private Sub Combo2_Click()
    Combo3.ListIndex = Combo2.ListIndex
    Combo5.ListIndex = Combo2.ListIndex
    If bEditMode = False Then Exit Sub
    Label3.Visible = True
    Image1.Visible = True
End Sub

Private Sub Combo3_Click()
    Combo2.ListIndex = Combo3.ListIndex
    Combo5.ListIndex = Combo3.ListIndex
End Sub

Private Sub DataShow_Click()
On Error GoTo ErrFlag
Dim StrTemp As String
Dim i As Long
    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)
    For i = 0 To Combo1.ListCount - 1
        If Combo1.List(i) = DataShow.TextMatrix(DataShow.Row, 1) Then
            Combo1.ListIndex = i
            Exit For
        End If
    Next
    
    For i = 0 To Combo2.ListCount - 1
        If Combo2.List(i) = DataShow.TextMatrix(DataShow.Row, 2) Then
            Combo2.ListIndex = i
            Exit For
        End If
    Next
    
    txtMin.Text = DataShow.TextMatrix(DataShow.Row, 4)
    txtMax.Text = DataShow.TextMatrix(DataShow.Row, 5)
    vkTextBox2.Text = DataShow.TextMatrix(DataShow.Row, 6)
    bEditMode = True
    Exit Sub
    
ErrFlag:
    MsgBox Err.Description, vbOKOnly + vbCritical
End Sub

Private Sub Form_Load()
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim RSTemp As New ADODB.Recordset
Dim strSQL As String, i As Long
    
    bEditMode = False
    vkMouseKeyEvents1.ControlHwnd = DataShow.hWnd
    vkMouseKeyEvents1.LaunchKeyMouseEvents
    
    strSQL = "select * from WH order by ID"
    ConnTemp.Open StrConn
    RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
    
    Combo1.AddItem ""
    Combo4.AddItem "-1"
    If RSTemp.RecordCount > 0 Then
        For i = 1 To RSTemp.RecordCount
            Combo1.AddItem RSTemp(1)
            Combo4.AddItem RSTemp(0)
            RSTemp.MoveNext
        Next
        Combo1.ListIndex = 0
        Combo4.ListIndex = 0
    End If
    RSTemp.Close
    
    strSQL = "select * from goods order by ID"
    RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
    
    If RSTemp.RecordCount > 0 Then
        For i = 1 To RSTemp.RecordCount
            Combo2.AddItem RSTemp(1)
            Combo3.AddItem RSTemp(2)
            Combo5.AddItem RSTemp(0)
            RSTemp.MoveNext
        Next
        Combo2.ListIndex = 0
        Combo3.ListIndex = 0
        Combo5.ListIndex = 0
    End If
    RSTemp.Close
    
    ConnTemp.Close
    Set RSTemp = Nothing
    Set ConnTemp = Nothing
    
    UpdateShow
    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
    
    
End Sub

Private Sub txtMin_Change()
    If bEditMode = False Then Exit Sub
    Label3.Visible = True
    Image1.Visible = True
End Sub

Private Sub txtMax_Change()
    If bEditMode = False Then Exit Sub
    Label3.Visible = True
    Image1.Visible = True

End Sub

Private Sub vkCommand1_Click()
    Unload Me
End Sub

Private Sub vkCommand2_Click()
Dim strMin As String
Dim strMax As String
Dim strFS As String
Dim strValue As String
    bEditMode = False
    strMin = Trim(txtMin.Text)
    strMax = Trim(txtMax.Text)
    strFS = "WHID,GoodsID"
    strValue = Combo4.Text & "," & Combo5.Text
    If strMin <> "" Then
        If IsNumeric(strMin) = False Then
            MsgBox "[最小库存]栏位为数字", vbOKOnly + vbCritical
            Exit Sub
        End If
        strFS = strFS & ",[MinValue]"
        strValue = strValue & "," & strMin
    End If
    
    If strMax <> "" Then
        If IsNumeric(strMax) = False Then
            MsgBox "[最大库存]栏位为数字", vbOKOnly + vbCritical
            Exit Sub
        End If
        If InStr(strFS, "[MinValue]") > 0 Then
            If Val(strMin) >= Val(strMax) Then
                MsgBox "最大库存必须大于最小库存", vbOKOnly + vbCritical
                Exit Sub
            End If
        End If
        strFS = strFS & ",[MaxValue]"
        strValue = strValue & "," & strMax
    End If
    If strMin = "" And strMax = "" Then
        MsgBox "必须输入最大库存或最小库存", vbOKOnly + vbCritical
        Exit Sub
    End If
    
    strFS = strFS & ",[memo]"
    strValue = strValue & ",'" & vkTextBox2.Text & "')"
    
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim strSQL As String
    
    strSQL = "insert into WHSetting (" & strFS & ") values(" & strValue
    ConnTemp.Open StrConn
    ConnTemp.Execute strSQL
    
    If Combo4.ListIndex = 0 Then
        strSQL = "update WHQty set WGType=-1 where GoodsID=" & Combo5.Text
    Else
        strSQL = "update WHQty set WGType=" & Combo4.Text & " where GoodsID=" & Combo5.Text & " AND WHID=" & Combo4.Text
    End If
    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 vkCommand3_Click()
Dim strMax As String
Dim strMin As String
Dim strSQL As String
    If txtID.Text = "" Then
        MsgBox "请选择要修改的物品", vbOKOnly + vbInformation
        Exit Sub
    End If
    
    strMin = txtMin.Text
    strMax = txtMax.Text
    strSQL = " WHID=" & Combo4.Text & ",GoodsID=" & Combo5.Text
    If strMin <> "" Then
        If IsNumeric(strMin) = False Then
            MsgBox "[最小库存]栏位为数字", vbOKOnly + vbCritical
            Exit Sub
        End If
        strSQL = strSQL & ",[MinValue]=" & strMin
    Else
        strSQL = strSQL & ",[MinValue]=null"
    End If
    
    If strMax <> "" Then
        If IsNumeric(strMax) = False Then
            MsgBox "[最大库存]栏位为数字", vbOKOnly + vbCritical
            Exit Sub
        End If
        If InStr(strSQL, "[MinValue]=") > 0 And InStr(strSQL, "[MinValue]=null") <= 0 Then
            If Val(strMin) >= Val(strMax) Then
                MsgBox "最大库存必须大于最小库存", vbOKOnly + vbCritical
                Exit Sub
            End If
        End If
        
        strSQL = strSQL & ",[MaxValue]=" & strMax
    Else
        strSQL = strSQL & ",[MaxValue]=null"
    End If
    strSQL = strSQL & ",[memo]='" & vkTextBox2.Text & "'"
    
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection


    strSQL = "update WHSetting set " & strSQL & " where ID=" & txtID.Text
    ConnTemp.Open StrConn
    ConnTemp.Execute strSQL
    
    If Combo4.ListIndex = 0 Then
        strSQL = "update WHQty set WGType=-1 where GoodsID=" & Combo5.Text
    Else
        strSQL = "update WHQty set WGType=" & Combo4.Text & " where GoodsID=" & Combo5.Text & " AND WHID=" & Combo4.Text
    End If
    ConnTemp.Execute strSQL
    
    ConnTemp.Close
    Image1.Visible = False
    Label3.Visible = False
    UpdateShow
    Exit Sub
    
ErrFlag:
    If ConnTemp.State = adStateOpen Then ConnTemp.Close
    MsgBox "[保存]" & Err.Description, vbCritical
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 WHSetting where ID=" & txtID.Text
    ConnTemp.Open StrConn
    ConnTemp.Execute strSQL
    
    If Combo4.ListIndex = 0 Then
        strSQL = "update WHQty set WGType=null where WGType=-1 AND GoodsID=" & Combo5.Text
    Else
        strSQL = "update WHQty set WGType=null where GoodsID=" & Combo5.Text & " AND WHID=" & Combo4.Text
    End If
    ConnTemp.Execute strSQL
    
    ConnTemp.Close
    bEditMode = False
    txtID.Text = ""
    UpdateShow
    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

Private Sub vkTextBox2_Change()
    If bEditMode = False Then Exit Sub
    Label3.Visible = True
    Image1.Visible = True
End Sub