VB程序学习代码记录20160726

Dim cnn As New ADODB.Connection
Dim rs1 As New ADODB.Recordset
Dim i As Integer, bmjc As Integer
Dim blntj As Boolean
Dim bmbh As String

Private Sub Form_Load()
Me.Caption = "部门管理"
cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_manpowerinfo.mdb;persist security info=false"
tree_add
tlbState True
If TreeView1.Nodes.Count > 0 Then TreeView1.Nodes(1).Selected = True
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "ok"
tlbState True
If Len(Text1(0)) > 10 Then
MsgBox "部门编号超长"
Exit Sub
End If
rs1.Open "select * from 部门表", cnn, adOpenKeyset, adLockOptimistic
rs1.AddNew
For i = 0 To 6
rs1.Fields(i) = Text1(i)
Next i
rs1.Fields("编码次级") = Len(Text1(0)) / 2
rs1.Update
rs1.Close
If TreeView1.Nodes.Count > 0 Then
If blntj = True Then
TreeView1.Nodes.Add TreeView1.SelectedItem.Key, tvwLast, Text1(3), "(" & Text1(1) & ")" & Text1(2), "close"
TreeView1.SelectedItem.LastSibling.Selected = True
Else
TreeView1.Nodes.Add TreeView1.SelectedItem.Key, tvwChild, Text1(3), "(" & Text1(1) & ")" & Text1(2), "close"
For i = 1 To TreeView1.Nodes.Count
TreeView1.Nodes(o).Sorted = True
Next i
TreeView1.SelectedItem.Child.LastSibling.Selected = True
End If
Else
Set node1 = TreeView1.Nodes.Add(, tvwFirst, Text1(3), "(" & Text1(1) & ")" & Text1(2))
node1.Selected = True
End If
Case "cancel"
tlbState True
Case "addnew"
tlbState False: blntj = True
For i = 0 To Text1.UBound
Text1(i).Text = ""
Next i
If TreeView1.Nodes.Count > 0 Then
rs1.Open "select * from 部门表 where 部门全称='" + TreeView1.SelectedItem.LastSibling.Key + "'order by 编码级次", cnn, adOpenKeyset, adLockOptimistic
If rs1.RecordCount > 0 Then
Text1(1) = Format(Val(rs1.Fields("本级编号")) + 1, "00")
Text1(0) = Left(rs1.Fields("部门编号"), Len(rs1.Fields("部门编号")) - 2) & Text1(1)
End If
rs1.Close
Else
Text1(0) = "01"
Text1(1) = "01"
End If
Text1(2).SetFocus
Case "addchild"
If TreeView1.Nodes.Count = 0 Then
MsgBox "没有上级部门，无法添加下级"
Exit Sub
End If
tlbState False: blntj = False
rs1.Open "select * from 部门表 where 部门编号 like '" + Text1(0) + "'+ '__' or 部门编号=" '+ text1(0) + '"order by 部门编号", cnn, adopenkeyset,adlockoptimistic
If rs1.RecordCount > 1 Then
rs1.MoveLast
Text1(1) = Format(Val(rs1.Fields("本级编号")) + 1, "00")
Text1(0) = Left(rs1.Fields("部门编号"), Len(rs1.Fields("部门编号")) - 2) & Text1(1)
Else
Text1(1) = "01"
Text1(0) = rs1.Fields("部门编号") & Text1(1)
End If
rs1.Close
For i = 2 To Text1.UBound
Text1(i).Text = ""
Next i
Text1(2).SetFocus
Case "del"
If TreeView1.SelectedItem.Children > 0 Then
MsgBox "此部门存在下级部门，不允许删除!"
Exit Sub
End If
cnn.Execute ("delete from 部门表 where 部门全称='" + TreeView1.SelectedItem.Key + "'")
tree_add
Case "expand"
For i = 1 To TreeView1.Nodes.Count
TreeView1.Nodes(i).Expanded = True
Next i
Case "nexpand"
For i = 1 To TreeView1.Nodes.Count
TreeView1.Nodes(i).Expanded = False
Next i
Case "exit"
End
End Select
End Sub

Sub tree_add()
TreeView1.Nodes.Clear
Dim mNode As Node
rs1.Open "select * from 部门表 order by 部门编号,编码级次", cnn, adOpenKeyset, adLockOptimistic
If rs1.RecordCount > 0 Then      '如果表中有记录
rs1.MoveFirst        '将记录指针移到第一条
'使用Do While语句并根据"编码级次"添加不同级别的数据到TreeView控件中
Do While rs1.EOF = False
Select Case rs1.Fields("编码级次")
Case 1
Set mNode = TreeView1.Nodes.Add()
mNode.Text = "(" & rs1.Fields("本级编号") & ")" & rs1.Fields("部门名称")
mNode.Key = rs1.Fields("部门全称")
mNode.Image = "close"
Case 2
Set mNode1 = TreeView1.Nodes.Add(mNode.Index, tvwChild)
mNode1.Text = "(" & rs1.Fields("本级编号") & ")" & rs1.Fields("部门名称")
mNode1.Key = rs1.Fields("部门全称")
mNode1.Image = "close"
Case 3
Set mNode2 = TreeView1.Nodes.Add(mNode1.Index, tvwChild)
mNode2.Text = "(" & rs1.Fields("本级编号") & ")" & rs1.Fields("部门名称")
mNode2.Key = rs1.Fields("部门全称")
mNode2.Image = "close"
Case 4
Set mNode3 = TreeView1.Nodes.Add(mNode2.Index, tvwChild)
mNode3.Text = "(" & rs1.Fields("本级编号") & ")" & rs1.Fields("部门名称")
mNode3.Key = rs1.Fields("部门全称")
mNode3.Image = "close"
Case 5
Set mNode4 = TreeView1.Nodes.Add(mNode3.Index, tvwChild)
mNode4.Text = "(" & rs1.Fields("本级编号") & ")" & rs1.Fields("部门名称")
mNode4.Key = rs1.Fields("部门全称")
mNode4.Image = "close"
End Select
rs1.MoveNext
Loop
End If
rs1.Close
End Sub

Sub tlbState(state As Boolean)
With Toolbar1
If state = True Then
.Buttons(1).Enabled = False
.Buttons(2).Enabled = False
For i = 4 To 9
.Buttons(i).Enabled = True
Next i
For i = 0 To Text1.UBound
Text1(i).Locked = True
Next i
Else
.Buttons(1).Enabled = True
.Buttons(2).Enabled = True
For i = 4 To 9
.Buttons(i).Enabled = False
Next i
For i = 0 To Text1.UBound
Text1(i).Locked = False
Next i
End If
End With
End Sub