![]() |
Tipp 0202
|
Lautstärke, Balance, Frequenz & Cursorposition
|
 |
|
Autor/Einsender: Datum: |
|
Alexander Csadek 22.02.2002 |
|
Entwicklungsumgebung:
DirectX-Version: |
|
VB 6
DirectX 7 |
|
|
Dieser Tipp zeigt auf, wie die Eigenschaften Lautstärke, Balance,
Frequenz und Cursorposition einer WAV-Datei über den DirectSoundBuffer ausgelesen und gesetzt werden können.
|
Zu diesem Tipp finden Sie eine ausführliche Beschreibung in unserer DirectX-Rubrik
zu DirectSound.
|
|
|
Option Explicit
Dim DX As New DirectX7
Dim DS As DirectSound
Dim dsWavDatei As DirectSoundBuffer
Dim CurrentVolume As Long
Dim AvgBytesPerSec As Long
Private Sub Form_Load()
On Local Error GoTo ErrorHandler
Set DS = DX.DirectSoundCreate("")
DS.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
Me.Show
Exit Sub
ErrorHandler:
MsgBox "Direct Sound Objekt konnte nicht initialisiert " & _
"werden." & vbCrLf & "Prüfe ob eine SoundKarte " & _
"installiert ist und ob sie funktioniert." & vbCr & _
Err.Number & "/" & Err.Description
End
End Sub
Private Sub cmd_Load_Click()
Dim dsBDesc As DSBUFFERDESC
Dim WavLen As Long
On Error GoTo ErrorHandler
With dsBDesc
.lFlags = DSBCAPS_STATIC Or DSBCAPS_CTRLVOLUME Or _
DSBCAPS_CTRLPAN Or DSBCAPS_CTRLFREQUENCY
End With
Dim s As WAVEFORMATEX
Set dsWavDatei = DS.CreateSoundBufferFromFile _
(App.Path & "\vbfun.wav", dsBDesc, s)
HS_Volume.Value = dsWavDatei.GetVolume
lbl_Volume.Caption = "Lautstärke: Absenkung in " & _
HS_Volume.Value & " hundertstel dB"
HS_Balance.Value = dsWavDatei.GetPan
lbl_Balance.Caption = "Balance: Links/Rechts in " & _
HS_Balance.Value & " hundertstel dB"
HS_Frequenz.Value = (dsWavDatei.GetFrequency \ 10)
lbl_Frequenz.Caption = _
"Frequenz: " & (CLng(HS_Frequenz.Value) * 10) & " Hz"
dsWavDatei.GetFormat s
lbl_Channels.Caption = "Anzahl der Kanäle : " & _
s.nChannels & " (1=Mono/2=Stereo)"
lbl_SamplesPerSec.Caption = "Samplingrate : " & _
Format(s.lSamplesPerSec, "##,###") & " Hz"
lbl_BitsPerSample.Caption = _
"Bitbreite : " & s.nBitsPerSample & " Bit"
lbl_BlockAlign.Caption = _
"Anzahl Bytes pro Block : " & s.nBlockAlign
lbl_AvgBytesPerSec.Caption = _
"Bytes pro Sekunde : " & s.lAvgBytesPerSec
WavLen = dsBDesc.lBufferBytes
lbl_FileLen.Caption = "Dateigröße : " & WavLen & " Bytes " & _
"(" & Format((WavLen / s.lAvgBytesPerSec), "#0.000") & _
" Sekunden)"
Slider1.Max = Int((WavLen / s.lAvgBytesPerSec) * 1000)
HS_Cursor.Max = Slider1.Max
AvgBytesPerSec = s.lAvgBytesPerSec
cmd_Load.Enabled = False
cmd_Play.Enabled = True
Timer1.Enabled = True
Exit Sub
ErrorHandler:
MsgBox "Fehler beim Laden der Wav-Datei." & vbCr & _
Err.Number & "/" & Err.Description
End
End Sub
Private Sub cmd_Play_Click()
Dim Pos As Long
If HS_Cursor.Value > 0 Then
Pos = CLng((HS_Cursor.Value / 1000) * AvgBytesPerSec)
End If
dsWavDatei.SetCurrentPosition Pos
If chk_Loop.Value = 0 Then
dsWavDatei.Play DSBPLAY_DEFAULT
Else
dsWavDatei.Play DSBPLAY_LOOPING
End If
cmd_Play.Enabled = False
chk_Loop.Enabled = False
End Sub
Private Sub cmd_Stop_Click()
dsWavDatei.Stop
dsWavDatei.SetCurrentPosition 0
Slider1.Value = 0
cmd_Play.Enabled = True
chk_Loop.Enabled = True
End Sub
Private Sub HS_Balance_Change()
lbl_Balance.Caption = "Balance: Links/Rechts in " & _
HS_Balance.Value & " hundertstel dB"
dsWavDatei.SetPan CLng(HS_Balance.Value)
End Sub
Private Sub HS_Frequenz_Change()
lbl_Frequenz.Caption = _
"Frequenz: " & (CLng(HS_Frequenz.Value) * 10) & " Hz"
dsWavDatei.SetFrequency (CLng(HS_Frequenz.Value) * 10)
End Sub
Private Sub HS_Volume_Change()
lbl_Volume.Caption = "Lautstärke: Absenkung in " & _
HS_Volume.Value & " hundertstel dB"
dsWavDatei.SetVolume CLng(HS_Volume.Value)
End Sub
Private Sub Timer1_Timer()
Dim dsstat As CONST_DSBSTATUSFLAGS
Dim dsc As DSCURSORS
Dim Pos As Long
dsstat = dsWavDatei.GetStatus
If dsstat = DSBSTATUS_PLAYING Or _
dsstat = (DSBSTATUS_PLAYING + DSBSTATUS_LOOPING) Then
cmd_Stop.Enabled = True
Else
cmd_Stop.Enabled = False
cmd_Play.Enabled = True
chk_Loop.Enabled = True
Slider1.Value = 0
End If
dsWavDatei.GetCurrentPosition dsc
If dsc.lPlay > 0 Then
Pos = Int((dsc.lPlay / AvgBytesPerSec) * 1000)
Slider1.Value = Pos
End If
End Sub
Private Sub cmd_Close_Click()
Set dsWavDatei = Nothing
Set DS = Nothing
Set DX = Nothing
End
End Sub
|
|
|
|
|
|
Um dieses Beispiel ausführen zu können, wird die DirectX 7
for Visual Basic Type Library
benötigt (siehe dazu die Erläuterungen in der DirectX-Rubrik).
|
|
Windows-Version |
95 |
 |
|
98/SE |
 |
|
ME |
 |
|
NT |
 |
|
2000 |
 |
|
XP |
 |
|
Vista |
 |
|
Win
7 |
 |
|
|
VB-Version |
VBA 5 |
 |
|
VBA 6 |
 |
|
VB 4/16 |
 |
|
VB 4/32 |
 |
|
VB 5 |
 |
|
VB 6 |
 |
|
|
|
Download (116
kB)
|
Downloads bisher: [ 4823
]
|
|
|