frm商品分类维护.frm

服装销售系统,VB开发.没有解压密码

         Caption         =   "大图标"
      End
      Begin VB.Menu mn小图标 
         Caption         =   "小图标"
      End
      Begin VB.Menu mn详细资料 
         Caption         =   "详细资料"
      End
   End
End
Attribute VB_Name = "frm商品分类维护"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'******************************************************************
'                   商品分类编码
'******************************************************************

Option Explicit

Public Rs As New ADODB.Recordset               '用于只打开单记录集时

Private Sub cmdAdd_Click()
    txtCode.Text = ""
    TxtName.Text = ""
    txtCode.SetFocus
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then SendKeys "{TAB}"
End Sub

Private Sub mn大图标_Click()
    vlstGoodsType.View = lvwIcon
End Sub

Private Sub mn关闭_Click()
    treGoodsType.SelectedItem.Expanded = False
End Sub

Private Sub mn删除_Click()
    Call cmdDelete_Click
End Sub

Private Sub mn详细资料_Click()
    vlstGoodsType.View = lvwReport
End Sub

Private Sub mn小图标_Click()
    vlstGoodsType.View = lvwSmallIcon
End Sub

Private Sub mn增加_Click()
    Call cmdAdd_Click
End Sub

Private Sub mn展开_Click()
    treGoodsType.SelectedItem.Expanded = True
End Sub

'鼠标右键弹出菜单
Private Sub treGoodsType_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    If Button = vbLeftButton Then Exit Sub
'    If treGoodsType.SelectedItem.Index = 3 Then Exit Sub
    If treGoodsType.SelectedItem.Text = "" Or treGoodsType.SelectedItem.Text = "商品分类编码" Or treGoodsType.SelectedItem.Children > 0 Then
        mn删除.Enabled = False
    Else
        mn删除.Enabled = True
    End If
    If treGoodsType.SelectedItem.Expanded = True Then
        mn展开.Visible = False
        mn关闭.Visible = True
    Else
        mn关闭.Visible = False
        mn展开.Visible = True
    End If
    PopupMenu mn商品分类
End Sub


Private Sub cmdDelete_Click()
    On Error GoTo DeleteErr
    sSQL = "DELETE FROM 商品分类表 WHERE 本节点名称='" & Trim(treGoodsType.SelectedItem.Text) & "'"
    
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute
    
    treGoodsType.Nodes.Remove treGoodsType.SelectedItem.Text
    vlstGoodsType.ListItems.Clear
    Exit Sub
DeleteErr:
    MsgBox "删除节点错误!", vbExclamation, "错误窗口"
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdHelp_Click()
    Temp = "在左侧分类树中单击鼠标右键可对分类信息进行维护。"
    MsgBox Temp, vbInformation, "帮助窗口"
End Sub

Private Sub cmdOK_Click()
    On Error GoTo AddErr
    Dim 级别
    Dim NodX
    Dim mItem As ListItem
    Dim v父节点名称
    If txtCode.Text = "" Or TxtName.Text = "" Then
        MsgBox "数据不能为空!", vbExclamation, "错误窗口"
        Exit Sub
    End If
    
    If treGoodsType.SelectedItem.Text = "商品分类编码" Then
        级别 = 1
    ElseIf treGoodsType.SelectedItem.Parent = "商品分类编码" Then
        级别 = 2
    ElseIf treGoodsType.SelectedItem.Parent.Parent = "商品分类编码" Then
        级别 = 3
    Else
        级别 = 4
    End If
    
    sSQL = "INSERT INTO 商品分类表(级别,父节点名称,本节点编码,本节点名称)" & _
            "VALUES('" & 级别 & "','" & _
            treGoodsType.SelectedItem.Text & "','" & _
            Trim(txtCode.Text) & "','" & _
            Trim(TxtName.Text) & "')"
    Cmd.ActiveConnection = Conn
    Cmd.CommandText = sSQL
    Cmd.Execute
    
    Set NodX = treGoodsType.Nodes.Add(treGoodsType.SelectedItem.Text, tvwChild, Trim(TxtName.Text), Trim(TxtName.Text), 级别 * 2 + 1, 级别 * 2 + 2)
    Set mItem = vlstGoodsType.ListItems.Add(, Trim(TxtName.Text), Trim(TxtName.Text), 1, 2)
    
    mItem.SubItems(1) = 级别
    mItem.SubItems(2) = txtCode.Text
    mItem.SubItems(3) = Trim(TxtName.Text)
    Exit Sub
AddErr:
    MsgBox "增加新分类错误!", vbExclamation, "错误窗口"
End Sub

Private Sub Form_Load()
    '初始化查询树
    On Error GoTo InitErr
    Dim NodX 'As Node
    
    Call SetFormToCenter(Me)
    treGoodsType.Nodes.Clear
    
    Set NodX = treGoodsType.Nodes.Add(, , "商品分类编码", "商品分类编码", 1, 2)

    '大分类
    sSQL = "SELECT * FROM 商品分类表 WHERE 级别=1"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    If RsTemp.EOF Then
'        MsgBox "未找到大分类信息!", vbInformation, "提示窗口"
        Exit Sub
    End If
    
    While Not RsTemp.EOF
        Set NodX = treGoodsType.Nodes.Add("商品分类编码", tvwChild, Trim(RsTemp("本节点名称")), Trim(RsTemp("本节点名称")), 3, 4)
        RsTemp.MoveNext
    Wend
    
    '中分类
    sSQL = "SELECT * FROM 商品分类表 WHERE 级别=2"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    If RsTemp.EOF Then
'        MsgBox "未找到中分类信息!", vbInformation, "提示窗口"
        Exit Sub
    End If
    
    While Not RsTemp.EOF
        Set NodX = treGoodsType.Nodes.Add(Trim(RsTemp("父节点名称")), tvwChild, Trim(RsTemp("本节点名称")), Trim(RsTemp("本节点名称")), 5, 6)
        RsTemp.MoveNext
    Wend
    
    '小分类
    sSQL = "SELECT * FROM 商品分类表 WHERE 级别=3"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    If RsTemp.EOF Then
'        MsgBox "未找到小分类信息!", vbInformation, "提示窗口"
        Exit Sub
    End If
    
    While Not RsTemp.EOF
        Set NodX = treGoodsType.Nodes.Add(Trim(RsTemp("父节点名称")), tvwChild, Trim(RsTemp("本节点名称")), Trim(RsTemp("本节点名称")), 7, 8)
        RsTemp.MoveNext
    Wend
    Exit Sub
InitErr:
    MsgBox "发生错误!" & vbCrLf & Err.Description, vbExclamation, "错误窗口"

End Sub

Private Sub treGoodsType_NodeClick(ByVal Node As MSComctlLib.Node)
    On Error Resume Next
    Dim mItem As ListItem
    
    vlstGoodsType.ListItems.Clear
    sSQL = "SELECT * FROM 商品分类表 WHERE 父节点名称='" & treGoodsType.SelectedItem.Text & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    
    If RsTemp.EOF Then Exit Sub
    
    While Not RsTemp.EOF
        Set mItem = vlstGoodsType.ListItems.Add(, Trim(RsTemp("本节点名称")), Trim(RsTemp("本节点名称")), 1, 2)
        mItem.SubItems(1) = RsTemp("级别")
        mItem.SubItems(2) = RsTemp("本节点编码")
        mItem.SubItems(3) = RsTemp("父节点名称")
        RsTemp.MoveNext
    Wend
End Sub

Private Sub txtCode_Validate(Cancel As Boolean)
    If Len(txtCode.Text) <> 2 Then
        Cancel = False
    End If
End Sub

Private Sub txtName_Validate(Cancel As Boolean)
    If TxtName.Text = "" Then
        Cancel = False
    End If
End Sub

Private Sub vlstGoodsType_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then Exit Sub
    Select Case vlstGoodsType.View
        Case lvwIcon
            mn大图标.Checked = True
            mn小图标.Checked = False
            mn详细资料.Checked = False
        Case lvwSmallIcon
            mn大图标.Checked = False
            mn小图标.Checked = True
            mn详细资料.Checked = False
        Case lvwReport
            mn大图标.Checked = False
            mn小图标.Checked = False
            mn详细资料.Checked = True
    End Select
    
    PopupMenu mn列表
End Sub