frmmain.frm

游戏《家园》源码

            fPosY = -(fPosY Mod fGridSize)
        Else
            fPosY = Sgn(fPosY) * fGridSize - (fPosY Mod fGridSize)
        End If
    
        'Snap y translation to grid
        If Abs(fPosZ) Mod fGridSize < fGridSize / 2 Then
            fPosZ = -(fPosZ Mod fGridSize)
        Else
            fPosZ = Sgn(fPosZ) * fGridSize - (fPosZ Mod fGridSize)
        End If
    
        'Translate object
        Call rendTransObj(nObj, fPosX, fPosY, fPosZ)
    End If
    
    'Set object position
    Call frmObjects.EditObject(Val(Mid(sCurKey, 2)))
    
    'Refresh graphics
    frmFront.Render
    frmTop.Render
    frmSide.Render
    frmCamera.Render
End Sub

Private Sub mnuPUGraphObjCopy_Click()
    'Set copy key and delete flag
    sCopyKey = sCurKey
    bDelFlag = False
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUGraphObjCut_Click()
    'Set copy key and delete flag
    sCopyKey = sCurKey
    bDelFlag = True
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUGraphObjDel_Click()
    'Commit
    Call CommitDB("Delete")
    
    'Delete item(s)
    Call DelList(sParKey, sCurKey, "")
End Sub

Private Sub mnuPUGraphObjDup_Click()
    'Commit
    Call CommitDB("Duplicate Objects")
    
    Call frmObjects.DupObjects(aCursor(0), aCursor(1), aCursor(2))
End Sub

Private Sub mnuPUGraphObjFind_Click()
    Call mnuEditFind_Click
End Sub

Private Sub mnuPUGraphObjList_Click()
    frmList.Show
    Call frmList.GetList(sCurKey, "")
    frmList.SetFocus
End Sub

Private Sub mnuPUGraphObjNew_Click()
    frmAttribs.Show
    Call frmAttribs.GetAttrib(sCurKey, "")
    frmAttribs.SetFocus
End Sub

Private Sub mnuPUGraphObjPaste_Click()
    'Get data from clipboard
    FromClipboard
    
    ' Check copy key
    If InStr(sCopyKey, "l") > 0 Then Exit Sub
    If InStr(sCopyKey, "o") > 0 Then Exit Sub
    
    'Commit
    Call CommitDB("Paste")
    
    'Copy item(s)
    Call CopyList(sCopyKey, sCurKey, sParKey, bDelFlag, sCopyFile)
End Sub

Private Sub mnuPUGraphObjProp_Click()
    frmObjects.Show
    Call frmObjects.GetObject(sParKey, sCurKey, 0, 0, 0)
    frmObjects.SetFocus
End Sub

Private Sub mnuPUGraphObjSel1_Click()
    Dim sList As String

    'Select links
    sList = frmObjects.SelGlobal(Val(Mid(sCurKey, 2)))
    If sList = "" Then Exit Sub
    sListKey = sList
    
    'Check form
    If mnuViewTabObject.Checked = True Then Call frmObjects.GetObject("", sListKey, 0, 0, 0)
    If mnuViewTabAttrib.Checked = True Then Call frmAttribs.GetAttrib("", sListKey)
    
    'Show list
    frmTree.ShowList (sListKey)
        
    'Set selection
    Call rendSetSel("o", sList)
    
    'Refresh graphics
    frmFront.Render
    frmTop.Render
    frmSide.Render
    frmCamera.Render
End Sub

Private Sub mnuPUGraphObjSel2_Click()
    Dim sList As String

    'Select links
    sList = frmObjects.SelObjects(Val(Mid(sCurKey, 2)))
    If sList = "" Then Exit Sub
    sListKey = sList
    
    'Check form
    If mnuViewTabObject.Checked = True Then Call frmObjects.GetObject("", sListKey, 0, 0, 0)
    If mnuViewTabAttrib.Checked = True Then Call frmAttribs.GetAttrib("", sListKey)
    
    'Show list
    frmTree.ShowList (sListKey)
        
    'Set selection
    Call rendSetSel("o", sList)
    
    'Refresh graphics
    frmFront.Render
    frmTop.Render
    frmSide.Render
    frmCamera.Render
End Sub

Private Sub mnuPUGraphObjSel3_Click()
    Dim sList As String
    
    sList = frmObjects.SelPath(Val(Mid(sCurKey, 2)))
    If sList = "" Then Exit Sub
    sListKey = sList
    
    'Check form
    If mnuViewTabObject.Checked = True Then Call frmObjects.GetObject("", sListKey, 0, 0, 0)
    If mnuViewTabAttrib.Checked = True Then Call frmAttribs.GetAttrib("", sListKey)
    
    'Show list
    frmTree.ShowList (sListKey)
        
    'Set selection
    Call rendSetSel("o", sList)
    
    'Refresh graphics
    frmFront.Render
    frmTop.Render
    frmSide.Render
    frmCamera.Render
End Sub

Private Sub mnuPUGraphSelCopy_Click()
    'Set copy key and delete flag
    sCopyKey = sListKey
    bDelFlag = False
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUGraphSelCut_Click()
    'Set copy key and delete flag
    sCopyKey = sListKey
    bDelFlag = True
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUGraphSelDel_Click()
    'Commit
    Call CommitDB("Delete")
    
    'Delete item(s)
    Call DelList(sParKey, sListKey, "")
End Sub

Private Sub mnuPUGraphSelProp_Click()
    'Get list property
    GetListProp
End Sub

Private Sub mnuPUListCopy_Click()
    'Set copy key and delete flag
    sCopyKey = sCurKey
    bDelFlag = False
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUListCut_Click()
    'Set copy key and delete flag
    sCopyKey = sCurKey
    bDelFlag = True
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUListDel_Click()
    'Commit
    Call CommitDB("Delete Attribute")
    
    'Del attrib
    Call frmAttribs.DelAttrib(sParKey, sCurKey, "")
End Sub

Private Sub mnuPUListNew_Click()
    frmAttribs.Show
    Call frmAttribs.GetAttrib(sCurKey, "")
    frmAttribs.SetFocus
End Sub

Private Sub mnuPUListPaste_Click()
    'Get data from clipboard
    FromClipboard
    
    'Check copy key
    If InStr(sCopyKey, " ") > 0 Then Exit Sub
    
    'Commit
    Call CommitDB("Paste")
    
    'Copy item(s)
    Call CopyList(sCopyKey, sCurKey, sParKey, bDelFlag, sCopyFile)
End Sub

Private Sub mnuPUListProp_Click()
    frmAttribs.Show
    Call frmAttribs.GetAttrib(sParKey, sCurKey)
    frmAttribs.SetFocus
End Sub

Private Sub mnuPUObjFileBrowse_Click()
    'Browse
    frmObjects.BrowseObject
End Sub

Private Sub mnuPUObjFileOpen_Click()
    Dim sFile As String

    'Get path
    sFile = frmObjects.txtFile.Text
    
    'Check path
    If InStr(sFile, ":") = 0 Then
        'Update path
        sFile = sObjDir + sFile
    End If
    
    'Attempt to open
    Call misShellExec(sFile)
End Sub

Private Sub mnuPUTreeAttribCopy_Click()
    'Set copy key and delete flag
    sCopyKey = sCurKey
    bDelFlag = False
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUTreeAttribCut_Click()
    'Set copy key and delete flag
    sCopyKey = sCurKey
    bDelFlag = True
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUTreeAttribDel_Click()
    'Commit
    Call CommitDB("Delete Attribute")
    
    'Del attrib
    Call frmAttribs.DelAttrib(sParKey, sCurKey, "")
End Sub

Private Sub mnuPUTreeAttribProp_Click()
    frmAttribs.Show
    Call frmAttribs.GetAttrib(sParKey, sCurKey)
    frmAttribs.SetFocus
End Sub

Private Sub mnuPUTreeLevCopy_Click()
    'Set copy key and delete flag
    sCopyKey = sCurKey
    bDelFlag = False
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUTreeLevCut_Click()
    'Set copy key and delete flag
    sCopyKey = sCurKey
    bDelFlag = True
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUTreeLevDel_Click()
    'Commit
    Call CommitDB("Delete Level")
    
    'Del level
    Call frmLevels.DelLevel(sParKey, sCurKey, "")
End Sub

Private Sub mnuPUTreeLevGen_Click()
    Dim sFile As String
    Dim sExt As String
    
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Check key
    If sCurKey = "" Then Exit Sub
    If Left(sCurKey, 1) <> "l" Then Exit Sub
    
    '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 file
    sFile = frmLevels.GetFile(sCurKey, -1)

    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show common dialog
    cdMission.FileName = sFile
    cdMission.InitDir = sDataDir
    cdMission.DefaultExt = sExt
    cdMission.DialogTitle = "Generate Level File"
    cdMission.Filter = "Level Files (*" + sExt + ")|*" + sExt + "|All Files|*.*"
    cdMission.ShowSave
    sFile = cdMission.FileName
    
    'Reset handler for Cancel button
    On Error GoTo 0

    'Commit
    Call CommitDB("Generate Level")
    
    'Generate level
    Call frmLevels.GenLevel(sCurKey, sFile)
    Exit Sub
    
    'Cancel button handler
Cancel:
    Exit Sub
End Sub

Private Sub mnuPUTreeLevList_Click()
    frmList.Show
    Call frmList.GetList(sCurKey, "")
    frmList.SetFocus
End Sub

Private Sub mnuPUTreeLevNew1_Click()
    frmObjects.Show
    Call frmObjects.GetObject(sCurKey, "", aCursor(0), aCursor(1), aCursor(2))
    frmObjects.SetFocus
End Sub

Private Sub mnuPUTreeLevNew2_Click()
    frmAttribs.Show
    Call frmAttribs.GetAttrib(sCurKey, "")
    frmAttribs.SetFocus
End Sub

Private Sub mnuPUTreeLevPaste_Click()
    'Get data from clipboard
    FromClipboard
    
    ' Check copy key
    If InStr(sCopyKey, "l") > 0 Then Exit Sub
    
    'Commit
    Call CommitDB("Paste")
    
    'Copy item(s)
    Call CopyList(sCopyKey, sCurKey, sParKey, bDelFlag, sCopyFile)
End Sub

Private Sub mnuPUTreeLevProp_Click()
    frmLevels.Show
    Call frmLevels.GetLevel(sParKey, sCurKey)
    frmLevels.SetFocus
End Sub

Private Sub mnuPUTreeMisGen_Click()
    'Commit
    Call CommitDB("Generate Mission")
    
    'Generate mission
    frmLevels.GenLevels
End Sub

Private Sub mnuPUTreeMisNew_Click()
    frmLevels.Show
    Call frmLevels.GetLevel(sCurKey, "")
    frmLevels.SetFocus
End Sub

Private Sub mnuPUTreeMisPaste_Click()
    'Get data from clipboard
    FromClipboard
    
    ' Check copy key
    If InStr(sCopyKey, " ") > 0 Then Exit Sub
    
    'Commit
    Call CommitDB("Paste")
    
    'Copy item(s)
    Call CopyList(sCopyKey, sCurKey, sParKey, bDelFlag, sCopyFile)
End Sub

Private Sub mnuPUTreeMisProp_Click()
    frmMission.Show
    frmMission.GetMission
    frmMission.SetFocus
End Sub

Private Sub mnuPUTreeObjCopy_Click()
    'Set copy key and delete flag
    sCopyKey = sCurKey
    bDelFlag = False
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUTreeObjCut_Click()
    'Set copy key and delete flag
    sCopyKey = sCurKey
    bDelFlag = True
    sCopyFile = ""
    
    'Put data in clipboard
    ToClipboard
End Sub

Private Sub mnuPUTreeObjDel_Click()
    'Commit
    Call CommitDB("Delete Object")
    
    'Del object
    Call frmObjects.DelObject(sParKey, sCurKey, "")
End Sub

Private Sub mnuPUTreeObjFind_Click()
    Call mnuEditFind_Click
End Sub

Private Sub mnuPUTreeObjGen_Click()
    Dim nType As Integer
    
    Dim nPos As Long

    Dim sFile As String
    Dim sExt As String
    
    'Check DB