frmlevels.frm

游戏《家园》源码

    nCount = 0
    
    'Get attribs
    Call misGetListByKey(frmMission.GetPrefix + MIS_SEC_LEV, MIS_KEY_ATTRIB, sList, nCount, MIS_MOD_CFG)
    
    'Check count
    If nCount = 0 Then Exit Sub
    
    'Truncate attribs
    sList = TruncStr(sList)

    'Loop thru names
    For n = 0 To nCount - 1
        'Get position of | character in string
        nPos = InStr(sList, "|")
        
        'Get default
        Call misGetVal(frmMission.GetPrefix + MIS_SEC_LEV, MIS_KEY_DEF + Trim(Str(n)), sVal, MIS_MOD_CFG)
        
        'Truncate default
        sVal = TruncStr(sVal)

        'If possible, truncate string at | character
        If nPos > 0 Then
            'Create new attrib
            Call frmAttribs.NewAttrib(sCurK, Left(sList, nPos - 1), sVal, "")
            sList = Mid(sList, nPos + 1, Len(sList))
        Else
            'Create new attrib
            Call frmAttribs.NewAttrib(sCurK, sList, sVal, "")
        End If
    Next n
End Sub

Sub DelLevel(ByVal sPKey As String, ByVal sCKey As String, ByVal sFile As String)
    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) <> "l" Then Exit Sub
    
    'Check parent
    If sPKey <> "" And sFile = "" Then
        'Prompt user
        If MsgBox("Delete level " + GetName(Val(Mid(sCKey, 2))) + "?", vbYesNo Or vbQuestion, "MissionMan") = vbNo Then Exit Sub
    End If
    
    'Del attribs
    Call frmAttribs.DelAttribs(sCKey, sFile)
    
    'Del objects
    Call frmObjects.DelObjects(sCKey, sFile)
    
    'Check file
    If sFile = "" Then
        'Check recordset
        If rsLevels.BOF = True Then Exit Sub
    End If
    
    'Set query
    sQuery = "SELECT * FROM Levels 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
            
    'Delete data
    rsTemp.Delete
    
    'Close temporary recordset
    Call CloseRecordSetByQuery(rsTemp, sFile)
    
    'Check file
    If sFile <> "" Then Exit Sub
    
    'Delete from tree
    Call frmTree.DelTree(sCKey)
    
    'Check parent
    If sPKey = "" Then Exit Sub
    
    'Select in tree
    Call frmTree.SelTree(sPKey)
    
    'Refresh graphics
    frmFront.Render
    frmTop.Render
    frmSide.Render
    frmCamera.Render
End Sub

Sub CopyLevel(ByVal sSrcKey As String, ByVal sDstKey As String, ByVal bFlag As Boolean, ByVal sSrcFile As String)
    Dim nKey As Long
    
    Dim sQuery As String
    
    Dim rsTemp As Recordset
    
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Check source
    If sSrcKey = "" Then Exit Sub
    If Left(sSrcKey, 1) <> "l" Then Exit Sub
    
    'Check destination
    If sDstKey = "" Then Exit Sub
    If Left(sDstKey, 1) <> "m" Then Exit Sub
    
    'Check source file
    If sSrcFile = "" Then
        'Check recordset
        If rsLevels.BOF = True Then Exit Sub
    End If
    
    'Set query
    sQuery = "SELECT * FROM Levels WHERE Key = " + Mid(sSrcKey, 2)
    
    'Open temporary recordset by query
    If OpenRecordSetByQuery(sQuery, rsTemp, sSrcFile) = False Then Exit Sub
        
    'Get data from recordset
    rsTemp.MoveFirst

    'Add data to recordset
    rsLevels.AddNew
    nKey = rsLevels!Key
    
    'Copy data
    rsLevels!NumObjs = rsTemp!NumObjs
    rsLevels!NumAttribs = rsTemp!NumAttribs
    rsLevels!Name = rsTemp!Name
    rsLevels!Info = rsTemp!Info
    rsLevels.Update
    
    'Close temporary recordset
    Call CloseRecordSetByQuery(rsTemp, sSrcFile)
    
    'Add to tree
    Call frmTree.AddTree(sDstKey, "l" + Trim(Str(nKey)))
    
    'Copy attrib
    Call frmAttribs.CopyAttribs(sSrcKey, "l" + Trim(Str(nKey)), sSrcFile)
   
    'Copy levels
    Call frmObjects.CopyObjects(sSrcKey, "l" + Trim(Str(nKey)), sSrcFile)
    
    'Check flag
    If bFlag = True Then Call DelLevel("", sSrcKey, sSrcFile)
    
    'Select in tree
    Call frmTree.SelTree("l" + Trim(Str(nKey)))
End Sub

Sub GenLevel(ByVal sKey As String, ByVal sFile As String)
    Dim bFlag As Boolean
    
    Dim n As Integer
    Dim nErr As Integer
    Dim nCount As Integer
    Dim nNum As Integer
    Dim nInd As Integer
    
    Dim nPos As Long
    Dim nObj As Long
    Dim nKey As Long
    Dim nStream As Long
    
    Dim fAngX As Single
    Dim fAngY As Single
    Dim fAngZ As Single
    Dim fAngH As Single
    Dim fAngV As Single
    Dim fSizeX As Single
    Dim fSizeY As Single
    Dim fSizeZ As Single
    
    Dim sQuery As String
    Dim sName As String
    Dim sAlias As String
    Dim sInfo As String
    Dim sExt As String
    Dim sForm As String
    Dim sMsg As String
    Dim sList As String
    Dim sVal As String
    
    Dim rsTemp As Recordset
    
    'Check DB
    If bDBFlag = False Then Exit Sub

    'Check key
    If sKey = "" Then Exit Sub
    If Left(sKey, 1) <> "l" Then Exit Sub
    
    'Check recordset
    If rsLevels.BOF = True Then Exit Sub
    
    'Set query
    sQuery = "SELECT * FROM Levels WHERE Key = " + Mid(sKey, 2)
    
    'Open temporary recordset by query
    If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Sub
        
    'Get data from recordset
    rsTemp.MoveFirst
    sName = rsTemp!Name
    sInfo = rsTemp!Info
    
    'Close temporary recordset
    rsTemp.Close
    
    'Get extension
    Call misGetVal(frmMission.GetPrefix + MIS_SEC_LEV, MIS_KEY_EXT, sExt, MIS_MOD_CFG)
    sExt = TruncStr(sExt)
    If sExt = "" Then Exit Sub
    
    'Set progress bar
    Call frmProgress.Init("Generating level " + sName + "...", 100)
    
    'Check file
    If sFile = "" Then sFile = sName + sExt
    
    'Open file
    nErr = misOpen(nStream, sFile)
    If nErr < 0 Then
        'Reset progress bar
        Call frmProgress.Clean
        
        'Inform user
        Call misGetErr(nErr, sMsg)
        Call MsgBox("Error: " + TruncStr(sMsg) + " " + sFile + " (Check attributes and directories)!", vbOKOnly Or vbExclamation, "MissionMan")
        Exit Sub
    End If
    
    'Write data
    Call misWriteInfo(nStream, "MissionMan script, " + Format(Date, "dddd, mmm d yyyy") + ", " + Format(Time, "h:mm:ss AMPM"))
    Call misWriteInfo(nStream, "Copyright (c) 1998-99, Relic Entertainment Inc.")
    Call misWriteInfo(nStream, frmMission.GetType + " Level: " + sName)
    If sInfo <> "" Then Call misWriteInfo(nStream, "Info: " + sInfo)
    misWriteNew (nStream)
    
    'Write data
    Call misWriteVal(nStream, "[%s]", sInfo)
    misWriteNew (nStream)
    misWriteNew (nStream)
    
    'Reset flag
    bFlag = False
    
    'Check recordset
    If rsObjects.BOF = False Then
        'Set query
        sQuery = "SELECT * FROM Objects WHERE Level = " + Mid(sKey, 2) + " AND Object = 0 ORDER BY Key"
    
        'Open temporary recordset by query
        If OpenRecordSetByQuery(sQuery, rsTemp, "") = True Then
            'Get data from recordset
            rsTemp.MoveFirst
            Do Until rsTemp.EOF
                'Update status bar
                Call frmProgress.Update(rsTemp.PercentPosition)
                
                'Get size
                Call rendFindObj(nObj, rsTemp!Key)
                Call rendGetObjSize(nObj, fSizeX, fSizeY, fSizeZ)
    
                'Get angles
                fAngX = rsTemp!RotX
                fAngY = rsTemp!RotY
                fAngZ = rsTemp!RotZ
                
                'Check angles
                If (rendAngCheck(fAngX, fAngY, fAngZ) < 0) Then
                    'Update database
                    rsTemp.Edit
                    rsTemp!RotX = fAngX
                    rsTemp!RotY = fAngY
                    rsTemp!RotZ = fAngZ
                    rsTemp.Update
                End If
                
                'Convert angles
                Call rendAngConv(fAngH, fAngV, rsTemp!RotX, rsTemp!RotY, rsTemp!RotZ)
               
                'Get vars
                Call misGetListByKey(frmMission.GetPrefix + MIS_SEC_OBJ + Trim(Str(rsTemp!Type - 1)), MIS_KEY_VAR, sList, nCount, MIS_MOD_CFG)
    
                'Check count
                If nCount > 0 Then
                    'Set flag
                    bFlag = True
                
                    'Truncate vars
                    sList = TruncStr(sList)

                    'Loop thru vars
                    For n = 0 To nCount - 1
                        'Reset name
                        sName = ""
                
                        'Get position of | character in string
                        nPos = InStr(sList, "|")
                
                        'If possible, truncate string at | character
                        If nPos > 0 Then
                            'Set name
                            sName = Left(sList, nPos - 1)
                            sList = Mid(sList, nPos + 1, Len(sList))
                        Else
                            'Set name
                            sName = sList
                        End If
                
                        'Check var
                        Select Case Trim(sName)
                            Case "!PosX"
                                sVal = Format(rsTemp!PosX, "0.0;-0.0")
                            Case "!PosY"
                                sVal = Format(rsTemp!PosY, "0.0;-0.0")
                            Case "!PosZ"
                                sVal = Format(rsTemp!PosZ, "0.0;-0.0")
                            Case "!ScaleX"
                                sVal = Format(rsTemp!ScaleX, "0.0;-0.0")
                            Case "!ScaleY"
                                sVal = Format(rsTemp!ScaleY, "0.0;-0.0")
                            Case "!ScaleZ"
                                sVal = Format(rsTemp!ScaleY, "0.0;-0.0")
                            Case "!SizeX"
                                sVal = Format(fSizeX * rsTemp!ScaleX, "0.0;-0.0")
                            Case "!SizeY"
                                sVal = Format(fSizeY * rsTemp!ScaleY, "0.0;-0.0")
                            Case "!SizeZ"
                                sVal = Format(fSizeZ * rsTemp!ScaleZ, "0.0;-0.0")
                            Case "!RotX"
                                sVal = Format(rsTemp!RotX, "0.0;-0.0")
                            Case "!RotY"
                                sVal = Format(rsTemp!RotY, "0.0;-0.0")
                            Case "!RotZ"
                                sVal = Format(rsTemp!RotY, "0.0;-0.0")
                            Case "!RotH"
                                sVal = Format(fAngH, "0.0;-0.0")