frmoptions.frm

游戏《家园》源码

    
    'Put status bar flag
    Call misPutVal(MIS_SEC_COM, MIS_KEY_STATB, Trim(Str(bStatFlag)), MIS_MOD_INI)
    
    'Reset list
    sList = ""
    For n = 0 To 2
        'Append list
        sList = sList + "|" + Format(aOffset(n) / fViewScale, "0.0;-0.0")
    Next n
    
    'Put offset
    Call misPutListByKey(MIS_SEC_GRAPH, MIS_KEY_VOFFSET, sList, MIS_MOD_INI)
    
    'Put default scale
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_VSCALE, Trim(Str(100 / fViewScale)), MIS_MOD_INI)

    'Put default color
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_VCOL, Trim(Str(nViewCol)), MIS_MOD_INI)

    'Put camera flag
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_CINDEP, Trim(Str(bCamFlag)), MIS_MOD_INI)
    
    'Reset list
    sList = ""
    For n = 0 To 2
        'Append list
        sList = sList + "|" + Format(aEye(n), "0.0;-0.0")
    Next n
    
    'Put eye
    Call misPutListByKey(MIS_SEC_GRAPH, MIS_KEY_CEYE, sList, MIS_MOD_INI)
    
    'Reset list
    sList = ""
    For n = 0 To 2
        'Append list
        sList = sList + "|" + Format(aFocus(n), "0.0;-0.0")
    Next n
    
    'Put focus
    Call misPutListByKey(MIS_SEC_GRAPH, MIS_KEY_CFOCUS, sList, MIS_MOD_INI)
    
    'Put camera color
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_CMCOL, Trim(Str(nCamCol)), MIS_MOD_INI)

    'Put grid flag
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_GSNAP, Trim(Str(bGridFlag)), MIS_MOD_INI)
    
    'Put grid size
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_GSIZE, Format(fGridSize, "0.0;-0.0"), MIS_MOD_INI)
    
    'Put grid color
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_GCOL, Trim(Str(nGridCol)), MIS_MOD_INI)
    
    'Put rotation flag
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_RSNAP, Trim(Str(bRotFlag)), MIS_MOD_INI)
    
    'Put rotation size
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_RANG, Format(fRotAngle, "0.0;-0.0"), MIS_MOD_INI)
    
    'Put rotation color
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_RCOL, Trim(Str(nRotCol)), MIS_MOD_INI)
    
    'Put scaling flag
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_SINDEP, Trim(Str(bScaleFlag)), MIS_MOD_INI)
    
    'Put selection color
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_SCOL, Trim(Str(nSelCol)), MIS_MOD_INI)
    
    'Put band box color
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_BCOL, Trim(Str(nBandCol)), MIS_MOD_INI)

    'Put cursor color
    Call misPutVal(MIS_SEC_GRAPH, MIS_KEY_CSCOL, Trim(Str(nCursCol)), MIS_MOD_INI)
    
    'Clear options flag
    bOptFlag = False
End Sub

Sub ShowOptions()
    'Get work dir
    txtWork.Text = sWDir
    
    'Get data dir
    txtData.Text = sDDir
    
    'Get object dir
    txtObjects.Text = sODir
    
    'Get toolbar flag
    chkTool.Value = bToolFlag
    
    'Get status bar flag
    chkStat.Value = bStatFlag
    
    'Get offset
    txtOffsetX.Text = Format(aOffset(0) / fViewScale, "0;-#")
    txtOffsetY.Text = Format(aOffset(1) / fViewScale, "0;-#")
    txtOffsetZ.Text = Format(aOffset(2) / fViewScale, "0;-#")
    
    'Get default scale
    txtScale.Text = Format(100 / fViewScale, "0;-#")

    'Get default color
    Call SelCol(0, nViewCol)

    'Get camera flag
    chkCam.Value = bCamFlag
    
    'Get camera eye
    txtEyeX.Text = Format(aEye(0), "0;-#")
    txtEyeY.Text = Format(aEye(1), "0;-#")
    txtEyeZ.Text = Format(aEye(2), "0;-#")
    
    'Get camera focus
    txtFocusX.Text = Format(aFocus(0), "0;-#")
    txtFocusY.Text = Format(aFocus(1), "0;-#")
    txtFocusZ.Text = Format(aFocus(2), "0;-#")
    
    'Get camera color
    Call SelCol(2, nCamCol)

    'Get grid flag
    chkGrid.Value = bGridFlag
    
    'Get grid size
    txtSize.Text = Format(fGridSize, "0;-#")
    
    'Get grid color
    Call SelCol(1, nGridCol)
    
    'Get rotation flag
    chkAngle.Value = bRotFlag
    
    'Get rotation size
    txtAngle.Text = Format(fRotAngle, "0;-#")
    
    'Get rotation color
    Call SelCol(3, nRotCol)
    
    'Get scaling flag
    chkScale.Value = bScaleFlag
    
    'Get selection color
    Call SelCol(4, nSelCol)
    
    'Get band box color
    Call SelCol(5, nBandCol)
    
    'Get cursor color
    Call SelCol(6, nCursCol)
End Sub

Sub UpdateOptions()
    Dim nCount As Integer
    
    Dim nCol As Long
    Dim nObj As Long
    
    Dim sVal As String
    Dim sList As String

    'Get work dir
    sVal = txtWork.Text
    If sVal <> "" Then sWDir = sVal
    If Mid(sWDir, Len(sWDir)) <> "\" Then sWDir = sWDir + "\"
    
    'Get data dir
    sVal = txtData.Text
    If sVal <> "" Then sDDir = sVal
    If Mid(sDDir, Len(sDDir)) <> "\" Then sDDir = sDDir + "\"
    
    'Get object dir
    sVal = txtObjects.Text
    If sVal <> "" Then sODir = sVal
    If Mid(sODir, Len(sODir)) <> "\" Then sODir = sODir + "\"
    
    'Get toolbar flag
    bToolFlag = chkTool.Value
    
    'Get status bar flag
    bStatFlag = chkStat.Value
    
    'Get default scale
    fViewScale = 100 / Val(txtScale.Text)

    'Get offset
    aOffset(0) = Val(txtOffsetX.Text) * fViewScale
    aOffset(1) = Val(txtOffsetY.Text) * fViewScale
    aOffset(2) = Val(txtOffsetZ.Text) * fViewScale
   
    'Get default color
    nCol = nViewCol
    nViewCol = FindCol(0)
    
    'Check default color
    If nCol <> nSelCol Then
        'Get selection
        Call rendGetSel("o", nCount, sList)
        
        'Re-initialize renderer
        rendClean
        rendInit
        frmObjects.GetObjects
        
        'Check count
        If nCount > 0 Then
            'Truncate list
            sList = TruncStr(sList)
            
            'Get selection
            Call rendSetSel("o", sList)
        End If
    End If

    'Get camera flag
    bCamFlag = chkCam.Value
    
    'Get camera eye
    aEye(0) = Val(txtEyeX.Text)
    aEye(1) = Val(txtEyeY.Text)
    aEye(2) = Val(txtEyeZ.Text)
    
    'Get camera focus
    aFocus(0) = Val(txtFocusX.Text)
    aFocus(1) = Val(txtFocusY.Text)
    aFocus(2) = Val(txtFocusZ.Text)
    
    'Get camera color
    nCamCol = FindCol(2)

    'Get grid flag
    bGridFlag = chkGrid.Value
    
    'Get grid size
    fGridSize = Val(txtSize.Text)
    
    'Get grid color
    nGridCol = FindCol(1)
    
    'Get rotation flag
    bRotFlag = chkAngle.Value
    
    'Get rotation size
    fRotAngle = Val(txtAngle.Text)
    
    'Get rotation color
    nRotCol = FindCol(3)
    
    'Get scaling flag
    bScaleFlag = chkScale.Value
    
    'Get selection color
    nSelCol = FindCol(4)
    
    'Get band box color
    nBandCol = FindCol(5)
       
    'Get cursor color
    nCursCol = FindCol(6)
       
    'Get flags
    fMainForm.GetFlags
    
    'Set options flag
    bOptFlag = True

    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Refresh front view
    frmFront.SetSel (False)
    frmFront.SetGrid (False)
    frmFront.SetCursor (False)
    frmFront.SetScale (False)
    frmFront.SetView (False)
    frmFront.SetCamera (True)
    
    'Refresh side view
    frmSide.SetSel (False)
    frmSide.SetGrid (False)
    frmSide.SetCursor (False)
    frmSide.SetScale (False)
    frmSide.SetView (False)
    frmSide.SetCamera (True)
    
    'Refresh top view
    frmTop.SetSel (False)
    frmTop.SetGrid (False)
    frmTop.SetCursor (False)
    frmTop.SetScale (False)
    frmTop.SetView (False)
    frmTop.SetCamera (True)
    
    'Refresh camera view
    frmCamera.SetSel (False)
    frmCamera.SetCamera (True)
End Sub

Sub SelCol(ByVal nIndex As Integer, ByVal nCol As Long)
    'Set flag
    bCombo = True
    
    'Check color
    If nCol < 0 Then
        'Set color
        cmbCol(nIndex).ListIndex = 0
        cmbCol(nIndex).BackColor = vbWhite
        Exit Sub
    End If
    
    'Set color
    cmbCol(nIndex).ListIndex = cmbCol(nIndex).ListCount - 1
    cmbCol(nIndex).BackColor = nCol

    'Clear flag
    bCombo = False
End Sub

Function FindCol(ByVal nIndex As Integer) As Long
    Dim n As Integer
    
    'Check combo
    If cmbCol(nIndex).ListCount > 1 Then
        If cmbCol(nIndex).ListIndex = 0 Then
            'Set color
            FindCol = cmbCol(nIndex).ItemData(0)
            Exit Function
        End If
    End If
        
    'Set color
    FindCol = cmbCol(nIndex).BackColor
End Function

Private Sub cmbCol_Click(Index As Integer)
    If bCombo = True Then Exit Sub
    
    'Check combo
    If cmbCol(Index).ListCount > 1 Then
        'Check combo
        If cmbCol(Index).ListIndex = 0 Then
            cmbCol(Index).BackColor = vbWhite
            Exit Sub
        End If
    End If
    
    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show open common dialog
    cdColor.Color = cmbCol(Index).BackColor
    cdColor.Flags = &H1
    cdColor.ShowColor
    
    'Set color
    cmbCol(Index).BackColor = cdColor.Color
    cmdApply.SetFocus
    Exit Sub
    
    'Cancel button handler
Cancel:
    Exit Sub
End Sub

Private Sub cmdApply_Click()
    'Update options
    UpdateOptions
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdData_Click()
    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show save common dialog
    cdBrowse.DialogTitle = "Select Data Directory"
    cdBrowse.FileName = "Select Data Directory"
    cdBrowse.ShowSave
    txtData.Text = Left(cdBrowse.FileName, InStr(1, cdBrowse.FileName, cdBrowse.FileTitle, vbTextCompare) - 1)
    Exit Sub
    
    'Cancel button handler
Cancel:
    Exit Sub
End Sub

Private Sub cmdObjects_Click()
    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show save common dialog
    cdBrowse.DialogTitle = "Select Object Directory"
    cdBrowse.FileName = "Select Object Directory"
    cdBrowse.ShowSave
    txtObjects.Text = Left(cdBrowse.FileName, InStr(1, cdBrowse.FileName, cdBrowse.FileTitle, vbTextCompare) - 1)
    Exit Sub
    
    'Cancel button handler
Cancel:
    Exit Sub
End Sub

Private Sub cmdOK_Click()
    'Update options
    UpdateOptions
    
    Unload Me
End Sub

Private Sub cmdReload_Click()
    'Get options
    GetOptions
    
    'Show options
    ShowOptions
End Sub

Private Sub cmdSave_Click()
    'Update options
    UpdateOptions
    
    'Put options
    PutOptions
End Sub

Private Sub cmdWork_Click()
    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show save common dialog
    cdBrowse.DialogTitle = "Select Work Directory"
    cdBrowse.FileName = "Select Work Directory"
    cdBrowse.ShowSave
    txtWork.Text = Left(cdBrowse.FileName, InStr(1, cdBrowse.FileName, cdBrowse.FileTitle, vbTextCompare) - 1)
    Exit Sub
    
    'Cancel button handler
Cancel:
    Exit Sub
End Sub

Private Sub Form_Load()
    Dim nMask As Long

    Dim sVal As String

    'Disable directory selection
    cmdWork.Enabled = False
    txtWork.Enabled = False
    cmdData.Enabled = False
    txtData.Enabled = False
    cmdObjects.Enabled = False
    txtObjects.Enabled = False
    
    'Get bit mask
    Call misGetVal(MIS_SEC_COM, MIS_KEY_BITM, sVal, MIS_MOD_CFG)
    sVal = TruncStr(sVal)
    If sVal <> "" Then
        'Set mask
        nMask = Val(sVal)
    
        'Check bit mask
        If (nMask And MIS_BIT_DEV) = MIS_BIT_DEV Then
            'Enable directory selection
            cmdWork.Enabled = True
            txtWork.Enabled = True
            cmdData.Enabled = True
            txtData.Enabled = True
            cmdObjects.Enabled = True
            txtObjects.Enabled = True
        End If
    End If
    
    'Clear flag
    bCombo = False
    
    'Show options
    ShowOptions
End Sub