frmattribs.frm

游戏《家园》源码

        'Get type
        nType = frmObjects.GetType(Val(Mid(sParK, 2)))
    
        'Get constants
        Call misGetListByKey(frmMission.GetPrefix + MIS_SEC_OBJ + Trim(Str(nType - 1)), MIS_KEY_CONST, sList, nCount, MIS_MOD_CFG)
    End If
    
    'Check count
    If nCount = 0 Then Exit Sub
    
    'Truncate constants
    sList = TruncStr(sList)

    'Loop thru constants
    For n = 0 To nCount - 1
        'Get position of | character in string
        nPos = InStr(sList, "|")
        
        'If possible, truncate string at | character
        If nPos > 0 Then
            'Add constant to combo
            cmbValue.AddItem (Left(sList, nPos - 1))
            sList = Mid(sList, nPos + 1, Len(sList))
        Else
            'Add constant to combo
            cmbValue.AddItem (sList)
        End If
    Next n
End Sub

Sub GetAll(ByVal sKey As String, ByVal sName As String, nKey As Long, sVal As String, sInfo As String)
    Dim bFlag As Boolean

    Dim sQuery As String
    
    Dim rsTemp As Recordset
    
    'Reset data
    sVal = ""
    sInfo = ""
    
    'Check recordset
    If rsAttribs.BOF = True Then
        nKey = -1
        Exit Sub
    End If
    
    'Reset Query
    sQuery = ""
    
    'Check source
    If Left(sKey, 1) = "l" Then
        'Set query
        sQuery = "SELECT * FROM Attrib WHERE Key > " + Str(nKey) + " AND Level = " + Mid(sKey, 2) + " AND Object = 0 AND Name = """ + sName + """ ORDER BY Key"
    End If
    
    'Check source
    If Left(sKey, 1) = "o" Then
        'Set query
        sQuery = "SELECT * FROM Attrib WHERE Key > " + Str(nKey) + " AND Level = 0 AND Object = " + Mid(sKey, 2) + " AND Name = """ + sName + """ ORDER BY Key"
    End If
    
    'Check query
    If sQuery = "" Then
        nKey = -1
        Exit Sub
    End If
        
    'Open temporary recordset by query
    If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then
        nKey = -1
        Exit Sub
    End If
        
    'Get data from recordset
    rsTemp.MoveFirst
    nKey = rsTemp!Key
    sVal = rsTemp!Value
    sInfo = rsTemp!Info
    
    'Close temporary recordset
    rsTemp.Close
End Sub

Function GetKey() As Long
    'Default
    GetKey = 0
    
    'Check form
    If fMainForm.mnuViewTabAttrib.Checked = False Then Exit Function
    
    'Return Key
    GetKey = Val(Mid(sCurK, 2))
End Function

Sub PutAttrib()
    Dim nType As Integer
    
    Dim nPos As Long
    Dim nObj As Long
    Dim nLink As Long
    Dim nRLev As Long
    Dim nRObj As Long
    
    Dim sCKey As String
    Dim sLKey As String
    Dim sQuery As String
    
    Dim rsTemp As Recordset
            
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Check key
    If sListK = "" Then
        'Add object
        AddAttrib
        Exit Sub
    End If
    
    'Check recordset
    If rsAttribs.BOF = True Then Exit Sub
    
    'Set list
    sLKey = sListK
    
    'Loop thru types
    Do
        'Get position of space character in string
        nPos = InStr(sLKey, " ")
        
        'If possible, truncate string at space character
        If nPos > 0 Then
            'Set key
            sCKey = Left(sLKey, nPos - 1)
            sLKey = Mid(sLKey, nPos + 1, Len(sLKey))
        Else
            'Set key
            sCKey = sLKey
        End If
        
        'Check key
        If Left(sCKey, 1) = "a" Then
            'Set query
            sQuery = "SELECT * FROM Attrib WHERE Key = " + Mid(sCKey, 2)
            
            'Open temporary recordset by query
            If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Sub
                
            'Put data in recordset
            rsTemp.MoveFirst
                    
            'Get data from controls
            rsTemp.Edit
            If cmbName.BackColor = vbWindowBackground Then rsTemp!Name = Trim(cmbName.Text)
            If cmbValue.BackColor = vbWindowBackground Then rsTemp!Value = Trim(cmbValue.Text)
            If txtInfo.BackColor = vbWindowBackground Then rsTemp!Info = Trim(txtInfo.Text)
            rsTemp.Update
            
            'Close temporary recordset
            rsTemp.Close
        
            'Edit and select tree
            frmTree.EditTree (sCKey)
        End If
        
        'Check position
        If nPos = 0 Then Exit Do
    Loop
    
    'Select in tree
    frmTree.SelTree ("")
    
    'Get list
    Call frmList.GetList("", "")
    
    'Check parent
    If Left(sParK, 1) <> "o" Then Exit Sub
    
    'Set link
    Call rendFindObj(nObj, Val(Mid(sParK, 2)))
    Call frmObjects.GetAll(Val(Mid(sParK, 2)), nRLev, nRObj, nType)
    Call rendFindObj(nLink, frmObjects.GetLink(Val(Mid(sParK, 2)), nRLev, nRObj, nType))
    Call rendSetObjLink(nObj, nLink)
    
    'Refresh graphics
    frmFront.Render
    frmTop.Render
    frmSide.Render
    frmCamera.Render
End Sub

Sub AddAttrib()
    Dim nType As Integer
    
    Dim nObj As Long
    Dim nLink As Long
    Dim nRLev As Long
    Dim nRObj As Long
    
    'Add data to recordset
    rsAttribs.AddNew
    
    'Set key
    sCurK = "a" + Trim(Str(rsAttribs!Key))
    sListK = sCurK

    'Check parent
    If Left(sParK, 1) = "l" Then
        rsAttribs!Level = Val(Mid(sParK, 2))
    Else
        rsAttribs!Level = 0
    End If
    
    'Check parent
    If Left(sParK, 1) = "o" Then
        rsAttribs!Object = Val(Mid(sParK, 2))
    Else
        rsAttribs!Object = 0
    End If
    
    'Get data from controls
    rsAttribs!Name = Trim(cmbName.Text)
    rsAttribs!Value = Trim(cmbValue.Text)
    rsAttribs!Info = Trim(txtInfo.Text)
    rsAttribs.Update
    
    'Add to tree
    Call frmTree.AddTree(sParK, sCurK)
    
    'Select in tree
    Call frmTree.SelTree(sCurK)
    
    'Get list
    Call frmList.GetList(sParK, sCurK)

    'Check parent
    If Left(sParK, 1) <> "o" Then Exit Sub
    
    'Set link
    Call rendFindObj(nObj, Val(Mid(sParK, 2)))
    Call frmObjects.GetAll(Val(Mid(sParK, 2)), nRLev, nRObj, nType)
    Call rendFindObj(nLink, frmObjects.GetLink(Val(Mid(sParK, 2)), nRLev, nRObj, nType))
    Call rendSetObjLink(nObj, nLink)
    
    'Refresh graphics
    frmFront.Render
    frmTop.Render
    frmSide.Render
    frmCamera.Render
End Sub

Sub NewAttrib(ByVal sKey As String, ByVal sName As String, ByVal sVal As String, ByVal sInfo As String)
    Dim nKey As Long
    Dim nObj As Long
    Dim nLink As Long

    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Check key
    If sKey = "" Then Exit Sub
    If Left(sKey, 1) = "m" Then Exit Sub
    If Left(sKey, 1) = "a" Then Exit Sub
    
    'Add data to recordset
    rsAttribs.AddNew
    nKey = rsAttribs!Key
    
    'Check parent
    If Left(sKey, 1) = "l" Then
        rsAttribs!Level = Val(Mid(sKey, 2))
    Else
        rsAttribs!Level = 0
    End If
    
    'Check parent
    If Left(sKey, 1) = "o" Then
        rsAttribs!Object = Val(Mid(sKey, 2))
    Else
        rsAttribs!Object = 0
    End If
    
    'Set data
    rsAttribs!Name = Trim(sName)
    rsAttribs!Value = Trim(sVal)
    rsAttribs!Info = Trim(sInfo)
    rsAttribs.Update
        
    'Add to tree
    Call frmTree.AddTree(sKey, "a" + Trim(Str(nKey)))
End Sub

Sub EditAttrib(ByVal nKey As Long, ByVal sName As String, ByVal sVal As String, ByVal sInfo As String)
    Dim nType As Integer
    
    Dim nRKey As Long
    Dim nObj As Long
    Dim nLink As Long
    Dim nRLev As Long
    Dim nRObj As Long
    
    Dim sQuery As String
    
    Dim rsTemp As Recordset
            
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Check recordset
    If rsAttribs.BOF = True Then Exit Sub
    
    'Set query
    sQuery = "SELECT * FROM Attrib WHERE Key = " + Str(nKey)
    
    'Open temporary recordset by query
    If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Sub
        
    'Put data in recordset
    rsTemp.MoveFirst
    nRKey = rsTemp!Object
        
    'Set data
    rsTemp.Edit
    rsTemp!Name = Trim(sName)
    rsTemp!Value = Trim(sVal)
    rsTemp!Info = Trim(sInfo)
    rsTemp.Update
    
    'Close temporary recordset
    rsTemp.Close
    
    'Update form
    If fMainForm.mnuViewTabAttrib.Checked = True And Val(Mid(sCurK, 2)) = nKey Then
        'Update data in controls
        cmbName.Text = Trim(sName)
        cmbValue.Text = Trim(sVal)
        txtInfo.Text = Trim(sInfo)
    End If
    
    'Edit and select in tree
    Call frmTree.EditTree("a" + Trim(Str(nKey)))
    
    'Get list
    Call frmList.GetList(sParK, sCurK)
    
    'Check parent
    If nRKey = 0 Then Exit Sub
    
    'Set link
    Call rendFindObj(nObj, nRKey)
    Call frmObjects.GetAll(nRKey, nRLev, nRObj, nType)
    Call rendFindObj(nLink, frmObjects.GetLink(nRKey, nRLev, nRObj, nType))
    Call rendSetObjLink(nObj, nLink)
    
    'Refresh graphics
    frmFront.Render
    frmTop.Render
    frmSide.Render
    frmCamera.Render
End Sub

Sub DelAttrib(ByVal sPKey As String, ByVal sCKey As String, ByVal sFile As String)
    Dim nKey As Long
    Dim nObj As Long
    
    Dim sQuery As String
    
    Dim rsTemp As Recordset
            
    'Check file
    If sFile = "" Then
        'Check DB
        If bDBFlag = False Then Exit Sub
    End If
    
    'Check key
    If sCKey = "" Then Exit Sub
    If Left(sCKey, 1) <> "a" Then Exit Sub
    
    'Check parent
    If sPKey <> "" And sFile = "" Then
        'Prompt user
        If MsgBox("Delete attribute " + GetName(Val(Mid(sCKey, 2))) + "?", vbYesNo Or vbQuestion, "MissionMan") = vbNo Then Exit Sub
    End If
    
    'Check file
    If sFile = "" Then
        'Check recordset
        If rsAttribs.BOF = True Then Exit Sub
    End If
    
    'Set query
    sQuery = "SELECT * FROM Attrib WHERE Key = " + Mid(sCKey, 2)
    
    'Open temporary recordset by query
    If OpenRecordSetByQuery(sQuery, rsTemp, sFile) = False Then Exit Sub
        
    'Delete data in recordset
    rsTemp.MoveFirst
    nKey = rsTemp!Object
            
    'Delete data
    rsTemp.Delete
    
    'Close temporary recordset
    Call CloseRecordSetByQuery(rsTemp, sFile)
    
    'Delete from tree
    Call frmTree.DelTree(sCKey)
    
    'Check parent
    If nKey > 0 Then