bas_treeview.bas

生产计划管理等信息 可以查询计划完成情况等

Attribute VB_Name = "Bas_Treeview"
Public Declare Function CoCreateGuid Lib "ole32.dll" (pGUID As Any) As Long
Public iFreeFile As Integer

#If DebugMode Then
    Public g_lObjCount          As Long
#End If

'***********  txtText.Text  是文本框  **********************************************************************************************
'从文本信息载入Treeview   （结构树从文本载入）

Public Function CreateGUID() As String
    Dim i As Variant, b(0 To 15) As Byte
    If CoCreateGuid(b(0)) = 0 Then
        For i = 0 To 15
            CreateGUID = CreateGUID & Right$("00" & Hex$(b(i)), 2)
        Next i
    Else
        MsgBox "创建GUID发生错误!"
    End If
End Function
Public Sub OpenTreeViewFromFileWithTab(FilePathName As String, TView As TreeView, CanEnsureVisible As Boolean)
    On Error GoTo Err_Handle
    iFreeFile = FreeFile
    Open FilePathName For Input As iFreeFile
    LoadNodesFromFileWithTab TView, CanEnsureVisible
    Close iFreeFile
    Exit Sub
Err_Handle:
    Close iFreeFile
End Sub
Public Sub LoadNodesFromFileWithTab(TView As TreeView, CanEnsureVisible As Boolean)
    Dim text_line As String
    Dim level As Integer
    Dim tree_nodes() As Node
    Dim num_nodes As Integer
    
    TView.Nodes.Clear
    Do While Not EOF(iFreeFile)
        Line Input #iFreeFile, text_line
        level = 1
        Do While Left$(text_line, 1) = vbTab
            level = level + 1
            text_line = Mid$(text_line, 2)
        Loop
        If level > num_nodes Then
            num_nodes = level
            ReDim Preserve tree_nodes(1 To num_nodes)
        End If
        If level = 1 Then
            Set tree_nodes(level) = TView.Nodes.Add(, , CreateGUID, text_line, 1, 2)
        Else
            Set tree_nodes(level) = TView.Nodes.Add(tree_nodes(level - 1), tvwChild, CreateGUID, text_line, 1, 2)
            If CanEnsureVisible = True Then tree_nodes(level).EnsureVisible
        End If
    Loop
    TView.Nodes.Item(1).EnsureVisible
End Sub
Public Sub OpenTreeViewFromFileWithFullPath(FilePathName As String, TView As TreeView, CanEnsureVisible As Boolean)
    On Error GoTo Err_Handle
    iFreeFile = FreeFile
    Open FilePathName For Input As iFreeFile
    LoadNodesFromFileWithFullPath TView, CanEnsureVisible
    Close iFreeFile
    Exit Sub
Err_Handle:
    Close iFreeFile
End Sub
Public Sub LoadNodesFromFileWithFullPath(TView As TreeView, CanEnsureVisible As Boolean)
    Dim text_line As String
    Dim level As Integer
    Dim tree_nodes() As Node
    Dim num_nodes As Integer
    Dim POS As Long
    TView.Nodes.Clear
    Do While Not EOF(iFreeFile)
        Line Input #iFreeFile, text_line
        level = UBound(Split(text_line, "\")) + 1
        If level > num_nodes Then
            num_nodes = level
            ReDim Preserve tree_nodes(1 To num_nodes)
        End If
        
        POS = InStrRev(text_line, "\")
        If POS Then text_line = Mid$(text_line, POS + 1)

        If level = 1 Then
            Set tree_nodes(level) = TView.Nodes.Add(, , CreateGUID, text_line, 1, 2)
            tree_nodes(level).EnsureVisible
        Else
            Set tree_nodes(level) = TView.Nodes.Add(tree_nodes(level - 1), tvwChild, CreateGUID, text_line, 1, 2)
            If CanEnsureVisible = True Then tree_nodes(level).EnsureVisible
        End If
    Loop
    TView.Nodes.Item(1).EnsureVisible
End Sub
Public Sub SaveTreeViewToFileWithTab(TView As TreeView, FilePathName As String)
    On Error GoTo Err_Handle
    iFreeFile = FreeFile()
    Open FilePathName For Output As #iFreeFile
    SaveTreeWithTab TView.Nodes.Item(1)
    Close #iFreeFile
    Exit Sub
Err_Handle:
    Close iFreeFile
    
End Sub
Public Sub SaveTreeWithTab(oNode As Node)
    Dim oSibNode As Node
    Set oSibNode = oNode
    Do
        Print #iFreeFile, String(UBound(Split(oSibNode.FullPath, "\")), vbTab) & oSibNode.Text
        If Not oSibNode.Child Is Nothing Then
            SaveTreeWithTab oSibNode.Child
        End If
        Set oSibNode = oSibNode.Next
   Loop While Not oSibNode Is Nothing
End Sub
Sub SaveTreeViewToFileWithFullPath(TView As TreeView, FilePathName As String)
    On Error GoTo Err_Handle
    iFreeFile = FreeFile()
    Open FilePathName For Output As #iFreeFile
    SaveTreeWithFullPath TView.Nodes.Item(1)
    Close #iFreeFile
    Exit Sub
Err_Handle:
    Close iFreeFile
End Sub
Public Sub SaveTreeWithFullPath(oNode As Node)
    Dim oSibNode As Node
    Set oSibNode = oNode
    Do
         Print #iFreeFile, oSibNode.FullPath
         If Not oSibNode.Child Is Nothing Then
             SaveTreeWithFullPath oSibNode.Child
         End If
         Set oSibNode = oSibNode.Next
    Loop While Not oSibNode Is Nothing
End Sub
Function GetFileText(ByVal strFilePathName As String) As String
    If FileExists(strFilePathName) Then
        Dim Buffer() As Byte
        ReDim Buffer(FileLen(strFilePathName))
        Open strFilePathName For Binary As #1  'Source
        Get #1, , Buffer
        Close
        GetFileText = Replace(BytesToStr(Buffer, False, False), Chr(0), "")
    End If
End Function
Public Function BytesToStr(Buffer() As Byte, _
    Optional IsAnsi As Boolean = True, _
    Optional IsUnicode As Boolean = False) As String
    Dim Unspecified     As Boolean
    Unspecified = (Abs(IsAnsi) + Abs(IsUnicode)) = 0
    If IsAnsi Or Unspecified Then
        BytesToStr = StrConv(Buffer, vbUnicode)
    Else
        BytesToStr = Buffer
    End If
End Function
Public Function FileExists(ByVal sFullPath As String) As Boolean
    FileExists = (Len(Dir(sFullPath)) > 0)
End Function