⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmoptions.frm

📁 游戏《家园》源码
💻 FRM
📖 第 1 页 / 共 3 页
字号:
         Left            =   120
         TabIndex        =   56
         Top             =   1020
         Width           =   615
      End
   End
   Begin VB.Frame fmeAngle 
      Caption         =   "Angle"
      Height          =   1395
      Left            =   6240
      TabIndex        =   45
      Top             =   1800
      Width           =   1875
      Begin VB.CheckBox chkAngle 
         Caption         =   "Snap Angle"
         Height          =   195
         Left            =   120
         TabIndex        =   17
         Top             =   240
         Width           =   1635
      End
      Begin VB.TextBox txtAngle 
         Height          =   285
         Left            =   840
         TabIndex        =   18
         Top             =   540
         Width           =   915
      End
      Begin VB.ComboBox cmbCol 
         Height          =   315
         Index           =   3
         ItemData        =   "frmOptions.frx":035C
         Left            =   840
         List            =   "frmOptions.frx":0367
         Style           =   2  'Dropdown List
         TabIndex        =   19
         Top             =   960
         Width           =   915
      End
      Begin VB.Label lblAngle 
         Caption         =   "Angle:"
         Height          =   195
         Left            =   120
         TabIndex        =   47
         Top             =   600
         Width           =   615
      End
      Begin VB.Label lblCol3 
         Caption         =   "Color:"
         Height          =   195
         Left            =   120
         TabIndex        =   46
         Top             =   1020
         Width           =   615
      End
   End
   Begin VB.Frame fmeGrid 
      Caption         =   "Grid"
      Height          =   1395
      Left            =   4200
      TabIndex        =   42
      Top             =   1800
      Width           =   1875
      Begin VB.ComboBox cmbCol 
         Height          =   315
         Index           =   1
         ItemData        =   "frmOptions.frx":0376
         Left            =   840
         List            =   "frmOptions.frx":0381
         Style           =   2  'Dropdown List
         TabIndex        =   16
         Top             =   960
         Width           =   915
      End
      Begin VB.TextBox txtSize 
         Height          =   285
         Left            =   840
         TabIndex        =   15
         Top             =   540
         Width           =   915
      End
      Begin VB.CheckBox chkGrid 
         Caption         =   "Snap Grid"
         Height          =   195
         Left            =   120
         TabIndex        =   14
         Top             =   240
         Width           =   1635
      End
      Begin VB.Label lbCol1 
         Caption         =   "Color:"
         Height          =   195
         Left            =   120
         TabIndex        =   44
         Top             =   1020
         Width           =   615
      End
      Begin VB.Label lblSize 
         Caption         =   "Size:"
         Height          =   195
         Left            =   120
         TabIndex        =   43
         Top             =   600
         Width           =   615
      End
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   4620
      TabIndex        =   33
      Tag             =   "OK"
      Top             =   5340
      Width           =   1095
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   5820
      TabIndex        =   34
      Tag             =   "Cancel"
      Top             =   5340
      Width           =   1095
   End
   Begin VB.CommandButton cmdApply 
      Caption         =   "&Apply"
      Height          =   375
      Left            =   7020
      TabIndex        =   35
      Tag             =   "Apply"
      Top             =   5340
      Width           =   1095
   End
   Begin VB.PictureBox picOptions 
      BorderStyle     =   0  'None
      Height          =   3780
      Index           =   3
      Left            =   -20000
      ScaleHeight     =   3840.968
      ScaleMode       =   0  'User
      ScaleWidth      =   5745.64
      TabIndex        =   37
      TabStop         =   0   'False
      Top             =   480
      Width           =   5685
      Begin VB.Frame fraSample4 
         Caption         =   "Sample 4"
         Height          =   2022
         Left            =   505
         TabIndex        =   41
         Tag             =   "Sample 4"
         Top             =   502
         Width           =   2033
      End
   End
   Begin VB.PictureBox picOptions 
      BorderStyle     =   0  'None
      Height          =   3780
      Index           =   2
      Left            =   -20000
      ScaleHeight     =   3840.968
      ScaleMode       =   0  'User
      ScaleWidth      =   5745.64
      TabIndex        =   39
      TabStop         =   0   'False
      Top             =   480
      Width           =   5685
      Begin VB.Frame fraSample3 
         Caption         =   "Sample 3"
         Height          =   2022
         Left            =   406
         TabIndex        =   40
         Tag             =   "Sample 3"
         Top             =   403
         Width           =   2033
      End
   End
   Begin VB.PictureBox picOptions 
      BorderStyle     =   0  'None
      Height          =   3780
      Index           =   1
      Left            =   -20000
      ScaleHeight     =   3840.968
      ScaleMode       =   0  'User
      ScaleWidth      =   5745.64
      TabIndex        =   36
      TabStop         =   0   'False
      Top             =   480
      Width           =   5685
      Begin VB.Frame fraSample2 
         Caption         =   "Sample 2"
         Height          =   2022
         Left            =   307
         TabIndex        =   38
         Tag             =   "Sample 2"
         Top             =   305
         Width           =   2033
      End
   End
   Begin MSComDlg.CommonDialog cdBrowse 
      Left            =   6240
      Top             =   4500
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      Filter          =   "Folders|Dir"
   End
   Begin MSComDlg.CommonDialog cdColor 
      Left            =   6840
      Top             =   4500
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
   End
End
Attribute VB_Name = "frmOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim bCombo As Boolean

Sub GetOptions()
    Dim n As Integer
    Dim nCount As Integer
    
    Dim nPos As Long
    
    Dim sVal As String
    Dim sList As String

    'Get work dir
    Call misGetVal(MIS_SEC_COM, MIS_KEY_WORKD, sWDir, MIS_MOD_INI)
    sWDir = TruncStr(sWDir)
    If sWDir = "" Then sWDir = MIS_DIR_WORK
    sWDir = DecodeEnv(sWDir)
        
    'Get data dir
    Call misGetVal(MIS_SEC_COM, MIS_KEY_DATAD, sDDir, MIS_MOD_INI)
    sDDir = TruncStr(sDDir)
    If sDDir = "" Then sDDir = MIS_DIR_DATA
    sDDir = DecodeEnv(sDDir)
    
    'Get object dir
    Call misGetVal(MIS_SEC_COM, MIS_KEY_OBJD, sODir, MIS_MOD_INI)
    sODir = TruncStr(sODir)
    If sODir = "" Then sODir = MIS_DIR_OBJ
    sODir = DecodeEnv(sODir)
    
    'Get toolbar flag
    bToolFlag = MIS_FLAG_TOOL
    Call misGetVal(MIS_SEC_COM, MIS_KEY_TOOLB, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then bToolFlag = Val(sVal)
    
    'Get status bar flag
    bStatFlag = MIS_FLAG_STAT
    Call misGetVal(MIS_SEC_COM, MIS_KEY_STATB, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then bStatFlag = Val(sVal)
    
    'Reset count
    nCount = 0
    
    'Get offset
    Call misGetListByKey(MIS_SEC_GRAPH, MIS_KEY_VOFFSET, sList, nCount, MIS_MOD_INI)
    
    'Check count
    If nCount > 0 Then
        'Truncate list
        sList = TruncStr(sList)

        'Loop thru list
        For n = 0 To 2
            'Get position of | character in string
            nPos = InStr(sList, "|")
        
            'If possible, truncate string at | character
            If nPos > 0 Then
                'Set eye
                aOffset(n) = Val(Left(sList, nPos - 1))
                sList = Mid(sList, nPos + 1, Len(sList))
            Else
                'Set eye
                aOffset(n) = Val(sList)
            End If
        Next n
    End If
    
    'Get default scale
    fViewScale = MIS_REND_VSCALE
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_VSCALE, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then fViewScale = 100 / Val(sVal)

    'Set offset
    aOffset(0) = MIS_REND_VOX * fViewScale
    aOffset(1) = MIS_REND_VOY * fViewScale
    aOffset(2) = MIS_REND_VOZ * fViewScale
    
    'Get default color
    nViewCol = MIS_REND_VCOL
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_VCOL, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then nViewCol = Val(sVal)

    'Get camera flag
    bCamFlag = MIS_CAM_INDEP
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_CINDEP, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then bCamFlag = Val(sVal)
    
    'Set camera eye
    aEye(0) = MIS_CAM_EX
    aEye(1) = MIS_CAM_EY
    aEye(2) = MIS_CAM_EZ
    
    'Set camera focus
    aFocus(0) = MIS_CAM_FX
    aFocus(1) = MIS_CAM_FY
    aFocus(2) = MIS_CAM_FZ
    
    'Reset count
    nCount = 0
    
    'Get eye
    Call misGetListByKey(MIS_SEC_GRAPH, MIS_KEY_CEYE, sList, nCount, MIS_MOD_INI)
    
    'Check count
    If nCount > 0 Then
        'Truncate list
        sList = TruncStr(sList)

        'Loop thru list
        For n = 0 To 2
            'Get position of | character in string
            nPos = InStr(sList, "|")
        
            'If possible, truncate string at | character
            If nPos > 0 Then
                'Set eye
                aEye(n) = Val(Left(sList, nPos - 1))
                sList = Mid(sList, nPos + 1, Len(sList))
            Else
                'Set eye
                aEye(n) = Val(sList)
            End If
        Next n
    End If
    
    'Reset count
    nCount = 0
    
    'Get focus
    Call misGetListByKey(MIS_SEC_GRAPH, MIS_KEY_CFOCUS, sList, nCount, MIS_MOD_INI)
    
    'Check count
    If nCount > 0 Then
        'Truncate list
        sList = TruncStr(sList)

        'Loop thru list
        For n = 0 To 2
            'Get position of | character in string
            nPos = InStr(sList, "|")
        
            'If possible, truncate string at | character
            If nPos > 0 Then
                'Set focus
                aFocus(n) = Val(Left(sList, nPos - 1))
                sList = Mid(sList, nPos + 1, Len(sList))
            Else
                'Set focus
                aFocus(n) = Val(sList)
            End If
        Next n
    End If
    
    'Get camera color
    nCamCol = MIS_CAM_COL
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_CMCOL, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then nCamCol = Val(sVal)

    'Get grid flag
    bGridFlag = MIS_REND_GSNAP
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_GSNAP, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then bGridFlag = Val(sVal)
    
    'Get grid size
    fGridSize = MIS_REND_GSIZE
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_GSIZE, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then fGridSize = Val(sVal)
    
    'Get grid color
    nGridCol = MIS_REND_GCOL
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_GCOL, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then nGridCol = Val(sVal)
    
    'Get rotation flag
    bRotFlag = MIS_REND_RSNAP
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_RSNAP, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then bRotFlag = Val(sVal)
    
    'Get rotation size
    fRotAngle = MIS_REND_RANG
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_RANG, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then fRotAngle = Val(sVal)
    
    'Get rotation color
    nRotCol = MIS_REND_RCOL
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_RCOL, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then nRotCol = Val(sVal)
    
    'Get scaling flag
    bScaleFlag = MIS_REND_SINDEP
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_SINDEP, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then bScaleFlag = Val(sVal)
    
    'Get selection color
    nSelCol = MIS_REND_SCOL
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_SCOL, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then nSelCol = Val(sVal)
    
    'Get band box color
    nBandCol = MIS_REND_BCOL
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_BCOL, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then nBandCol = Val(sVal)

    'Get cursor color
    nCursCol = MIS_REND_CCOL
    Call misGetVal(MIS_SEC_GRAPH, MIS_KEY_CSCOL, sVal, MIS_MOD_INI)
    sVal = TruncStr(sVal)
    If sVal <> "" Then nCursCol = Val(sVal)
End Sub

Sub PutOptions()
    Dim n As Integer
    Dim nCount As Integer
    
    Dim nPos As Long
    Dim nMask As Long
   
    Dim sVal As String
    Dim sList As String

    '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
            'Put work dir
            sWDir = EncodeEnv(sWDir)
            Call misPutVal(MIS_SEC_COM, MIS_KEY_WORKD, sWDir, MIS_MOD_INI)
            
            'Put data dir
            sDDir = EncodeEnv(sDDir)
            Call misPutVal(MIS_SEC_COM, MIS_KEY_DATAD, sDDir, MIS_MOD_INI)
            
            'Put object dir
            sODir = EncodeEnv(sODir)
            Call misPutVal(MIS_SEC_COM, MIS_KEY_OBJD, sODir, MIS_MOD_INI)
        End If
    End If
    
    'Put toolbar flag
    Call misPutVal(MIS_SEC_COM, MIS_KEY_TOOLB, Trim(Str(bToolFlag)), MIS_MOD_INI)

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -