frmwh.frm

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

         Caption         =   "地址"
         Height          =   180
         Left            =   120
         TabIndex        =   11
         Top             =   720
         Width           =   360
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "已修改，未保存"
         ForeColor       =   &H8000000D&
         Height          =   180
         Left            =   7320
         TabIndex        =   9
         Top             =   2280
         Visible         =   0   'False
         Width           =   1260
      End
      Begin VB.Image Image1 
         Height          =   240
         Left            =   6960
         Picture         =   "frmWH.frx":11F2
         Top             =   2280
         Visible         =   0   'False
         Width           =   240
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "仓库名称"
         Height          =   180
         Left            =   120
         TabIndex        =   7
         Top             =   360
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Height          =   180
         Left            =   120
         TabIndex        =   6
         Top             =   480
         Visible         =   0   'False
         Width           =   90
      End
   End
End
Attribute VB_Name = "frmWH"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim strGoodsOldID As String
Dim strGoodsOldName As String
Dim bEditMode As Boolean

Function AddWHRecorder() As Boolean
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim RSTemp As New ADODB.Recordset
Dim RSTT As New ADODB.Recordset
Dim strSQL As String, i As Long
Dim lngID As Long
    strSQL = "SELECT Max(ID) AS MAXID from WH"
    ConnTemp.Open StrConn
    RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
    lngID = RSTemp(0).Value
    RSTemp.Close
    
    strSQL = "select * from goods"
    RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
    If RSTemp.RecordCount > 0 Then
        For i = 1 To RSTemp.RecordCount
            strSQL = "select * from WHSetting where WHID=-1 and GoodsID=" & RSTemp(0).Value
            RSTT.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
            If RSTT.RecordCount > 0 Then
                strSQL = "insert into WHQty (GoodsID,WHID,WGType) values(" & RSTemp(0).Value & "," & lngID & ",-1)"
            Else
                strSQL = "insert into WHQty (GoodsID,WHID) values(" & RSTemp(0).Value & "," & lngID & ")"
            End If
            RSTT.Close
            ConnTemp.Execute strSQL
            RSTemp.MoveNext
        Next
    End If
    RSTemp.Close
    ConnTemp.Close
    Set RSTT = Nothing
    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, j As Long
    strSQL = "select * from WH order by ID"
    ConnTemp.Open StrConn
    RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
    With DataShow
            .Redraw = False
            .Clear
            .Cols = 6
            .Rows = 1
            .ColWidth(0) = 0
            For i = 1 To 5
                .ColWidth(i) = 2000
            Next
            .ColWidth(2) = 4000
            .ColWidth(5) = 4000
            For i = 0 To 5
                .ColAlignment(i) = 1
            Next
            
            .Row = 0
            For i = 0 To 5
                .Col = i
                .CellAlignment = 4
            Next

            .TextMatrix(0, 0) = "ID"
            .TextMatrix(0, 1) = "仓库名称"
            .TextMatrix(0, 2) = "地址"
            .TextMatrix(0, 3) = "电话"
            .TextMatrix(0, 4) = "联系人"
            .TextMatrix(0, 5) = "备注"
            .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 = 0 To RSTemp.Fields.Count - 1
                    If IsNull(RSTemp(j).Value) = False Then .TextMatrix(i, j) = RSTemp(j).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
    
    DataShow.Redraw = True
End Sub

Private Sub DataShow_Click()
    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
    txtGoodsID.Text = DataShow.TextMatrix(DataShow.Row, 0)
    txtGoodsName.Text = DataShow.TextMatrix(DataShow.Row, 1)
    txtAddress.Text = DataShow.TextMatrix(DataShow.Row, 2)
    txtTel.Text = DataShow.TextMatrix(DataShow.Row, 3)
    txtCont.Text = DataShow.TextMatrix(DataShow.Row, 4)
    vkTextBox1.Text = DataShow.TextMatrix(DataShow.Row, 5)
    
    strGoodsOldID = txtGoodsID.Text
    strGoodsOldName = txtGoodsName.Text
    bEditMode = True
End Sub

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

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

End Sub

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

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

Private Sub txtTel_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 strID As String
Dim strName As String
    bEditMode = False
    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 = "insert into WH (WHName,[Address],[Tel],[Contactor],[Memo]) values('" + strName + "','"
    strSQL = strSQL & txtAddress.Text & "','" & txtTel.Text & "','" & txtCont.Text & "','" & vkTextBox1.Text & "')"
    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

    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 WH set WHName='" + strName + "', [address]='" + txtAddress.Text & "',[Tel]='"
    strSQL = strSQL & txtTel.Text & "',[Contactor]='" & txtCont.Text & "',[Memo]='" & vkTextBox1.Text & "' where ID=" + strGoodsOldID
    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 txtGoodsID.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 WH where ID=" + strGoodsOldID
    ConnTemp.Open StrConn
    ConnTemp.Execute strSQL
    
    strSQL = "delete * from WHQty where WHID=" & strGoodsOldID
    ConnTemp.Execute strSQL
    
    strSQL = "delete * from WHSetting where WHID=" & strGoodsOldID
    ConnTemp.Execute strSQL
    
    strSQL = "delete * from InData where WHID=" & strGoodsOldID
    ConnTemp.Execute strSQL
    
    strSQL = "delete * from OutData where WHID=" & strGoodsOldID
    ConnTemp.Execute strSQL
    
    ConnTemp.Close
    bEditMode = False
    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 vkTextBox1_Change()
    If bEditMode = False Then Exit Sub
    Label3.Visible = True
    Image1.Visible = True
End Sub