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

📄 frmobjects.frm

📁 游戏《家园》源码
💻 FRM
📖 第 1 页 / 共 5 页
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmObjects 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Object"
   ClientHeight    =   5010
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4665
   Icon            =   "frmObjects.frx":0000
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   5010
   ScaleWidth      =   4665
   Begin VB.CheckBox chkLayer 
      Caption         =   "Check1"
      Height          =   192
      Left            =   720
      TabIndex        =   35
      ToolTipText     =   "Select by Layer"
      Top             =   1560
      Width           =   132
   End
   Begin VB.CheckBox chkName 
      Caption         =   "Check1"
      Height          =   192
      Left            =   720
      TabIndex        =   34
      ToolTipText     =   "Select By Name"
      Top             =   660
      Width           =   132
   End
   Begin VB.CheckBox chkType 
      Caption         =   "Check1"
      Height          =   192
      Left            =   720
      TabIndex        =   33
      ToolTipText     =   "Select By Type"
      Top             =   180
      Width           =   132
   End
   Begin VB.TextBox txtSizeX 
      Height          =   285
      Left            =   1020
      TabIndex        =   15
      Top             =   4020
      Width           =   1095
   End
   Begin VB.TextBox txtSizeY 
      Height          =   285
      Left            =   2220
      TabIndex        =   16
      Top             =   4020
      Width           =   1095
   End
   Begin VB.TextBox txtSizeZ 
      Height          =   285
      Left            =   3420
      TabIndex        =   17
      Top             =   4020
      Width           =   1095
   End
   Begin VB.TextBox txtScaleX 
      Height          =   285
      Left            =   1020
      TabIndex        =   12
      Top             =   3600
      Width           =   1095
   End
   Begin VB.TextBox txtScaleY 
      Height          =   285
      Left            =   2220
      TabIndex        =   13
      Top             =   3600
      Width           =   1095
   End
   Begin VB.TextBox txtScaleZ 
      Height          =   285
      Left            =   3420
      TabIndex        =   14
      Top             =   3600
      Width           =   1095
   End
   Begin VB.ComboBox cmbLayer 
      Height          =   315
      Left            =   1020
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   1500
      Width           =   3495
   End
   Begin VB.TextBox txtFile 
      Height          =   285
      Left            =   1200
      OLEDropMode     =   1  'Manual
      TabIndex        =   5
      Top             =   1980
      Width           =   3315
   End
   Begin VB.CommandButton cmdBrowse 
      Caption         =   "4"
      BeginProperty Font 
         Name            =   "Webdings"
         Size            =   8.25
         Charset         =   2
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   1020
      TabIndex        =   4
      Tag             =   "Apply"
      ToolTipText     =   "Browse"
      Top             =   1980
      Width           =   195
   End
   Begin VB.TextBox txtPosX 
      Height          =   285
      Left            =   1020
      TabIndex        =   6
      Top             =   2760
      Width           =   1095
   End
   Begin VB.TextBox txtPosY 
      Height          =   285
      Left            =   2220
      TabIndex        =   7
      Top             =   2760
      Width           =   1095
   End
   Begin VB.TextBox txtPosZ 
      Height          =   285
      Left            =   3420
      TabIndex        =   8
      Top             =   2760
      Width           =   1095
   End
   Begin VB.TextBox txtRotZ 
      Height          =   285
      Left            =   3420
      TabIndex        =   11
      Top             =   3180
      Width           =   1095
   End
   Begin VB.TextBox txtRotY 
      Height          =   285
      Left            =   2220
      TabIndex        =   10
      Top             =   3180
      Width           =   1095
   End
   Begin VB.TextBox txtRotX 
      Height          =   285
      Left            =   1020
      TabIndex        =   9
      Top             =   3180
      Width           =   1095
   End
   Begin VB.ComboBox cmbName 
      Height          =   315
      Left            =   1020
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   600
      Width           =   3495
   End
   Begin MSComDlg.CommonDialog cdBrowse 
      Left            =   120
      Top             =   4440
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      DialogTitle     =   "Open File"
      Filter          =   "All Files|*.*"
   End
   Begin VB.ComboBox cmbType 
      Height          =   315
      Left            =   1020
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   120
      Width           =   3495
   End
   Begin VB.TextBox txtInfo 
      Height          =   285
      Left            =   1020
      TabIndex        =   2
      Top             =   1080
      Width           =   3495
   End
   Begin VB.CommandButton cmdApply 
      Caption         =   "&Apply"
      Height          =   375
      Left            =   3420
      TabIndex        =   20
      Tag             =   "Apply"
      Top             =   4500
      Width           =   1095
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   2220
      TabIndex        =   19
      Tag             =   "Cancel"
      Top             =   4500
      Width           =   1095
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   1020
      TabIndex        =   18
      Tag             =   "OK"
      Top             =   4500
      Width           =   1095
   End
   Begin VB.Label lblSize 
      Caption         =   "Size:"
      Height          =   195
      Left            =   120
      TabIndex        =   32
      Top             =   4080
      Width           =   825
   End
   Begin VB.Label lblScale 
      Caption         =   "Scale:"
      Height          =   195
      Left            =   120
      TabIndex        =   31
      Top             =   3660
      Width           =   795
   End
   Begin VB.Label lblLayer 
      Caption         =   "Layer:"
      Height          =   192
      Left            =   120
      TabIndex        =   30
      Top             =   1560
      Width           =   552
   End
   Begin VB.Label lblFile 
      Caption         =   "File:"
      Height          =   195
      Left            =   120
      TabIndex        =   29
      Top             =   2040
      Width           =   795
   End
   Begin VB.Label lblPos 
      Caption         =   "Position:"
      Height          =   195
      Left            =   120
      TabIndex        =   28
      Top             =   2820
      Width           =   795
   End
   Begin VB.Label lblRot 
      Caption         =   "Rotation:"
      Height          =   195
      Left            =   120
      TabIndex        =   27
      Top             =   3240
      Width           =   795
   End
   Begin VB.Label lblX 
      Alignment       =   2  'Center
      Caption         =   "x"
      Height          =   195
      Left            =   1020
      TabIndex        =   26
      Top             =   2460
      Width           =   1095
   End
   Begin VB.Label lblY 
      Alignment       =   2  'Center
      Caption         =   "y"
      Height          =   195
      Left            =   2220
      TabIndex        =   25
      Top             =   2460
      Width           =   1095
   End
   Begin VB.Label lblZ 
      Alignment       =   2  'Center
      Caption         =   "z"
      Height          =   195
      Left            =   3420
      TabIndex        =   24
      Top             =   2460
      Width           =   1095
   End
   Begin VB.Label lplType 
      Caption         =   "Type:"
      Height          =   192
      Left            =   120
      TabIndex        =   23
      Top             =   180
      Width           =   552
   End
   Begin VB.Label lblInfo 
      Caption         =   "Info:"
      Height          =   195
      Left            =   120
      TabIndex        =   22
      Top             =   1140
      Width           =   795
   End
   Begin VB.Label lblName 
      Caption         =   "Name:"
      Height          =   192
      Left            =   120
      TabIndex        =   21
      Top             =   660
      Width           =   552
   End
End
Attribute VB_Name = "frmObjects"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim bSel As Boolean

Dim bSize As Boolean
Dim bScale As Boolean
Dim aPos(4) As Single

Dim sParK As String
Dim sCurK As String
Dim sRefK As String
Dim sListK As String

Sub InsObject(ByVal sCKey As String, ByVal sRKey As String, ByVal X As Single, ByVal Y As Single, ByVal Z As Single)
    'Get object
    Call GetObject(sCKey, "", X, Y, Z)
        
    'Set reference key
    sRefK = sRKey
End Sub
Sub GetObject(ByVal sPKey As String, ByVal sLKey As String, ByVal X As Single, ByVal Y As Single, ByVal Z As Single)
    Dim nType As Integer
    Dim nInd As Integer
    
    Dim nPos As Long
    
    Dim sCKey As String
    Dim sQuery As String
    Dim sTxt As String
    Dim sVal As String
    
    Dim rsTemp As Recordset
         
    'Reset caption
    Me.Caption = "Object"
    
    'Show size controls
    lblSize.Visible = True
    txtSizeX.Visible = True
    txtSizeY.Visible = True
    txtSizeZ.Visible = True
    
    'Reset color
    txtPosX.BackColor = vbWindowBackground
    txtPosY.BackColor = vbWindowBackground
    txtPosZ.BackColor = vbWindowBackground
    txtScaleX.BackColor = vbWindowBackground
    txtScaleY.BackColor = vbWindowBackground
    txtScaleZ.BackColor = vbWindowBackground
    txtRotX.BackColor = vbWindowBackground
    txtRotY.BackColor = vbWindowBackground
    txtRotZ.BackColor = vbWindowBackground
    cmbType.BackColor = vbWindowBackground
    cmbLayer.BackColor = vbWindowBackground
    cmbName.BackColor = vbWindowBackground
    txtInfo.BackColor = vbWindowBackground
    txtFile.BackColor = vbWindowBackground
            
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Set local keys
    sParK = sPKey
    sListK = sLKey
    sCurK = ""
    
    'Check keys
    If sParK = "" Then
        'Set selection flag
        bSel = True
        
        'Set caption
        Me.Caption = "Object selection"
        
        'Hide size controls
        lblSize.Visible = False
        txtSizeX.Visible = False
        txtSizeY.Visible = False
        txtSizeZ.Visible = False
    Else
        'Clear slection flag
        bSel = False
            
        'Check parent
        If Left(sParK, 1) = "l" Then
            'Set caption
            Me.Caption = "Object of " + frmLevels.GetName(Val(Mid(sParK, 2)))
        End If
        
        'Check parent
        If Left(sParK, 1) = "o" Then
            'Get name
            sTxt = frmObjects.GetName(Val(Mid(sParK, 2)))
        
            'Get type
            nType = frmObjects.GetType(Val(Mid(sParK, 2)))
            Call misGetVal(frmMission.GetPrefix + MIS_SEC_OBJ + Trim(Str(nType - 1)), MIS_KEY_TYPE, sVal, MIS_MOD_CFG)
            
            'Truncate type
            sVal = TruncStr(sVal)
            
            'Check type
            If sVal <> "" Then sTxt = sVal + ": " + sTxt
                    
            'Set caption
            Me.Caption = "Object of " + sTxt
        End If
    End If
    
    'Get types
    GetTypes

    'Get layers
    GetLayers
    
    'Check key
    If sListK = "" Then
        If bGridFlag = 1 Then
            'Snap x translation to grid

⌨️ 快捷键说明

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