Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0004: Lautstärke und Balance einstellen

 von 

Beschreibung 

Es ist durchaus möglich bei der Ausgabe von WAV Dateien per VB auf die Parameter Laustärke und Balance Einfluss zu nehmen.

Überarbeitet von Florian Rittmeier mit Hilfe von Klaus Langbein.

Dieser Tipp wurde am 23. September 2004 von Klaus Langbein komplett überarbeitet. Die Routine SetVolume wurde dabei stark verbessert.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

mciSendStringA (mciSendString), waveOutSetVolume

Download:

Download des Beispielprojektes [96,15 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
' Es muss ein Verweis auf 'Standard OLE Types' gesetzt werden.
' Die Komponente ' (mci32.ocx)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Vertikale Scrollbar "VScroll2"
' Steuerelement: Vertikale Scrollbar "VScroll1"
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"


' Überarbeitet im Aug. 2004 durch K. Langbein

Option Explicit


' API-Funktionen:
Private Declare Function mciSendString Lib "winmm.dll" _
                         Alias "mciSendStringA" ( _
                         ByVal lpstrCommand As String, _
                         ByVal lpstrRet As String, _
                         ByVal uReturnLength As Long, _
                         ByVal hwndCallback As Long) As Long

Private Declare Function waveOutSetVolume Lib "winmm.dll" ( _
                         ByVal uDeviceID As Long, _
                         ByVal dwVolume As Long) As Long

Private Type intVolumeType
    Left As Integer
    Right As Integer
End Type

Private Type lngVolumeType
    Value As Long
End Type

Function SignedInteger(ByVal UnsignedInteger As Long) As Integer
    ' Zur Sicherheit werden nur die niederwertigen 2 Byte
    ' berücksichtigt.
    UnsignedInteger = UnsignedInteger And 65535
        
    If (UnsignedInteger And 32768) Then
        ' Wenn das MSB gesetzt ist, subtrahieren wir 65536.
        SignedInteger = UnsignedInteger - 65536
    Else
        ' Ansonsten können wir den Wert unverändert übernehmen.
        SignedInteger = UnsignedInteger
    End If
End Function

Sub SetVolume()
    Dim intVol As intVolumeType
    Dim lngVol As lngVolumeType
    
    ' Der Maximalwert der Vscrolls ist 10000. Durch
    ' Multiplizieren mit 6.5535 wird der Maximalwert
    ' zu 65535, was dem Maximum eines vorzeichenlosen
    ' 2-Byte-Integer entspricht.
    
    ' Mit Hilfe der Funktion SignedInteger konvertieren wir
    ' den Sollwert zu einem vorzeichenbehafteten VB-Integer:
    intVol.Left = SignedInteger(VScroll1.Value * 6.5535)
    intVol.Right = SignedInteger(VScroll2.Value * 6.5535)
    
    ' Mit folgendem Befehl kann der Inhalt von intVol in lngVol
    ' übertragen werden. Auf diese Weise können wir die zwei
    ' Integer ohne viel Aufhebens zu einem Long zusammenfassen.
    LSet lngVol = intVol

    'Lautstärke einstellen
    Call waveOutSetVolume(0, lngVol.Value)
End Sub

Private Sub Command1_Click()
    Dim lngResult As Long
    Dim strRet As String
    Dim strFile As String

    strRet = Space$(128)
    lngResult = mciSendString("stop sound", strRet, 128, 0&)
    lngResult = mciSendString("close sound", strRet, 128, 0&)

    'Abspielen
    strRet = Space$(128)
    strFile = App.Path & "\test.wav"
    
    lngResult = mciSendString("open waveaudio!" & strFile & _
                              " alias sound", strRet, 128, 0&)
                              
    If lngResult <> 0 Then
        MsgBox lngResult
    End If

    lngResult = mciSendString("play sound", strRet, 128, 0&)
    
    If lngResult <> 0 Then
        MsgBox lngResult
    End If
    
    Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
    Dim lngResult As Long
    Dim strRet As String

    strRet = Space$(128)
    lngResult = mciSendString("stop sound", strRet, 128, 0&)
    lngResult = mciSendString("close sound", strRet, 128, 0&)
    Timer1.Enabled = 0
End Sub


Private Sub Form_Load()
    'Control-Eigenschaften initialisieren

    Label1.Caption = "L"
    Label2.Caption = "R"

    VScroll1.LargeChange = 1000
    VScroll1.Min = 10000
    VScroll1.Max = 0
    VScroll1.Value = 5000

    VScroll2.LargeChange = 1000
    VScroll2.Min = 10000
    VScroll2.Max = 0
    VScroll2.Value = 5000
    Call SetVolume
    Timer1.Enabled = 0
    Timer1.Interval = 17000
End Sub

Private Sub Timer1_Timer()
    Call Command1_Click
End Sub

Private Sub VScroll1_Scroll()
    Call SetVolume
End Sub

Private Sub VScroll2_Scroll()
    Call SetVolume
End Sub

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von blub am 01.07.2010 um 09:57

Nur mal schnell eine Frage, ich bräuchte so etwas in der art auch für mein projekt, wir programmieren aber in vb.net funktioniert dieses beispiel auch in vb.net?

Kommentar von - am 02.08.2009 um 00:13

Warum kein Vista in der Combobox, zudem funtioniert der code nicht!

Kommentar von Milan am 12.07.2004 um 21:37

Ja funktioniert bis auf:
lngVolume = lngVolume Or intRight
wenn intRight einen Wert >= &H8000 annimmt sind die ersten 2Byte von lngvolume = &HFFFF egal was vorher in lngvolume vorhanden war. warum weiß ich nicht würd mich aber sehr interessieren! (warscheinlich hat das was mit den datentypen zutun zweierkomplement oder sowas)