frm_node.frm

一个资料管理系统的源程序

      Picture         =   "frm_node.frx":206E4
      Top             =   5760
      Width           =   285
   End
   Begin VB.Image imgTitleMinimize 
      Height          =   210
      Left            =   3480
      Picture         =   "frm_node.frx":20E2E
      Stretch         =   -1  'True
      Top             =   5760
      Width           =   210
   End
   Begin VB.Image imgTitleClose 
      Height          =   210
      Left            =   3525
      Picture         =   "frm_node.frx":21078
      Stretch         =   -1  'True
      Top             =   6120
      Width           =   210
   End
   Begin VB.Image imgTitleHelp 
      Height          =   210
      Left            =   3480
      Picture         =   "frm_node.frx":212C2
      Stretch         =   -1  'True
      Top             =   6480
      Width           =   210
   End
   Begin VB.Image imgTitleMain 
      Height          =   450
      Left            =   2040
      Picture         =   "frm_node.frx":2150C
      Stretch         =   -1  'True
      Top             =   6210
      Width           =   285
   End
   Begin VB.Image imgWindowRight 
      Height          =   450
      Left            =   3120
      Picture         =   "frm_node.frx":21C56
      Stretch         =   -1  'True
      Top             =   6240
      Width           =   285
   End
   Begin VB.Image imgWindowLeft 
      Height          =   450
      Left            =   2760
      Picture         =   "frm_node.frx":223A0
      Stretch         =   -1  'True
      Top             =   6240
      Width           =   285
   End
   Begin VB.Image imgWindowBottom 
      Height          =   450
      Left            =   2400
      Picture         =   "frm_node.frx":22AEA
      Stretch         =   -1  'True
      Top             =   6240
      Width           =   285
   End
   Begin VB.Image imgTitleRight 
      Height          =   450
      Left            =   2400
      Picture         =   "frm_node.frx":23234
      Top             =   5760
      Width           =   285
   End
   Begin VB.Image imgTitleLeft 
      Height          =   450
      Left            =   2040
      Picture         =   "frm_node.frx":2397E
      Top             =   5760
      Width           =   285
   End
End
Attribute VB_Name = "Frm_node"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

 Dim mrs As ADODB.Recordset

Private Sub CmdDep_Click(Index As Integer)
 Dim oNodex As Node
 Dim iIndex As Integer
Select Case Index
  Case 0
    iIndex = TreeView1.SelectedItem.Index
    Set oNodex = TreeView1.Nodes.Add(iIndex, tvwNext, , "未命名", 1, 2)
    oNodex.Selected = True
    cmd_tf
    TreeView1.StartLabelEdit
  Case 1
    iIndex = TreeView1.SelectedItem.Index
    Set oNodex = TreeView1.Nodes.Add(iIndex, tvwPrevious, , "未命名", 1, 2)
    oNodex.Selected = True
    cmd_tf
    TreeView1.StartLabelEdit
  Case 2
    iIndex = TreeView1.SelectedItem.Index
    Set oNodex = TreeView1.Nodes.Add(iIndex, tvwFirst, , "未命名", 1, 2)
    oNodex.Selected = True
   cmd_tf
    TreeView1.StartLabelEdit
  Case 3
    iIndex = TreeView1.SelectedItem.Index
    Set oNodex = TreeView1.Nodes.Add(iIndex, tvwLast, , "未命名", 1, 2)
    oNodex.Selected = True
    cmd_tf
    TreeView1.StartLabelEdit
  Case 4
    iIndex = TreeView1.SelectedItem.Index
    Set oNodex = TreeView1.Nodes.Add(iIndex, tvwChild, , "未命名", 1, 2)
    oNodex.EnsureVisible
    oNodex.Selected = True
   
    cmd_tf
    
    TreeView1.StartLabelEdit
    
   
    
  Case 5
    If TreeView1.SelectedItem.Text <> "未命名" Then
      i = MsgBox("确认删除!", vbQuestion + vbYesNo, "确认")
     ' MsgBox i
      If i = 6 Then
       iIndex = TreeView1.SelectedItem.Index
       TreeView1.Nodes.Remove iIndex
       cmd_tf
      End If
      Else
      iIndex = TreeView1.SelectedItem.Index
       TreeView1.Nodes.Remove iIndex
       cmd_tf
    End If
  Case 6
    save_mu
  Case 7
    Unload Me
   
End Select

End Sub

Private Sub Form_Load()
 MakeWindow Me

 LoadFromTable
 For i = 1 To 4
 TreeView1.Nodes(i).Expanded = True
 Next i
 
 TreeView1.Nodes(1).Selected = True
  
 cmd_tf
  

End Sub

Private Sub imgTitleClose_Click()
Unload Me

End Sub

Private Sub imgTitleLeft_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub imgTitleMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub imgTitleMinimize_Click()
    Me.WindowState = 1
End Sub

Private Sub imgTitleRight_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub






Private Sub TreeView1_DblClick()
  
  'MsgBox TreeView1.SelectedItem.Index & "  key Is " & TreeView1.SelectedItem.Key
  'MsgBox "parent is " & TreeView1.SelectedItem.Parent.Index
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
  cmd_tf
End Sub

Private Sub save_mu()
On Error GoTo err61:
  Dim mdb As ADODB.Connection
  
  
  Set mdb = New ADODB.Connection
  mdb.CursorLocation = adUseClient
  mdb.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("mdb\ziliao.lbl")
  
  Set mrs = New Recordset
  
  mrs.Open "select 代号,父代号,文本,图片1,图片2 from ml_v ", mdb, adOpenStatic, adLockOptimistic
    
    If mrs.RecordCount > 0 Then
    ' Delete any records that may be in the table
        mrs.MoveFirst
        Do While mrs.EOF = False
            mrs.Delete
            mrs.MoveNext
        Loop
    End If
    
    
  For iIndex = 1 To 4
    
    mrs.AddNew
    mrs("父代号") = 0
    mrs("代号") = TreeView1.Nodes(iIndex).Index
    mrs("文本") = TreeView1.Nodes(iIndex).Text
    mrs("图片1") = TreeView1.Nodes(iIndex).Image
    mrs("图片2") = TreeView1.Nodes(iIndex).SelectedImage
    mrs.Update
   
    If TreeView1.Nodes(iIndex).Children > 0 Then
        WriteChild (iIndex)
    End If
    Next iIndex
    
    mrs.Close
    mdb.Close
    
    MsgBox "目录保存成功!", vbInformation, "提示"
    Exit Sub
err61:
   MsgBox Err.Description, vbCritical, "错误"
   
End Sub



Private Sub WriteChild(ByVal iNodeIndex As Integer)

    Dim i As Integer
    Dim iTempIndex As Integer
    iTempIndex = TreeView1.Nodes(iNodeIndex).Child.FirstSibling.Index
    'Loop through all a Parents Child Nodes
    For i = 1 To TreeView1.Nodes(iNodeIndex).Children
        mrs.AddNew
       mrs("父代号") = TreeView1.Nodes(iTempIndex).Parent.Index
       mrs("代号") = TreeView1.Nodes(iTempIndex).Index
       mrs("文本") = TreeView1.Nodes(iTempIndex).Text
       mrs("图片1") = TreeView1.Nodes(iTempIndex).Image
       mrs("图片2") = TreeView1.Nodes(iTempIndex).SelectedImage
       mrs.Update
        ' If the Node we are on has a child call the Sub again
        If TreeView1.Nodes(iTempIndex).Children > 0 Then
            WriteChild (iTempIndex)
        End If
        ' If we are not on the last child move to the next child Node
        If i <> TreeView1.Nodes(iNodeIndex).Children Then
            iTempIndex = TreeView1.Nodes(iTempIndex).Next.Index
        End If
    Next i
End Sub

Private Sub LoadFromTable()
On Error GoTo err62:
    Dim oNodex As Node
    Dim nImage As Integer
    Dim nSelectedImage As Integer
    Dim i As Integer
    Dim sTableNames As String
    Dim sNodeTable As String
    
     Set mdb = New ADODB.Connection
     mdb.CursorLocation = adUseClient
     mdb.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("mdb\ziliao.lbl")
  
     Set mrs = New Recordset
  
    mrs.Open "select 代号,父代号,文本,图片1,图片2 from ml_v order by 代号", mdb, adOpenStatic, adLockOptimistic
      
   
   
   
    
    
    If mrs.RecordCount > 0 Then
        mrs.MoveFirst
        Do While mrs.EOF = False
            nImage = mrs("图片1")
            nSelectedImage = mrs("图片2")
            i = mrs("父代号")
            
            
            If i = 0 Then
                Set oNodex = TreeView1.Nodes.Add(, , , mrs("文本"), nImage, nSelectedImage)
               
            Else
                
                Set oNodex = TreeView1.Nodes.Add(i, tvwChild, , mrs("文本"), nImage, nSelectedImage)
                'oNodex.EnsureVisible
            End If
                
            mrs.MoveNext
        Loop
    End If
    mrs.Close
    mdb.Close
    Exit Sub
err62:
   MsgBox Err.Description, vbCritical, "错误"
End Sub


Private Sub cmd_tf()
Select Case TreeView1.SelectedItem.Index
       Case 1, 2, 3, 4
          For i = 0 To 5
            cmddep(i).Enabled = False
          Next i
            cmddep(4).Enabled = True
            TreeView1.LabelEdit = tvwManual
            Case Else
              For i = 0 To 5
                cmddep(i).Enabled = True
              Next i
              TreeView1.LabelEdit = tvwAutomatic
          Select Case TreeView1.SelectedItem.Parent.Index
              Case 3, 4
                cmddep(4).Enabled = False
              Case Else
                Select Case TreeView1.SelectedItem.Parent.Index
                   Case 1, 2
                   
                   Case Else
                       Select Case TreeView1.SelectedItem.Parent.Parent.Index
                       
                           Case 1
                             cmddep(4).Enabled = False
                           Case Else
                              Select Case TreeView1.SelectedItem.Parent.Parent.Index
                                Case 1, 2
                                     
                                Case Else
                                     Select Case TreeView1.SelectedItem.Parent.Parent.Parent.Index
                                         Case 1
                                         
                                         Case 2
                                         cmddep(4).Enabled = False
                                     End Select
                               End Select
                        End Select
                 End Select
           End Select
          'MsgBox TreeView1.SelectedItem.Index & "  key Is " & TreeView1.SelectedItem.Key
 End Select
 
End Sub