frmlevels.frm

游戏《家园》源码

                            Case "!RotV"
                                sVal = Format(fAngV, "0.0;-0.0")
                            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 "!SizeX/2"
                                sVal = Format(fSizeX * rsTemp!ScaleX / 2, "0.0;-0.0")
                            Case "!SizeY/2"
                                sVal = Format(fSizeY * rsTemp!ScaleY / 2, "0.0;-0.0")
                            Case "!SizeZ/2"
                                sVal = Format(fSizeZ * rsTemp!ScaleZ / 2, "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")
                            Case "-!RotV"
                                sVal = Format(-fAngV, "0.0;-0.0")
                            Case "!Type"
                                Call misGetVal(frmMission.GetPrefix + MIS_SEC_OBJ + Trim(Str(rsTemp!Type - 1)), MIS_KEY_TYPE, sVal, MIS_MOD_CFG)
                                sVal = TruncStr(sVal)
                            Case "!Name"
                                sVal = Trim(rsTemp!Name)
                            Case "!File"
                                sVal = Trim(rsTemp!File)
                            Case "!Count"
                                Call frmObjects.CountLinks(rsTemp!Key, rsTemp!Level, rsTemp!Object, rsTemp!Type, nInd, nNum)
                                sVal = Trim(Str(nInd)) + "/" + Trim(Str(nNum))
                            Case Else
                                'Reset key
                                nKey = 0
                                
                                'Check value
                                If Left(sName, 1) = "-" Then
                                    'Get negative value
                                    Call frmAttribs.GetAll("o" + Trim(Str(rsTemp!Key)), Mid(sName, 2), nKey, sVal, sInfo)
                                    If sVal = "" Then sVal = MIS_NAM_NULL
                                    sVal = "-" + sVal
                                Else
                                    'Get positive value
                                    Call frmAttribs.GetAll("o" + Trim(Str(rsTemp!Key)), sName, nKey, sVal, sInfo)
                                    If sVal = "" Then sVal = MIS_NAM_NULL
                                End If
                        End Select
                
                        'Get format
                        Call misGetVal(frmMission.GetPrefix + MIS_SEC_OBJ + Trim(Str(rsTemp!Type - 1)), MIS_KEY_FORM + Trim(Str(n)), sForm, MIS_MOD_CFG)
        
                        'Truncate format
                        sForm = TruncStr(sForm)

                        'Write data
                        If n = 0 And rsTemp!Info <> "" Then Call misWriteInfo(nStream, rsTemp!Info)
                        Call misWriteVal(nStream, sForm, sVal)
                    Next n
            
                    'Write newline
                    misWriteNew (nStream)
                End If
        
                rsTemp.MoveNext
            Loop
            
            'Close temporary recordset
            rsTemp.Close
    
        'Check flag
        If bFlag = True Then misWriteNew (nStream)
        End If
    End If
    
    'Reset progress bar
    Call frmProgress.Clean
    
    'Get attribs
    Call misGetListByKey(frmMission.GetPrefix + MIS_SEC_LEV, MIS_KEY_ATTRIB, sList, nCount, MIS_MOD_CFG)
    
    'Check count
    If nCount > 0 Then
        'Set progress bar
        Call frmProgress.Init("Generating attributes for level " + sName + "...", nCount)
    
        'Truncate attribs
        sList = TruncStr(sList)

        'Loop thru attribs
        For n = 0 To nCount - 1
            'Update status bar
            Call frmProgress.Update(n)
            
            '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
            
            'Reset key
            nKey = 0
                           
            'Loop
            Do Until nKey < 0
                'Get values
                Call frmAttribs.GetAll(sKey, sName, nKey, sVal, sInfo)
                If sVal <> "" Then
                    'Get alias
                    Call misGetVal(frmMission.GetPrefix + MIS_SEC_LEV, MIS_KEY_ALIAS + Trim(Str(n)), sAlias, MIS_MOD_CFG)
                    sAlias = TruncStr(sAlias)
                    If sAlias = "" Then sAlias = sName
        
                    'Write data
                    If sInfo <> "" Then Call misWriteInfo(nStream, sInfo)
                    Call misWriteAttrib(nStream, sAlias, sVal)
                End If
            Loop
        Next n
        
        'Reset progress bar
        Call frmProgress.Clean
    End If
        
    'Close event file
    misClose (nStream)
End Sub

Sub GenLevels()
    Dim nInd As Integer
    
    Dim sQuery As String
    Dim sFile As String
    
    Dim rsTemp As Recordset
    
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Check recordset
    If rsLevels.BOF = True Then Exit Sub
    
    'Prompt user
    If MsgBox("Generate all level and object files?", vbYesNo Or vbQuestion, "MissionMan") = vbNo Then Exit Sub
    
    'Set query
    sQuery = "SELECT * FROM Levels"
    
    'Open temporary recordset by query
    If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Sub
        
    'Reset index
    nInd = 0
    
    'Get data from recordset
    rsTemp.MoveFirst
    Do Until rsTemp.EOF
        'Generate objects
        frmObjects.GenObjects ("l" + Trim(Str(rsTemp!Key)))
        
        'Get file
        sFile = GetFile("l" + Trim(Str(rsTemp!Key)), nInd)

        'Generate level
        Call GenLevel("l" + Trim(Str(rsTemp!Key)), sFile)

        'Increment index
        nInd = nInd + 1
        rsTemp.MoveNext
    Loop
    
    'Close temporary recordset
    rsTemp.Close
End Sub

Function CountObjects(ByVal nKey As Long) As Integer
    Dim nCount As Integer

    Dim sQuery As String
    
    Dim rsTemp As Recordset
    
    'Reset count
    CountObjects = 0
    
    'Check recordset
    If rsObjects.BOF = True Then Exit Function
    
    'Set query
    sQuery = "SELECT * FROM Objects WHERE Level = " + Str(nKey) + " AND Object = 0 ORDER BY Key"
    
    'Open temporary recordset by query
    If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Function
        
    'Get data from recordset
    rsTemp.MoveFirst
    Do Until rsTemp.EOF
        CountObjects = CountObjects + 1
        rsTemp.MoveNext
    Loop
    
    'Close temporary recordset
    rsTemp.Close
End Function

Function CountAttribs(ByVal nKey As Long) As Integer
    Dim nCount As Integer

    Dim sQuery As String
    
    Dim rsTemp As Recordset
    
    'Reset count
    CountAttribs = 0
    
    'Check recordset
    If rsAttribs.BOF = True Then Exit Function
    
    'Set query
    sQuery = "SELECT * FROM Attrib WHERE Level = " + Str(nKey) + " AND Object = 0 ORDER BY Key"
    
    'Open temporary recordset by query
    If OpenRecordSetByQuery(sQuery, rsTemp, "") = False Then Exit Function
        
    'Get data from recordset
    rsTemp.MoveFirst
    Do Until rsTemp.EOF
        CountAttribs = CountAttribs + 1
        rsTemp.MoveNext
    Loop
    
    'Close temporary recordset
    rsTemp.Close
End Function

Private Sub cmdApply_Click()
    'Commit
    Call CommitDB("Edit Level")
    
    'Put level
    PutLevel
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    'Commit
    Call CommitDB("Edit Level")
    
    'Put level
    PutLevel
    
    Unload Me
End Sub

Private Sub Form_Load()
    Dim n As Integer
    Dim nCount As Integer
    
    Dim nPos As Long
        
    Dim sList As String

    'Set tree view position
    aPos(0) = fMainForm.ScaleWidth / 4
    aPos(1) = fMainForm.ScaleHeight / 4
    
    'Reset count
    nCount = 0
    
    'Get window
    Call misGetListByKey(MIS_SEC_COM, MIS_KEY_LEVT, sList, nCount, MIS_MOD_INI)
    
    'Check count
    If nCount > 0 Then
        'Truncate list
        sList = TruncStr(sList)

        'Loop thru list
        For n = 0 To 1
            'Get position of | character in string
            nPos = InStr(sList, "|")
        
            'If possible, truncate string at | character
            If nPos > 0 Then
                'Set position
                aPos(n) = Val(Left(sList, nPos - 1)) * fConvScale
                sList = Mid(sList, nPos + 1, Len(sList))
            Else
                'Set position
                aPos(n) = Val(sList) * fConvScale
            End If
        Next n
    End If
    
    'Initialize form
    On Error Resume Next
    Call Me.Move(aPos(0), aPos(1))
    On Error GoTo 0
    fMainForm.mnuViewTabLevel.Checked = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim n As Integer
    
    Dim sList As String
    
    'Cleanup form
    fMainForm.mnuViewTabLevel.Checked = False

    'Check position
    If aPos(0) = Me.Left And aPos(1) = Me.Top Then Exit Sub
    
    'Set position
    aPos(0) = Me.Left
    aPos(1) = Me.Top
    
    'Reset list
    sList = ""
    For n = 0 To 1
        'Append list
        sList = sList + "|" + Format(aPos(n) / fConvScale, "0.0;-0.0")
    Next n
    
    'Put window
    Call misPutListByKey(MIS_SEC_COM, MIS_KEY_LEVT, sList, MIS_MOD_INI)
End Sub

Private Sub txtInfo_Change()
    'Reset color
    txtInfo.BackColor = vbWindowBackground
End Sub

Private Sub txtName_Change()
    'Reset color
    txtName.BackColor = vbWindowBackground
End Sub