Initial commit: ROW Client source code
Game client codebase including: - CharacterActionControl: Character and creature management - GlobalScript: Network, items, skills, quests, utilities - RYLClient: Main client application with GUI and event handlers - Engine: 3D rendering engine (RYLGL) - MemoryManager: Custom memory allocation - Library: Third-party dependencies (DirectX, boost, etc.) - Tools: Development utilities 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
@@ -0,0 +1,745 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
|
||||
Begin VB.Form frmAdjust
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Caption = "Adjust Sound"
|
||||
ClientHeight = 6420
|
||||
ClientLeft = 240
|
||||
ClientTop = 525
|
||||
ClientWidth = 6900
|
||||
Icon = "frmAdjust.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 6420
|
||||
ScaleWidth = 6900
|
||||
StartUpPosition = 2 'CenterScreen
|
||||
Begin VB.Timer tmrUpdate
|
||||
Interval = 250
|
||||
Left = 7200
|
||||
Top = 240
|
||||
End
|
||||
Begin MSComctlLib.Slider sldFreq
|
||||
Height = 270
|
||||
Left = 2460
|
||||
TabIndex = 17
|
||||
Top = 960
|
||||
Width = 3615
|
||||
_ExtentX = 6376
|
||||
_ExtentY = 476
|
||||
_Version = 393216
|
||||
LargeChange = 1000
|
||||
SmallChange = 100
|
||||
Min = 100
|
||||
Max = 100000
|
||||
SelStart = 100
|
||||
TickFrequency = 10000
|
||||
Value = 100
|
||||
End
|
||||
Begin MSComDlg.CommonDialog cdlFile
|
||||
Left = 8880
|
||||
Top = 240
|
||||
_ExtentX = 847
|
||||
_ExtentY = 847
|
||||
_Version = 393216
|
||||
End
|
||||
Begin VB.CommandButton cmdExit
|
||||
Caption = "Exit"
|
||||
Height = 315
|
||||
Left = 5760
|
||||
TabIndex = 12
|
||||
Top = 6060
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdStop
|
||||
Caption = "Stop"
|
||||
Enabled = 0 'False
|
||||
Height = 315
|
||||
Left = 1080
|
||||
TabIndex = 11
|
||||
Top = 6060
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdPlay
|
||||
Caption = "Play"
|
||||
Enabled = 0 'False
|
||||
Height = 315
|
||||
Left = 60
|
||||
TabIndex = 10
|
||||
Top = 6060
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdSound
|
||||
Caption = "Sound &File"
|
||||
Default = -1 'True
|
||||
Height = 315
|
||||
Left = 120
|
||||
TabIndex = 9
|
||||
Top = 120
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CheckBox chkLoop
|
||||
Caption = "Loop Sound"
|
||||
Height = 315
|
||||
Left = 120
|
||||
TabIndex = 8
|
||||
Top = 5580
|
||||
Width = 3135
|
||||
End
|
||||
Begin VB.Frame Frame1
|
||||
Caption = "Expected Behavior"
|
||||
Height = 2475
|
||||
Index = 1
|
||||
Left = 120
|
||||
TabIndex = 7
|
||||
Top = 3060
|
||||
Width = 6615
|
||||
Begin VB.Label lblBehavior
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Expected Behavior Text"
|
||||
Height = 2055
|
||||
Left = 120
|
||||
TabIndex = 13
|
||||
Top = 300
|
||||
Width = 6375
|
||||
End
|
||||
End
|
||||
Begin VB.Frame Frame1
|
||||
Caption = "Buffer Settings"
|
||||
Height = 915
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 6
|
||||
Top = 2040
|
||||
Width = 6615
|
||||
Begin VB.PictureBox Picture1
|
||||
BorderStyle = 0 'None
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 1260
|
||||
ScaleHeight = 255
|
||||
ScaleWidth = 5235
|
||||
TabIndex = 32
|
||||
Top = 540
|
||||
Width = 5235
|
||||
Begin VB.OptionButton optDefault
|
||||
Caption = "Default"
|
||||
Height = 195
|
||||
Left = 0
|
||||
TabIndex = 35
|
||||
Top = 0
|
||||
Value = -1 'True
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.OptionButton optHardware
|
||||
Caption = "Hardware"
|
||||
Height = 195
|
||||
Left = 1200
|
||||
TabIndex = 34
|
||||
Top = 0
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.OptionButton optSoftware
|
||||
Caption = "Software"
|
||||
Height = 195
|
||||
Left = 2400
|
||||
TabIndex = 33
|
||||
Top = 0
|
||||
Width = 1035
|
||||
End
|
||||
End
|
||||
Begin VB.PictureBox Picture1
|
||||
BorderStyle = 0 'None
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 1260
|
||||
ScaleHeight = 255
|
||||
ScaleWidth = 5235
|
||||
TabIndex = 28
|
||||
Top = 180
|
||||
Width = 5235
|
||||
Begin VB.OptionButton optGlobal
|
||||
Caption = "Global"
|
||||
Height = 195
|
||||
Left = 2400
|
||||
TabIndex = 31
|
||||
Top = 0
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.OptionButton optSticky
|
||||
Caption = "Sticky"
|
||||
Height = 195
|
||||
Left = 1200
|
||||
TabIndex = 30
|
||||
Top = 0
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.OptionButton optNormal
|
||||
Caption = "Normal"
|
||||
Height = 195
|
||||
Left = 0
|
||||
TabIndex = 29
|
||||
Top = 0
|
||||
Value = -1 'True
|
||||
Width = 1035
|
||||
End
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Buffer Mixing"
|
||||
Height = 195
|
||||
Index = 11
|
||||
Left = 120
|
||||
TabIndex = 27
|
||||
Top = 540
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Focus"
|
||||
Height = 195
|
||||
Index = 10
|
||||
Left = 120
|
||||
TabIndex = 26
|
||||
Top = 240
|
||||
Width = 555
|
||||
End
|
||||
End
|
||||
Begin MSComctlLib.Slider sldPan
|
||||
Height = 270
|
||||
Left = 2460
|
||||
TabIndex = 24
|
||||
Top = 1320
|
||||
Width = 3615
|
||||
_ExtentX = 6376
|
||||
_ExtentY = 476
|
||||
_Version = 393216
|
||||
LargeChange = 1000
|
||||
SmallChange = 100
|
||||
Min = -10000
|
||||
Max = 10000
|
||||
TickFrequency = 1000
|
||||
End
|
||||
Begin MSComctlLib.Slider sldVolume
|
||||
Height = 270
|
||||
Left = 2460
|
||||
TabIndex = 25
|
||||
Top = 1680
|
||||
Width = 3615
|
||||
_ExtentX = 6376
|
||||
_ExtentY = 476
|
||||
_Version = 393216
|
||||
LargeChange = 1000
|
||||
SmallChange = 100
|
||||
Min = -2500
|
||||
Max = 0
|
||||
TickFrequency = 250
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Alignment = 2 'Center
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "High"
|
||||
Height = 195
|
||||
Index = 9
|
||||
Left = 6240
|
||||
TabIndex = 23
|
||||
Top = 1740
|
||||
Width = 555
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Alignment = 2 'Center
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Low"
|
||||
Height = 195
|
||||
Index = 8
|
||||
Left = 1860
|
||||
TabIndex = 22
|
||||
Top = 1740
|
||||
Width = 555
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Alignment = 2 'Center
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Right"
|
||||
Height = 195
|
||||
Index = 7
|
||||
Left = 6180
|
||||
TabIndex = 21
|
||||
Top = 1380
|
||||
Width = 555
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Alignment = 2 'Center
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Left"
|
||||
Height = 195
|
||||
Index = 6
|
||||
Left = 1860
|
||||
TabIndex = 20
|
||||
Top = 1380
|
||||
Width = 555
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "100 KHz"
|
||||
Height = 195
|
||||
Index = 5
|
||||
Left = 6120
|
||||
TabIndex = 19
|
||||
Top = 1020
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "100 Hz"
|
||||
Height = 195
|
||||
Index = 4
|
||||
Left = 1860
|
||||
TabIndex = 18
|
||||
Top = 1020
|
||||
Width = 555
|
||||
End
|
||||
Begin VB.Label lblVolume
|
||||
BackStyle = 0 'Transparent
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Height = 315
|
||||
Left = 1200
|
||||
TabIndex = 16
|
||||
Top = 1680
|
||||
Width = 555
|
||||
End
|
||||
Begin VB.Label lblPan
|
||||
BackStyle = 0 'Transparent
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Height = 315
|
||||
Left = 1200
|
||||
TabIndex = 15
|
||||
Top = 1320
|
||||
Width = 555
|
||||
End
|
||||
Begin VB.Label lblFrequency
|
||||
BackStyle = 0 'Transparent
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Height = 315
|
||||
Left = 1200
|
||||
TabIndex = 14
|
||||
Top = 960
|
||||
Width = 555
|
||||
End
|
||||
Begin VB.Label lblStatus
|
||||
BackStyle = 0 'Transparent
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Height = 315
|
||||
Left = 1200
|
||||
TabIndex = 5
|
||||
Top = 540
|
||||
Width = 5475
|
||||
End
|
||||
Begin VB.Label lblFile
|
||||
BackStyle = 0 'Transparent
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Height = 315
|
||||
Left = 1200
|
||||
TabIndex = 4
|
||||
Top = 120
|
||||
Width = 5475
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Volume"
|
||||
Height = 195
|
||||
Index = 3
|
||||
Left = 180
|
||||
TabIndex = 3
|
||||
Top = 1740
|
||||
Width = 795
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Pan"
|
||||
Height = 195
|
||||
Index = 2
|
||||
Left = 180
|
||||
TabIndex = 2
|
||||
Top = 1380
|
||||
Width = 795
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Frequency"
|
||||
Height = 195
|
||||
Index = 1
|
||||
Left = 180
|
||||
TabIndex = 1
|
||||
Top = 1020
|
||||
Width = 795
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Status"
|
||||
Height = 195
|
||||
Index = 0
|
||||
Left = 180
|
||||
TabIndex = 0
|
||||
Top = 600
|
||||
Width = 795
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmAdjust"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmAdjust.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'API declare for windows folder
|
||||
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
|
||||
|
||||
Private dx As New DirectX8
|
||||
Private ds As DirectSound8
|
||||
Private dsb As DirectSoundSecondaryBuffer8
|
||||
Private msFile As String
|
||||
|
||||
Private Sub cmdExit_Click()
|
||||
Cleanup
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Cleanup()
|
||||
If Not (dsb Is Nothing) Then dsb.Stop
|
||||
Set dsb = Nothing
|
||||
Set ds = Nothing
|
||||
Set dx = Nothing
|
||||
End Sub
|
||||
|
||||
Private Function InitDSound() As Boolean
|
||||
On Error GoTo FailedInit
|
||||
InitDSound = True
|
||||
Set ds = dx.DirectSoundCreate(vbNullString)
|
||||
ds.SetCooperativeLevel Me.hWnd, DSSCL_PRIORITY
|
||||
Exit Function
|
||||
|
||||
FailedInit:
|
||||
InitDSound = False
|
||||
End Function
|
||||
|
||||
Private Sub cmdPlay_Click()
|
||||
Dim dsBuf As DSBUFFERDESC
|
||||
Dim bFocusSticky As Boolean, bFocusGlobal As Boolean
|
||||
Dim bMixHardware As Boolean, bMixSoftware As Boolean
|
||||
|
||||
On Error GoTo ErrOut
|
||||
bFocusSticky = (optSticky.Value)
|
||||
bFocusGlobal = (optGlobal.Value)
|
||||
bMixHardware = (optHardware.Value)
|
||||
bMixSoftware = (optSoftware.Value)
|
||||
|
||||
dsBuf.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME
|
||||
If bFocusGlobal Then
|
||||
dsBuf.lFlags = dsBuf.lFlags Or DSBCAPS_GLOBALFOCUS
|
||||
End If
|
||||
|
||||
If bFocusSticky Then
|
||||
dsBuf.lFlags = dsBuf.lFlags Or DSBCAPS_STICKYFOCUS
|
||||
End If
|
||||
|
||||
If bMixHardware Then
|
||||
dsBuf.lFlags = dsBuf.lFlags Or DSBCAPS_LOCHARDWARE
|
||||
End If
|
||||
|
||||
If bMixSoftware Then
|
||||
dsBuf.lFlags = dsBuf.lFlags Or DSBCAPS_LOCSOFTWARE
|
||||
End If
|
||||
|
||||
Set dsb = ds.CreateSoundBufferFromFile(msFile, dsBuf)
|
||||
'Update the buffer based on the current slider
|
||||
OnSliderChange
|
||||
If chkLoop.Value = vbChecked Then
|
||||
dsb.Play DSBPLAY_LOOPING
|
||||
Else
|
||||
dsb.Play 0
|
||||
End If
|
||||
lblStatus.Caption = "File playing."
|
||||
EnablePlayUI False
|
||||
Exit Sub
|
||||
|
||||
ErrOut:
|
||||
lblStatus.Caption = "An error occured trying to play this file with these settings."
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSound_Click()
|
||||
|
||||
Static sCurDir As String
|
||||
Static lFilter As Long
|
||||
Dim dsBuf As DSBUFFERDESC
|
||||
|
||||
'Now we should load a wave file
|
||||
'Ask them for a file to load
|
||||
UpdateStatus "Loading file..."
|
||||
With cdlFile
|
||||
.flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
|
||||
.FilterIndex = lFilter
|
||||
.Filter = "Wave Files (*.wav)|*.wav"
|
||||
.FileName = vbNullString
|
||||
If sCurDir = vbNullString Then
|
||||
'Set the init folder to \windows\media if it exists. If not, set it to the \windows folder
|
||||
Dim sWindir As String
|
||||
sWindir = Space$(255)
|
||||
If GetWindowsDirectory(sWindir, 255) = 0 Then
|
||||
'We couldn't get the windows folder for some reason, use the c:\
|
||||
.InitDir = "C:\"
|
||||
Else
|
||||
Dim sMedia As String
|
||||
sWindir = Left$(sWindir, InStr(sWindir, Chr$(0)) - 1)
|
||||
If Right$(sWindir, 1) = "\" Then
|
||||
sMedia = sWindir & "Media"
|
||||
Else
|
||||
sMedia = sWindir & "\Media"
|
||||
End If
|
||||
If Dir$(sMedia, vbDirectory) <> vbNullString Then
|
||||
.InitDir = sMedia
|
||||
Else
|
||||
.InitDir = sWindir
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
.InitDir = sCurDir
|
||||
End If
|
||||
.ShowOpen ' Display the Open dialog box
|
||||
If .FileName = vbNullString Then
|
||||
UpdateStatus "No file loaded."
|
||||
Exit Sub 'We didn't click anything exit
|
||||
End If
|
||||
'Save the current information
|
||||
sCurDir = GetFolder(.FileName)
|
||||
lFilter = .FilterIndex
|
||||
UpdateStatus "File loaded."
|
||||
|
||||
'Save the filename for later use
|
||||
msFile = .FileName
|
||||
If Not (dsb Is Nothing) Then dsb.Stop
|
||||
Set dsb = Nothing
|
||||
dsBuf.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME
|
||||
On Error Resume Next
|
||||
Set dsb = ds.CreateSoundBufferFromFile(msFile, dsBuf)
|
||||
If Err Then
|
||||
UpdateStatus "Could not create buffer."
|
||||
Exit Sub
|
||||
End If
|
||||
sldFreq.Value = dsBuf.fxFormat.lSamplesPerSec
|
||||
lblFile.Caption = .FileName
|
||||
EnablePlayUI True
|
||||
End With
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub cmdStop_Click()
|
||||
If Not (dsb Is Nothing) Then
|
||||
dsb.Stop 'Stop the buffer and reset it's position
|
||||
dsb.SetCurrentPosition 0
|
||||
lblStatus.Caption = "File stopped."
|
||||
EnablePlayUI True
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
'First we should set up our DirectSound object
|
||||
If Not InitDSound Then
|
||||
MsgBox "Could not initialize DirectSound. This sample is exiting.", vbOKOnly Or vbInformation, "Failed."
|
||||
Cleanup
|
||||
Unload Me
|
||||
End
|
||||
End If
|
||||
UpdateBehaviorText
|
||||
OnSliderChange
|
||||
UpdateStatus "No file loaded."
|
||||
End Sub
|
||||
|
||||
Private Sub UpdateBehaviorText()
|
||||
Dim sText As String
|
||||
Dim bFocusSticky As Boolean, bFocusGlobal As Boolean
|
||||
Dim bMixHardware As Boolean, bMixSoftware As Boolean
|
||||
|
||||
bFocusSticky = (optSticky.Value)
|
||||
bFocusGlobal = (optGlobal.Value)
|
||||
bMixHardware = (optHardware.Value)
|
||||
bMixSoftware = (optSoftware.Value)
|
||||
'Figure what the user should expect based on the dialog choice
|
||||
If bFocusSticky Then
|
||||
sText = "With sticky focus an application using DirectSound " & _
|
||||
"can continue to play its sticky focus buffers if the " & _
|
||||
"user switches to another application not using " & _
|
||||
"DirectSound. However, if the user switches to another " & _
|
||||
"DirectSound application, all sound buffers, both normal " & _
|
||||
"and sticky focus, in the previous application are muted."
|
||||
|
||||
ElseIf bFocusGlobal Then
|
||||
sText = "With global focus, an application using DirectSound " & _
|
||||
"can continue to play its buffers if the user switches " & _
|
||||
"focus to another application, even if the new application " & _
|
||||
"uses DirectSound. The one exception is if you switch " & _
|
||||
"focus to a DirectSound application that uses the " & _
|
||||
"DSSCL_WRITEPRIMARY flag for its " & _
|
||||
"cooperative level. In this case, the global sounds from " & _
|
||||
"other applications will not be audible."
|
||||
Else
|
||||
'Normal focus
|
||||
sText = "With normal focus, an application using DirectSound " & _
|
||||
"will mute its buffers if the user switches focus to " & _
|
||||
"another application"
|
||||
End If
|
||||
|
||||
|
||||
If bMixHardware Then
|
||||
sText = sText & vbCrLf & vbCrLf & "With hardware mixing, the new buffer will be " & _
|
||||
"forced to use hardware mixing. If the device does " & _
|
||||
"not support hardware mixing or if the required " & _
|
||||
"hardware memory is not available, the call to the " & _
|
||||
"IDirectSound::CreateSoundBuffer method will fail."
|
||||
ElseIf bMixSoftware Then
|
||||
sText = sText & vbCrLf & vbCrLf & "With software mixing, the new buffer will be " & _
|
||||
"stored in software memory and use software mixing, " & _
|
||||
"even if hardware resources are available."
|
||||
Else
|
||||
'Default mixing
|
||||
sText = sText & vbCrLf & vbCrLf & "With default mixing, the new buffer will use " & _
|
||||
"hardware mixing if availible, otherwise software " & _
|
||||
"memory and mixing will be used."
|
||||
End If
|
||||
|
||||
'Tell the user what to expect
|
||||
lblBehavior.Caption = sText
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub optDefault_Click()
|
||||
UpdateBehaviorText
|
||||
End Sub
|
||||
|
||||
Private Sub optGlobal_Click()
|
||||
UpdateBehaviorText
|
||||
End Sub
|
||||
|
||||
Private Sub optHardware_Click()
|
||||
UpdateBehaviorText
|
||||
End Sub
|
||||
|
||||
Private Sub optNormal_Click()
|
||||
UpdateBehaviorText
|
||||
End Sub
|
||||
|
||||
Private Sub optSoftware_Click()
|
||||
UpdateBehaviorText
|
||||
End Sub
|
||||
|
||||
Private Sub optSticky_Click()
|
||||
UpdateBehaviorText
|
||||
End Sub
|
||||
|
||||
Private Function GetFolder(ByVal sFile As String) As String
|
||||
Dim lCount As Long
|
||||
|
||||
For lCount = Len(sFile) To 1 Step -1
|
||||
If Mid$(sFile, lCount, 1) = "\" Then
|
||||
GetFolder = Left$(sFile, lCount)
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
GetFolder = vbNullString
|
||||
End Function
|
||||
|
||||
Private Sub OnSliderChange()
|
||||
Dim lFrequency As Long, lPan As Long, lVolume As Long
|
||||
'Get the position of the sliders
|
||||
lFrequency = sldFreq.Value
|
||||
lPan = sldPan.Value
|
||||
lVolume = sldVolume.Value
|
||||
|
||||
'Set the static labels
|
||||
lblFrequency.Caption = CStr(lFrequency)
|
||||
lblPan.Caption = CStr(lPan)
|
||||
lblVolume.Caption = CStr(lVolume)
|
||||
|
||||
'Set the options in the DirectSound buffer
|
||||
If Not (dsb Is Nothing) Then
|
||||
dsb.SetFrequency lFrequency
|
||||
dsb.SetPan lPan
|
||||
dsb.SetVolume lVolume
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub sldFreq_Change()
|
||||
OnSliderChange
|
||||
End Sub
|
||||
|
||||
Private Sub sldFreq_Scroll()
|
||||
OnSliderChange
|
||||
End Sub
|
||||
|
||||
Private Sub sldPan_Change()
|
||||
OnSliderChange
|
||||
End Sub
|
||||
|
||||
Private Sub sldPan_Scroll()
|
||||
OnSliderChange
|
||||
End Sub
|
||||
|
||||
Private Sub sldVolume_Change()
|
||||
OnSliderChange
|
||||
End Sub
|
||||
|
||||
Private Sub UpdateStatus(ByVal sStatus As String)
|
||||
lblStatus.Caption = sStatus
|
||||
End Sub
|
||||
|
||||
Private Sub sldVolume_Scroll()
|
||||
OnSliderChange
|
||||
End Sub
|
||||
|
||||
Private Sub tmrUpdate_Timer()
|
||||
If Not (dsb Is Nothing) Then
|
||||
If (dsb.GetStatus And DSBSTATUS_PLAYING) <> DSBSTATUS_PLAYING Then
|
||||
If cmdPlay.Enabled = False Then
|
||||
EnablePlayUI True
|
||||
lblStatus.Caption = "File stopped."
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub EnablePlayUI(ByVal fEnable As Boolean)
|
||||
On Error Resume Next
|
||||
If fEnable Then
|
||||
chkLoop.Enabled = True
|
||||
cmdPlay.Enabled = True
|
||||
cmdStop.Enabled = False
|
||||
optNormal.Enabled = True
|
||||
optSticky.Enabled = True
|
||||
optGlobal.Enabled = True
|
||||
optDefault.Enabled = True
|
||||
optHardware.Enabled = True
|
||||
optSoftware.Enabled = True
|
||||
cmdSound.Enabled = True
|
||||
cmdPlay.SetFocus
|
||||
Else
|
||||
chkLoop.Enabled = False
|
||||
cmdPlay.Enabled = False
|
||||
cmdStop.Enabled = True
|
||||
optNormal.Enabled = False
|
||||
optSticky.Enabled = False
|
||||
optGlobal.Enabled = False
|
||||
optDefault.Enabled = False
|
||||
optHardware.Enabled = False
|
||||
optSoftware.Enabled = False
|
||||
cmdSound.Enabled = False
|
||||
cmdStop.SetFocus
|
||||
End If
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,47 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: VB AdjustSound Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
AdjustSound sample shows how to load and play a wave file using
|
||||
a DirectSound buffer and adjust its focus, frequency, pan, and volume.
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\DirectSound\AdjustSound
|
||||
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectSound\Bin
|
||||
|
||||
User's Guide
|
||||
============
|
||||
Load a wave file by clicking Sound File. Select Focus and Buffer Mixing
|
||||
options; note that the various settings are explained under Expected Behavior
|
||||
as you select them. Click Play. If you don't hear any sound, check the Status
|
||||
pane. The application might fail to create the buffer in hardware if this
|
||||
option has been selected.
|
||||
|
||||
By using the sliders you can adjust the frequency, pan, and volume dynamically
|
||||
as the buffer is playing.
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
To set the focus of a buffer call DirectSound.CreateSoundBufferFromFile with
|
||||
DSBCAPS_GLOBALFOCUS or DSBCAPS_STICKYFOCUS or neither of these flags.
|
||||
|
||||
To set the memory location of a buffer call DirectSound.CreateSoundBufferFromFile
|
||||
with DSBCAPS_LOCHARDWARE or DSBCAPS_LOCSOFTWARE or neither of these flags.
|
||||
|
||||
To control various aspects of DirectSound buffer:
|
||||
To adjust the frequency call DirectSoundSecondaryBuffer.SetFrequency
|
||||
To adjust the pan call DirectSoundSecondaryBuffer.SetPan
|
||||
To adjust the volume call DirectSoundSecondaryBuffer.SetVolume
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,32 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=frmAdjust.frm
|
||||
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; Mscomctl.ocx
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Startup="frmAdjust"
|
||||
Command32=""
|
||||
Name="vbAdjustSound"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,503 @@
|
||||
VERSION 5.00
|
||||
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
|
||||
Begin VB.Form frmEffects
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Caption = "Audio Effects using DirectSound Buffers"
|
||||
ClientHeight = 4965
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 4740
|
||||
Icon = "frmFX.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 4965
|
||||
ScaleWidth = 4740
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.Timer tmrUpdate
|
||||
Interval = 50
|
||||
Left = 6180
|
||||
Top = 1620
|
||||
End
|
||||
Begin VB.CheckBox chkLoop
|
||||
Caption = "Loop Sound"
|
||||
Height = 315
|
||||
Left = 840
|
||||
TabIndex = 7
|
||||
Top = 4500
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.CommandButton cmdStop
|
||||
Caption = "&Stop"
|
||||
Height = 375
|
||||
Left = 3600
|
||||
TabIndex = 6
|
||||
Top = 4500
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdPlay
|
||||
Caption = "&Play"
|
||||
Height = 375
|
||||
Left = 2400
|
||||
TabIndex = 5
|
||||
Top = 4500
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Frame fraEffects
|
||||
Caption = "Effects Information"
|
||||
Height = 3615
|
||||
Left = 120
|
||||
TabIndex = 1
|
||||
Top = 780
|
||||
Width = 4515
|
||||
Begin VB.CommandButton cmdApply
|
||||
Caption = "Apply Effects"
|
||||
Height = 315
|
||||
Left = 2460
|
||||
TabIndex = 12
|
||||
Top = 3180
|
||||
Width = 1875
|
||||
End
|
||||
Begin VB.CommandButton cmdRemove
|
||||
Height = 285
|
||||
Left = 2400
|
||||
MaskColor = &H000000FF&
|
||||
Picture = "frmFX.frx":0442
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 11
|
||||
Top = 1920
|
||||
UseMaskColor = -1 'True
|
||||
Width = 315
|
||||
End
|
||||
Begin VB.CommandButton cmdAdd
|
||||
Height = 285
|
||||
Left = 2040
|
||||
MaskColor = &H000000FF&
|
||||
Picture = "frmFX.frx":0984
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 10
|
||||
Top = 1920
|
||||
UseMaskColor = -1 'True
|
||||
Width = 315
|
||||
End
|
||||
Begin VB.ListBox lstUse
|
||||
Height = 840
|
||||
Left = 120
|
||||
TabIndex = 9
|
||||
Top = 2220
|
||||
Width = 4275
|
||||
End
|
||||
Begin VB.ListBox lstAvail
|
||||
Height = 840
|
||||
ItemData = "frmFX.frx":0EC6
|
||||
Left = 120
|
||||
List = "frmFX.frx":0EE2
|
||||
TabIndex = 8
|
||||
Top = 1020
|
||||
Width = 4275
|
||||
End
|
||||
Begin VB.TextBox txtFile
|
||||
Height = 285
|
||||
Left = 120
|
||||
Locked = -1 'True
|
||||
TabIndex = 3
|
||||
Text = "No file loaded..."
|
||||
Top = 480
|
||||
Width = 3975
|
||||
End
|
||||
Begin VB.CommandButton cmdBrowse
|
||||
Caption = "..."
|
||||
Height = 285
|
||||
Left = 4140
|
||||
TabIndex = 2
|
||||
ToolTipText = "Open a new audio file..."
|
||||
Top = 480
|
||||
Width = 315
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Available Effects"
|
||||
Height = 195
|
||||
Index = 3
|
||||
Left = 120
|
||||
TabIndex = 15
|
||||
Top = 780
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Effects in use"
|
||||
Height = 195
|
||||
Index = 2
|
||||
Left = 120
|
||||
TabIndex = 14
|
||||
Top = 1980
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Available Effects"
|
||||
Height = 195
|
||||
Index = 1
|
||||
Left = 180
|
||||
TabIndex = 13
|
||||
Top = 600
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Currently loaded sound file:"
|
||||
Height = 195
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 4
|
||||
Top = 240
|
||||
Width = 4515
|
||||
End
|
||||
End
|
||||
Begin MSComDlg.CommonDialog cdlOpen
|
||||
Left = 300
|
||||
Top = 3720
|
||||
_ExtentX = 847
|
||||
_ExtentY = 847
|
||||
_Version = 393216
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Audio Effects using Defered loading DirectSoundBuffers. This allows you to check the status of effects before playing."
|
||||
Height = 615
|
||||
Index = 4
|
||||
Left = 660
|
||||
TabIndex = 0
|
||||
Top = 60
|
||||
Width = 3195
|
||||
End
|
||||
Begin VB.Image Image1
|
||||
Height = 480
|
||||
Left = 120
|
||||
Picture = "frmFX.frx":0F33
|
||||
Top = 180
|
||||
Width = 480
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmEffects"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmFX.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'API declare for windows folder
|
||||
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
|
||||
|
||||
Private Const mlMaxEffects As Long = 20
|
||||
'Private declares for our DirectX objects
|
||||
Private dx As DirectX8
|
||||
Private ds As DirectSound8
|
||||
Private dsb As DirectSoundSecondaryBuffer8
|
||||
Private mlEffectKey As Long
|
||||
|
||||
Private Sub cmdAdd_Click()
|
||||
If lstAvail.ListIndex = -1 Then 'Nothing is selected
|
||||
MsgBox "Please select an available effect before attempting to add it.", vbOKOnly Or vbInformation, "Nothing selected."
|
||||
Exit Sub
|
||||
End If
|
||||
If lstUse.ListCount >= mlMaxEffects Then
|
||||
MsgBox "You cannot add more than " & CStr(mlMaxEffects) & " effects in this sample.", vbOKOnly Or vbInformation, "No more effects."
|
||||
Exit Sub
|
||||
End If
|
||||
'Add this item to our list of effects
|
||||
lstUse.AddItem lstAvail.List(lstAvail.ListIndex) & " - Unallocated"
|
||||
End Sub
|
||||
|
||||
Private Sub cmdApply_Click()
|
||||
On Local Error GoTo NoFX
|
||||
Dim DSEffects() As DSEFFECTDESC
|
||||
Dim lResults() As Long
|
||||
Dim lTempEffect As Long
|
||||
Dim lCount As Long
|
||||
|
||||
'Do we have a sound buffer
|
||||
If dsb Is Nothing Then
|
||||
MsgBox "You must first load a wave file into a sound buffer before you can apply effects to it.", vbOKOnly Or vbInformation, "No buffer"
|
||||
Exit Sub
|
||||
End If
|
||||
'Yup, now is there a sound already playing?
|
||||
If (dsb.GetStatus And DSBSTATUS_PLAYING) = DSBSTATUS_PLAYING Then
|
||||
MsgBox "Stop the currently playing sound before adding effects.", vbOKOnly Or vbInformation, "Sound is playing"
|
||||
Exit Sub
|
||||
End If
|
||||
'Yes we do, do we have effects selected?
|
||||
If lstUse.ListCount = 0 Then
|
||||
If MsgBox("Do you want to turn off effects for this buffer?", vbYesNo Or vbQuestion, "No effects") = vbYes Then
|
||||
'Calling SetFX with a count of 0 removes the effects from the buffer
|
||||
dsb.SetFX 0, DSEffects, lResults
|
||||
Exit Sub
|
||||
Else
|
||||
MsgBox "You must first select some effects to use.", vbOKOnly Or vbInformation, "No effects"
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
'Ok, let's apply our effects info here
|
||||
|
||||
'First get an array of effects structs the right size
|
||||
ReDim DSEffects(lstUse.ListCount - 1)
|
||||
ReDim lResults(lstUse.ListCount - 1)
|
||||
|
||||
For lCount = 0 To lstUse.ListCount - 1
|
||||
Select Case Left$(LCase(lstUse.List(lCount)), InStr(lstUse.List(lCount), " ") - 1)
|
||||
Case "distortion"
|
||||
lTempEffect = lTempEffect + (lCount + &H10)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_DISTORTION
|
||||
Case "echo"
|
||||
lTempEffect = lTempEffect + (lCount + &H20)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_ECHO
|
||||
Case "chorus"
|
||||
lTempEffect = lTempEffect + (lCount + &H40)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_CHORUS
|
||||
Case "flanger"
|
||||
lTempEffect = lTempEffect + (lCount + &H80)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_FLANGER
|
||||
Case "compressor"
|
||||
lTempEffect = lTempEffect + (lCount + &H100)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_COMPRESSOR
|
||||
Case "gargle"
|
||||
lTempEffect = lTempEffect + (lCount + &H200)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_GARGLE
|
||||
Case "parameq"
|
||||
lTempEffect = lTempEffect + (lCount + &H400)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_PARAMEQ
|
||||
Case "wavesreverb"
|
||||
lTempEffect = lTempEffect + (lCount + &H800)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_WAVES_REVERB
|
||||
End Select
|
||||
Next
|
||||
If mlEffectKey <> lTempEffect Then 'They don't match, set the fx.
|
||||
dsb.SetFX lstUse.ListCount, DSEffects, lResults
|
||||
'Now we can acquire the resources needed for these effects.
|
||||
dsb.AcquireResources 0, lResults
|
||||
Dim sNewItem As String
|
||||
For lCount = 0 To lstUse.ListCount - 1
|
||||
sNewItem = Left$(lstUse.List(lCount), InStr(lstUse.List(lCount), " ") - 1)
|
||||
Select Case lResults(lCount)
|
||||
Case DSFXR_FAILED
|
||||
lstUse.List(lCount) = sNewItem & " - Failed"
|
||||
Case DSFXR_LOCHARDWARE
|
||||
lstUse.List(lCount) = sNewItem & " - Hardware"
|
||||
Case DSFXR_LOCSOFTWARE
|
||||
lstUse.List(lCount) = sNewItem & " - Software"
|
||||
Case DSFXR_UNALLOCATED
|
||||
lstUse.List(lCount) = sNewItem & " - Unallocated"
|
||||
Case DSFXR_UNKNOWN
|
||||
lstUse.List(lCount) = sNewItem & " - Unknown"
|
||||
Case DSFXR_PRESENT
|
||||
lstUse.List(lCount) = sNewItem & " - Present"
|
||||
End Select
|
||||
Next
|
||||
End If
|
||||
mlEffectKey = lTempEffect
|
||||
Exit Sub
|
||||
|
||||
NoFX:
|
||||
MsgBox "This set of effects could not be set on this audio file.", vbOKOnly Or vbInformation, "Cannot set"
|
||||
End Sub
|
||||
|
||||
Private Sub cmdBrowse_Click()
|
||||
Static sCurDir As String
|
||||
Dim desc As DSBUFFERDESC
|
||||
|
||||
'We want to open a file now
|
||||
cdlOpen.flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
|
||||
cdlOpen.Filter = "Wave Files (*.wav)|*.wav"
|
||||
cdlOpen.FileName = vbNullString
|
||||
If sCurDir = vbNullString Then
|
||||
'Set the init folder to \windows\media if it exists. If not, set it to the \windows folder
|
||||
Dim sWindir As String
|
||||
sWindir = Space$(255)
|
||||
If GetWindowsDirectory(sWindir, 255) = 0 Then
|
||||
'We couldn't get the windows folder for some reason, use the c:\
|
||||
cdlOpen.InitDir = "C:\"
|
||||
Else
|
||||
Dim sMedia As String
|
||||
sWindir = Left$(sWindir, InStr(sWindir, Chr$(0)) - 1)
|
||||
If Right$(sWindir, 1) = "\" Then
|
||||
sMedia = sWindir & "Media"
|
||||
Else
|
||||
sMedia = sWindir & "\Media"
|
||||
End If
|
||||
'We are trying to find the windows\media directory. If it
|
||||
'doesn't exist, then use the windows folder as a default
|
||||
If Dir$(sMedia, vbDirectory) <> vbNullString Then
|
||||
cdlOpen.InitDir = sMedia
|
||||
Else
|
||||
cdlOpen.InitDir = sWindir
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
'No need to move folders. Stay where they picked the last file
|
||||
cdlOpen.InitDir = sCurDir
|
||||
End If
|
||||
On Local Error GoTo ClickedCancel
|
||||
cdlOpen.CancelError = True
|
||||
cdlOpen.ShowOpen ' Display the Open dialog box
|
||||
|
||||
'Save the current information
|
||||
sCurDir = GetFolder(cdlOpen.FileName)
|
||||
|
||||
On Local Error GoTo NoLoadSegment
|
||||
'Before we load the buffer stop one if it's playing
|
||||
If Not (dsb Is Nothing) Then If dsb.GetStatus = DSBSTATUS_PLAYING Then dsb.Stop
|
||||
'We need to set the CTRLFX flag so we can control the effects on this object
|
||||
'We pass the LOCDEFER flag so we can acquire the
|
||||
'resources for the effects before we play them
|
||||
desc.lFlags = DSBCAPS_CTRLFX Or DSBCAPS_LOCDEFER
|
||||
'Now let's load the segment
|
||||
Set dsb = ds.CreateSoundBufferFromFile(cdlOpen.FileName, desc)
|
||||
mlEffectKey = 0
|
||||
txtFile.Text = cdlOpen.FileName
|
||||
|
||||
Exit Sub
|
||||
NoLoadSegment:
|
||||
If Err.Number = DSERR_BUFFERTOOSMALL Then 'This buffer isn't big enough to control effects on
|
||||
MsgBox "This file isn't long enough to control effects. Please choose a longer audio file.", vbOKOnly Or vbCritical, "Couldn't load"
|
||||
Else 'Some other error
|
||||
MsgBox "Couldn't load this file", vbOKOnly Or vbCritical, "Couldn't load"
|
||||
End If
|
||||
ClickedCancel:
|
||||
End Sub
|
||||
|
||||
Private Sub cmdPlay_Click()
|
||||
If dsb Is Nothing Then
|
||||
MsgBox "You must first load a wave file into a sound buffer before you can play it.", vbOKOnly Or vbInformation, "No buffer"
|
||||
Exit Sub
|
||||
End If
|
||||
dsb.Play chkLoop.Value
|
||||
EnablePlayUI False
|
||||
End Sub
|
||||
|
||||
Private Sub cmdRemove_Click()
|
||||
If lstUse.ListIndex = -1 Then 'Nothing is selected
|
||||
MsgBox "Please select an effect that's being used before attempting to remove it.", vbOKOnly Or vbInformation, "Nothing selected."
|
||||
Exit Sub
|
||||
End If
|
||||
'Add this item to our list of effects
|
||||
lstUse.RemoveItem lstUse.ListIndex
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSave_Click()
|
||||
On Error GoTo ClickedCancel
|
||||
With cdlOpen
|
||||
.InitDir = GetFolder(txtFile.Text)
|
||||
.FileName = txtFile.Text
|
||||
.CancelError = True
|
||||
.ShowSave
|
||||
dsb.SaveToFile .FileName
|
||||
End With
|
||||
Exit Sub
|
||||
|
||||
ClickedCancel:
|
||||
End Sub
|
||||
|
||||
Private Sub cmdStop_Click()
|
||||
If dsb Is Nothing Then
|
||||
MsgBox "You must first load a wave file into a sound buffer before you can stop it.", vbOKOnly Or vbInformation, "No buffer"
|
||||
Exit Sub
|
||||
End If
|
||||
dsb.Stop
|
||||
'Stop doesn't reset the current position
|
||||
dsb.SetCurrentPosition 0
|
||||
EnablePlayUI True
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
EnablePlayUI True
|
||||
InitDSound
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
CleanupDSound
|
||||
End Sub
|
||||
|
||||
Private Sub InitDSound()
|
||||
|
||||
On Error GoTo FailedInit
|
||||
Set dx = New DirectX8
|
||||
'Create our default DirectSound object
|
||||
Set ds = dx.DirectSoundCreate(vbNullString)
|
||||
ds.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
|
||||
Exit Sub
|
||||
|
||||
FailedInit:
|
||||
MsgBox "Could not initialize DirectSound." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
|
||||
Unload Me
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub CleanupDSound()
|
||||
'Let's clean up now
|
||||
If Not dsb Is Nothing Then
|
||||
'iF we are playing our file, stop it
|
||||
If dsb.GetStatus = DSBSTATUS_PLAYING Then dsb.Stop
|
||||
'Destroy our objects
|
||||
Set dsb = Nothing
|
||||
End If
|
||||
Set ds = Nothing
|
||||
Set dx = Nothing
|
||||
End Sub
|
||||
|
||||
Private Function GetFolder(ByVal sFile As String) As String
|
||||
Dim lCount As Long
|
||||
|
||||
For lCount = Len(sFile) To 1 Step -1
|
||||
If Mid$(sFile, lCount, 1) = "\" Then
|
||||
GetFolder = Left$(sFile, lCount)
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
GetFolder = vbNullString
|
||||
End Function
|
||||
|
||||
Private Sub lstAvail_DblClick()
|
||||
'Double clicking should be the same as clicking the 'Add' button
|
||||
cmdAdd_Click
|
||||
End Sub
|
||||
|
||||
Private Sub lstUse_DblClick()
|
||||
'Double clicking should be the same as clicking the 'Remove' button
|
||||
cmdRemove_Click
|
||||
End Sub
|
||||
|
||||
Private Sub EnablePlayUI(ByVal fEnable As Boolean)
|
||||
On Error Resume Next
|
||||
If fEnable Then
|
||||
chkLoop.Enabled = True
|
||||
cmdPlay.Enabled = True
|
||||
cmdStop.Enabled = False
|
||||
cmdBrowse.Enabled = True
|
||||
cmdPlay.SetFocus
|
||||
Else
|
||||
chkLoop.Enabled = False
|
||||
cmdPlay.Enabled = False
|
||||
cmdStop.Enabled = True
|
||||
cmdBrowse.Enabled = False
|
||||
cmdStop.SetFocus
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub tmrUpdate_Timer()
|
||||
If Not (dsb Is Nothing) Then
|
||||
If (dsb.GetStatus And DSBSTATUS_PLAYING) <> DSBSTATUS_PLAYING Then
|
||||
If cmdPlay.Enabled = False Then
|
||||
EnablePlayUI True
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,44 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: VB Deferred Effects Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
// GM/GS<47> Sound Set Copyright <20>1996, Roland Corporation U.S.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The sample demonstrates:
|
||||
How to use standard effects (FX) with DirectSound and AcquireResources
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\DirectSound\DefferedEffects
|
||||
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectSound\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
- make sure a sound file is loaded (can be WAV)
|
||||
|
||||
- by default, no FX are enabled. try playing the sound to see what it
|
||||
orginally sounds like.
|
||||
|
||||
- enable one or more FXs by adding them to the 'In use' listbox
|
||||
|
||||
- Click Apply to call AcquireResources and load the effects (the listbox will now show
|
||||
you were they were allocated, ie hardware or software).
|
||||
|
||||
- Hit play to hear the FX applied.
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
Fill one or more DSEFFECTDESC structs, and pass them into DirectSoundSecondaryBuffer.SetFX,
|
||||
and then call AcquireResources before playing the buffer.
|
||||
@@ -0,0 +1,32 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#DX8VB.DLL#DirectX 8 for Visual Basic Type Library
|
||||
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; Mscomctl.ocx
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Form=frmFX.frm
|
||||
Startup="frmEffects"
|
||||
Command32=""
|
||||
Name="vbDeferredEffects"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,318 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmChorus
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "Chorus Effects Update"
|
||||
ClientHeight = 4440
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 2775
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 4440
|
||||
ScaleWidth = 2775
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.CommandButton cmdOK
|
||||
Caption = "OK"
|
||||
Height = 315
|
||||
Left = 1800
|
||||
TabIndex = 15
|
||||
Top = 4020
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.OptionButton optSin
|
||||
Caption = "Sine"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 11
|
||||
Top = 3600
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.OptionButton optTriangle
|
||||
Caption = "Triangle"
|
||||
Height = 255
|
||||
Left = 1680
|
||||
TabIndex = 10
|
||||
Top = 3600
|
||||
Width = 915
|
||||
End
|
||||
Begin MSComctlLib.Slider sldFeedback
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 0
|
||||
Top = 360
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
Min = -99
|
||||
Max = 99
|
||||
SelStart = 1
|
||||
TickFrequency = 10
|
||||
Value = 1
|
||||
End
|
||||
Begin MSComctlLib.Slider sldDelay
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 1
|
||||
Top = 900
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
Max = 20
|
||||
TickFrequency = 2
|
||||
End
|
||||
Begin MSComctlLib.Slider sldDepth
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 2
|
||||
Top = 1440
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
Max = 100
|
||||
TickFrequency = 10
|
||||
End
|
||||
Begin MSComctlLib.Slider sldFreq
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 3
|
||||
Top = 1980
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
TickFrequency = 2
|
||||
End
|
||||
Begin MSComctlLib.Slider sldPhase
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 8
|
||||
Top = 2520
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 2
|
||||
Max = 4
|
||||
End
|
||||
Begin MSComctlLib.Slider sldWetDry
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 13
|
||||
Top = 3060
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
SmallChange = 5
|
||||
Max = 100
|
||||
SelStart = 1
|
||||
TickFrequency = 10
|
||||
Value = 1
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Wet Dry Mix"
|
||||
Height = 255
|
||||
Index = 6
|
||||
Left = 60
|
||||
TabIndex = 14
|
||||
Top = 2820
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Wave Form"
|
||||
Height = 255
|
||||
Index = 5
|
||||
Left = 60
|
||||
TabIndex = 12
|
||||
Top = 3360
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Phase"
|
||||
Height = 255
|
||||
Index = 2
|
||||
Left = 60
|
||||
TabIndex = 9
|
||||
Top = 2280
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Feedback"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 60
|
||||
TabIndex = 7
|
||||
Top = 120
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Delay"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 60
|
||||
TabIndex = 6
|
||||
Top = 660
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Depth"
|
||||
Height = 255
|
||||
Index = 3
|
||||
Left = 60
|
||||
TabIndex = 5
|
||||
Top = 1200
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Frequency"
|
||||
Height = 255
|
||||
Index = 4
|
||||
Left = 60
|
||||
TabIndex = 4
|
||||
Top = 1740
|
||||
Width = 1035
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmChorus"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmChorus.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
Private oBuffer As DirectSoundSecondaryBuffer8
|
||||
Private mlIndex As Long
|
||||
|
||||
Private oFX As DirectSoundFXChorus8
|
||||
|
||||
Private Sub SaveAllSettings()
|
||||
Dim fxNew As DSFXCHORUS
|
||||
|
||||
'Ok, save these new settings
|
||||
'Set the new information up
|
||||
With fxNew
|
||||
.fFeedback = CSng(sldFeedback.Value)
|
||||
.fDelay = CSng(sldDelay.Value)
|
||||
.fDepth = CSng(sldDepth.Value)
|
||||
.fWetDryMix = CSng(sldWetDry.Value)
|
||||
.fFrequency = CSng(sldFreq.Value)
|
||||
.lPhase = sldPhase.Value
|
||||
If optSin.Value Then
|
||||
.lWaveform = DSFX_WAVE_SIN
|
||||
ElseIf optTriangle.Value Then
|
||||
.lWaveform = DSFX_WAVE_TRIANGLE
|
||||
End If
|
||||
End With
|
||||
'Now update the effect
|
||||
oFX.SetAllParameters fxNew
|
||||
End Sub
|
||||
Private Sub cmdOK_Click()
|
||||
SaveAllSettings
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim fxCurrent As DSFXCHORUS
|
||||
|
||||
'Get the echo interface
|
||||
Set oFX = oBuffer.GetObjectinPath(DSFX_STANDARD_CHORUS, mlIndex, IID_DirectSoundFXChorus)
|
||||
'Get the current settings from it
|
||||
fxCurrent = oFX.GetAllParameters
|
||||
'Now put them out there
|
||||
With fxCurrent
|
||||
sldFeedback.Value = CLng(.fFeedback)
|
||||
sldDelay.Value = CLng(.fDelay)
|
||||
sldDepth.Value = CLng(.fDepth)
|
||||
sldWetDry.Value = CLng(.fWetDryMix)
|
||||
sldFreq.Value = CLng(.fFrequency)
|
||||
sldPhase.Value = .lPhase
|
||||
If .lWaveform = DSFX_WAVE_SIN Then
|
||||
optSin.Value = True
|
||||
ElseIf .lWaveform = DSFX_WAVE_TRIANGLE Then
|
||||
optTriangle.Value = True
|
||||
End If
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Public Sub SetBuffer(oBuf As DirectSoundSecondaryBuffer8, Index As Long)
|
||||
'Store the buffer and index
|
||||
Set oBuffer = oBuf
|
||||
mlIndex = Index
|
||||
End Sub
|
||||
|
||||
Private Sub optSin_Click()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub optTriangle_Click()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldDelay_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldDelay_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldDepth_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldDepth_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldFeedback_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldFeedback_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldFreq_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldFreq_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldPhase_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldPhase_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldWetDry_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldWetDry_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
@@ -0,0 +1,286 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmCompressor
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "Compressor Effects Update"
|
||||
ClientHeight = 2145
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 5550
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 2145
|
||||
ScaleWidth = 5550
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.CommandButton cmdOK
|
||||
Caption = "OK"
|
||||
Height = 315
|
||||
Left = 4560
|
||||
TabIndex = 12
|
||||
Top = 1680
|
||||
Width = 915
|
||||
End
|
||||
Begin MSComctlLib.Slider sldAttack
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 0
|
||||
Top = 300
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
SmallChange = 5
|
||||
Min = 1
|
||||
Max = 500
|
||||
SelStart = 1
|
||||
TickFrequency = 33
|
||||
Value = 1
|
||||
End
|
||||
Begin MSComctlLib.Slider sldOutputGain
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 1
|
||||
Top = 840
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
SmallChange = 2
|
||||
Min = -60
|
||||
Max = 60
|
||||
TickFrequency = 10
|
||||
End
|
||||
Begin MSComctlLib.Slider sldDelay
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 2
|
||||
Top = 1380
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 1
|
||||
Max = 4
|
||||
End
|
||||
Begin MSComctlLib.Slider sldRatio
|
||||
Height = 195
|
||||
Left = 2820
|
||||
TabIndex = 3
|
||||
Top = 840
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
Min = 1
|
||||
Max = 100
|
||||
SelStart = 1
|
||||
TickFrequency = 10
|
||||
Value = 1
|
||||
End
|
||||
Begin MSComctlLib.Slider sldRelease
|
||||
Height = 195
|
||||
Left = 2835
|
||||
TabIndex = 4
|
||||
Top = 1365
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
SmallChange = 5
|
||||
Min = 50
|
||||
Max = 3000
|
||||
SelStart = 50
|
||||
TickFrequency = 100
|
||||
Value = 50
|
||||
End
|
||||
Begin MSComctlLib.Slider sldThreshold
|
||||
Height = 195
|
||||
Left = 2820
|
||||
TabIndex = 10
|
||||
Top = 300
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
Min = -60
|
||||
Max = 0
|
||||
TickFrequency = 5
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Threshold"
|
||||
Height = 255
|
||||
Index = 8
|
||||
Left = 2820
|
||||
TabIndex = 11
|
||||
Top = 60
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Ratio"
|
||||
Height = 255
|
||||
Index = 4
|
||||
Left = 2820
|
||||
TabIndex = 9
|
||||
Top = 600
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Pre-Delay"
|
||||
Height = 255
|
||||
Index = 3
|
||||
Left = 60
|
||||
TabIndex = 8
|
||||
Top = 1140
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Gain"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 60
|
||||
TabIndex = 7
|
||||
Top = 600
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Attack"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 60
|
||||
TabIndex = 6
|
||||
Top = 60
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Release"
|
||||
Height = 255
|
||||
Index = 2
|
||||
Left = 2835
|
||||
TabIndex = 5
|
||||
Top = 1125
|
||||
Width = 1035
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmCompressor"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmCompressor.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
Private oBuffer As DirectSoundSecondaryBuffer8
|
||||
Private mlIndex As Long
|
||||
|
||||
Private oFX As DirectSoundFXCompressor8
|
||||
Private Sub SaveAllSettings()
|
||||
Dim fxNew As DSFXCOMPRESSOR
|
||||
|
||||
'Ok, save these new settings
|
||||
'Set the new information up
|
||||
With fxNew
|
||||
.fAttack = CSng(sldAttack.Value)
|
||||
.fGain = CSng(sldOutputGain.Value)
|
||||
.fPredelay = CSng(sldDelay.Value)
|
||||
.fRatio = CSng(sldRatio.Value)
|
||||
.fRelease = CSng(sldRelease.Value)
|
||||
.fThreshold = CSng(sldThreshold.Value)
|
||||
End With
|
||||
'Now update the effect
|
||||
oFX.SetAllParameters fxNew
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOK_Click()
|
||||
SaveAllSettings
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim fxCurrent As DSFXCOMPRESSOR
|
||||
|
||||
'Get the echo interface
|
||||
Set oFX = oBuffer.GetObjectinPath(DSFX_STANDARD_COMPRESSOR, mlIndex, IID_DirectSoundFXCompressor)
|
||||
'Get the current settings from it
|
||||
fxCurrent = oFX.GetAllParameters
|
||||
'Now put them out there
|
||||
With fxCurrent
|
||||
sldAttack.Value = CLng(.fAttack)
|
||||
sldOutputGain.Value = CLng(.fGain)
|
||||
sldDelay.Value = CLng(.fPredelay)
|
||||
sldRatio.Value = CLng(.fRatio)
|
||||
sldRelease.Value = CLng(.fRelease)
|
||||
sldThreshold.Value = CLng(.fThreshold)
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Public Sub SetBuffer(oBuf As DirectSoundSecondaryBuffer8, Index As Long)
|
||||
'Store the buffer and index
|
||||
Set oBuffer = oBuf
|
||||
mlIndex = Index
|
||||
End Sub
|
||||
|
||||
Private Sub sldAttack_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldAttack_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldDelay_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldDelay_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldOutputGain_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldOutputGain_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldRatio_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldRatio_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldRelease_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldRelease_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldThreshold_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldThreshold_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
@@ -0,0 +1,254 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmDistortion
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "Distortion Effects Update"
|
||||
ClientHeight = 3240
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 2775
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 3240
|
||||
ScaleWidth = 2775
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.CommandButton cmdOK
|
||||
Caption = "OK"
|
||||
Height = 315
|
||||
Left = 1800
|
||||
TabIndex = 10
|
||||
Top = 2820
|
||||
Width = 915
|
||||
End
|
||||
Begin MSComctlLib.Slider sldGain
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 0
|
||||
Top = 300
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
Min = -60
|
||||
Max = 0
|
||||
TickFrequency = 5
|
||||
End
|
||||
Begin MSComctlLib.Slider sldEdge
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 1
|
||||
Top = 840
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
Max = 100
|
||||
TickFrequency = 5
|
||||
End
|
||||
Begin MSComctlLib.Slider sldPostEQCenter
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 2
|
||||
Top = 1380
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 500
|
||||
SmallChange = 100
|
||||
Min = 100
|
||||
Max = 8000
|
||||
SelStart = 100
|
||||
TickFrequency = 500
|
||||
Value = 100
|
||||
End
|
||||
Begin MSComctlLib.Slider sldPostEQBand
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 3
|
||||
Top = 1920
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 500
|
||||
SmallChange = 100
|
||||
Min = 100
|
||||
Max = 8000
|
||||
SelStart = 100
|
||||
TickFrequency = 500
|
||||
Value = 100
|
||||
End
|
||||
Begin MSComctlLib.Slider sldPreLow
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 4
|
||||
Top = 2460
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 500
|
||||
SmallChange = 100
|
||||
Min = 100
|
||||
Max = 8000
|
||||
SelStart = 100
|
||||
TickFrequency = 500
|
||||
Value = 100
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Post EQ Bandwith"
|
||||
Height = 255
|
||||
Index = 4
|
||||
Left = 60
|
||||
TabIndex = 9
|
||||
Top = 1680
|
||||
Width = 2055
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Post EQ Center Frequency"
|
||||
Height = 255
|
||||
Index = 3
|
||||
Left = 60
|
||||
TabIndex = 8
|
||||
Top = 1140
|
||||
Width = 2475
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Edge"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 60
|
||||
TabIndex = 7
|
||||
Top = 600
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Gain"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 60
|
||||
TabIndex = 6
|
||||
Top = 60
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Prelow Pass Cutoff"
|
||||
Height = 255
|
||||
Index = 2
|
||||
Left = 60
|
||||
TabIndex = 5
|
||||
Top = 2220
|
||||
Width = 2535
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmDistortion"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmDistortion.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
Private oBuffer As DirectSoundSecondaryBuffer8
|
||||
Private mlIndex As Long
|
||||
|
||||
Private oFX As DirectSoundFXDistortion8
|
||||
|
||||
Private Sub SaveAllSettings()
|
||||
Dim fxNew As DSFXDISTORTION
|
||||
|
||||
'Ok, save these new settings
|
||||
'Set the new information up
|
||||
With fxNew
|
||||
.fEdge = CSng(sldEdge.Value)
|
||||
.fGain = CSng(sldGain.Value)
|
||||
.fPostEQBandwidth = CSng(sldPostEQBand.Value)
|
||||
.fPostEQCenterFrequency = CSng(sldPostEQCenter.Value)
|
||||
.fPreLowpassCutoff = CSng(sldPreLow.Value)
|
||||
End With
|
||||
'Now update the effect
|
||||
oFX.SetAllParameters fxNew
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOK_Click()
|
||||
SaveAllSettings
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim fxCurrent As DSFXDISTORTION
|
||||
|
||||
'Get the echo interface
|
||||
Set oFX = oBuffer.GetObjectinPath(DSFX_STANDARD_DISTORTION, mlIndex, IID_DirectSoundFXDistortion)
|
||||
'Get the current settings from it
|
||||
fxCurrent = oFX.GetAllParameters
|
||||
'Now put them out there
|
||||
With fxCurrent
|
||||
sldEdge.Value = CLng(.fEdge)
|
||||
sldGain.Value = CLng(.fGain)
|
||||
sldPostEQBand.Value = CLng(.fPostEQBandwidth)
|
||||
sldPostEQCenter.Value = CLng(.fPostEQCenterFrequency)
|
||||
sldPreLow.Value = CLng(.fPreLowpassCutoff)
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Public Sub SetBuffer(oBuf As DirectSoundSecondaryBuffer8, Index As Long)
|
||||
'Store the buffer and index
|
||||
Set oBuffer = oBuf
|
||||
mlIndex = Index
|
||||
End Sub
|
||||
|
||||
Private Sub sldEdge_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldEdge_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldGain_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldGain_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldPostEQBand_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldPostEQBand_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldPostEQCenter_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldPostEQCenter_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldPreLow_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldPreLow_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
@@ -0,0 +1,235 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmEcho
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "Echo Effects Update"
|
||||
ClientHeight = 3090
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 2775
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 3090
|
||||
ScaleWidth = 2775
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.CheckBox chkPan
|
||||
Caption = "Pan Delay Max"
|
||||
Height = 195
|
||||
Left = 120
|
||||
TabIndex = 9
|
||||
Top = 2340
|
||||
Width = 2535
|
||||
End
|
||||
Begin VB.CommandButton cmdOK
|
||||
Caption = "OK"
|
||||
Height = 315
|
||||
Left = 1800
|
||||
TabIndex = 8
|
||||
Top = 2700
|
||||
Width = 915
|
||||
End
|
||||
Begin MSComctlLib.Slider sldFeedback
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 0
|
||||
Top = 360
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
Max = 100
|
||||
SelStart = 1
|
||||
TickFrequency = 10
|
||||
Value = 1
|
||||
End
|
||||
Begin MSComctlLib.Slider sldLeft
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 2
|
||||
Top = 900
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 100
|
||||
SmallChange = 10
|
||||
Min = 1
|
||||
Max = 2000
|
||||
SelStart = 1
|
||||
TickFrequency = 100
|
||||
Value = 1
|
||||
End
|
||||
Begin MSComctlLib.Slider sldRight
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 4
|
||||
Top = 1440
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 100
|
||||
SmallChange = 10
|
||||
Min = 1
|
||||
Max = 2000
|
||||
SelStart = 1
|
||||
TickFrequency = 100
|
||||
Value = 1
|
||||
End
|
||||
Begin MSComctlLib.Slider sldWetDry
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 6
|
||||
Top = 1980
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
SmallChange = 5
|
||||
Max = 100
|
||||
SelStart = 1
|
||||
TickFrequency = 10
|
||||
Value = 1
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Wet Dry Mix"
|
||||
Height = 255
|
||||
Index = 4
|
||||
Left = 60
|
||||
TabIndex = 7
|
||||
Top = 1740
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Right Delay"
|
||||
Height = 255
|
||||
Index = 3
|
||||
Left = 60
|
||||
TabIndex = 5
|
||||
Top = 1200
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Left Delay"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 60
|
||||
TabIndex = 3
|
||||
Top = 660
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Feedback"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 60
|
||||
TabIndex = 1
|
||||
Top = 120
|
||||
Width = 735
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmEcho"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmEcho.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
Private oBuffer As DirectSoundSecondaryBuffer8
|
||||
Private mlIndex As Long
|
||||
|
||||
Private oFX As DirectSoundFXEcho8
|
||||
|
||||
Private Sub SaveAllSettings()
|
||||
Dim fxNew As DSFXECHO
|
||||
|
||||
'Ok, save these new settings
|
||||
'Set the new information up
|
||||
With fxNew
|
||||
.fFeedback = CSng(sldFeedback.Value)
|
||||
.fLeftDelay = CSng(sldLeft.Value)
|
||||
.fRightDelay = CSng(sldRight.Value)
|
||||
.fWetDryMix = CSng(sldWetDry.Value)
|
||||
.lPanDelay = chkPan.Value
|
||||
End With
|
||||
'Now update the effect
|
||||
oFX.SetAllParameters fxNew
|
||||
End Sub
|
||||
|
||||
Private Sub chkPan_Click()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOK_Click()
|
||||
SaveAllSettings
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim fxCurrent As DSFXECHO
|
||||
|
||||
'Get the echo interface
|
||||
Set oFX = oBuffer.GetObjectinPath(DSFX_STANDARD_ECHO, mlIndex, IID_DirectSoundFXEcho)
|
||||
'Get the current settings from it
|
||||
fxCurrent = oFX.GetAllParameters
|
||||
'Now put them out there
|
||||
With fxCurrent
|
||||
sldFeedback.Value = CLng(.fFeedback)
|
||||
sldLeft.Value = CLng(.fLeftDelay)
|
||||
sldRight.Value = CLng(.fRightDelay)
|
||||
sldWetDry.Value = CLng(.fWetDryMix)
|
||||
chkPan.Value = .lPanDelay
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Public Sub SetBuffer(oBuf As DirectSoundSecondaryBuffer8, Index As Long)
|
||||
'Store the buffer and index
|
||||
Set oBuffer = oBuf
|
||||
mlIndex = Index
|
||||
End Sub
|
||||
|
||||
Private Sub sldFeedback_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldFeedback_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldLeft_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldLeft_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldRight_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldRight_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldWetDry_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldWetDry_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
@@ -0,0 +1,665 @@
|
||||
VERSION 5.00
|
||||
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
|
||||
Begin VB.Form frmEffects
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Caption = "Audio Effects using DirectSound Buffers"
|
||||
ClientHeight = 5790
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 4770
|
||||
Icon = "frmFX.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 5790
|
||||
ScaleWidth = 4770
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.Timer tmrUpdate
|
||||
Interval = 50
|
||||
Left = 5760
|
||||
Top = 900
|
||||
End
|
||||
Begin VB.CheckBox chkLoop
|
||||
Caption = "Loop Sound"
|
||||
Height = 315
|
||||
Left = 840
|
||||
TabIndex = 16
|
||||
Top = 5340
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.CommandButton cmdStop
|
||||
Caption = "&Stop"
|
||||
Height = 375
|
||||
Left = 3600
|
||||
TabIndex = 14
|
||||
Top = 5340
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdPlay
|
||||
Caption = "&Play"
|
||||
Height = 375
|
||||
Left = 2400
|
||||
TabIndex = 13
|
||||
Top = 5340
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Frame fraEffects
|
||||
Caption = "Effects Information"
|
||||
Height = 3675
|
||||
Left = 120
|
||||
TabIndex = 2
|
||||
Top = 1560
|
||||
Width = 4515
|
||||
Begin VB.CommandButton cmdModify
|
||||
Caption = "Modify Selected Effects"
|
||||
Enabled = 0 'False
|
||||
Height = 315
|
||||
Left = 120
|
||||
TabIndex = 17
|
||||
Top = 3240
|
||||
Width = 2235
|
||||
End
|
||||
Begin VB.TextBox txtFile
|
||||
Height = 285
|
||||
Left = 120
|
||||
Locked = -1 'True
|
||||
TabIndex = 9
|
||||
Text = "No file loaded..."
|
||||
Top = 480
|
||||
Width = 3915
|
||||
End
|
||||
Begin VB.CommandButton cmdBrowse
|
||||
Caption = "..."
|
||||
Height = 285
|
||||
Left = 4020
|
||||
TabIndex = 8
|
||||
ToolTipText = "Open a new audio file..."
|
||||
Top = 480
|
||||
Width = 315
|
||||
End
|
||||
Begin VB.ListBox lstAvail
|
||||
Height = 840
|
||||
ItemData = "frmFX.frx":0442
|
||||
Left = 120
|
||||
List = "frmFX.frx":045E
|
||||
TabIndex = 7
|
||||
Top = 1080
|
||||
Width = 4275
|
||||
End
|
||||
Begin VB.ListBox lstUse
|
||||
Height = 840
|
||||
Left = 120
|
||||
TabIndex = 6
|
||||
Top = 2280
|
||||
Width = 4275
|
||||
End
|
||||
Begin VB.CommandButton cmdAdd
|
||||
Height = 285
|
||||
Left = 2040
|
||||
MaskColor = &H000000FF&
|
||||
Picture = "frmFX.frx":04AF
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 5
|
||||
Top = 1980
|
||||
UseMaskColor = -1 'True
|
||||
Width = 315
|
||||
End
|
||||
Begin VB.CommandButton cmdRemove
|
||||
Height = 285
|
||||
Left = 2400
|
||||
MaskColor = &H000000FF&
|
||||
Picture = "frmFX.frx":09F1
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 4
|
||||
Top = 1980
|
||||
UseMaskColor = -1 'True
|
||||
Width = 315
|
||||
End
|
||||
Begin VB.CommandButton cmdApply
|
||||
Caption = "Apply Effects"
|
||||
Height = 315
|
||||
Left = 2460
|
||||
TabIndex = 3
|
||||
Top = 3240
|
||||
Width = 1875
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Currently loaded sound file:"
|
||||
Height = 195
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 12
|
||||
Top = 240
|
||||
Width = 4515
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Available Effects"
|
||||
Height = 195
|
||||
Index = 1
|
||||
Left = 120
|
||||
TabIndex = 11
|
||||
Top = 840
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Effects in use"
|
||||
Height = 195
|
||||
Index = 2
|
||||
Left = 120
|
||||
TabIndex = 10
|
||||
Top = 2040
|
||||
Width = 1215
|
||||
End
|
||||
End
|
||||
Begin MSComDlg.CommonDialog cdlOpen
|
||||
Left = 300
|
||||
Top = 3720
|
||||
_ExtentX = 847
|
||||
_ExtentY = 847
|
||||
_Version = 393216
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = $"frmFX.frx":0F33
|
||||
Height = 675
|
||||
Index = 5
|
||||
Left = 120
|
||||
TabIndex = 15
|
||||
Top = 840
|
||||
Width = 4575
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Audio Effects using DirectSoundBuffers"
|
||||
Height = 255
|
||||
Index = 4
|
||||
Left = 660
|
||||
TabIndex = 1
|
||||
Top = 60
|
||||
Width = 3195
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Copyright (C) 1999-2001 Microsoft Corporation, All Rights Reserved."
|
||||
Height = 435
|
||||
Index = 3
|
||||
Left = 660
|
||||
TabIndex = 0
|
||||
Top = 300
|
||||
Width = 3555
|
||||
End
|
||||
Begin VB.Image Image1
|
||||
Height = 480
|
||||
Left = 120
|
||||
Picture = "frmFX.frx":0FCA
|
||||
Top = 180
|
||||
Width = 480
|
||||
End
|
||||
Begin VB.Menu mnuPop
|
||||
Caption = "pop"
|
||||
Visible = 0 'False
|
||||
Begin VB.Menu mnuRemove
|
||||
Caption = "Remove"
|
||||
End
|
||||
Begin VB.Menu mnuChange
|
||||
Caption = "Change Settings..."
|
||||
End
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmEffects"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmFX.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
'API declare for windows folder
|
||||
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
|
||||
|
||||
Private Const mlMaxEffects As Long = 20
|
||||
'Private declares for our DirectX objects
|
||||
Private dx As DirectX8
|
||||
Private ds As DirectSound8
|
||||
Private dsb As DirectSoundSecondaryBuffer8
|
||||
Private mlEffectKey As Long
|
||||
|
||||
Private Sub cmdAdd_Click()
|
||||
If lstAvail.ListIndex = -1 Then 'Nothing is selected
|
||||
MsgBox "Please select an available effect before attempting to add it.", vbOKOnly Or vbInformation, "Nothing selected."
|
||||
Exit Sub
|
||||
End If
|
||||
If Not (dsb Is Nothing) Then
|
||||
'Yup, now is there a sound already playing?
|
||||
If (dsb.GetStatus And DSBSTATUS_PLAYING) = DSBSTATUS_PLAYING Then
|
||||
MsgBox "Stop the currently playing sound before adding any effects.", vbOKOnly Or vbInformation, "Sound is playing"
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
If lstUse.ListCount >= mlMaxEffects Then
|
||||
MsgBox "You cannot add more than " & CStr(mlMaxEffects) & " effects in this sample.", vbOKOnly Or vbInformation, "No more effects."
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Add this item to our list of effects
|
||||
lstUse.AddItem lstAvail.List(lstAvail.ListIndex) & " (Unallocated)"
|
||||
RemoveAllForms
|
||||
End Sub
|
||||
|
||||
Private Sub cmdApply_Click()
|
||||
ApplySettings
|
||||
End Sub
|
||||
|
||||
Private Sub cmdBrowse_Click()
|
||||
Static sCurDir As String
|
||||
Dim desc As DSBUFFERDESC
|
||||
|
||||
'We want to open a file now
|
||||
cdlOpen.flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
|
||||
cdlOpen.Filter = "Wave Files (*.wav)|*.wav"
|
||||
cdlOpen.FileName = vbNullString
|
||||
If sCurDir = vbNullString Then
|
||||
'Set the init folder to \windows\media if it exists. If not, set it to the \windows folder
|
||||
Dim sWindir As String
|
||||
sWindir = Space$(255)
|
||||
If GetWindowsDirectory(sWindir, 255) = 0 Then
|
||||
'We couldn't get the windows folder for some reason, use the c:\
|
||||
cdlOpen.InitDir = "C:\"
|
||||
Else
|
||||
Dim sMedia As String
|
||||
sWindir = Left$(sWindir, InStr(sWindir, Chr$(0)) - 1)
|
||||
If Right$(sWindir, 1) = "\" Then
|
||||
sMedia = sWindir & "Media"
|
||||
Else
|
||||
sMedia = sWindir & "\Media"
|
||||
End If
|
||||
'We are trying to find the windows\media directory. If it
|
||||
'doesn't exist, then use the windows folder as a default
|
||||
If Dir$(sMedia, vbDirectory) <> vbNullString Then
|
||||
cdlOpen.InitDir = sMedia
|
||||
Else
|
||||
cdlOpen.InitDir = sWindir
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
'No need to move folders. Stay where they picked the last file
|
||||
cdlOpen.InitDir = sCurDir
|
||||
End If
|
||||
On Local Error GoTo ClickedCancel
|
||||
cdlOpen.CancelError = True
|
||||
cdlOpen.ShowOpen ' Display the Open dialog box
|
||||
|
||||
'Save the current information
|
||||
sCurDir = GetFolder(cdlOpen.FileName)
|
||||
|
||||
On Local Error GoTo NoLoadSegment
|
||||
'Before we load the buffer stop one if it's playing
|
||||
If Not (dsb Is Nothing) Then If dsb.GetStatus = DSBSTATUS_PLAYING Then dsb.Stop
|
||||
'We need to set the CTRLFX flag so we can control the effects on this object
|
||||
desc.lFlags = DSBCAPS_CTRLFX
|
||||
'Now let's load the segment
|
||||
RemoveAllForms
|
||||
Set dsb = ds.CreateSoundBufferFromFile(cdlOpen.FileName, desc)
|
||||
mlEffectKey = 0
|
||||
txtFile.Text = cdlOpen.FileName
|
||||
|
||||
Exit Sub
|
||||
NoLoadSegment:
|
||||
If Err.Number = DSERR_BUFFERTOOSMALL Then 'This buffer isn't big enough to control effects on
|
||||
MsgBox "This file isn't long enough to control effects. Please choose a longer audio file.", vbOKOnly Or vbCritical, "Couldn't load"
|
||||
Else 'Some other error
|
||||
MsgBox "Couldn't load this file", vbOKOnly Or vbCritical, "Couldn't load"
|
||||
End If
|
||||
ClickedCancel:
|
||||
End Sub
|
||||
|
||||
Private Sub cmdModify_Click()
|
||||
ChangeSettings
|
||||
End Sub
|
||||
|
||||
Private Sub cmdPlay_Click()
|
||||
If dsb Is Nothing Then
|
||||
MsgBox "You must first load a wave file into a sound buffer before you can play it.", vbOKOnly Or vbInformation, "No buffer"
|
||||
Exit Sub
|
||||
End If
|
||||
'We need to pre-roll any effects parameter changes that occurred since the last
|
||||
'call to an API that does pre-rolling (ie, Stop or SetCurrentPosition)
|
||||
dsb.SetCurrentPosition 0
|
||||
dsb.Play chkLoop.Value
|
||||
EnablePlayUI False
|
||||
End Sub
|
||||
|
||||
Private Sub cmdRemove_Click()
|
||||
Dim lLastIndex As Long
|
||||
If lstUse.ListIndex = -1 Then 'Nothing is selected
|
||||
MsgBox "Please select an effect that's being used before attempting to remove it.", vbOKOnly Or vbInformation, "Nothing selected."
|
||||
Exit Sub
|
||||
End If
|
||||
If Not (dsb Is Nothing) Then
|
||||
'Yup, now is there a sound already playing?
|
||||
If (dsb.GetStatus And DSBSTATUS_PLAYING) = DSBSTATUS_PLAYING Then
|
||||
MsgBox "Stop the currently playing sound before removing any effects.", vbOKOnly Or vbInformation, "Sound is playing"
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
lLastIndex = lstUse.ListIndex
|
||||
'Add this item to our list of effects
|
||||
lstUse.RemoveItem lstUse.ListIndex
|
||||
If (lstUse.ListCount > 0) Then
|
||||
If lstUse.ListCount > lLastIndex Then
|
||||
lstUse.ListIndex = lLastIndex
|
||||
Else
|
||||
lstUse.ListIndex = 0
|
||||
End If
|
||||
End If
|
||||
'Enable the menus
|
||||
If lstUse.ListCount < 1 Or lstUse.ListIndex < 0 Then
|
||||
EnableMenus False
|
||||
Else
|
||||
EnableMenus True
|
||||
End If
|
||||
mlEffectKey = 0
|
||||
RemoveAllForms
|
||||
End Sub
|
||||
|
||||
Private Sub cmdStop_Click()
|
||||
If dsb Is Nothing Then
|
||||
MsgBox "You must first load a wave file into a sound buffer before you can stop it.", vbOKOnly Or vbInformation, "No buffer"
|
||||
Exit Sub
|
||||
End If
|
||||
dsb.Stop
|
||||
'Stop doesn't reset the current position
|
||||
dsb.SetCurrentPosition 0
|
||||
EnablePlayUI True
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
EnablePlayUI True
|
||||
InitDSound
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
RemoveAllForms
|
||||
CleanupDSound
|
||||
End Sub
|
||||
|
||||
Private Sub InitDSound()
|
||||
|
||||
On Error GoTo FailedInit
|
||||
Set dx = New DirectX8
|
||||
'Create our default DirectSound object
|
||||
Set ds = dx.DirectSoundCreate(vbNullString)
|
||||
ds.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
|
||||
Exit Sub
|
||||
|
||||
FailedInit:
|
||||
MsgBox "Could not initialize DirectSound." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
|
||||
Unload Me
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub CleanupDSound()
|
||||
'Let's clean up now
|
||||
If Not dsb Is Nothing Then
|
||||
'If we are playing our file, stop it
|
||||
If dsb.GetStatus = DSBSTATUS_PLAYING Then dsb.Stop
|
||||
'Destroy our objects
|
||||
Set dsb = Nothing
|
||||
End If
|
||||
Set ds = Nothing
|
||||
Set dx = Nothing
|
||||
End Sub
|
||||
|
||||
Private Function GetFolder(ByVal sFile As String) As String
|
||||
Dim lCount As Long
|
||||
|
||||
For lCount = Len(sFile) To 1 Step -1
|
||||
If Mid$(sFile, lCount, 1) = "\" Then
|
||||
GetFolder = Left$(sFile, lCount)
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
GetFolder = vbNullString
|
||||
End Function
|
||||
|
||||
Private Sub lstAvail_DblClick()
|
||||
'Double clicking should be the same as clicking the 'Add' button
|
||||
cmdAdd_Click
|
||||
End Sub
|
||||
|
||||
Private Sub lstUse_Click()
|
||||
'Enable the menu
|
||||
If lstUse.ListCount < 1 Or lstUse.ListIndex < 0 Then
|
||||
EnableMenus False
|
||||
Else
|
||||
EnableMenus True
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub lstUse_DblClick()
|
||||
'Double clicking should be the same as clicking the 'Remove' button
|
||||
cmdRemove_Click
|
||||
End Sub
|
||||
|
||||
Private Sub lstUse_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
|
||||
If Button = vbRightButton Then
|
||||
'Show the popup menu
|
||||
If lstUse.ListCount < 1 Or lstUse.ListIndex < 0 Then
|
||||
EnableMenus False
|
||||
Else
|
||||
EnableMenus True
|
||||
End If
|
||||
PopupMenu mnuPop, , X + lstUse.Left, Y + lstUse.Top + fraEffects.Top, mnuRemove
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub EnableMenus(ByVal fEnable As Boolean)
|
||||
mnuChange.Enabled = fEnable
|
||||
mnuRemove.Enabled = fEnable
|
||||
cmdModify.Enabled = fEnable
|
||||
End Sub
|
||||
|
||||
Private Sub mnuChange_Click()
|
||||
ChangeSettings
|
||||
End Sub
|
||||
|
||||
Private Sub mnuRemove_Click()
|
||||
cmdRemove_Click
|
||||
End Sub
|
||||
|
||||
Private Sub ChangeSettings()
|
||||
Dim fGargle As frmGargle, fCompressor As frmCompressor
|
||||
Dim fEcho As frmEcho, fDistortion As frmDistortion
|
||||
Dim fChorus As frmChorus, fFlanger As frmFlanger
|
||||
Dim fParam As frmParamEQ, fWave As frmWaves
|
||||
Dim lIndex As Long, lCount As Long
|
||||
|
||||
On Error GoTo LeaveSub
|
||||
'First we need to force the effects to be applied
|
||||
If Not ApplySettings(True) Then Exit Sub
|
||||
'No need to continue if the sound is playing or there is no sound buffer
|
||||
If dsb Is Nothing Then Exit Sub
|
||||
|
||||
'Now we need to get the index of this effect
|
||||
lIndex = -1
|
||||
For lCount = 0 To lstUse.ListIndex
|
||||
If LCase(lstUse.List(lstUse.ListIndex)) = LCase(lstUse.List(lCount)) Then lIndex = lIndex + 1
|
||||
Next
|
||||
|
||||
'Now show the correct screen based on the info
|
||||
Select Case Left$(LCase(lstUse.List(lstUse.ListIndex)), InStr(lstUse.List(lstUse.ListIndex), " ") - 1)
|
||||
Case "distortion"
|
||||
Set fDistortion = New frmDistortion
|
||||
fDistortion.SetBuffer dsb, lIndex
|
||||
fDistortion.Show vbModeless, Me
|
||||
Case "echo"
|
||||
Set fEcho = New frmEcho
|
||||
fEcho.SetBuffer dsb, lIndex
|
||||
fEcho.Show vbModeless, Me
|
||||
Case "chorus"
|
||||
Set fChorus = New frmChorus
|
||||
fChorus.SetBuffer dsb, lIndex
|
||||
fChorus.Show vbModeless, Me
|
||||
Case "flanger"
|
||||
Set fFlanger = New frmFlanger
|
||||
fFlanger.SetBuffer dsb, lIndex
|
||||
fFlanger.Show vbModeless, Me
|
||||
Case "compressor"
|
||||
Set fCompressor = New frmCompressor
|
||||
fCompressor.SetBuffer dsb, lIndex
|
||||
fCompressor.Show vbModeless, Me
|
||||
Case "gargle"
|
||||
Set fGargle = New frmGargle
|
||||
fGargle.SetBuffer dsb, lIndex
|
||||
fGargle.Show vbModeless, Me
|
||||
Case "parameq"
|
||||
Set fParam = New frmParamEQ
|
||||
fParam.SetBuffer dsb, lIndex
|
||||
fParam.Show vbModeless, Me
|
||||
Case "wavesreverb"
|
||||
Set fWave = New frmWaves
|
||||
fWave.SetBuffer dsb, lIndex
|
||||
fWave.Show vbModeless, Me
|
||||
End Select
|
||||
LeaveSub:
|
||||
End Sub
|
||||
|
||||
Private Sub EnablePlayUI(ByVal fEnable As Boolean)
|
||||
On Error Resume Next
|
||||
If fEnable Then
|
||||
chkLoop.Enabled = True
|
||||
cmdPlay.Enabled = True
|
||||
cmdStop.Enabled = False
|
||||
cmdBrowse.Enabled = True
|
||||
cmdPlay.SetFocus
|
||||
Else
|
||||
chkLoop.Enabled = False
|
||||
cmdPlay.Enabled = False
|
||||
cmdStop.Enabled = True
|
||||
cmdBrowse.Enabled = False
|
||||
cmdStop.SetFocus
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub tmrUpdate_Timer()
|
||||
If Not (dsb Is Nothing) Then
|
||||
If (dsb.GetStatus And DSBSTATUS_PLAYING) <> DSBSTATUS_PLAYING Then
|
||||
If cmdPlay.Enabled = False Then
|
||||
EnablePlayUI True
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Function ApplySettings(Optional ByVal fIgnoreSoundPlaying As Boolean = False) As Boolean
|
||||
On Local Error GoTo NoFX
|
||||
Dim DSEffects() As DSEFFECTDESC
|
||||
Dim lResults() As Long
|
||||
Dim lCount As Long
|
||||
Dim lTempEffect As Long
|
||||
|
||||
'Do we have a sound buffer
|
||||
If dsb Is Nothing Then
|
||||
MsgBox "You must first load a wave file into a sound buffer before you can apply effects to it.", vbOKOnly Or vbInformation, "No buffer"
|
||||
Exit Function
|
||||
End If
|
||||
If Not fIgnoreSoundPlaying Then
|
||||
'Yup, now is there a sound already playing?
|
||||
If (dsb.GetStatus And DSBSTATUS_PLAYING) = DSBSTATUS_PLAYING Then
|
||||
MsgBox "Stop the currently playing sound before adding effects.", vbOKOnly Or vbInformation, "Sound is playing"
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
'Yes we do, do we have effects selected?
|
||||
If lstUse.ListCount = 0 Then
|
||||
If MsgBox("Do you want to turn off effects for this buffer?", vbYesNo Or vbQuestion, "No effects") = vbYes Then
|
||||
dsb.SetFX 0, DSEffects, lResults
|
||||
Exit Function
|
||||
Else
|
||||
MsgBox "You must first select some effects to use.", vbOKOnly Or vbInformation, "No effects"
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
'Ok, let's apply our effects info here
|
||||
|
||||
'First get an array of effects structs the right size
|
||||
ReDim DSEffects(lstUse.ListCount - 1)
|
||||
ReDim lResults(lstUse.ListCount - 1)
|
||||
|
||||
'Now we don't want to apply the effects if they've already been applied. So,
|
||||
'through our list, and create a 'unique' number to describe this set of effects
|
||||
'and only apply them if the number is different form our stored one.
|
||||
For lCount = 0 To lstUse.ListCount - 1
|
||||
Select Case Left$(LCase(lstUse.List(lCount)), InStr(lstUse.List(lCount), " ") - 1)
|
||||
Case "distortion"
|
||||
lTempEffect = lTempEffect + (lCount + &H10)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_DISTORTION
|
||||
Case "echo"
|
||||
lTempEffect = lTempEffect + (lCount + &H20)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_ECHO
|
||||
Case "chorus"
|
||||
lTempEffect = lTempEffect + (lCount + &H40)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_CHORUS
|
||||
Case "flanger"
|
||||
lTempEffect = lTempEffect + (lCount + &H80)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_FLANGER
|
||||
Case "compressor"
|
||||
lTempEffect = lTempEffect + (lCount + &H100)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_COMPRESSOR
|
||||
Case "gargle"
|
||||
lTempEffect = lTempEffect + (lCount + &H200)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_GARGLE
|
||||
Case "parameq"
|
||||
lTempEffect = lTempEffect + (lCount + &H400)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_PARAMEQ
|
||||
Case "wavesreverb"
|
||||
lTempEffect = lTempEffect + (lCount + &H800)
|
||||
DSEffects(lCount).guidDSFXClass = DSFX_STANDARD_WAVES_REVERB
|
||||
End Select
|
||||
Next
|
||||
If mlEffectKey <> lTempEffect Then 'They don't match, set the fx.
|
||||
dsb.SetFX lstUse.ListCount, DSEffects, lResults
|
||||
Dim sNewItem As String
|
||||
For lCount = 0 To lstUse.ListCount - 1
|
||||
sNewItem = Left$(lstUse.List(lCount), InStr(lstUse.List(lCount), " ") - 1)
|
||||
Select Case lResults(lCount)
|
||||
Case DSFXR_FAILED
|
||||
lstUse.List(lCount) = sNewItem & " - Failed"
|
||||
Case DSFXR_LOCHARDWARE
|
||||
lstUse.List(lCount) = sNewItem & " - Hardware"
|
||||
Case DSFXR_LOCSOFTWARE
|
||||
lstUse.List(lCount) = sNewItem & " - Software"
|
||||
Case DSFXR_UNALLOCATED
|
||||
lstUse.List(lCount) = sNewItem & " - Unallocated"
|
||||
Case DSFXR_UNKNOWN
|
||||
lstUse.List(lCount) = sNewItem & " - Unknown"
|
||||
Case DSFXR_PRESENT
|
||||
lstUse.List(lCount) = sNewItem & " - Present"
|
||||
End Select
|
||||
Next
|
||||
End If
|
||||
mlEffectKey = lTempEffect
|
||||
ApplySettings = True
|
||||
Exit Function
|
||||
|
||||
NoFX:
|
||||
MsgBox "This set of effects could not be set on this audio file.", vbOKOnly Or vbInformation, "Cannot set"
|
||||
ApplySettings = False
|
||||
End Function
|
||||
|
||||
Private Sub RemoveAllForms()
|
||||
'Get rid of all forms
|
||||
Dim f As Form
|
||||
For Each f In Forms
|
||||
If Not (f Is Me) Then Unload f
|
||||
Next
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,319 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmFlanger
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "Flanger Effects Update"
|
||||
ClientHeight = 4440
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 2775
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 4440
|
||||
ScaleWidth = 2775
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.OptionButton optTriangle
|
||||
Caption = "Triangle"
|
||||
Height = 255
|
||||
Left = 1680
|
||||
TabIndex = 2
|
||||
Top = 3540
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.OptionButton optSin
|
||||
Caption = "Sine"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 1
|
||||
Top = 3540
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.CommandButton cmdOK
|
||||
Caption = "OK"
|
||||
Height = 315
|
||||
Left = 1800
|
||||
TabIndex = 0
|
||||
Top = 3960
|
||||
Width = 915
|
||||
End
|
||||
Begin MSComctlLib.Slider sldFeedback
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 3
|
||||
Top = 300
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
Min = -99
|
||||
Max = 99
|
||||
SelStart = 1
|
||||
TickFrequency = 10
|
||||
Value = 1
|
||||
End
|
||||
Begin MSComctlLib.Slider sldDelay
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 4
|
||||
Top = 840
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 2
|
||||
Max = 4
|
||||
End
|
||||
Begin MSComctlLib.Slider sldDepth
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 5
|
||||
Top = 1380
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
Max = 100
|
||||
TickFrequency = 10
|
||||
End
|
||||
Begin MSComctlLib.Slider sldFreq
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 6
|
||||
Top = 1920
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
TickFrequency = 2
|
||||
End
|
||||
Begin MSComctlLib.Slider sldPhase
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 7
|
||||
Top = 2460
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 2
|
||||
Max = 4
|
||||
End
|
||||
Begin MSComctlLib.Slider sldWetDry
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 8
|
||||
Top = 3000
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
SmallChange = 5
|
||||
Max = 100
|
||||
SelStart = 1
|
||||
TickFrequency = 10
|
||||
Value = 1
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Frequency"
|
||||
Height = 255
|
||||
Index = 4
|
||||
Left = 60
|
||||
TabIndex = 15
|
||||
Top = 1680
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Depth"
|
||||
Height = 255
|
||||
Index = 3
|
||||
Left = 60
|
||||
TabIndex = 14
|
||||
Top = 1140
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Delay"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 60
|
||||
TabIndex = 13
|
||||
Top = 600
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Feedback"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 60
|
||||
TabIndex = 12
|
||||
Top = 60
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Phase"
|
||||
Height = 255
|
||||
Index = 2
|
||||
Left = 60
|
||||
TabIndex = 11
|
||||
Top = 2220
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Wave Form"
|
||||
Height = 255
|
||||
Index = 5
|
||||
Left = 60
|
||||
TabIndex = 10
|
||||
Top = 3300
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Wet Dry Mix"
|
||||
Height = 255
|
||||
Index = 6
|
||||
Left = 60
|
||||
TabIndex = 9
|
||||
Top = 2760
|
||||
Width = 1035
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmFlanger"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmFlanger.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
Private oBuffer As DirectSoundSecondaryBuffer8
|
||||
Private mlIndex As Long
|
||||
|
||||
Private oFX As DirectSoundFXFlanger8
|
||||
|
||||
Private Sub SaveAllSettings()
|
||||
Dim fxNew As DSFXFLANGER
|
||||
|
||||
'Ok, save these new settings
|
||||
'Set the new information up
|
||||
With fxNew
|
||||
.fFeedback = CSng(sldFeedback.Value)
|
||||
.fDelay = CSng(sldDelay.Value)
|
||||
.fDepth = CSng(sldDepth.Value)
|
||||
.fWetDryMix = CSng(sldWetDry.Value)
|
||||
.fFrequency = CSng(sldFreq.Value)
|
||||
.lPhase = sldPhase.Value
|
||||
If optSin.Value Then
|
||||
.lWaveform = DSFX_WAVE_SIN
|
||||
ElseIf optTriangle.Value Then
|
||||
.lWaveform = DSFX_WAVE_TRIANGLE
|
||||
End If
|
||||
End With
|
||||
'Now update the effect
|
||||
oFX.SetAllParameters fxNew
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOK_Click()
|
||||
SaveAllSettings
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim fxCurrent As DSFXFLANGER
|
||||
|
||||
'Get the echo interface
|
||||
Set oFX = oBuffer.GetObjectinPath(DSFX_STANDARD_FLANGER, mlIndex, IID_DirectSoundFXFlanger)
|
||||
'Get the current settings from it
|
||||
fxCurrent = oFX.GetAllParameters
|
||||
'Now put them out there
|
||||
With fxCurrent
|
||||
sldFeedback.Value = CLng(.fFeedback)
|
||||
sldDelay.Value = CLng(.fDelay)
|
||||
sldDepth.Value = CLng(.fDepth)
|
||||
sldWetDry.Value = CLng(.fWetDryMix)
|
||||
sldFreq.Value = CLng(.fFrequency)
|
||||
sldPhase.Value = .lPhase
|
||||
If .lWaveform = DSFX_WAVE_SIN Then
|
||||
optSin.Value = True
|
||||
ElseIf .lWaveform = DSFX_WAVE_TRIANGLE Then
|
||||
optTriangle.Value = True
|
||||
End If
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Public Sub SetBuffer(oBuf As DirectSoundSecondaryBuffer8, Index As Long)
|
||||
'Store the buffer and index
|
||||
Set oBuffer = oBuf
|
||||
mlIndex = Index
|
||||
End Sub
|
||||
|
||||
Private Sub optSin_Click()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub optTriangle_Click()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldDelay_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldDelay_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldDepth_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldDepth_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldFeedback_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldFeedback_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldFreq_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldFreq_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldPhase_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldPhase_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldWetDry_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldWetDry_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
@@ -0,0 +1,163 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmGargle
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "Gargle Effects Update"
|
||||
ClientHeight = 1635
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 2775
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 1635
|
||||
ScaleWidth = 2775
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.OptionButton optTriangle
|
||||
Caption = "Triangle"
|
||||
Height = 255
|
||||
Left = 1680
|
||||
TabIndex = 6
|
||||
Top = 540
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.OptionButton optSquare
|
||||
Caption = "Square"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 5
|
||||
Top = 540
|
||||
Width = 915
|
||||
End
|
||||
Begin MSComctlLib.Slider sldRate
|
||||
Height = 195
|
||||
Left = 780
|
||||
TabIndex = 4
|
||||
Top = 960
|
||||
Width = 1935
|
||||
_ExtentX = 3413
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 100
|
||||
SmallChange = 10
|
||||
Min = 1
|
||||
Max = 1000
|
||||
SelStart = 1
|
||||
TickFrequency = 100
|
||||
Value = 1
|
||||
End
|
||||
Begin VB.CommandButton cmdOK
|
||||
Caption = "OK"
|
||||
Height = 315
|
||||
Left = 1800
|
||||
TabIndex = 3
|
||||
Top = 1260
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Rate Hz"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 60
|
||||
TabIndex = 2
|
||||
Top = 960
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Wave Type"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 60
|
||||
TabIndex = 1
|
||||
Top = 300
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Here you can modify the gargle effect"
|
||||
Height = 255
|
||||
Index = 4
|
||||
Left = 60
|
||||
TabIndex = 0
|
||||
Top = 60
|
||||
Width = 2655
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmGargle"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmGargle.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
Private oBuffer As DirectSoundSecondaryBuffer8
|
||||
Private mlIndex As Long
|
||||
|
||||
Private oFX As DirectSoundFXGargle8
|
||||
|
||||
Private Sub SaveAllSettings()
|
||||
Dim fxNew As DSFXGARGLE
|
||||
|
||||
'Ok, save these new settings
|
||||
'Set the new information up
|
||||
fxNew.lRateHz = CLng(sldRate.Value)
|
||||
If optSquare.Value Then
|
||||
fxNew.lWaveShape = DSFXGARGLE_WAVE_SQUARE
|
||||
ElseIf optTriangle.Value Then
|
||||
fxNew.lWaveShape = DSFXGARGLE_WAVE_TRIANGLE
|
||||
End If
|
||||
'Now update the effect
|
||||
oFX.SetAllParameters fxNew
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOK_Click()
|
||||
SaveAllSettings
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim fxCurrent As DSFXGARGLE
|
||||
|
||||
'Get the gargle interface
|
||||
Set oFX = oBuffer.GetObjectinPath(DSFX_STANDARD_GARGLE, mlIndex, IID_DirectSoundFXGargle)
|
||||
'Get the current settings from it
|
||||
fxCurrent = oFX.GetAllParameters
|
||||
'Now put them out there
|
||||
sldRate.Value = fxCurrent.lRateHz
|
||||
If fxCurrent.lWaveShape = DSFXGARGLE_WAVE_SQUARE Then
|
||||
optSquare.Value = True
|
||||
ElseIf fxCurrent.lWaveShape = DSFXGARGLE_WAVE_TRIANGLE Then
|
||||
optTriangle.Value = True
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub SetBuffer(oBuf As DirectSoundSecondaryBuffer8, Index As Long)
|
||||
'Store the buffer and index
|
||||
Set oBuffer = oBuf
|
||||
mlIndex = Index
|
||||
End Sub
|
||||
|
||||
Private Sub optSquare_Click()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub optTriangle_Click()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldRate_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldRate_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
@@ -0,0 +1,183 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmParamEQ
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "ParamEQ Effects Update"
|
||||
ClientHeight = 2220
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 2775
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 2220
|
||||
ScaleWidth = 2775
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.CommandButton cmdOK
|
||||
Caption = "OK"
|
||||
Height = 315
|
||||
Left = 1800
|
||||
TabIndex = 6
|
||||
Top = 1800
|
||||
Width = 915
|
||||
End
|
||||
Begin MSComctlLib.Slider sldCenter
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 0
|
||||
Top = 360
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 500
|
||||
SmallChange = 100
|
||||
Min = 80
|
||||
Max = 16000
|
||||
SelStart = 80
|
||||
TickFrequency = 1000
|
||||
Value = 80
|
||||
End
|
||||
Begin MSComctlLib.Slider sldBand
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 1
|
||||
Top = 900
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 4
|
||||
Min = 1
|
||||
Max = 36
|
||||
SelStart = 1
|
||||
TickFrequency = 4
|
||||
Value = 1
|
||||
End
|
||||
Begin MSComctlLib.Slider sldGain
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 2
|
||||
Top = 1440
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
Min = -15
|
||||
Max = 15
|
||||
TickFrequency = 2
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Center"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 60
|
||||
TabIndex = 5
|
||||
Top = 120
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Bandwith"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 60
|
||||
TabIndex = 4
|
||||
Top = 660
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Gain"
|
||||
Height = 255
|
||||
Index = 3
|
||||
Left = 60
|
||||
TabIndex = 3
|
||||
Top = 1200
|
||||
Width = 1035
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmParamEQ"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmParamEQ.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
Private oBuffer As DirectSoundSecondaryBuffer8
|
||||
Private mlIndex As Long
|
||||
|
||||
Private oFX As DirectSoundFXParamEq8
|
||||
|
||||
Private Sub SaveAllSettings()
|
||||
Dim fxNew As DSFXPARAMEQ
|
||||
|
||||
'Ok, save these new settings
|
||||
'Set the new information up
|
||||
With fxNew
|
||||
.fBandwidth = CSng(sldBand.Value)
|
||||
.fCenter = CSng(sldCenter.Value)
|
||||
.fGain = CSng(sldGain.Value)
|
||||
End With
|
||||
'Now update the effect
|
||||
oFX.SetAllParameters fxNew
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOK_Click()
|
||||
SaveAllSettings
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim fxCurrent As DSFXPARAMEQ
|
||||
|
||||
'Get the echo interface
|
||||
Set oFX = oBuffer.GetObjectinPath(DSFX_STANDARD_PARAMEQ, mlIndex, IID_DirectSoundFXParamEq)
|
||||
'Get the current settings from it
|
||||
fxCurrent = oFX.GetAllParameters
|
||||
'Now put them out there
|
||||
With fxCurrent
|
||||
sldBand.Value = CLng(.fBandwidth)
|
||||
sldCenter.Value = CLng(.fCenter)
|
||||
sldGain.Value = CLng(.fGain)
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Public Sub SetBuffer(oBuf As DirectSoundSecondaryBuffer8, Index As Long)
|
||||
'Store the buffer and index
|
||||
Set oBuffer = oBuf
|
||||
mlIndex = Index
|
||||
End Sub
|
||||
|
||||
Private Sub sldBand_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldBand_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldCenter_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldCenter_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldGain_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldGain_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
@@ -0,0 +1,219 @@
|
||||
VERSION 5.00
|
||||
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
||||
Begin VB.Form frmWaves
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "WavesReverb Effects Update"
|
||||
ClientHeight = 2775
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 2775
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 2775
|
||||
ScaleWidth = 2775
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.CommandButton cmdOK
|
||||
Caption = "OK"
|
||||
Height = 315
|
||||
Left = 1800
|
||||
TabIndex = 8
|
||||
Top = 2340
|
||||
Width = 915
|
||||
End
|
||||
Begin MSComctlLib.Slider sldInGain
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 0
|
||||
Top = 360
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
Min = -96
|
||||
Max = 0
|
||||
TickFrequency = 10
|
||||
End
|
||||
Begin MSComctlLib.Slider sldReverbMix
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 2
|
||||
Top = 900
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 10
|
||||
SmallChange = 2
|
||||
Min = -96
|
||||
Max = 0
|
||||
TickFrequency = 10
|
||||
End
|
||||
Begin MSComctlLib.Slider sldReverbTime
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 4
|
||||
Top = 1440
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 100
|
||||
SmallChange = 10
|
||||
Min = 1
|
||||
Max = 3000
|
||||
SelStart = 1
|
||||
TickFrequency = 200
|
||||
Value = 1
|
||||
End
|
||||
Begin MSComctlLib.Slider sldHighFreq
|
||||
Height = 195
|
||||
Left = 60
|
||||
TabIndex = 6
|
||||
Top = 1980
|
||||
Width = 2655
|
||||
_ExtentX = 4683
|
||||
_ExtentY = 344
|
||||
_Version = 393216
|
||||
LargeChange = 100
|
||||
SmallChange = 10
|
||||
Min = 1
|
||||
Max = 999
|
||||
SelStart = 1
|
||||
TickFrequency = 50
|
||||
Value = 1
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "High Freq RT Ratio"
|
||||
Height = 255
|
||||
Index = 4
|
||||
Left = 60
|
||||
TabIndex = 7
|
||||
Top = 1740
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Reverb Time"
|
||||
Height = 255
|
||||
Index = 3
|
||||
Left = 60
|
||||
TabIndex = 5
|
||||
Top = 1200
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Reverb Mix"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 60
|
||||
TabIndex = 3
|
||||
Top = 660
|
||||
Width = 1275
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "In Gain"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 60
|
||||
TabIndex = 1
|
||||
Top = 120
|
||||
Width = 735
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmWaves"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmWaves.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
Private oBuffer As DirectSoundSecondaryBuffer8
|
||||
Private mlIndex As Long
|
||||
|
||||
Private oFX As DirectSoundFXWavesReverb8
|
||||
|
||||
Private Sub SaveAllSettings()
|
||||
Dim fxNew As DSFXWAVESREVERB
|
||||
|
||||
'Ok, save these new settings
|
||||
'Set the new information up
|
||||
With fxNew
|
||||
.fInGain = CSng(sldInGain.Value)
|
||||
.fReverbMix = CSng(sldReverbMix.Value)
|
||||
.fReverbTime = CSng(sldReverbTime.Value)
|
||||
.fHighFreqRTRatio = CSng(sldHighFreq.Value / 1000) 'Range is 0.001 - 0.999
|
||||
End With
|
||||
'Now update the effect
|
||||
oFX.SetAllParameters fxNew
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOK_Click()
|
||||
SaveAllSettings
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim fxCurrent As DSFXWAVESREVERB
|
||||
|
||||
'Get the echo interface
|
||||
Set oFX = oBuffer.GetObjectinPath(DSFX_STANDARD_WAVES_REVERB, mlIndex, IID_DirectSoundFXWavesReverb)
|
||||
'Get the current settings from it
|
||||
fxCurrent = oFX.GetAllParameters
|
||||
'Now put them out there
|
||||
With fxCurrent
|
||||
sldInGain.Value = CLng(.fInGain)
|
||||
sldReverbMix.Value = CLng(.fReverbMix)
|
||||
sldReverbTime.Value = CLng(.fReverbTime)
|
||||
sldHighFreq.Value = CLng(.fHighFreqRTRatio * 1000) 'Range is 0.001 - 0.999
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Public Sub SetBuffer(oBuf As DirectSoundSecondaryBuffer8, Index As Long)
|
||||
'Store the buffer and index
|
||||
Set oBuffer = oBuf
|
||||
mlIndex = Index
|
||||
End Sub
|
||||
|
||||
Private Sub sldHighFreq_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldHighFreq_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldInGain_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldInGain_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldReverbMix_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldReverbMix_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldReverbTime_Change()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
|
||||
Private Sub sldReverbTime_Scroll()
|
||||
SaveAllSettings
|
||||
End Sub
|
||||
@@ -0,0 +1,54 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: Effects Form Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
// GM/GS<47> Sound Set Copyright <20>1996, Roland Corporation U.S.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The sample demonstrates:
|
||||
|
||||
(1) how to use standard effects (FX) with DirectSound
|
||||
(2) how to manipulate FX parameters - and what the results sounds like
|
||||
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\DirectSound\EffectsForm
|
||||
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectSound\Bin
|
||||
|
||||
|
||||
User's Guide
|
||||
============
|
||||
- make sure a sound file is loaded (can be WAV)
|
||||
|
||||
- by default, no FX are enabled. try playing the sound to see what it
|
||||
orginally sounds like.
|
||||
|
||||
- enable one or more FXs by adding them to the list of in use effects.
|
||||
|
||||
- Hit Apply to introduce the effects.
|
||||
|
||||
- Hit play to hear the FX applied.
|
||||
|
||||
- you can adjust parameters for any FX by selecting the effect in the
|
||||
in use list box, and clicking the modify effects button beneath it.
|
||||
If you are adjusting parameters for an active FX while sound is playing,
|
||||
you will hearing the difference immediately.
|
||||
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
Fill one or more DSEFFECTDESC structs, and pass them into
|
||||
DirectSoundSecondaryBuffer8.SetFX.
|
||||
|
||||
When modify effects is clicked call GetObjectInPath to retreive an effects
|
||||
interface, and then you can call SetAllParameters to modify the effects as
|
||||
they are playing.
|
||||
@@ -0,0 +1,40 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Form=frmFX.frm
|
||||
Form=frmGargle.frm
|
||||
Form=frmFlanger.frm
|
||||
Form=frmChorus.frm
|
||||
Form=frmEcho.frm
|
||||
Form=frmDistortion.frm
|
||||
Form=frmCompressor.frm
|
||||
Form=frmParamEQ.frm
|
||||
Form=frmWaves.frm
|
||||
Startup="frmEffects"
|
||||
Command32=""
|
||||
Name="vbEffectsBuffer"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,165 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmEnum
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "EnumDevices"
|
||||
ClientHeight = 1740
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 3960
|
||||
Icon = "frmEnum.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 1740
|
||||
ScaleWidth = 3960
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.ComboBox cboCapture
|
||||
Height = 315
|
||||
Left = 1320
|
||||
Style = 2 'Dropdown List
|
||||
TabIndex = 6
|
||||
Top = 840
|
||||
Width = 2535
|
||||
End
|
||||
Begin VB.ComboBox cboSound
|
||||
Height = 315
|
||||
Left = 1320
|
||||
Style = 2 'Dropdown List
|
||||
TabIndex = 5
|
||||
Top = 420
|
||||
Width = 2535
|
||||
End
|
||||
Begin VB.CommandButton cmdExit
|
||||
Cancel = -1 'True
|
||||
Caption = "E&xit"
|
||||
Height = 315
|
||||
Left = 2880
|
||||
TabIndex = 4
|
||||
Top = 1260
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdCreate
|
||||
Caption = "&Create"
|
||||
Default = -1 'True
|
||||
Height = 315
|
||||
Left = 120
|
||||
TabIndex = 3
|
||||
Top = 1260
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Capture Device:"
|
||||
Height = 255
|
||||
Index = 2
|
||||
Left = 120
|
||||
TabIndex = 2
|
||||
Top = 900
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Sound Device:"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 120
|
||||
TabIndex = 1
|
||||
Top = 480
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "This sample shows how to enumerate devices."
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 0
|
||||
Top = 60
|
||||
Width = 4455
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmEnum"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmEnum.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
Private dx As New DirectX8
|
||||
Private dsEnum As DirectSoundEnum8
|
||||
Private dscEnum As DirectSoundEnum8
|
||||
Private ds As DirectSound8
|
||||
Private dsc As DirectSoundCapture8
|
||||
|
||||
Private Sub cmdCreate_Click()
|
||||
On Error GoTo FailedCreate
|
||||
|
||||
'Create a DirectSound object
|
||||
Set ds = dx.DirectSoundCreate(dsEnum.GetGuid(cboSound.ListIndex + 1))
|
||||
Set ds = Nothing 'We should get rid of it now, since we don't want to fail
|
||||
'If the machine doesn't support full duplex
|
||||
|
||||
'Create a Capture Buffer
|
||||
Set dsc = dx.DirectSoundCaptureCreate(dscEnum.GetGuid(cboCapture.ListIndex + 1))
|
||||
Set dsc = Nothing 'Release it
|
||||
'Notify the user we succeeded
|
||||
MsgBox "DirectSound8 and DirectSoundCapture8 object creation succeeded.", vbOKOnly Or vbInformation, "Success"
|
||||
Exit Sub
|
||||
|
||||
FailedCreate:
|
||||
'Notify the user we failed
|
||||
MsgBox "DirectSound8 and DirectSoundCapture8 object creation failed.", vbOKOnly Or vbInformation, "Failure"
|
||||
End Sub
|
||||
|
||||
Private Sub cmdExit_Click()
|
||||
'We're done exit
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub CleanUp()
|
||||
Set dscEnum = Nothing
|
||||
Set dsEnum = Nothing
|
||||
Set dx = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
'Enum the devices and load them into the box
|
||||
LoadEnum
|
||||
End Sub
|
||||
|
||||
Private Sub LoadEnum()
|
||||
Dim lCount As Long
|
||||
|
||||
On Error GoTo FailedEnum
|
||||
Set dsEnum = dx.GetDSEnum
|
||||
Set dscEnum = dx.GetDSCaptureEnum
|
||||
|
||||
'Add each description to the combo box
|
||||
For lCount = 1 To dsEnum.GetCount
|
||||
cboSound.AddItem dsEnum.GetDescription(lCount)
|
||||
Next
|
||||
'Add each description to the combo box
|
||||
For lCount = 1 To dscEnum.GetCount
|
||||
cboCapture.AddItem dscEnum.GetDescription(lCount)
|
||||
Next
|
||||
On Error Resume Next
|
||||
'Select the first item in each combo box
|
||||
cboCapture.ListIndex = 0
|
||||
cboSound.ListIndex = 0
|
||||
Exit Sub
|
||||
|
||||
FailedEnum:
|
||||
MsgBox "Error enumerating DirectSound devices. " & vbCrLf & "Sample will now exit.", vbOKOnly Or vbInformation, "DirectSound Sample"
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
CleanUp
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,33 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: VB EnumDevices Sample
|
||||
//
|
||||
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The EnumDevices sample shows how to enumerate and create playback
|
||||
and capture devices.
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\VBSamples\DirectSound\EnumDevices
|
||||
|
||||
Executable: DXSDK\Samples\Multimedia\VBSamples\DirectSound\Bin
|
||||
|
||||
User's Guide
|
||||
============
|
||||
Select a playback and capture device from the dropdown lists. Click Create.
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
This sample was intended to be very simple, showing the basics how to
|
||||
enumerate the DirectSound and DirectSoundCapture devices.
|
||||
|
||||
To enumerate DirectSound devices call GetDSEnum.
|
||||
|
||||
To enumerate DirectSoundCapture devices call GetDSCaptureEnum.
|
||||
|
||||
@@ -0,0 +1,30 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=frmEnum.frm
|
||||
Startup="frmEnum"
|
||||
Command32=""
|
||||
Name="vbEnumDevices"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,497 @@
|
||||
VERSION 5.00
|
||||
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
|
||||
Begin VB.Form DS3DPositionForm
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "DS 3D Positioning"
|
||||
ClientHeight = 5565
|
||||
ClientLeft = 930
|
||||
ClientTop = 330
|
||||
ClientWidth = 5055
|
||||
Icon = "Sound3D.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 5565
|
||||
ScaleWidth = 5055
|
||||
Begin VB.Timer tmrUpdate
|
||||
Interval = 50
|
||||
Left = 4260
|
||||
Top = 2100
|
||||
End
|
||||
Begin MSComDlg.CommonDialog cdlFile
|
||||
Left = 3780
|
||||
Top = 2040
|
||||
_ExtentX = 847
|
||||
_ExtentY = 847
|
||||
_Version = 393216
|
||||
End
|
||||
Begin VB.PictureBox picDraw
|
||||
BackColor = &H00FFFFFF&
|
||||
FillStyle = 7 'Diagonal Cross
|
||||
Height = 2775
|
||||
Left = 120
|
||||
ScaleHeight = 181
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 317
|
||||
TabIndex = 7
|
||||
TabStop = 0 'False
|
||||
Top = 2640
|
||||
Width = 4815
|
||||
End
|
||||
Begin VB.PictureBox picContainer
|
||||
Height = 1755
|
||||
Index = 0
|
||||
Left = 120
|
||||
ScaleHeight = 1695
|
||||
ScaleWidth = 4755
|
||||
TabIndex = 10
|
||||
TabStop = 0 'False
|
||||
Top = 120
|
||||
Width = 4815
|
||||
Begin VB.TextBox txtSound
|
||||
BackColor = &H8000000F&
|
||||
Height = 315
|
||||
Left = 960
|
||||
Locked = -1 'True
|
||||
TabIndex = 13
|
||||
Top = 120
|
||||
Width = 3735
|
||||
End
|
||||
Begin VB.CommandButton cmdSound
|
||||
Caption = "Sound..."
|
||||
Enabled = 0 'False
|
||||
Height = 315
|
||||
Left = 60
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CommandButton cmdPlay
|
||||
Caption = "Play"
|
||||
Height = 375
|
||||
Left = 120
|
||||
TabIndex = 3
|
||||
Top = 1200
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CommandButton cmdPause
|
||||
Caption = "Pause"
|
||||
Height = 375
|
||||
Left = 1020
|
||||
TabIndex = 4
|
||||
Top = 1200
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CommandButton cmdStop
|
||||
Caption = "Stop"
|
||||
Height = 375
|
||||
Left = 1920
|
||||
TabIndex = 5
|
||||
Top = 1200
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.CheckBox chLoop
|
||||
Caption = "Loop Play"
|
||||
Height = 315
|
||||
Left = 2760
|
||||
TabIndex = 6
|
||||
Top = 1260
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.HScrollBar scrlVol
|
||||
Height = 255
|
||||
LargeChange = 20
|
||||
Left = 840
|
||||
Max = 0
|
||||
Min = -3000
|
||||
SmallChange = 500
|
||||
TabIndex = 1
|
||||
Top = 540
|
||||
Width = 3855
|
||||
End
|
||||
Begin VB.HScrollBar scrlAngle
|
||||
Height = 255
|
||||
LargeChange = 20
|
||||
Left = 840
|
||||
Max = 360
|
||||
Min = -360
|
||||
SmallChange = 10
|
||||
TabIndex = 2
|
||||
Top = 840
|
||||
Value = -90
|
||||
Width = 3855
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Volume"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 12
|
||||
Top = 600
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Direction"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 11
|
||||
Top = 900
|
||||
Width = 975
|
||||
End
|
||||
End
|
||||
Begin VB.Label Label5
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Click and drag the red triangle around with the left mouse button to change the sound position."
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 9
|
||||
Top = 2160
|
||||
Width = 4755
|
||||
End
|
||||
Begin VB.Label Label4
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Sound Positions"
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 8.25
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 120
|
||||
TabIndex = 8
|
||||
Top = 1920
|
||||
Width = 1575
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "DS3DPositionForm"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: Sound3d.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
'API declare for windows folder
|
||||
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
|
||||
|
||||
Dim dx As New DirectX8 'Our DirectX object
|
||||
Dim ds As DirectSound8 'Our DirectSound object
|
||||
Dim dsBuffer As DirectSoundSecondaryBuffer8 'Our SoundBuffer
|
||||
Dim ds3dBuffer As DirectSound3DBuffer8 'We need to get a 3DSoundBuffer
|
||||
Dim oPos As D3DVECTOR 'Position
|
||||
Dim fMouseDown As Boolean 'Is the mouse down?
|
||||
|
||||
Private Sub cmdSound_Click()
|
||||
|
||||
Static sCurDir As String
|
||||
Static lFilter As Long
|
||||
Dim dsBuf As DSBUFFERDESC
|
||||
|
||||
'Now we should load a wave file
|
||||
'Ask them for a file to load
|
||||
With cdlFile
|
||||
.flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
|
||||
.FilterIndex = lFilter
|
||||
.Filter = "Wave Files (*.wav)|*.wav"
|
||||
.FileName = vbNullString
|
||||
If sCurDir = vbNullString Then
|
||||
'Set the init folder to \windows\media if it exists. If not, set it to the \windows folder
|
||||
Dim sWindir As String
|
||||
sWindir = Space$(255)
|
||||
If GetWindowsDirectory(sWindir, 255) = 0 Then
|
||||
'We couldn't get the windows folder for some reason, use the c:\
|
||||
.InitDir = "C:\"
|
||||
Else
|
||||
Dim sMedia As String
|
||||
sWindir = Left$(sWindir, InStr(sWindir, Chr$(0)) - 1)
|
||||
If Right$(sWindir, 1) = "\" Then
|
||||
sMedia = sWindir & "Media"
|
||||
Else
|
||||
sMedia = sWindir & "\Media"
|
||||
End If
|
||||
If Dir$(sMedia, vbDirectory) <> vbNullString Then
|
||||
.InitDir = sMedia
|
||||
Else
|
||||
.InitDir = sWindir
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
.InitDir = sCurDir
|
||||
End If
|
||||
.ShowOpen ' Display the Open dialog box
|
||||
If .FileName = vbNullString Then
|
||||
Exit Sub 'We didn't click anything exit
|
||||
End If
|
||||
'Save the current information
|
||||
sCurDir = GetFolder(.FileName)
|
||||
lFilter = .FilterIndex
|
||||
|
||||
'Save the filename for later use
|
||||
If Not (dsBuffer Is Nothing) Then dsBuffer.Stop
|
||||
Set dsBuffer = Nothing
|
||||
txtSound.Text = vbNullString
|
||||
dsBuf.lFlags = DSBCAPS_CTRL3D Or DSBCAPS_CTRLVOLUME
|
||||
'Before we load the 3D dialog check to see if this is a mono file
|
||||
On Error Resume Next
|
||||
Set dsBuffer = ds.CreateSoundBufferFromFile(.FileName, dsBuf)
|
||||
If Err Then
|
||||
'First check to see if this is a stereo wav file
|
||||
If (dsBuf.fxFormat.nChannels > 1) And (Err.Number = 5) Then 'Yup
|
||||
MsgBox "You must load a mono wave file to control 3D sound. Stereo wave files are not supported.", vbOKOnly Or vbInformation, "Couldn't load"
|
||||
Else
|
||||
MsgBox "Could not load this wave file." & vbCrLf & "Format is not supported.", vbOKOnly Or vbInformation, "Couldn't load"
|
||||
End If
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Now we need to get the 3D virtualization params
|
||||
Dim f3DParams As New frm3DAlg
|
||||
|
||||
f3DParams.Show vbModal, Me
|
||||
If f3DParams.OKHit Then
|
||||
If f3DParams.optFull Then dsBuf.guid3DAlgorithm = GUID_DS3DALG_HRTF_FULL
|
||||
If f3DParams.optHalf Then dsBuf.guid3DAlgorithm = GUID_DS3DALG_HRTF_LIGHT
|
||||
If f3DParams.optNone Then dsBuf.guid3DAlgorithm = GUID_DS3DALG_NO_VIRTUALIZATION
|
||||
Else
|
||||
Set dsBuffer = Nothing
|
||||
Exit Sub
|
||||
End If
|
||||
On Error Resume Next
|
||||
Set dsBuffer = ds.CreateSoundBufferFromFile(.FileName, dsBuf)
|
||||
If Err Then
|
||||
MsgBox "Could not create the sound buffer.", vbOKOnly Or vbInformation, "Couldn't load"
|
||||
Exit Sub
|
||||
End If
|
||||
txtSound.Text = .FileName
|
||||
EnablePlayUI True
|
||||
Set ds3dBuffer = dsBuffer.GetDirectSound3DBuffer
|
||||
ds3dBuffer.SetConeAngles DS3D_MINCONEANGLE, 100, DS3D_IMMEDIATE
|
||||
ds3dBuffer.SetConeOutsideVolume -400, DS3D_IMMEDIATE
|
||||
' position our sound
|
||||
ds3dBuffer.SetPosition oPos.x / 50, 0, oPos.z / 50, DS3D_IMMEDIATE
|
||||
'Update the volume
|
||||
scrlVol_Change
|
||||
End With
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
|
||||
|
||||
On Local Error Resume Next
|
||||
Set ds = dx.DirectSoundCreate(vbNullString) 'Create a default DirectSound object
|
||||
'We couldn't create the DSound object. End the app now
|
||||
If Err.Number <> 0 Then
|
||||
MsgBox "Could not initialize DirectSound." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
|
||||
Unload Me
|
||||
End
|
||||
End If
|
||||
'Set the coop level
|
||||
ds.SetCooperativeLevel Me.hWnd, DSSCL_PRIORITY
|
||||
|
||||
'Show the form
|
||||
Me.Show
|
||||
oPos.x = 0: oPos.z = 5
|
||||
'- Make sure we pickup the correct volume and orientation
|
||||
scrlAngle_Change
|
||||
scrlVol_Change
|
||||
|
||||
DrawPositions
|
||||
EnablePlayUI True
|
||||
cmdPlay.Enabled = False
|
||||
cmdSound.SetFocus
|
||||
End Sub
|
||||
|
||||
Private Sub cmdPlay_Click()
|
||||
If dsBuffer Is Nothing Then Exit Sub
|
||||
|
||||
'Play plays the sound from the current position
|
||||
'if the sound was paused using the stop command
|
||||
'then play will begin where it last left off
|
||||
dsBuffer.Play chLoop.Value 'Checked = 1 (looping), Unchecked = 0 (Default)
|
||||
EnablePlayUI False
|
||||
End Sub
|
||||
|
||||
Private Sub cmdStop_Click()
|
||||
If dsBuffer Is Nothing Then Exit Sub
|
||||
|
||||
dsBuffer.Stop
|
||||
dsBuffer.SetCurrentPosition 0 'Reset the position since Stop doesn't
|
||||
EnablePlayUI True
|
||||
End Sub
|
||||
|
||||
Private Sub cmdPause_Click()
|
||||
If dsBuffer Is Nothing Then Exit Sub
|
||||
dsBuffer.Stop 'Stop doesn't reset the position
|
||||
End Sub
|
||||
|
||||
'They've changed the volume. Update it
|
||||
Private Sub scrlVol_Change()
|
||||
If dsBuffer Is Nothing Then Exit Sub
|
||||
dsBuffer.SetVolume scrlVol.Value
|
||||
End Sub
|
||||
|
||||
Private Sub scrlVol_Scroll()
|
||||
scrlVol_Change
|
||||
End Sub
|
||||
|
||||
'They've changed the angle. Update it
|
||||
Private Sub scrlAngle_Change()
|
||||
|
||||
'We need to calculate a vector of what direction the sound is traveling in.
|
||||
Dim x As Single
|
||||
Dim z As Single
|
||||
'we take the current angle in degrees convert to radians
|
||||
'and get the cos or sin to find the direction from an angle
|
||||
x = 5 * Cos(3.141 * scrlAngle.Value / 180)
|
||||
z = 5 * Sin(3.141 * scrlAngle.Value / 180)
|
||||
|
||||
'Update the UI
|
||||
DrawPositions
|
||||
If dsBuffer Is Nothing Then Exit Sub
|
||||
ds3dBuffer.SetConeOrientation x, 0, z, DS3D_IMMEDIATE
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub scrlAngle_Scroll()
|
||||
scrlAngle_Change
|
||||
End Sub
|
||||
|
||||
Sub UpdatePosition(x As Single, z As Single)
|
||||
On Error Resume Next
|
||||
oPos.x = x - picDraw.ScaleWidth / 2
|
||||
oPos.z = z - picDraw.ScaleHeight / 2
|
||||
|
||||
DrawPositions
|
||||
|
||||
'the zero at the end indicates we want the postion updated immediately
|
||||
If ds3dBuffer Is Nothing Then Exit Sub
|
||||
|
||||
ds3dBuffer.SetPosition oPos.x / 50, 0, oPos.z / 50, DS3D_IMMEDIATE
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub picDraw_MouseDown(Button As Integer, Shift As Integer, x As Single, z As Single)
|
||||
On Error Resume Next
|
||||
If Button = vbLeftButton Then
|
||||
UpdatePosition x, z
|
||||
fMouseDown = True
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub picDraw_MouseMove(Button As Integer, Shift As Integer, x As Single, z As Single)
|
||||
On Error Resume Next
|
||||
If Not fMouseDown Then Exit Sub
|
||||
If Button = vbLeftButton Then
|
||||
'Only update the position if it is outside of the box
|
||||
If x < 0 Or z < 0 Or x > picDraw.ScaleWidth Or z > picDraw.ScaleHeight Then Exit Sub
|
||||
UpdatePosition x, z
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub picDraw_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
|
||||
On Error Resume Next
|
||||
fMouseDown = False
|
||||
End Sub
|
||||
|
||||
Private Sub picDraw_Paint()
|
||||
DrawPositions
|
||||
End Sub
|
||||
|
||||
Sub DrawPositions()
|
||||
Dim x As Integer
|
||||
Dim z As Integer
|
||||
|
||||
picDraw.Cls
|
||||
|
||||
'listener is in center and is black
|
||||
DrawTriangle 0, picDraw.ScaleWidth / 2, picDraw.ScaleHeight / 2, 90
|
||||
|
||||
'draw sound as RED
|
||||
x = CInt(oPos.x) + picDraw.ScaleWidth / 2
|
||||
z = CInt(oPos.z) + picDraw.ScaleHeight / 2
|
||||
DrawTriangle RGB(256, 0, 0), x, z, scrlAngle.Value
|
||||
|
||||
End Sub
|
||||
|
||||
'Draw a triangle representing where we are
|
||||
Sub DrawTriangle(col As Long, x As Integer, z As Integer, ByVal a As Single)
|
||||
|
||||
Dim x1 As Integer
|
||||
Dim z1 As Integer
|
||||
Dim x2 As Integer
|
||||
Dim z2 As Integer
|
||||
Dim x3 As Integer
|
||||
Dim z3 As Integer
|
||||
|
||||
a = 3.141 * (a - 90) / 180
|
||||
Dim q As Integer
|
||||
q = 10
|
||||
|
||||
x1 = q * Sin(a) + x
|
||||
z1 = q * Cos(a) + z
|
||||
|
||||
x2 = q * Sin(a + 3.141 / 1.3) + x
|
||||
z2 = q * Cos(a + 3.141 / 1.3) + z
|
||||
|
||||
x3 = q * Sin(a - 3.141 / 1.3) + x
|
||||
z3 = q * Cos(a - 3.141 / 1.3) + z
|
||||
|
||||
picDraw.Line (x1, z1)-(x2, z2), col
|
||||
picDraw.Line (x1, z1)-(x3, z3), col
|
||||
picDraw.Line (x2, z2)-(x3, z3), col
|
||||
End Sub
|
||||
|
||||
Private Function GetFolder(ByVal sFile As String) As String
|
||||
Dim lCount As Long
|
||||
|
||||
For lCount = Len(sFile) To 1 Step -1
|
||||
If Mid$(sFile, lCount, 1) = "\" Then
|
||||
GetFolder = Left$(sFile, lCount)
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
GetFolder = vbNullString
|
||||
End Function
|
||||
|
||||
Private Sub EnablePlayUI(ByVal fEnable As Boolean)
|
||||
On Error Resume Next
|
||||
If fEnable Then
|
||||
chLoop.Enabled = True
|
||||
cmdPlay.Enabled = True
|
||||
cmdPause.Enabled = False
|
||||
cmdStop.Enabled = False
|
||||
cmdSound.Enabled = True
|
||||
cmdPlay.SetFocus
|
||||
Else
|
||||
chLoop.Enabled = False
|
||||
cmdPlay.Enabled = False
|
||||
cmdStop.Enabled = True
|
||||
cmdPause.Enabled = True
|
||||
cmdSound.Enabled = False
|
||||
cmdStop.SetFocus
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub tmrUpdate_Timer()
|
||||
If Not (dsBuffer Is Nothing) Then
|
||||
If (dsBuffer.GetStatus And DSBSTATUS_PLAYING) <> DSBSTATUS_PLAYING Then
|
||||
If cmdPlay.Enabled = False Then
|
||||
EnablePlayUI True
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,87 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frm3DAlg
|
||||
BorderStyle = 4 'Fixed ToolWindow
|
||||
Caption = "Select 3D Algorithm"
|
||||
ClientHeight = 1755
|
||||
ClientLeft = 45
|
||||
ClientTop = 285
|
||||
ClientWidth = 5700
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 1755
|
||||
ScaleWidth = 5700
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.CommandButton cmdOK
|
||||
Caption = "OK"
|
||||
Default = -1 'True
|
||||
Height = 315
|
||||
Left = 3660
|
||||
TabIndex = 4
|
||||
Top = 1320
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.CommandButton cmdCancel
|
||||
Cancel = -1 'True
|
||||
Caption = "Cancel"
|
||||
Height = 315
|
||||
Left = 4620
|
||||
TabIndex = 3
|
||||
Top = 1320
|
||||
Width = 915
|
||||
End
|
||||
Begin VB.OptionButton optHalf
|
||||
Caption = "&Light Quality (WDM Only. Good quality 3D effect, uses less CPU)"
|
||||
Height = 255
|
||||
Left = 60
|
||||
TabIndex = 2
|
||||
Top = 840
|
||||
Width = 5415
|
||||
End
|
||||
Begin VB.OptionButton optFull
|
||||
Caption = "&High Quality (WDM Only. Highest quality 3D effect, but uses more CPU)"
|
||||
Height = 255
|
||||
Left = 60
|
||||
TabIndex = 1
|
||||
Top = 480
|
||||
Width = 5415
|
||||
End
|
||||
Begin VB.OptionButton optNone
|
||||
Caption = "&No Virtualization (WDM or VxD - CPU efficient, but basic 3D effect)"
|
||||
Height = 255
|
||||
Left = 60
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Value = -1 'True
|
||||
Width = 5415
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frm3DAlg"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frm3DAlg.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
Private mfOkHit As Boolean
|
||||
|
||||
Private Sub cmdCancel_Click()
|
||||
mfOkHit = False
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdOK_Click()
|
||||
mfOkHit = True
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Public Property Get OKHit() As Boolean
|
||||
OKHit = mfOkHit
|
||||
End Property
|
||||
@@ -0,0 +1,50 @@
|
||||
//-----------------------------------------------------------------------------
|
||||
//
|
||||
// Sample Name: Play3DSound Sample
|
||||
//
|
||||
// Copyright (c) 1999 Microsoft Corporation. All rights reserved.
|
||||
//
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Description
|
||||
===========
|
||||
The Play3DSound sample shows how to create a 3-D sound buffer and
|
||||
manipulate its properties. It is similar to the 3DAudio sample but does not
|
||||
use an audiopath.
|
||||
|
||||
Path
|
||||
====
|
||||
Source: DXSDK\Samples\Multimedia\DSound\Play3DSound
|
||||
|
||||
Executable: DXSDK\Samples\Multimedia\DSound\Bin
|
||||
|
||||
User's Guide
|
||||
============
|
||||
Click Sound... and load a wave file. Play the Buffer. The position of the
|
||||
sound source is shown as a triangle on the graph, where the x-axis is from
|
||||
left to right and the z-axis is from bottom to top. Change the range of
|
||||
movement on the two axes by holding down the mouse button and moving the mouse.
|
||||
|
||||
The listener is located at the center of the graph, and has its default
|
||||
orientation, looking along the positive z-axis; that is, toward the top of
|
||||
the screen. The sound source can move to the listener's left and right and to
|
||||
the listener's front and rear, but does not move above and below the listener.
|
||||
|
||||
Programming Notes
|
||||
=================
|
||||
|
||||
* To create a DirectSound3DBuffer object
|
||||
1. Fill out a DSBUFFERDESC struct with
|
||||
DSBCAPS_CTRL3D and the 3D virtualization guid
|
||||
2. Call DirectSound.CreateSoundBufferFromFile passing in the DSBUFFERDESC
|
||||
This will create a secondary buffer with 3D control.
|
||||
3. Call DirectSoundSecondaryBuffer.Get3DBuffer to query for the
|
||||
DirectSound3DBuffer
|
||||
|
||||
* Set the postion of the 3D buffer
|
||||
1. Call DirectSound3DBuffer.SetPosition
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,32 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=Sound3D.frm
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Form=frm3DAlg.frm
|
||||
Startup="DS3DPositionForm"
|
||||
Command32=""
|
||||
Name="vbPlay3DSound"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft Corp"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=-1
|
||||
BoundsCheck=-1
|
||||
OverflowCheck=-1
|
||||
FlPointCheck=-1
|
||||
FDIVCheck=-1
|
||||
UnroundedFP=-1
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,129 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form frmAudTut1
|
||||
Caption = "Audio Tutorial 1"
|
||||
ClientHeight = 1320
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 5460
|
||||
Icon = "audtut1.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 1320
|
||||
ScaleWidth = 5460
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.CommandButton cmdClose
|
||||
Caption = "Close"
|
||||
Default = -1 'True
|
||||
Height = 375
|
||||
Left = 4260
|
||||
TabIndex = 0
|
||||
Top = 900
|
||||
Width = 1035
|
||||
End
|
||||
Begin VB.Image Image1
|
||||
Height = 480
|
||||
Left = 120
|
||||
Picture = "audtut1.frx":0442
|
||||
Top = 120
|
||||
Width = 480
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Copyright (C) 1999-2001 Microsoft Corporation, All Rights Reserved."
|
||||
Height = 255
|
||||
Index = 2
|
||||
Left = 600
|
||||
TabIndex = 3
|
||||
Top = 300
|
||||
Width = 4800
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "GM/GS<47> Sound Set Copyright <20>1996, Roland Corporation U.S."
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 600
|
||||
TabIndex = 2
|
||||
Top = 540
|
||||
Width = 4755
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "DirectMusic Segment Tutorial"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 600
|
||||
TabIndex = 1
|
||||
Top = 60
|
||||
Width = 2655
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmAudTut1"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: audTut1.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
Option Explicit
|
||||
' Our DX variables
|
||||
Private dx As New DirectX8
|
||||
'We need a loader variable
|
||||
Private dml As DirectMusicLoader8
|
||||
'We need our performance object
|
||||
Private dmp As DirectMusicPerformance8
|
||||
'We also need our DMusic segment
|
||||
Private seg As DirectMusicSegment8
|
||||
|
||||
Private Sub cmdClose_Click()
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Dim dmA As DMUS_AUDIOPARAMS
|
||||
'Get our loader and performance
|
||||
Set dml = dx.DirectMusicLoaderCreate
|
||||
Set dmp = dx.DirectMusicPerformanceCreate
|
||||
|
||||
'We will put in error checking here in case we can't init DMusic
|
||||
'ie, if there is no sound card
|
||||
On Error GoTo FailedInit
|
||||
'Initialize our DMusic Audio with a default environment
|
||||
dmp.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmA, Nothing, DMUS_APATH_SHARED_STEREOPLUSREVERB, 64
|
||||
|
||||
'Here we will load our audio file. We could load a wave file,
|
||||
'a midi file, and rmi file, or a DMusic segment. For this
|
||||
'tutorial we will load a segment.
|
||||
|
||||
'Before we load our segment, set our search directory
|
||||
dml.SetSearchDirectory FindMediaDir("sample.sgt")
|
||||
'Now we can load our segment
|
||||
Set seg = dml.LoadSegment("sample.sgt")
|
||||
'Download our segment to the default audio path (created during our call to InitAudio)
|
||||
seg.Download dmp.GetDefaultAudioPath
|
||||
'Play our segment from the beginning
|
||||
dmp.PlaySegmentEx seg, 0, 0
|
||||
Exit Sub
|
||||
|
||||
FailedInit:
|
||||
MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
|
||||
Unload Me
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
On Error Resume Next
|
||||
'Stops everything playing on the audio path
|
||||
dmp.StopEx dmp.GetDefaultAudioPath, 0, 0
|
||||
'Destroy all of our objects
|
||||
Set seg = Nothing
|
||||
'Closedown the performance object (we should always do this).
|
||||
dmp.CloseDown
|
||||
'Destroy the rest of our objects
|
||||
Set dmp = Nothing
|
||||
Set dml = Nothing
|
||||
Set dx = Nothing
|
||||
End Sub
|
||||
@@ -0,0 +1,245 @@
|
||||
VERSION 5.00
|
||||
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
|
||||
Begin VB.Form frmCapture
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "Audio Capture Tutorial"
|
||||
ClientHeight = 1395
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 4305
|
||||
Icon = "frmCapture.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 1395
|
||||
ScaleWidth = 4305
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin MSComDlg.CommonDialog cdlSave
|
||||
Left = 4140
|
||||
Top = 0
|
||||
_ExtentX = 847
|
||||
_ExtentY = 847
|
||||
_Version = 393216
|
||||
CancelError = -1 'True
|
||||
End
|
||||
Begin VB.CommandButton cmdSave
|
||||
Caption = "Sa&ve"
|
||||
Enabled = 0 'False
|
||||
Height = 375
|
||||
Left = 3038
|
||||
TabIndex = 2
|
||||
Top = 840
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdStop
|
||||
Caption = "&Stop"
|
||||
Enabled = 0 'False
|
||||
Height = 375
|
||||
Left = 1898
|
||||
TabIndex = 1
|
||||
Top = 840
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CommandButton cmdStart
|
||||
Caption = "&Record"
|
||||
Height = 375
|
||||
Left = 638
|
||||
TabIndex = 0
|
||||
Top = 840
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Audio Capture Tutorial"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 660
|
||||
TabIndex = 4
|
||||
Top = 120
|
||||
Width = 2655
|
||||
End
|
||||
Begin VB.Label lbl
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Copyright (C) 1999-2001 Microsoft Corporation, All Rights Reserved."
|
||||
Height = 435
|
||||
Index = 2
|
||||
Left = 660
|
||||
TabIndex = 3
|
||||
Top = 360
|
||||
Width = 3510
|
||||
End
|
||||
Begin VB.Image Image1
|
||||
Height = 480
|
||||
Left = 120
|
||||
Picture = "frmCapture.frx":0442
|
||||
Top = 120
|
||||
Width = 480
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmCapture"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: frmCapture.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
'This tutorial will show basic functionality. You will capture a buffer to memory,
|
||||
'and then write it out to a file.
|
||||
|
||||
'Variable declarations for our app
|
||||
Private dx As New DirectX8
|
||||
Private dsc As DirectSoundCapture8
|
||||
Private dscb As DirectSoundCaptureBuffer8
|
||||
Private dscd As DSCBUFFERDESC
|
||||
Private capFormat As WAVEFORMATEX
|
||||
Private ds As DirectSound8
|
||||
|
||||
Private Sub InitCapture()
|
||||
|
||||
Dim cCaps As DSCCAPS
|
||||
On Local Error Resume Next
|
||||
'We need to create a direct sound object before the capture object
|
||||
If ds Is Nothing Then Set ds = dx.DirectSoundCreate(vbNullString)
|
||||
If Err Then
|
||||
MsgBox "Unable to create a DirectSound object", vbOKOnly Or vbCritical, "Cannot continue"
|
||||
Cleanup
|
||||
End
|
||||
End If
|
||||
'First we need to create our capture buffer on the default object
|
||||
Set dsc = dx.DirectSoundCaptureCreate(vbNullString)
|
||||
If Err Then
|
||||
MsgBox "Unable to create a Capture object", vbOKOnly Or vbCritical, "Cannot continue"
|
||||
Cleanup
|
||||
End
|
||||
End If
|
||||
|
||||
'Lets get the caps for our object
|
||||
dsc.GetCaps cCaps
|
||||
|
||||
'Check for a capture format we will support in the sample
|
||||
If cCaps.lFormats And WAVE_FORMAT_4M08 Then
|
||||
capFormat = CreateWaveFormatEx(44100, 1, 8)
|
||||
ElseIf cCaps.lFormats And WAVE_FORMAT_2M08 Then
|
||||
capFormat = CreateWaveFormatEx(22050, 1, 8)
|
||||
ElseIf cCaps.lFormats And WAVE_FORMAT_1M08 Then
|
||||
capFormat = CreateWaveFormatEx(11025, 1, 8)
|
||||
Else
|
||||
MsgBox "Could not get the caps we need on this card.", vbOKOnly Or vbCritical, "Exiting."
|
||||
Cleanup
|
||||
End
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub CreateCaptureBuffer()
|
||||
dscd.fxFormat = capFormat
|
||||
dscd.lBufferBytes = capFormat.lAvgBytesPerSec * 20
|
||||
dscd.lFlags = DSCBCAPS_WAVEMAPPED
|
||||
|
||||
Set dscb = dsc.CreateCaptureBuffer(dscd)
|
||||
End Sub
|
||||
Private Sub Cleanup()
|
||||
Set ds = Nothing
|
||||
Set dscb = Nothing
|
||||
Set dsc = Nothing
|
||||
Set dx = Nothing
|
||||
End Sub
|
||||
Private Function CreateWaveFormatEx(Hz As Long, Channels As Integer, BITS As Integer) As WAVEFORMATEX
|
||||
|
||||
'Create a WaveFormatEX structure using the vars we provide
|
||||
With CreateWaveFormatEx
|
||||
.nFormatTag = WAVE_FORMAT_PCM
|
||||
.nChannels = Channels
|
||||
.lSamplesPerSec = Hz
|
||||
.nBitsPerSample = BITS
|
||||
.nBlockAlign = Channels * BITS / 8
|
||||
.lAvgBytesPerSec = .lSamplesPerSec * .nBlockAlign
|
||||
.nSize = 0
|
||||
End With
|
||||
End Function
|
||||
|
||||
Private Sub cmdSave_Click()
|
||||
On Local Error Resume Next
|
||||
With cdlSave
|
||||
'Set our initial properties
|
||||
.FileName = vbNullString
|
||||
.flags = cdlOFNHideReadOnly
|
||||
.Filter = "Wave files(*.WAV)|*.wav"
|
||||
.ShowOpen
|
||||
If Err Then Exit Sub 'We clicked cancel
|
||||
If .FileName = vbNullString Then Exit Sub 'No file
|
||||
'Save the file to disk
|
||||
GetSoundBufferFromCapture(dscb).SaveToFile .FileName
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Private Sub cmdStart_Click()
|
||||
'We want to record sound now.
|
||||
|
||||
'First we need to get rid of any sound we may have
|
||||
Set dscb = Nothing
|
||||
'Now get our capture buffer once more
|
||||
CreateCaptureBuffer
|
||||
|
||||
'Now start recording
|
||||
dscb.Start DSCBSTART_DEFAULT
|
||||
'Disable/Enable our buttons accordingly
|
||||
cmdStop.Enabled = True
|
||||
cmdStart.Enabled = False
|
||||
cmdSave.Enabled = False
|
||||
End Sub
|
||||
|
||||
Private Sub cmdStop_Click()
|
||||
Dim lbufferStatus As Long
|
||||
|
||||
'Stop the buffer
|
||||
dscb.Stop
|
||||
|
||||
'Disable/Enable our buttons accordingly
|
||||
cmdStop.Enabled = False
|
||||
cmdStart.Enabled = True
|
||||
cmdSave.Enabled = True
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
|
||||
'Lets init our capture device
|
||||
InitCapture
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
Cleanup
|
||||
End Sub
|
||||
|
||||
Private Function GetSoundBufferFromCapture(ByVal oCaptureBuffer As DirectSoundCaptureBuffer8) As DirectSoundSecondaryBuffer8
|
||||
Dim lbufferStatus As Long
|
||||
Dim capCURS As DSCURSORS
|
||||
Dim dsd As DSBUFFERDESC
|
||||
Dim ByteBuffer() As Integer 'Our digital data from our capture buffer
|
||||
|
||||
'Are we still capturing? If so, stop
|
||||
oCaptureBuffer.Stop
|
||||
|
||||
'Get the capture info
|
||||
oCaptureBuffer.GetCurrentPosition capCURS
|
||||
dsd.lBufferBytes = capCURS.lWrite + 1
|
||||
dsd.fxFormat = dscd.fxFormat
|
||||
'If there is nothing to write, then exit
|
||||
If capCURS.lWrite = 0 Then Exit Function
|
||||
|
||||
Set GetSoundBufferFromCapture = ds.CreateSoundBuffer(dsd)
|
||||
'Set the size for our new Data
|
||||
ReDim ByteBuffer(capCURS.lWrite)
|
||||
'Read the data from our capture buffer
|
||||
oCaptureBuffer.ReadBuffer 0, capCURS.lWrite, ByteBuffer(0), DSCBLOCK_DEFAULT
|
||||
'Write the data to our sound buffer
|
||||
GetSoundBufferFromCapture.WriteBuffer 0, capCURS.lWrite, ByteBuffer(0), DSBLOCK_DEFAULT
|
||||
|
||||
End Function
|
||||
Binary file not shown.
@@ -0,0 +1,31 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
|
||||
Form=frmCapture.frm
|
||||
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
|
||||
Startup="frmCapture"
|
||||
Command32=""
|
||||
ExeName32="vb_AudTut3.exe"
|
||||
Name="vbAudTut3"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
Reference in New Issue
Block a user