Tipp 0158 Sounds binär in SoundBuffer laden
Autor/Einsender:
Datum:
  Alexander Csadek
12.11.2001
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 7
Dieser Tipp basiert auf dem Tipp Binäre Ressourcen-Datei und zeigt, wie die Sounds direkt aus der binären Ressourcen-Datei in einen DirectSoundBuffer geschrieben werden können.
Es gibt zwar die Ressourcen-Datei bei Visual Basic, aber es gibt auch die Möglichkeit mit einer binären Ressourcen-Datei zu arbeiten. Dies hat mehrere Vorteile, zum einem sind die mühsam erstellten Ressourcen besser geschützt und zum anderen bleibt die .exe-Datei klein und muss nicht ausgetauscht werden, wenn sich mal eine Ressource ändern sollte.
Das Prinzip ist ganz einfach, die gewünschten Ressourcen (Dateien) werden mit open binary access geöffnet, binär eingelesen, die Größe der Ressourcen ermittelt und nacheinander in eine Datei geschrieben. Die Anzahl und Größe der einzelnen Dateien ist natürlich wichtig, da diese zum Auslesen wieder gebraucht werden.
In einem allgemeine FileHeader werden die Anzahl der Ressourcen und die Gesamtgröße in Bytes separat gespeichert. Somit kann erkannt werden, ob versucht wurde, die Binär-Datei zu manipulieren. Für jede Ressource wird noch ein InfoHeader erstellt, in den der Name, die Größe in Bytes und das StartByte geschrieben wird, an der die Ressource in der Binär-Datei beginnt.
Die Namen der Sound-Dateien müssen nicht unbedingt mit in die Binär-Datei geschrieben werden, da die Sounds ja nicht wieder auf die Festplatte geschrieben werden müssen. Entweder lässt man die Namen leer oder ändert die InfoHeader entsprechend ab, wobei zu beachten ist, dass der InfoHeader-Satz dann kürzer ist. Der FileHeader, die InfoHeader pro Ressource und natürlich die Ressourcen selbst werden dann in eine neue Datei geschrieben, und schon ist die binäre Ressourcendatei fertig.
Nun kommt der 2. Schritt, das Auslesen der Sounds und das Schreiben in einen DirectSoundBuffer.
Die Binär-Datei wird zunächst mit open binary access geöffnet, der FileHeader eingelesen und die Größe der Datei mit der im FileHeader gespeicherten Größe verglichen. Stimmen diese Daten nicht überein, dann ist etwas mit der Binär-Datei nicht in Ordnung.
Als nächstes werden die InfoHeader pro Sound eingelesen, und nun können mit dem StartByte und der Größe aus dem InfoHeader die einzelnen Sounds aus der Binär-Datei eingelesen werden. Danach werden die Sounds mit der Funktion WriteBuffer des DirectSoundBuffer-Objekts direkt in den SoundBuffer geschrieben.
Code im Codebereich des Moduls MainModule
 
Option Explicit

Sub Main()
  DSoundModule.InitializeDS (frmMain.hWnd)
  frmMain.Show
End Sub

Sub ExitProgramm()
  DSoundModule.SoundTerminate
End Sub
 
Code im Codebereich des Moduls BinModule
 
Option Explicit

Private Type FILEHEADER
  intNumFiles As Integer
  lngFileSize As Long
End Type

Private Type INFOHEADER
  lngFileSize As Long
  lngFileStart As Long
  strFileName As String * 16
End Type
Public InfoHead() As INFOHEADER

Private Type WAVETYPE
  strHead As String * 12
  strFormatID As String * 4
  lngChunkSize As Long
  intFormat As Integer
  intChannels As Integer
  lngSamplesPerSec As Long
  lngAvgBytesPerSec As Long
  intBlockAlign As Integer
  intBitsPerSample As Integer
End Type

Global gudtHeader As WAVETYPE
Global glngChunkSize As Long
Global gbytData() As Byte

Function OpenBinFile(strFile As String) As Boolean
  Dim intBinaryFile As Integer
  Dim FileHead As FILEHEADER

  On Local Error GoTo ErrOut

  intBinaryFile = FreeFile
  Open App.Path & strFile _
        For Binary Access Read Lock Write As intBinaryFile

  Get intBinaryFile, 1, FileHead

  If LOF(intBinaryFile) <> FileHead.lngFileSize Then
    MsgBox "This is not a valid file format.", vbOKOnly, _
          "Invalid File"
    OpenBinFile = False
    Exit Function
  End If

  ReDim InfoHead(FileHead.intNumFiles - 1)
  Get intBinaryFile, , InfoHead
  Close intBinaryFile

  OpenBinFile = True
  Exit Function

ErrOut:
  OpenBinFile = False
  Close intBinaryFile
  MsgBox "Unable to decode binary file.", vbOKOnly, "Error"
End Function

Sub ExtractWaveData(strFileName As String, lngOffset As Long)
  Dim intWAVFile As Integer
  Dim i As Long
  Dim strTemp As String * 4
  Dim blnFound As Boolean

  intWAVFile = FreeFile()
  Open strFileName For Binary Access Read Lock Write As intWAVFile
    Get intWAVFile, lngOffset, gudtHeader

    For i = lngOffset To LOF(intWAVFile)
      Get intWAVFile, i, strTemp
      If strTemp = "data" Then
        blnFound = True
        Exit For
      End If
    Next i

    If blnFound = False Then
      MsgBox "Invalid wave data.", vbCritical, "Invalid Wave"
      Close intWAVFile
      Exit Sub
    End If

    Get intWAVFile, , glngChunkSize
    ReDim gbytData(glngChunkSize)
    Get intWAVFile, , gbytData
  Close intWAVFile
End Sub

Private Function FileSize(lngWidth As Long, lngHeight As Long) _
      As Long
  If lngWidth Mod 4 > 0 Then
    FileSize = ((lngWidth \ 4) + 1) * 4 * lngHeight - 1
  Else
    FileSize = lngWidth * lngHeight - 1
  End If
End Function
 
Code im Codebereich des Moduls DSoundModule
 
Option Explicit

Public dx As New DirectX7
Public DS As DirectSound
Public dsPrimaryBuffer As DirectSoundBuffer
Public dsSound1 As DirectSoundBuffer
Public dsSound2 As DirectSoundBuffer

Public Sub InitializeDS(WindowHandle As Long)
  Dim dsBDesc As DSBUFFERDESC
  Dim bdesc As DSBUFFERDESC

  Set DS = dx.DirectSoundCreate("")
  DS.SetCooperativeLevel WindowHandle, DSSCL_NORMAL
  With bdesc
    .lFlags = DSBCAPS_PRIMARYBUFFER Or DSBCAPS_CTRLPAN
  End With

  Dim s As WAVEFORMATEX
  Set dsPrimaryBuffer = DS.CreateSoundBuffer(bdesc, s)
End Sub

Public Sub GetSound()
  LoadSound dsSound1, InfoHead(0).lngFileStart
  LoadSound dsSound2, InfoHead(1).lngFileStart
End Sub

Public Sub LoadSound(objBuffer As DirectSoundBuffer, _
      lngLocation As Long)
  Dim udtBufferDesc As DSBUFFERDESC
  Dim udtFormat As WAVEFORMATEX

  ExtractWaveData App.Path & "\Sound.dat", lngLocation

  With udtFormat
    .nFormatTag = gudtHeader.intFormat
    .nChannels = gudtHeader.intChannels
    .lSamplesPerSec = gudtHeader.lngSamplesPerSec
    .nBitsPerSample = gudtHeader.intBitsPerSample
    .nBlockAlign = gudtHeader.intBlockAlign
    .lAvgBytesPerSec = gudtHeader.lngAvgBytesPerSec
  End With

  udtBufferDesc.lBufferBytes = glngChunkSize
  Set objBuffer = DS.CreateSoundBuffer(udtBufferDesc, udtFormat)
 
  objBuffer.WriteBuffer _
       0, glngChunkSize, gbytData(0), DSBLOCK_ENTIREBUFFER
End Sub

Public Sub SoundTerminate()
  Set dsSound1 = Nothing
  Set dsSound2 = Nothing
  Set DS = Nothing
End Sub
 
Code im Codebereich der Form frmMain
 
Option Explicit

Private Type FILEHEADER
  intNumFiles As Integer
  lngFileSize As Long
End Type

Private Type INFOHEADER
  lngFileSize As Long
  lngFileStart As Long
  strFileName As String * 16
End Type

Const DatFileName As String = "Sound.DAT"

Dim strFiles(2) As String

Private Sub Command1_Click()
  Dim intSample1File As Integer
  Dim intBinaryFile As Integer
  Dim bytSample1Data() As Byte
  Dim FileHead As FILEHEADER
  Dim InfoHead() As INFOHEADER
  Dim lngFileStart As Long
  Dim i As Single

  If Dir(App.Path & "\Sound.DAT", vbNormal) <> "" Then
      Kill App.Path & "\Sound.DAT"
  End If

  On Local Error GoTo ErrOut

  Me.MousePointer = vbHourglass

  strFiles(1) = "Sound1.wav"
  strFiles(2) = "Sound2.wav"

  FileHead.intNumFiles = 2

  FileHead.lngFileSize = (6) + (FileHead.intNumFiles * 24)

  ReDim InfoHead(FileHead.intNumFiles - 1)
  lngFileStart = (6) + (FileHead.intNumFiles * 24) + 1

  For i = 1 To FileHead.intNumFiles
    intSample1File = FreeFile
    Open App.Path & "\" & strFiles(i) _
          For Binary Access Read Lock Write As intSample1File

    ReDim bytSample1Data(LOF(intSample1File) - 1)
    Get intSample1File, 1, bytSample1Data
    Close intSample1File

    FileHead.lngFileSize = _
          FileHead.lngFileSize + (UBound(bytSample1Data) + 1)

    InfoHead(i - 1).lngFileSize = UBound(bytSample1Data) + 1
    InfoHead(i - 1).lngFileStart = lngFileStart
    lngFileStart = lngFileStart + InfoHead(i - 1).lngFileSize
    InfoHead(i - 1).strFileName = strFiles(i)
  Next i

  intBinaryFile = FreeFile
  Open App.Path & "\" & DatFileName _
        For Binary Access Write Lock Write As intBinaryFile

  Put intBinaryFile, 1, FileHead
  Put intBinaryFile, , InfoHead

  For i = 1 To FileHead.intNumFiles
    intSample1File = FreeFile
    Open App.Path & "\" & strFiles(i) _
          For Binary Access Read Lock Write As intSample1File
    ReDim bytSample1Data(LOF(intSample1File) - 1)
    Get intSample1File, 1, bytSample1Data
    Put intBinaryFile, , bytSample1Data
    Close intSample1File
  Next i

  Close intBinaryFile

  Me.MousePointer = vbNormal
  MsgBox "Binärdatei wurde erstellt!"
  Command2.Enabled = True

  Exit Sub

ErrOut:
  MsgBox "Binärdatei konnte nicht erstellt werden.", _
        vbOKOnly, "Fehler"
End Sub

Private Sub Command2_Click()
  If OpenBinFile("\Sound.DAT") Then
    MsgBox "Wav-Files werden nun in den SoundBuffer geschrieben."
    DSoundModule.GetSound
    frmPlaySound.Show vbModal
  End If
End Sub

Private Sub cmd_Beenden_Click()
  ExitProgramm
  End
End Sub
 
Code im Codebereich der Form frmPlaySound
 
Option Explicit

Private Sub Command1_Click()
  dsSound1.Play DSBPLAY_DEFAULT
End Sub

Private Sub Command2_Click()
  dsSound2.Play DSBPLAY_DEFAULT
End Sub

Private Sub Command3_Click()
  Unload Me
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, _
      UnloadMode As Integer)
  Me.Hide
End Sub
 
Weitere Links zum Thema
Read- und WriteBuffer
Sound-Dateien laden, abspielen, wiederholen
Hinweis
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  (52,6 kB) Downloads bisher: [ 906 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Montag, 8. August 2011