frmsetting.frm

都是基于VB所做的程序集合,值得大家作为实践的参考资料.

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{293E8D26-4371-4926-B955-B9E9AE5C074B}#4.0#0"; "GridCellex.ocx"
Begin VB.Form frmSetting 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "参数设置"
   ClientHeight    =   6075
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5805
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6075
   ScaleWidth      =   5805
   StartUpPosition =   1  'CenterOwner
   Begin MSComDlg.CommonDialog cmdOpen 
      Left            =   825
      Top             =   5595
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command3 
      Caption         =   "应用"
      Height          =   405
      Left            =   1815
      TabIndex        =   4
      Top             =   5490
      Width           =   1245
   End
   Begin VB.CommandButton Command2 
      Caption         =   "取消"
      Height          =   405
      Left            =   4470
      TabIndex        =   3
      Top             =   5490
      Width           =   1245
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   405
      Left            =   3135
      TabIndex        =   2
      Top             =   5490
      Width           =   1245
   End
   Begin TabDlg.SSTab SSTab1 
      Height          =   5280
      Left            =   45
      TabIndex        =   0
      Top             =   15
      Width           =   5730
      _ExtentX        =   10107
      _ExtentY        =   9313
      _Version        =   393216
      Style           =   1
      Tabs            =   1
      TabHeight       =   520
      TabCaption(0)   =   "三维场景"
      TabPicture(0)   =   "frmSetting.frx":0000
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "GridCellex1"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).ControlCount=   1
      Begin GridCellExOcx.GridCellex GridCellex1 
         Height          =   4815
         Left            =   105
         TabIndex        =   1
         Top             =   390
         Width           =   5550
         _ExtentX        =   9790
         _ExtentY        =   8493
      End
   End
End
Attribute VB_Name = "frmSetting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()
    ApplySetting
    Me.Hide
End Sub

Private Sub Command2_Click()
    Me.Hide
End Sub

Private Sub Command3_Click()
   ApplySetting
End Sub

Private Sub Form_Load()
    Call InitSetting
End Sub

Private Sub InitSetting()  '初始化
    
    GridCellex1.Cols = 2
    GridCellex1.Rows = 8
    GridCellex1.ColWidth(0) = Me.GridCellex1.Width / 2
    GridCellex1.ColWidth(1) = Me.GridCellex1.Width / 2

    GridCellex1.Items.SetText 0, 0, "渲染系统", 0, False
    GridCellex1.Items.SetText 0, 1, "OpenGL", 0, False
    
    
    GridCellex1.Items.SetText 1, 0, "颜色缓存深度", 0, False
    GridCellex1.Items.SetText 1, 1, "32", 0, False
    
    GridCellex1.Items.SetText 2, 0, "垂直同步", 0, False
    GridCellex1.Items.SetText 2, 1, "否", 0, False
    
    GridCellex1.Items.SetText 3, 0, "使用深度缓存", 0, False
    GridCellex1.Items.SetText 3, 1, "否", 0, False
    
    GridCellex1.Items.SetText 4, 0, "环境光颜色", 0, False
    GridCellex1.Items.SetText 4, 1, frmMain.Super3D1.LightColor, 2, False


    GridCellex1.Items.SetText 5, 0, "雾参数", 4, False
    
    
    GridCellex1.Items.SetText 6, 0, "背景贴图", 0, False
    GridCellex1.Items.SetText 6, 1, "", 2, False

    GridCellex1.Items.SetText 7, 0, "视口背景", 0, False
    GridCellex1.Items.SetText 7, 1, frmMain.Super3D1.BackColor, 2, False

    Dim ActiveCellItem As soCellItem
    Set ActiveCellItem = GridCellex1.Items.Item(5, 0)
    ActiveCellItem.TreeItem.BackColor = vbYellow
    Dim cellitem As soCellItem
    Set cellitem = ActiveCellItem.TreeItem.AddItem(ActiveCellItem.Row + 1, 0, "状态", 0)
    
    ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 1, 1, "没有", 0

    ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 2, 0, "方式", 0
    Select Case frmMain.Super3D1.Fog.FogMode
        Case 0:
            ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 2, 1, "None", 3
        Case 1:
            ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 2, 1, "EXP", 3
        Case 2:
            ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 2, 1, "EXP2", 3
        Case 3:
            ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 2, 1, "Linear", 3
    End Select

    ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 3, 0, "颜色", 0
    ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 3, 1, frmMain.Super3D1.Fog.FogColor, 2

    ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 4, 0, "密度", 0
    ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 4, 1, frmMain.Super3D1.Fog.FogDensity, 1

    ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 5, 0, "距离(开始)", 0
    ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 5, 1, frmMain.Super3D1.Fog.FogStart, 1

    ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 6, 0, "距离(结束)", 0
    ActiveCellItem.TreeItem.AddItem ActiveCellItem.Row + 6, 1, frmMain.Super3D1.Fog.FogEnd, 1

    GridCellex1.Refresh
End Sub

Private Sub GridCellex1_ButtonClick(ActiveCellItem As GridCellExOcx.soCellItem)
    Select Case GridCellex1.Items.Item(ActiveCellItem.Row, ActiveCellItem.Col - 1).Text
        Case "环境光颜色":
            cmdOpen.Color = ActiveCellItem.Text
            cmdOpen.ShowColor
            ActiveCellItem.Text = cmdOpen.Color
        Case "视口背景":
            cmdOpen.Color = ActiveCellItem.Text
            cmdOpen.ShowColor
            ActiveCellItem.Text = cmdOpen.Color
        Case "颜色":
            If IsNumeric(ActiveCellItem.Text) Then cmdOpen.Color = ActiveCellItem.Text
            cmdOpen.ShowColor

            ActiveCellItem.Text = cmdOpen.Color
        Case "背景贴图":
            With cmdOpen
                .DialogTitle = "打开背景贴图图片"
                .Filter = "(*.bmp)|*.bmp|(*.jpg)|*.jpg|(*.png)|*.png|(*.tga)|*.tga"
                .CancelError = False
                .ShowOpen
                If .FileName <> "" Then ActiveCellItem.Text = .FileName
            End With
    End Select
End Sub

Private Sub GridCellex1_ComboboxClick(ActiveCellItem As GridCellExOcx.soCellItem)
    Dim cmblist As ComboBox
    Set cmblist = ActiveCellItem.ComboBox
    ActiveCellItem.Text = cmblist.Text
    cmblist.Visible = False
End Sub

Private Sub GridCellex1_ItemSelect(SelectCellItem As GridCellExOcx.soCellItem)
    If SelectCellItem.m_ItemType = 3 Then
        
        Dim cmblist As ComboBox
        Set cmblist = SelectCellItem.ComboBox
        cmblist.Clear
        cmblist.AddItem "None"
        cmblist.AddItem "EXP"
        cmblist.AddItem "EXP2"
        cmblist.AddItem "Linear"
    End If
End Sub

Private Sub GridCellex1_TextChange(ActiveCellItem As GridCellExOcx.soCellItem)
    ActiveCellItem.Text = ActiveCellItem.TextItem.Text
End Sub

Private Sub GridCellex1_TreeListClick(ActiveCellItem As GridCellExOcx.soCellItem)
    Select Case ActiveCellItem.Text '控制下来列表
        Case "雾参数":
            If ActiveCellItem.TreeItem.Expand = True Then
                ActiveCellItem.TreeItem.TreeNodeVisble = True
            Else
                ActiveCellItem.TreeItem.TreeNodeVisble = False
            End If
    End Select
    ActiveCellItem.TreeItem.Update
End Sub

Private Sub GridCellex2_TextChange(ActiveCellItem As GridCellExOcx.soCellItem)
    ActiveCellItem.Text = ActiveCellItem.TextItem
End Sub

Private Sub GridCellex2_TreeListClick(ActiveCellItem As GridCellExOcx.soCellItem)
    If ActiveCellItem.TreeItem.Expand = True Then
        ActiveCellItem.TreeItem.TreeNodeVisble = True
    Else
        ActiveCellItem.TreeItem.TreeNodeVisble = False
    End If
    
    ActiveCellItem.TreeItem.Update
End Sub

Private Sub ApplySetting()  '应用设置
    Dim i As Integer, j As Integer
    
    frmMain.Super3D1.LightColor = GridCellex1.Items.Item(4, 1).Text
    Dim FogItem  As soCellItem
    Dim objFog As soFog
    
    Set FogItem = GridCellex1.Items.Item(5, 0)
    Set objFog = frmMain.Super3D1.Fog
        
    objFog.FogColor = FogItem.TreeItem.Item(8, 1).Text
    Select Case FogItem.TreeItem.Item(7, 1).Text
        Case "None":
            objFog.FogMode = scfFogNone
        Case "EXP":
            objFog.FogMode = scfFogEXP
        Case "EXP2":
            objFog.FogMode = scfFogEXP2
        Case "Linear":
            objFog.FogMode = scfFogLinear
    End Select
    
    objFog.FogDensity = CDbl(FogItem.TreeItem.Item(9, 1).Text)
    objFog.FogStart = FogItem.TreeItem.Item(10, 1).Text
    objFog.FogEnd = FogItem.TreeItem.Item(11, 1).Text
    
    If GridCellex1.Items.GetItemFromIndex(13).Text <> "" Then
        frmMain.Super3D1.BackGroundTexture = GridCellex1.Items.GetItemFromIndex(13).Text
    End If
    
    frmMain.Super3D1.BackColor = GridCellex1.Items.GetItemFromIndex(15).Text
    frmMain.Super3D1.Refresh
End Sub