frmmain.frm

游戏《家园》源码

    If bDBFlag = False Then Exit Sub
    
    'Check key
    If sCurKey = "" Then Exit Sub
    If Left(sCurKey, 1) <> "o" Then Exit Sub
    If Left(sParKey, 1) <> "l" Then Exit Sub
    
    'Get extension
    nType = frmObjects.GetType(Val(Mid(sCurKey, 2)))
    Call misGetVal(frmMission.GetPrefix + MIS_SEC_OBJ + Trim(Str(nType - 1)), MIS_KEY_EXT, sExt, MIS_MOD_CFG)
    sExt = TruncStr(sExt)
    If sExt = "" Then Exit Sub
    
    'Get file
    sFile = frmObjects.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 Object File"
    cdMission.Filter = "Object Files (*" + sExt + ")|*" + sExt + "|All Files|*.*"
    cdMission.ShowSave
    sFile = cdMission.FileName
    
    'Reset handler for Cancel button
    On Error GoTo 0
    
    'Commit
    Call CommitDB("Generate Object")
    
    'Put file
    Call frmObjects.PutFile(sCurKey, sFile)
    
    'Generate object
    Call frmObjects.GenObject(sCurKey, sFile)
    Exit Sub
    
    'Cancel button handler
Cancel:
    Exit Sub
End Sub

Private Sub mnuPUTreeObjIns_Click()
    frmObjects.Show
    Call frmObjects.InsObject(sParKey, sCurKey, aCursor(0), aCursor(1), aCursor(2))
    frmObjects.SetFocus
End Sub

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

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

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

Private Sub mnuPUTreeObjPaste_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 mnuPUTreeObjProp_Click()
    frmObjects.Show
    Call frmObjects.GetObject(sParKey, sCurKey, 0, 0, 0)
    frmObjects.SetFocus
End Sub

Private Sub mnuPUTreeObjSel1_Click()
    mnuPUGraphObjSel1_Click
End Sub

Private Sub mnuPUTreeObjSel2_Click()
    mnuPUGraphObjSel2_Click
End Sub

Private Sub mnuPUTreeObjSel3_Click()
    mnuPUGraphObjSel3_Click
End Sub

Private Sub mnuPUTreeSelCollapse_Click()
    'Collapse tree
    Call frmTree.ExpandTree(False)
End Sub

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

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

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

Private Sub mnuPUTreeSelDesel_Click()
    'Deselect key
    frmTree.DelKey
End Sub

Private Sub mnuPUTreeSelExpand_Click()
    'Expand tree
    Call frmTree.ExpandTree(True)
End Sub

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

Private Sub mnuPUTreeSelClear_Click()
    'Set key
    frmTree.ShowList (sCurKey)
End Sub

Private Sub mnuToolsAngle_Click()
    If mnuToolsAngle.Checked Then
        bRotFlag = 0
        frmOptions.ShowOptions
        mnuToolsAngle.Checked = False
    Else
        bRotFlag = 1
        frmOptions.ShowOptions
        mnuToolsAngle.Checked = True
    End If
    
    'Show status
    ShowStatus (sCurKey)
End Sub

Private Sub mnuToolsCamera_Click()
    If mnuToolsCamera.Checked Then
        bCamFlag = 0
        frmOptions.ShowOptions
        mnuToolsCamera.Checked = False
    Else
        bCamFlag = 1
        frmOptions.ShowOptions
        mnuToolsCamera.Checked = True
    End If
    
    'Show status
    ShowStatus (sCurKey)
End Sub

Private Sub mnuToolsFind1_Click()
    'Set offset
    aOffset(0) = -aCursor(0) * fViewScale
    aOffset(1) = -aCursor(1) * fViewScale
    aOffset(2) = -aCursor(2) * fViewScale
    
    'Refresh
    frmFront.SetView (True)
    frmTop.SetView (True)
    frmSide.SetView (True)
End Sub

Private Sub mnuToolsFind2_Click()
    'Set offset
    aOffset(0) = 0
    aOffset(1) = 0
    aOffset(2) = 0
    
    'Set focus
    aFocus(0) = 0
    aFocus(1) = 0
    aFocus(2) = 0
    
    'Refresh
    frmFront.SetView (False)
    frmFront.SetCamera (True)
    frmTop.SetView (False)
    frmTop.SetCamera (True)
    frmSide.SetView (False)
    frmSide.SetCamera (True)
    frmCamera.SetCamera (True)
End Sub

Private Sub mnuToolsGrid_Click()
    If mnuToolsGrid.Checked Then
        bGridFlag = 0
        frmOptions.ShowOptions
        mnuToolsGrid.Checked = False
    Else
        bGridFlag = 1
        frmOptions.ShowOptions
        mnuToolsGrid.Checked = True
    End If
    
    'Show status
    ShowStatus (sCurKey)
End Sub

Private Sub mnuToolsScale_Click()
    If mnuToolsScale.Checked Then
        bScaleFlag = 0
        frmOptions.ShowOptions
        mnuToolsScale.Checked = False
    Else
        bScaleFlag = 1
        frmOptions.ShowOptions
        mnuToolsScale.Checked = True
    End If
    
    'Show status
    ShowStatus (sCurKey)
End Sub

Private Sub mnuToolsStatusBar_Click()
    If mnuToolsStatusBar.Checked Then
        bStatFlag = 0
        sbStatusBar.Visible = False
        mnuToolsStatusBar.Checked = False
    Else
        bStatFlag = 1
        sbStatusBar.Visible = True
        mnuToolsStatusBar.Checked = True
    End If
End Sub

Private Sub mnuToolsToolbar_Click()
    If mnuToolsToolbar.Checked Then
        bToolFlag = 0
        tbToolBar.Visible = False
        mnuToolsToolbar.Checked = False
    Else
        bToolFlag = 1
        tbToolBar.Visible = True
        mnuToolsToolbar.Checked = True
    End If
End Sub

Private Sub mnuToolsOptions_Click()
    frmOptions.Show
    frmOptions.SetFocus
End Sub

Private Sub mnuViewDock_Click()
    If mnuViewDock.Checked Then
        mnuViewDock.Checked = False
    Else
        mnuViewDock.Checked = True
    End If
End Sub

Private Sub mnuViewGraphCamera_Click()
    If mnuViewGraphCamera.Checked Then
        Unload frmCamera
    Else
        frmCamera.Show
        frmCamera.SetFocus
    End If
End Sub

Private Sub mnuViewGraphFront_Click()
    If mnuViewGraphFront.Checked Then
        Unload frmFront
    Else
        frmFront.Show
        frmFront.SetFocus
    End If
End Sub

Private Sub mnuViewGraphTop_Click()
    If mnuViewGraphTop.Checked Then
        Unload frmTop
    Else
        frmTop.Show
        frmTop.SetFocus
    End If
End Sub

Private Sub mnuViewGraphSide_Click()
    If mnuViewGraphSide.Checked Then
        Unload frmSide
    Else
        frmSide.Show
        frmSide.SetFocus
    End If
End Sub

Private Sub mnuViewList_Click()
    If mnuViewList.Checked Then
        Unload frmList
    Else
        frmList.Show
        frmList.SetFocus
    End If
End Sub

Private Sub mnuViewTree_Click()
    If mnuViewTree.Checked Then
        Unload frmTree
    Else
        frmTree.Show
        frmTree.GetTree (sListKey)
        frmTree.SetFocus
    End If
End Sub

Private Sub mnuViewRefresh_Click()
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Refresh tree
    frmTree.GetTree (sListKey)
    
    'Re-initialize renderer
    rendClean
    rendInit
    frmObjects.GetObjects
    Call rendSetSel("o", sListKey)
       
    'Show views
    frmCamera.Render
    frmFront.Render
    frmTop.Render
    frmSide.Render
    
    'Refresh layers
    frmLayers.GetLayers (0)
    
    'Refresh list
    Call frmList.GetList(sCurKey, "")
    
    'Set focus
    frmTree.SetFocus
End Sub

Private Sub mnuViewTabAttrib_Click()
    If mnuViewTabAttrib.Checked Then
        Unload frmAttribs
    Else
        frmAttribs.Show
        frmAttribs.SetFocus
    End If
End Sub

Private Sub mnuViewTabLayer_Click()
    If mnuViewTabLayer.Checked Then
        Unload frmLayers
    Else
        frmLayers.Show
        frmLayers.GetLayers (0)
        frmLayers.SetFocus
    End If
End Sub

Private Sub mnuViewTabLevel_Click()
    If mnuViewTabLevel.Checked Then
        Unload frmLevels
    Else
        frmLevels.Show
        frmLevels.SetFocus
    End If
End Sub

Private Sub mnuViewTabMission_Click()
    If mnuViewTabMission.Checked Then
        Unload frmMission
    Else
        frmMission.Show
        frmMission.SetFocus
    End If
End Sub

Private Sub mnuViewTabObject_Click()
    If mnuViewTabObject.Checked Then
        Unload frmObjects
    Else
        frmObjects.Show
        frmObjects.SetFocus
    End If
End Sub

Private Sub mnuWindowDefaultLayout_Click()
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Hide other views
    Unload frmList
    Unload frmLayers
    Unload frmMission
    Unload frmLevels
    Unload frmObjects
    Unload frmAttribs
    
    'Reset and show tree view
    frmTree.Reset
    frmTree.Show
    
    'Reset views
    frmCamera.Reset
    frmFront.Reset
    frmTop.Reset
    frmSide.Reset
    
    'Show views
    frmCamera.Show
    frmFront.Show
    frmTop.Show
    frmSide.Show
    
    'Set focus
    frmTree.SetFocus
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As ComctlLib.Button)
    Select Case Button.Key
        Case "Open"
            mnuFileOpen_Click
        Case "Generate"
            mnuFileGenerate_Click
        Case "Cut"
            mnuEditCut_Click
        Case "Copy"
            mnuEditCopy_Click
        Case "Paste"
            mnuEditPaste_Click
    End Select
End Sub

Private Sub mnuWindowArrangeIcons_Click()
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowTileVertical_Click()
    Me.Arrange vbTileVertical
End Sub

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

Private Sub mnuEditNew_Click()
    ' Check key
    If Left(sCurKey, 1) = "a" Then Exit Sub
    
    ' Check key
    If Left(sCurKey, 1) = "m" Then
        'New level
        frmLevels.Show
        Call frmLevels.GetLevel(sCurKey, "")
        frmLevels.SetFocus
        Exit Sub
    End If
    
    ' Check k