📄 frm3dtest.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frm3Dtest
BorderStyle = 1 'Fixed Single
Caption = "BASS - 3D Test"
ClientHeight = 4005
ClientLeft = 45
ClientTop = 330
ClientWidth = 5415
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4005
ScaleWidth = 5415
StartUpPosition = 2 'CenterScreen
Begin VB.Frame Frame6
Caption = "Doppler factor"
Height = 495
Left = 2640
TabIndex = 12
Top = 3360
Width = 2655
Begin VB.HScrollBar ID_Doppler
Height = 135
Left = 120
Max = 20
TabIndex = 14
Top = 240
Value = 10
Width = 2415
End
End
Begin VB.Frame Frame5
Caption = "Rolloff factor"
Height = 495
Left = 2640
TabIndex = 11
Top = 2760
Width = 2655
Begin VB.HScrollBar ID_Rolloff
Height = 135
Left = 120
Max = 20
TabIndex = 13
Top = 240
Value = 10
Width = 2415
End
End
Begin VB.Frame Frame4
Height = 2655
Left = 2640
TabIndex = 3
Top = 0
Width = 2655
Begin VB.PictureBox picDisplay
FillStyle = 0 'Solid
Height = 2295
Left = 120
ScaleHeight = 149
ScaleMode = 3 'Pixel
ScaleWidth = 157
TabIndex = 4
Top = 240
Width = 2415
End
End
Begin VB.Frame Frame1
Caption = "Channels (sample/music)"
Height = 2295
Left = 120
TabIndex = 2
Top = 0
Width = 2415
Begin VB.Timer tmr3D
Enabled = 0 'False
Interval = 50
Left = 1800
Top = 840
End
Begin MSComDlg.CommonDialog DLG
Left = 1800
Top = 360
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton cmdStop
Caption = "Stop"
Enabled = 0 'False
Height = 300
Left = 1320
TabIndex = 9
Top = 1920
Width = 975
End
Begin VB.CommandButton cmdPlay
Caption = "Play"
Enabled = 0 'False
Height = 300
Left = 120
TabIndex = 8
Top = 1920
Width = 975
End
Begin VB.CommandButton cmdRemove
Caption = "Remove"
Enabled = 0 'False
Height = 300
Left = 1320
TabIndex = 7
Top = 1560
Width = 975
End
Begin VB.CommandButton cmdAdd
Caption = "Add ..."
Height = 300
Left = 120
TabIndex = 6
Top = 1560
Width = 975
End
Begin VB.ListBox lstChannels
Height = 1230
Left = 120
TabIndex = 5
Top = 240
Width = 2175
End
End
Begin VB.Frame Frame2
Caption = "Movement"
ClipControls = 0 'False
Height = 765
Left = 120
TabIndex = 1
Top = 2280
Width = 2415
Begin VB.CommandButton btnReset
Caption = "reset"
Enabled = 0 'False
Height = 255
Left = 1680
TabIndex = 19
Top = 310
Width = 615
End
Begin VB.TextBox txtX
Enabled = 0 'False
Height = 285
Left = 360
MaxLength = 2
TabIndex = 16
Top = 300
Width = 375
End
Begin VB.TextBox txtZ
Enabled = 0 'False
Height = 285
Left = 1080
MaxLength = 2
TabIndex = 15
Top = 300
Width = 375
End
Begin VB.Label lblZ
AutoSize = -1 'True
Caption = "z:"
Height = 195
Left = 840
TabIndex = 18
Top = 310
Width = 120
End
Begin VB.Label lblX
AutoSize = -1 'True
Caption = "x:"
Height = 195
Left = 120
TabIndex = 17
Top = 310
Width = 120
End
End
Begin VB.Frame Frame3
Caption = "EAX Environment"
ClipControls = 0 'False
Height = 735
Left = 120
TabIndex = 0
Top = 3120
Width = 2415
Begin VB.ComboBox cmbEAX
BackColor = &H00FFFFFF&
Enabled = 0 'False
Height = 315
Left = 120
Style = 2 'Dropdown List
TabIndex = 10
Top = 240
Width = 2175
End
End
End
Attribute VB_Name = "frm3Dtest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'/////////////////////////////////////////////////////////////
' BASS 3D test, copyright (c) 1999 Adam Hoult.
'
' Updated: 2003-2007 by (: JOBnik! :) [Arthur Aminov, ISRAEL]
' [http://www.jobnik.org]
' [ jobnik@jobnik.org ]
'
' Other source: frmDevice.frm
'
' Originally translated from - 3dtest.c - example of Ian Luck
'/////////////////////////////////////////////////////////////
Option Explicit
' channel (sample/music) info structure
Private Type channel
channel As Long ' the channel
pos As BASS_3DVECTOR ' position
vel As BASS_3DVECTOR ' velocity
End Type
Dim chans() As channel ' array of channels
Dim chanc As Long ' number of Channels
Dim chan As Long ' current Channel
Const TIMERPERIOD = 50 ' timer period (ms)
Const MAXDIST = 50 ' maximum distance of the channels (m)
Const SPEED = 12 ' speed of the channels' movement (m/s)
' display error messages
Sub Error_(ByVal es As String)
Call MsgBox(es & vbCrLf & vbCrLf & "error code: " & BASS_ErrorGetCode, vbExclamation, "Error")
End Sub
Private Sub Form_Load()
' change and set the current path, to prevent from VB not finding BASS.DLL
ChDrive App.Path
ChDir App.Path
' check the correct BASS was loaded
If (HiWord(BASS_GetVersion) <> BASSVERSION) Then
Call MsgBox("An incorrect version of BASS.DLL was loaded", vbCritical)
End
End If
With cmbEAX
.AddItem "Off"
.AddItem "Generic"
.AddItem "Padded Cell"
.AddItem "Room"
.AddItem "Bathroom"
.AddItem "Living Room"
.AddItem "Stone Room"
.AddItem "Auditorium"
.AddItem "Concert Hall"
.AddItem "Cave"
.AddItem "Arena"
.AddItem "Hangar"
.AddItem "Carpeted Hallway"
.AddItem "Hallway"
.AddItem "Stone Corridor"
.AddItem "Alley"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -