frmtree.frm

游戏《家园》源码

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "Comctl32.ocx"
Begin VB.Form frmTree 
   Caption         =   "Tree"
   ClientHeight    =   3210
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4650
   Icon            =   "FrmTree.frx":0000
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3210
   ScaleWidth      =   4650
   Begin VB.ListBox lstTree 
      Height          =   1968
      IntegralHeight  =   0   'False
      ItemData        =   "FrmTree.frx":030A
      Left            =   120
      List            =   "FrmTree.frx":030C
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   1080
      Width           =   4395
   End
   Begin ComctlLib.TreeView tvTree 
      CausesValidation=   0   'False
      Height          =   855
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4395
      _ExtentX        =   7752
      _ExtentY        =   1508
      _Version        =   327682
      HideSelection   =   0   'False
      LabelEdit       =   1
      LineStyle       =   1
      Sorted          =   -1  'True
      Style           =   6
      Appearance      =   1
   End
   Begin VB.PictureBox pbTree 
      BorderStyle     =   0  'None
      Height          =   2940
      Left            =   120
      MousePointer    =   7  'Size N S
      ScaleHeight     =   2940
      ScaleWidth      =   4335
      TabIndex        =   2
      Top             =   120
      Width           =   4332
   End
End
Attribute VB_Name = "frmTree"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    
'Local variables
Dim bClick As Boolean

Dim nShift As Integer

Dim fMx As Single
Dim fMy As Single
Dim fRy As Single
Dim fHeight As Single

Dim aPos(4) As Single

Dim nodTree As Node

Sub GetTree(ByVal sList As String)
    'Check flag
    If Not fMainForm.mnuViewTree.Checked Then Exit Sub
    
    'Hide tree
    tvTree.Visible = False

    'Clear tree
    tvTree.Nodes.Clear
    
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Check flag
    If Not fMainForm.mnuViewTree.Checked Then Exit Sub
    
    'Get mission
    GetMission
    
    'Get levels
    GetLevels
    
    'Get objects
    GetObjects
    
    'Get attribs
    GetAttribs
      
    'Select tree
    SelTree (sList)

    'Show tree
    tvTree.Visible = True
End Sub

Sub SelTree(ByVal sList As String)
    Dim bFlag As Boolean
    
    Dim sQuery As String
    
    Dim rsTemp As Recordset
    
    'Clear flag
    bFlag = False
    
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Set flag
    If sList <> sListKey Then bFlag = True
    
    'Set list
    If sList <> "" Then sListKey = sList
    
    'Set keys
    sCurKey = FirstStr(sListKey, " ")
    sParKey = ""
       
    'Check current key
    If sCurKey = "a" Then
        'Set current key
        sCurKey = "o"
        
        'Check recordset
        If rsAttribs.BOF = False Then
            'Open temporary recordset by query
            sQuery = "SELECT * FROM Attrib"
            If OpenRecordSetByQuery(sQuery, rsTemp, "") = True Then
                'Get data from recordset
                rsTemp.MoveFirst
                sCurKey = "a" + Trim(Str(rsTemp!Key))
                sListKey = sCurKey
                
                'Close temporary recordset
                rsTemp.Close
            End If
        End If
    End If
    
    'Check current key
    If sCurKey = "o" Then
        'Set current key
        sCurKey = "l"
        
        'Check recordset
        If rsObjects.BOF = False Then
            'Open temporary recordset by query
            sQuery = "SELECT * FROM Objects"
            If OpenRecordSetByQuery(sQuery, rsTemp, "") = True Then
                'Get data from recordset
                rsTemp.MoveFirst
                sCurKey = "o" + Trim(Str(rsTemp!Key))
                sListKey = sCurKey
                
                'Close temporary recordset
                rsTemp.Close
            End If
        End If
    End If
    
    'Check current key
    If sCurKey = "l" Then
        'Set current key
        sCurKey = "m"
        
        'Check recordset
        If rsLevels.BOF = False Then
            'Open temporary recordset by query
            sQuery = "SELECT * FROM Levels"
            If OpenRecordSetByQuery(sQuery, rsTemp, "") = True Then
                'Get data from recordset
                rsTemp.MoveFirst
                sCurKey = "l" + Trim(Str(rsTemp!Key))
                sListKey = sCurKey
                
                'Close temporary recordset
                rsTemp.Close
            End If
        End If
    End If
    
    'Set node error handler
    On Error GoTo NodeErr
    
    'Check flag
    If fMainForm.mnuViewTree.Checked Then
        'Set parent key
        If Left(sCurKey, 1) <> "m" Then
            sParKey = tvTree.Nodes.Item(sCurKey).Parent.Key
        End If
    
        'Select node
        tvTree.Nodes.Item(sCurKey).Selected = True
    End If
    
    'Show list
    If bFlag = True Then ShowList (sListKey)
    
    'Get status
    fMainForm.ShowStatus (sCurKey)
    Exit Sub
    
NodeErr:
    'Select tree
    SelTree (Left(sCurKey, 1))
End Sub

Sub AddTree(ByVal sPKey As String, ByVal sCKey As String)
    Dim sTxt As String
    Dim sVal As String
    Dim sQuery As String
    
    Dim rsTemp As Recordset
    
    'Check flag
    If Not fMainForm.mnuViewTree.Checked Then Exit Sub
    
    ' Check key
    If Left(sCKey, 1) = "l" Then
        'Check recordset
        If rsLevels.BOF = True Then Exit Sub
    
        'Open temporary recordset by query
        sQuery = "SELECT * FROM Levels WHERE Key = " + Mid(sCKey, 2)
        If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Sub
        
        'Get data from recordset
        rsTemp.MoveFirst
        sTxt = rsTemp!Name
        
        'Close temporary recordset
        rsTemp.Close
        
        'Add node
        Set nodTree = tvTree.Nodes.Add(sPKey, tvwChild, sCKey, sTxt)
        nodTree.Expanded = True
        Exit Sub
    End If
    
    ' Check key
    If Left(sCKey, 1) = "o" Then
        'Check recordset
        If rsObjects.BOF = True Then Exit Sub
    
        'Open temporary recordset by query
        sQuery = "SELECT * FROM Objects WHERE Key = " + Mid(sCKey, 2)
        If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Sub
        
        'Get data from recordset
        rsTemp.MoveFirst
        sTxt = rsTemp!Name
        
        'Get type
        Call misGetVal(frmMission.GetPrefix + MIS_SEC_OBJ + Trim(Str(rsTemp!Type - 1)), MIS_KEY_TYPE, sVal, MIS_MOD_CFG)
        sVal = TruncStr(sVal)
        If sVal <> "" Then sTxt = sVal + ": " + sTxt
        
        'Close temporary recordset
        rsTemp.Close
        
        'Add node
        Set nodTree = tvTree.Nodes.Add(sPKey, tvwChild, sCKey, sTxt)
        If Left(sPKey, 1) = "l" Then
            nodTree.Expanded = True
        Else
            nodTree.Expanded = False
        End If
        Exit Sub
    End If
    
    ' Check key
    If Left(sCKey, 1) = "a" Then
        'Check recordset
        If rsAttribs.BOF = True Then Exit Sub
    
        'Open temporary recordset by query
        sQuery = "SELECT * FROM Attrib WHERE Key = " + Mid(sCKey, 2)
        If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Sub
        
        'Get data from recordset
        rsTemp.MoveFirst
        sTxt = rsTemp!Name
        If rsTemp!Value <> "" Then sTxt = sTxt + ": " + rsTemp!Value
        
        'Close temporary recordset
        rsTemp.Close
        
        'Add node
        Set nodTree = tvTree.Nodes.Add(sPKey, tvwChild, sCKey, sTxt)
        nodTree.Expanded = False
        Exit Sub
    End If
End Sub

Sub EditTree(ByVal sKey As String)
    Dim sTxt As String
    Dim sVal As String
    Dim sQuery As String
    
    Dim rsTemp As Recordset
    
    'Check flag
    If Not fMainForm.mnuViewTree.Checked Then Exit Sub
    
    ' Check key
    If Left(sKey, 1) = "m" Then
        rsMission.MoveFirst
        sTxt = rsMission!Name + ": " + frmMission.GetType
    End If
    
    ' Check key
    If Left(sKey, 1) = "l" Then
        'Check recordset
        If rsLevels.BOF = True Then Exit Sub
    
        'Open temporary recordset by query
        sQuery = "SELECT * FROM Levels WHERE Key = " + Mid(sKey, 2)
        If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Sub
        
        'Get data from recordset
        rsTemp.MoveFirst
        sTxt = rsTemp!Name
        
        'Close temporary recordset
        rsTemp.Close
    End If
    
    ' Check key
    If Left(sKey, 1) = "o" Then
        'Check recordset
        If rsObjects.BOF = True Then Exit Sub
    
        'Open temporary recordset by query
        sQuery = "SELECT * FROM Objects WHERE Key = " + Mid(sKey, 2)
        If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Sub
        
        'Get data from recordset
        rsTemp.MoveFirst
        sTxt = rsTemp!Name
        
        'Get type
        Call misGetVal(frmMission.GetPrefix + MIS_SEC_OBJ + Trim(Str(rsTemp!Type - 1)), MIS_KEY_TYPE, sVal, MIS_MOD_CFG)
        sVal = TruncStr(sVal)
        If sVal <> "" Then sTxt = sVal + ": " + sTxt
        
        'Close temporary recordset
        rsTemp.Close
    End If
    
    ' Check key
    If Left(sKey, 1) = "a" Then
        'Check recordset
        If rsAttribs.BOF = True Then Exit Sub
    
        'Open temporary recordset by query
        sQuery = "SELECT * FROM Attrib WHERE Key = " + Mid(sKey, 2)
        If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Sub
        
        'Get data from recordset
        rsTemp.MoveFirst
        sTxt = rsTemp!Name
        If rsTemp!Value <> "" Then sTxt = sTxt + ": " + rsTemp!Value
        
        'Close temporary recordset
        rsTemp.Close
    End If
    
    'Edit node
    tvTree.Nodes.Item(sKey).Text = sTxt
End Sub

Sub ShowTree(ByVal sList As String)
    'Set list
    sListKey = sList

    'Set current key
    sCurKey = FirstStr(sListKey, " ")
    
    'Set parent key
    If Left(sCurKey, 1) = "m" Then
        sParKey = ""
    Else
        sParKey = tvTree.Nodes.Item(sCurKey).Parent.Key
    End If
    
    'Get status
    fMainForm.ShowStatus (sCurKey)
        
    ' Check node key
    If Left(sCurKey, 1) = "m" Then
        'Select objects
        Call rendSetSel("o", "")
    End If
    
    ' Check node key
    If Left(sCurKey, 1) = "l" Then
        'Select objects
        Call rendSetSel("o", "")
    End If
    
    ' Check node key
    If Left(sCurKey, 1) = "o" Then
        'Select objects
        Call rendSetSel("o", sListKey)
    End If
    
    ' Check node key
    If Left(sCurKey, 1) = "a" Then
        'Select objects
        Call rendSetSel("o", "")
    End If
    
    'Show list
    ShowList (sListKey)