Mehrere Töne gleichzeitig abspielen

-Franky- · 29. Juni 2024, 20:18

Hi. Keine Ahnung ob die Bass.dll mehrere Frequenzen gleichzeitig abspielen kann ohne das erst das ganze neu berechnet werden muss. Üblicherweise erstellt man mehrere SoundBuffer mit unterschiedlichen Frequenzen die gleichzeitig abgespielt werden können. Um das zusammen mixen hat sich die entsprechende Schnittstelle (WASAPI, DirectSound, MediaFoundation) zu kümmern. Noch einfacher ist es eine oder mehrere Grundfrequenzen zu erstellen und diese per Pitch an die gewünschte Frequenz anzupassen ohne ständig alles selbst neu berechnen zu müssen. Natürlich spielt auch die Phasenlage eine gewisse Rolle wie die gemixte Frequenz wahrgenommen wird.

RodFromGermany · 30. Juni 2024, 10:24

Haudruferzappeltnoch schrieb:

Also was verstehst du unter "akustisch eine Rolle spielen"?

Generiere Dir je eine Wave-Sequenz über sagen wir 10 Sekunden mit 2 Frequenzen und verschiedenen Phasenlagen der Frequenzen zueinander.
Spiele sie nacheinander ab und versuche akustisch, also hörend, einen Unterschied zu erkennen.
Es gibt keinen.

Haudruferzappeltnoch · 30. Juni 2024, 13:41

Ok, bei nur zwei Frequenzen kann das gut funktionieren, wenn sie nicht zu nah beieinander liegen, macht Sinn.
Ich sagte ja bereits, wenn ich nur eine Frequenz in der Phase verschiebe, dann ist das logisch. Bei zwei lässt sich das noch gut nachvollziehen, wenn sie nicht annähernd gleich sind.
Aber bei drei Frequenzen wird es schon kompliziert die richtigen Randbedingungen anzugeben um die Aussage wahr zu machen.

Ich frag mich wie Noise-Cancelling-Kopfhörer programmiert werden. Das müsste ganz ähnlich laufen: erzeuge die richtigen Frequenzen = höre weniger...aber mehr hören kann man mit den Dingern auch machen, da wird sicherlich auch dynamisch die Phase berücksichtigt der eingehenden Töne.

DTF · 30. Juni 2024, 17:02

Bei ANC(Active Noise Cancelling) werden zwar gegen Schallwellen verwendet, aber man müsste nicht mal die störenden Geräusche komplett eliminieren, nur soweit abschwächen das sie nicht mehr oder kaum noch warnehmbar sind, wenn es dann kaum warnehmbar ist, wird man es beim Musikhören "überhören". Dazu wird man nicht unbedingt die Phase berücksichtigen müssen. Die Wellen treffen aufeinandern und stören/neutralisieren sich, kommt eher auf die richtige Stärke an, damit man nicht ein störendes Geräusch erzeugt.

Haudruferzappeltnoch · 30. Juni 2024, 17:10

Doch natürlich, sagen wir der eingehende Schall ist eine normale Sinuswelle. Die Gegenwelle ist identisch, also die sollte auch ungefähr aussehen wie ein Sinus.
Und wenn man da nun die Phase nicht berücksichtigt, dann ist das Resultat der Amplitude irgendwo zwischen doppelt so laut und weg, alles mögliche. Wie in Post 18 zu sehen.

-Franky- · 30. Juni 2024, 17:40

@tron25 Im Prinzip benötigst Du eine Kombination aus onlinetonegenerator.com/multiple-tone-generator.html und szynalski.com/tone-generator/ Beim ersten kannst Du mehrere feste Frequenzen erzeugen, ein oder ausschalten, Panning und Volume ändern. Beim zweiten kann man die Frequenz über den Schieberegler entsprechend anpassen.

Edit: Nur der Vollständigkeit halber wie es per DirectSound funktioniert: handmade.network/forums/articles/t/3040-directsound Im Prinzip erstellt man mehrere SoundBuffer und mit den entsprechenden DSBCAPS_-Flags hast Du alles was Du brauchst und kannst Volume, Pitch, Panning entsprechend, und wenn ich mich nicht irre, on the fly anpassen.

tron25 · 1. Juli 2024, 20:44

Sorry, dass ich mich so spät melde, aber ich war in den letzten Tagen sehr beschäftigt.

Vielen Dank erst einmal für die Zahlreichen Beiträge.

So, jetzt habe ich auch einen ersten Entwurf für die Oberfläche. Zum Testen wollte ich versuchen, zwei Töne gleichzeitig abzuspielen. Dabei habe ich das Problem, wie ich die Werte für Lautstärke oder die Frequenzen in Variablen packen kann. Beispielsweise für die Lautstärke "0.5D". Die Lautstärke ist ja ein "Double". Aber wie bekomme ich das "D" dahinter? Mit "&" funktioniert es nicht. Hier der bisherige Code:

VB.NET-Quellcode

Imports System.Runtime.InteropServices
Imports Un4seen.Bass
Public Class MultiBeepFormular
'handle für den audio stream
Private streamHandle1 As Integer = 0
Private streamHandle2 As Integer = 0
'STREAMPROC delegate, "zeigt" dann auf die angegebene Funktion die dann
'regelmäßig gecallt wird
Private streamProc1 As STREAMPROC
Private streamProc2 As STREAMPROC
Dim Links1Frequenz As Integer
Dim Links2Frequenz As Integer
Dim Links1Lautstaerke As Double
Dim Links2Lautstaerke As Double
Dim Rechts1Frequenz As Integer
Dim Rechts1Lautstaerke As Double
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
If Not Bass.BASS_Init(-1, 44100, BASSInit.BASS_DEVICE_CPSPEAKERS, IntPtr.Zero) Then
MessageBox.Show($"BASS Initialisierungsfehler: { Bass.BASS_ErrorGetCode() }")
Application.Exit()
End If
End Sub
Private Function StreamProcCallback(handle As Integer, buffer As IntPtr, length As Integer, user As IntPtr) As Integer
'einen puffer anlegen um Daten aus und in den Speicher zu kopieren
Dim buff As Byte() = New Byte(length) {}
'die Daten aus dem Speicher in unseren Puffer kopieren, die Daten sind "stumm" weil nichts im Stream zum abspielen da ist
Marshal.Copy(buffer, buff, 0, length)
Dim samplerate As Double = 44100D
'Wie bekomme ich den Wert "500D" in eine Variable?
Dim waveFrequencyLeft As Double = 500D 'frequenz in Hz linker Kanal
Dim waveFrequencyRight As Double = 1000D 'frequenz in Hz rechter Kanal
'Das Gleiche mit der Lautstärke
Dim gainLeft As Double = 0.1D 'lautstärke linker Kanal
Dim gainRight As Double = 1D 'lautstärke rechter Kanal
'die einzelnen Samples erstellen, jedes Sample besteht aus 8 Bytes, je 2 Singles(2x 4 Bytes), je einmal für links und einmal für rechts
For i As Integer = 0 To buff.Length - 9 Step 8
Dim left As Single = CSng(Math.Sin(i / 8D * 2D * Math.PI * waveFrequencyLeft / samplerate) * gainLeft)
Dim right As Single = CSng(Math.Sin(i / 8D * 2D * Math.PI * waveFrequencyRight / samplerate) * gainRight)
'die bytes für den Puffer
Dim bytesLeft As Byte() = BitConverter.GetBytes(left)
Dim bytesRight As Byte() = BitConverter.GetBytes(right)
'die bytes in unseren Puffer kopieren
Array.Copy(bytesLeft, 0, buff, i, 4)
Array.Copy(bytesRight, 0, buff, i + 4, 4)
Next
'die Daten aus unseren Puffer in den Speicher kopieren, damit sie nun abgespielt werden können.
Marshal.Copy(buff, 0, buffer, length)
Return length
End Function
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Bass.BASS_ChannelStop(streamHandle1)
Bass.BASS_ChannelStop(streamHandle2)
streamProc1 = Nothing
streamProc2 = Nothing
Bass.BASS_StreamFree(streamHandle1)
Bass.BASS_StreamFree(streamHandle2)
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'neues STREAMPROC, "zeigt" auf die Sub StreamProcCallback
streamProc1 = New STREAMPROC(AddressOf StreamProcCallback)
streamProc2 = New STREAMPROC(AddressOf StreamProcCallback)
'das handle für den Stream erstellen
streamHandle1 = Bass.BASS_StreamCreate(44100, 2, BASSFlag.BASS_SAMPLE_FLOAT, streamProc1, IntPtr.Zero)
streamHandle2 = Bass.BASS_StreamCreate(44100, 2, BASSFlag.BASS_SAMPLE_FLOAT, streamProc2, IntPtr.Zero)
'den stream starten
Bass.BASS_ChannelPlay(streamHandle1, False)
Bass.BASS_ChannelPlay(streamHandle2, False)
End Sub
End Class

Wenn ich das Programm laufen lasse, höre ich auch den Ton. Allerdings kann ich wegen der oben genannten Probleme keine zweite Frequenz bestimmen. Natürlich könnte ich versuchen, die Funktion zu dublizieren, aber das erscheint mir nicht effizient. Zudem hätte ich dann immernoch das Problem mit den Variablen.

Habt ihr da eine Idee? Oder könntet ihr die Funktionen auf zwei Frequenzen erweitern, sodas ich dann damit weiterarbeiten kann?

Vielen Dank nochmal.

ErfinderDesRades · 1. Juli 2024, 22:01

@-Franky-: Menno, ich hab 2 Tage dran gearbeitet, Töne zu bauen, zu überlagern, abzuspeichern!
Und jetzt haust du da diese Online-Apps raus, wo das alles gelöst ist, inklusive das Problem, bei grossem Frequenzbereich gleichzeitig extrem fein tunen können zu müssen.

@tron25: Komisch, dass du da garnet drauf eingehst.

tron25 · 1. Juli 2024, 22:13

Ich habe mir die zwei Programme angeschaut. Leider sind das aber beides Webanwendungen, die für Blinde, die einen Screenreader verwenden nicht sonderlich barrierefrei sind.

Den C-Code habe ich mir auch angeschaut. Allerdings brauche ich da Zeit, um den Code in VB zu übersetzen.

Trotzdem danke für die Tips.

-Franky- · 1. Juli 2024, 23:15

ErfinderDesRades schrieb:

Und jetzt haust du da diese Online-Apps raus, wo das alles gelöst ist, ...

Diese Beispiele sollten nur zeigen, wie ich mir so eine App vorstellen könnte. Adhoc einfach noch eine weitere Frequenz dazu packen oder wieder wegnehmen, Pitch, Volume, Panning usw. ohne das alles neu berechnet werden muss wenn sich ein Parameter ändert. Jetzt braucht man halt die geeignete Soundschnittstelle die das abbilden kann.

@tron25 Siehe Quote -> @ErfinderDesRades
Es ist mir schon klar das diese Webanwendungen für Dich ungeeignet sind. Falls Du den Code von meinem Link übersetzen möchtest, es ist nur eine API, zwei COM-Interfaces plus ein paar Structure, Const und Enums. Für Dich mag es eventuell auch einfacher sein, wenn Du z.B. SharpDX nutzt. Da hatte ich ja auch schon einen Link zu einem SinusGenrator mit SharpDX gepostet.

-Franky- · 2. Juli 2024, 16:35

@tron25 Ich hatte etwas Zeit und hab mal den Code vom DirectSound-Link nach VB.NET übersetzt.
Code in der Form

VB.NET-Quellcode

Imports System.ComponentModel
Public Class Form1
Private SinGen As SinusGenerator
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
SinGen = New SinusGenerator(Me.Handle)
End Sub
Private Sub Form1_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
SinGen = Nothing
End Sub
End Class

Code in eine Klasse SinusGenerator (einige Interface Funktionen sind nicht komplett)

Spoiler anzeigen

VB.NET-Quellcode

Imports System.Runtime.InteropServices
Public Class SinusGenerator
#Region "APIs"
<DllImport("DSound.dll", EntryPoint:="DirectSoundCreate8")>
<PreserveSig> Private Shared Function DirectSoundCreate8(<[In]> ByRef lpcGuidDevice As Guid,
<Out, MarshalAs(UnmanagedType.Interface)> ByRef ppDS8 As IDirectSound8,
<[In]> pUnkOuter As IntPtr) As Integer
End Function
#End Region
#Region "Class"
Public Sub New(OwnerHwnd As IntPtr)
If OwnerHwnd <> IntPtr.Zero Then
If DirectSoundCreate8(New Guid(DSDEVID_DefaultPlayback),
m_IDirectSound8,
IntPtr.Zero) = DS_OK Then
If m_IDirectSound8.SetCooperativeLevel(OwnerHwnd, DSSCL_FLAG.DSSCL_PRIORITY) = DS_OK Then
Dim BufferDescription As New DSBUFFERDESC With {
.dwSize = Marshal.SizeOf(Of DSBUFFERDESC),
.dwFlags = DSBCAPS_FLAGS.DSBCAPS_PRIMARYBUFFER
}
If m_IDirectSound8.CreateSoundBuffer(BufferDescription, m_IDirectSoundBuffer_Primary, IntPtr.Zero) = DS_OK Then
Dim WaveFormat As New WAVEFORMATEX With {
.wFormatTag = WAVE_FORMAT_PCM,
.nSamplesPerSec = 44100,
.wBitsPerSample = 16,
.nChannels = 2
}
WaveFormat.nBlockAlign = CShort((WaveFormat.wBitsPerSample / 8) * WaveFormat.nChannels)
WaveFormat.nAvgBytesPerSec = WaveFormat.nSamplesPerSec * WaveFormat.nBlockAlign
If m_IDirectSoundBuffer_Primary.SetFormat(WaveFormat) = DS_OK Then
BufferDescription.dwFlags = DSBCAPS_FLAGS.DSBCAPS_CTRLVOLUME Or
DSBCAPS_FLAGS.DSBCAPS_CTRLFREQUENCY Or
DSBCAPS_FLAGS.DSBCAPS_CTRLPAN
BufferDescription.dwBufferBytes = 44100 * 4
Dim pWaveFormat As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(Of WAVEFORMATEX))
Marshal.StructureToPtr(WaveFormat, pWaveFormat, True)
BufferDescription.lpwfxFormat = pWaveFormat
Marshal.FreeHGlobal(pWaveFormat)
If m_IDirectSound8.CreateSoundBuffer(BufferDescription, m_IDirectSoundBuffer_Secundary, IntPtr.Zero) = DS_OK Then
Dim pBuffer As IntPtr
Dim BufferSize As Integer
If m_IDirectSoundBuffer_Secundary.Lock(0, BufferDescription.dwBufferBytes,
pBuffer, BufferSize, IntPtr.Zero,
0, DSBLOCK_FLAG.DSBLOCK_NONE) = DS_OK Then
Const Frequency As Double = 440
Dim LeftRight As Integer
Dim TimeStep As Double
Dim Values As Integer() = New Integer(WaveFormat.nSamplesPerSec) {}
For i = 0 To WaveFormat.nSamplesPerSec - 1
LeftRight = CInt(32000 * Math.Sin(2 * Math.PI * Frequency * TimeStep))
Values(i) = 65536 * LeftRight + LeftRight
TimeStep += 1D / WaveFormat.nSamplesPerSec
Next i
Marshal.Copy(Values, 0, pBuffer, Values.Length)
If m_IDirectSoundBuffer_Secundary.Unlock(pBuffer, BufferSize, IntPtr.Zero, 0) = DS_OK Then
m_IDirectSoundBuffer_Secundary.SetCurrentPosition(0)
m_IDirectSoundBuffer_Secundary.SetVolume(DSBVOLUME_MAX)
m_IDirectSoundBuffer_Secundary.SetPan(DSBPAN_CENTER)
m_IDirectSoundBuffer_Secundary.SetFrequency(DSBFREQUENCY_ORIGINAL)
If m_IDirectSoundBuffer_Secundary.Play(0, 0, DSBPLAY_FLAGS.DSBPLAY_LOOPING) = DS_OK Then
End If
End If
End If
End If
End If
End If
End If
End If
End If
End Sub
Protected Overrides Sub Finalize()
If m_IDirectSound8 IsNot Nothing Then
If m_IDirectSoundBuffer_Secundary IsNot Nothing Then
Marshal.ReleaseComObject(m_IDirectSoundBuffer_Secundary)
m_IDirectSoundBuffer_Secundary = Nothing
End If
If m_IDirectSoundBuffer_Primary IsNot Nothing Then
Marshal.ReleaseComObject(m_IDirectSoundBuffer_Primary)
m_IDirectSoundBuffer_Primary = Nothing
End If
Marshal.ReleaseComObject(m_IDirectSound8)
m_IDirectSound8 = Nothing
End If
MyBase.Finalize()
End Sub
#End Region
#Region "Enums"
Private Enum DSBLOCK_FLAG As Integer
DSBLOCK_NONE = &H0
DSBLOCK_FROMWRITECURSOR = &H1
DSBLOCK_ENTIREBUFFER = &H2
End Enum
Private Enum DSSCL_FLAG As Integer
DSSCL_NONE = &H0
DSSCL_NORMAL = &H1
DSSCL_PRIORITY = &H2
DSSCL_EXCLUSIVE = &H3
DSSCL_WRITEPRIMARY = &H4
End Enum
Private Enum DSBPLAY_FLAGS As Integer
DSBPLAY_NONE = &H0
DSBPLAY_LOOPING = &H1
'DSBPLAY_LOCHARDWARE = &H2
'DSBPLAY_LOCSOFTWARE = &H4
'DSBPLAY_TERMINATEBY_TIME = &H8
'DSBPLAY_TERMINATEBY_DISTANCE = &H10
'DSBPLAY_TERMINATEBY_PRIORITY = &H20
End Enum
Private Enum DSBSTATUS
DSBSTATUS_NONE = &H0
DSBSTATUS_PLAYING = &H1
DSBSTATUS_BUFFERLOST = &H2
DSBSTATUS_LOOPING = &H4
DSBSTATUS_LOCHARDWARE = &H8
DSBSTATUS_LOCSOFTWARE = &H10
DSBSTATUS_TERMINATED = &H20
End Enum
Private Enum DSBCAPS_FLAGS As Integer
DSBCAPS_NONE = &H0
DSBCAPS_PRIMARYBUFFER = &H1
DSBCAPS_STATIC = &H2
DSBCAPS_LOCHARDWARE = &H4
DSBCAPS_LOCSOFTWARE = &H8
DSBCAPS_CTRL3D = &H10
DSBCAPS_CTRLFREQUENCY = &H20
DSBCAPS_CTRLPAN = &H40
DSBCAPS_CTRLVOLUME = &H80
DSBCAPS_CTRLPOSITIONNOTIFY = &H100
DSBCAPS_CTRLFX = &H200
DSBCAPS_STICKYFOCUS = &H4000
DSBCAPS_GLOBALFOCUS = &H8000
DSBCAPS_GETCURRENTPOSITION2 = &H10000
DSBCAPS_MUTE3DATMAXDISTANCE = &H20000
DSBCAPS_LOCDEFER = &H40000
DSBCAPS_TRUEPLAYPOSITION = &H80000
End Enum
#End Region
#Region "Consts"
Private Const DS_OK As Integer = 0
Private Const WAVE_FORMAT_PCM As Integer = 1
' IDirectSoundBuffer.SetVolume Min/Max
Private Const DSBVOLUME_MAX As Long = 0
Private Const DSBVOLUME_MIN As Long = -10000
' IDirectSoundBuffer.SetFrequency Min/Max
Private Const DSBFREQUENCY_ORIGINAL As Integer = 0
Private Const DSBFREQUENCY_MIN As Integer = 100
Private Const DSBFREQUENCY_MAX As Integer = 100000
' IDirectSoundBuffer.SetPan Min/Max
Private Const DSBPAN_LEFT As Long = -10000
Private Const DSBPAN_CENTER As Long = 0
Private Const DSBPAN_RIGHT As Long = 10000
Private Const DSDEVID_DefaultPlayback As String = "def00000-9c6d-47ed-aaf1-4Dda8f2b5c03"
Private Const IID_IDirectSound8 As String = "c50a7e93-f395-4834-9ef6-7fa99de50966"
Private Const IID_IDirectSoundBuffer As String = "279afa85-4981-11ce-a521-0020af0be560"
#End Region
#Region "Variables"
Private m_IDirectSound8 As IDirectSound8
Private m_IDirectSoundBuffer_Primary As IDirectSoundBuffer
Private m_IDirectSoundBuffer_Secundary As IDirectSoundBuffer
#End Region
#Region "Structures"
Private Structure WAVEFORMATEX
Dim wFormatTag As Short
Dim nChannels As Short
Dim nSamplesPerSec As Integer
Dim nAvgBytesPerSec As Integer
Dim nBlockAlign As Short
Dim wBitsPerSample As Short
Dim cbSize As Short
End Structure
Private Structure DSBUFFERDESC
Dim dwSize As Integer
Dim dwFlags As DSBCAPS_FLAGS
Dim dwBufferBytes As Integer
Dim dwReserved As Integer
Dim lpwfxFormat As IntPtr '<- WAVEFORMATEX
Dim guid3DAlgorithm As Guid
End Structure
#End Region
#Region "Interface IDirectSound8"
<ComImport>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
<Guid(IID_IDirectSound8)>
Private Interface IDirectSound8
<PreserveSig> Function CreateSoundBuffer(<[In]> ByRef pcDSBufferDesc As DSBUFFERDESC,
<Out, MarshalAs(UnmanagedType.Interface)> ByRef ppDSBuffer As IDirectSoundBuffer,
<[In]> pUnkOuter As IntPtr) As Integer
<PreserveSig> Function GetCaps() As Integer
<PreserveSig> Function DuplicateSoundBuffer() As Integer
<PreserveSig> Function SetCooperativeLevel(<[In]> hwnd As IntPtr,
<[In]> dwLevel As DSSCL_FLAG) As Integer
<PreserveSig> Function Compact() As Integer
<PreserveSig> Function GetSpeakerConfig() As Integer
<PreserveSig> Function SetSpeakerConfig() As Integer
<PreserveSig> Function Initialize() As Integer
<PreserveSig> Function VerifyCertification() As Integer
End Interface
#End Region
#Region "Interface IDirectSoundBuffer"
<ComImport>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
<Guid(IID_IDirectSoundBuffer)>
Private Interface IDirectSoundBuffer
<PreserveSig> Function GetCaps() As Integer
<PreserveSig> Function GetCurrentPosition() As Integer
<PreserveSig> Function GetFormat() As Integer
<PreserveSig> Function GetVolume() As Integer
<PreserveSig> Function GetPan() As Integer
<PreserveSig> Function GetFrequency() As Integer
<PreserveSig> Function GetStatus(<Out> ByRef lpdwStatus As DSBSTATUS) As Integer
<PreserveSig> Function Initialize() As Integer
<PreserveSig> Function Lock(<[In]> dwOffset As Integer,
<[In]> dwBytes As Integer,
<Out> ByRef ppvAudioPtr1 As IntPtr,
<Out> ByRef pdwAudioBytes1 As Integer,
<Out> ByRef ppvAudioPtr2 As IntPtr,
<Out> ByRef pdwAudioBytes2 As Integer,
<[In]> dwFlags As DSBLOCK_FLAG) As Integer
<PreserveSig> Function Play(<[In]> dwReserved1 As Integer,
<[In]> dwReserved2 As Integer,
<[In]> dwFlags As DSBPLAY_FLAGS) As Integer
<PreserveSig> Function SetCurrentPosition(<[In]> dwNewPosition As Integer) As Integer
<PreserveSig> Function SetFormat(<[In]> ByRef pcfxFormat As WAVEFORMATEX) As Integer
<PreserveSig> Function SetVolume(<[In]> lVolume As Long) As Integer
<PreserveSig> Function SetPan(<[In]> lPan As Long) As Integer
<PreserveSig> Function SetFrequency(<[In]> dwFrequency As Integer) As Integer
<PreserveSig> Function [Stop]() As Integer
<PreserveSig> Function Unlock(<[In]> pvAudioPtr1 As IntPtr,
<[In]> dwAudioBytes1 As Integer,
<[In]> pvAudioPtr2 As IntPtr,
<[In]> dwAudioBytes2 As Integer) As Integer
<PreserveSig> Function Restore() As Integer
End Interface
#End Region
End Class

Denke das das ganze einfach zu verstehen ist. Für jede weitere Frequenz erzeugst Du einfach weitere Secundary DirectSoundBuffer per DirectSound8.CreateSoundBuffer, füllst diese mit Daten und DirectSoundBuffer.Play/Stop usw. Volume, Panning und Pitsch (SetFrequency) kannst Du vorher einstellen und auch wenn der DirectSoundBuffer abgespielt wird.

tron25 · 2. Juli 2024, 17:37

Vielen Dank für die Übersetzung.

Wenn ich etwas funktionierendes gebastelt habe, kann ich es ja hier reinsetzen.

Das wird aber etwas dauern. Ich muß zuerst den Text aufbereiten, beispielsweise die Zeilennummer und in jeder Zeile das Thema entfernen, dann in meine Oberfläche einbinden, den Code begreifen und etwas funktionierendes bauen.

-----

Inzwischen habe ich etwas mit Erfolg ausprobiert.

Ich habe die Funktion

VB.NET-Quellcode

Private Function StreamProcCallback(handle As Integer, buffer As IntPtr, length As Integer, user As IntPtr) As Integer

dupliziert. Jede dieser Funktionen erzeugt eine unterschiedliche Frequenz. Wenn ich nun beide aufrufe, höre ich auch zwei unterschiedliche Töne, so wie ich es eigentlich auch haben möchte. Allerdings weiß ich leider immer noch nicht, wie ich den Wert der Frequenz in eine Variable packen kann. An der Zahl klebt noch ein "D" und ich weiß nicht, wie ich solch eine Zahl generieren kann.

VB.NET-Quellcode

Dim waveFrequencyLeft As Double = 100D 'frequenz in Hz linker Kanal

Hat jemand eine Idee, wie solche Zahlen konvertiert bzw erzeugt werden?

RodFromGermany · 2. Juli 2024, 18:28

@tron25 So:

VB.NET-Quellcode

Dim waveFrequencyLeft As Double = 100

Das As Double und das D-Appendix sind redundant.
Wo liegt das Problem?

ErfinderDesRades · 2. Juli 2024, 19:08

Das D-Appendix ist für Decimal. Double hat # - aber wie gesagt: besser weglassen.

tron25 · 2. Juli 2024, 23:00

So, jetzt werden sich einige von euch die Hände beim Anblick des folgenden Codes über dem Kopf zusammenschlagen, aber es funktioniert.

VB.NET-Quellcode

Imports System.Runtime.InteropServices
Imports Un4seen.Bass
Public Class MultiBeepFormular
'handle für den audio stream
Private Links1StreamHandle As Integer = 0
Private Links2StreamHandle As Integer = 0
'STREAMPROC delegate, "zeigt" dann auf die angegebene Funktion die dann
'regelmäßig gecallt wird
Private Links1StreamProc As STREAMPROC
Private Links2StreamProc As STREAMPROC
Dim Links1Frequenz As Double = 100
Dim Links2Frequenz As Double = 1200
Dim Links1Lautstaerke As Double = 0.2
Dim Links2Lautstaerke As Double = 0.2
Dim Samplingrate As Double = 44100
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
End
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
If Not Bass.BASS_Init(-1, 44100, BASSInit.BASS_DEVICE_CPSPEAKERS, IntPtr.Zero) Then
MessageBox.Show($"BASS Initialisierungsfehler: { Bass.BASS_ErrorGetCode() }")
Application.Exit()
End If
End Sub
Private Function Links1TonErzeugen(handle As Integer, buffer As IntPtr, length As Integer, user As IntPtr) As Integer
'einen puffer anlegen um Daten aus und in den Speicher zu kopieren
Dim buff As Byte() = New Byte(length) {}
'die Daten aus dem Speicher in unseren Puffer kopieren, die Daten sind "stumm" weil nichts im Stream zum abspielen da ist
Marshal.Copy(buffer, buff, 0, length)
'die einzelnen Samples erstellen, jedes Sample besteht aus 8 Bytes, je 2 Singles(2x 4 Bytes), je einmal für links und einmal für rechts
For i As Integer = 0 To buff.Length - 9 Step 8
Dim Links As Single = CSng(Math.Sin(i / 8D * 2D * Math.PI * Links1Frequenz / Samplingrate) * Links1Lautstaerke)
Dim Rechts As Single = CSng(Math.Sin(i / 8D * 2D * Math.PI * 0 / Samplingrate) * 0)
'die bytes für den Puffer
Dim LinksBytes As Byte() = BitConverter.GetBytes(Links)
Dim RechtsBytes As Byte() = BitConverter.GetBytes(Rechts)
'die bytes in unseren Puffer kopieren
Array.Copy(LinksBytes, 0, buff, i, 4)
Array.Copy(RechtsBytes, 0, buff, i + 4, 4)
Next
'die Daten aus unseren Puffer in den Speicher kopieren, damit sie nun abgespielt werden können.
Marshal.Copy(buff, 0, buffer, length)
Return length
End Function
Private Function Links2TonErzeugen(handle As Integer, buffer As IntPtr, length As Integer, user As IntPtr) As Integer
'einen puffer anlegen um Daten aus und in den Speicher zu kopieren
Dim buff As Byte() = New Byte(length) {}
'die Daten aus dem Speicher in unseren Puffer kopieren, die Daten sind "stumm" weil nichts im Stream zum abspielen da ist
Marshal.Copy(buffer, buff, 0, length)
'die einzelnen Samples erstellen, jedes Sample besteht aus 8 Bytes, je 2 Singles(2x 4 Bytes), je einmal für links und einmal für rechts
For i As Integer = 0 To buff.Length - 9 Step 8
Dim Links As Single = CSng(Math.Sin(i / 8D * 2D * Math.PI * Links2Frequenz / Samplingrate) * Links2Lautstaerke)
Dim Rechts As Single = CSng(Math.Sin(i / 8D * 2D * Math.PI * 0 / Samplingrate) * 0)
'die bytes für den Puffer
Dim LinksBytes As Byte() = BitConverter.GetBytes(Links)
Dim RechtsBytes As Byte() = BitConverter.GetBytes(Rechts)
'die bytes in unseren Puffer kopieren
Array.Copy(LinksBytes, 0, buff, i, 4)
Array.Copy(RechtsBytes, 0, buff, i + 4, 4)
Next
'die Daten aus unseren Puffer in den Speicher kopieren, damit sie nun abgespielt werden können.
Marshal.Copy(buff, 0, buffer, length)
Return length
End Function
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Bass.BASS_ChannelStop(Links1StreamHandle)
Links1StreamProc = Nothing
Bass.BASS_StreamFree(Links1StreamHandle)
Bass.BASS_ChannelStop(Links2StreamHandle)
Links2StreamProc = Nothing
Bass.BASS_StreamFree(Links2StreamHandle)
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'neues STREAMPROC, "zeigt" auf die Sub StreamProcCallback
Links1StreamProc = New STREAMPROC(AddressOf Links1TonErzeugen)
Links2StreamProc = New STREAMPROC(AddressOf Links2TonErzeugen)
'das handle für den Stream erstellen
Links1StreamHandle = Bass.BASS_StreamCreate(CInt(Samplingrate), 2, BASSFlag.BASS_SAMPLE_FLOAT, Links1StreamProc, IntPtr.Zero)
Links2StreamHandle = Bass.BASS_StreamCreate(CInt(Samplingrate), 2, BASSFlag.BASS_SAMPLE_FLOAT, Links2StreamProc, IntPtr.Zero)
'den stream starten
Bass.BASS_ChannelPlay(Links1StreamHandle, False)
Bass.BASS_ChannelPlay(Links2StreamHandle, False)
End Sub
End Class

Wenn ich die Funktion für jeden Ton mit neuen Werten aufrufe, werden die Frequenzen nicht gleichzeitig abgespielt. Daher habe ich eine Funktion für jeden einzelnen Ton.
Ich werde das Ganze nun für 5 Töne auf jedem Ohr ausweiten.

ErfinderDesRades · 3. Juli 2024, 00:39

-Franky- schrieb:

Es ist mir schon klar das diese Webanwendungen für Dich ungeeignet sind.

Na, wenn das so ist, kann mein Werk ja doch noch was nütze sein.

rechts wählt man einen Output an.
Jeder Output hat zwei Akkorde (links, rechts)
Jeder Akkord hat keinen bis viele Töne, sowie eine Lautstärke.
Jeder Ton hat Frequenz und Lautstärken-Anteil.
Beachte die Warnung aus der Browser-App: Mit Kopfhörer kann man schon bei moderater Lautstärke bei höheren Frequenzen Hz sich das Ohr beschädigen.
Das ist tückisch: tiefe Töne muss man laut drehen, aber wenn man dann die Frequenz erhöht sollte man vorher die Lautstärke drastisch runterdrehen.

Und ich zumindest brauch die Anwendung garnet. Hier mein Browser-App-Tinnitus: MyTinnitus
Und solche Links kann man sich ja mehrere zurücklegen

tron25 · 3. Juli 2024, 17:10

Vielen Dank für dein Programm. Ich habe allerdings noch einige Schwierigkeiten, es zu öffnen.
Erst einmal kann ich keine Formularansicht aktivieren. Außerdem bekomme ich folgende Fehlermeldungen:

"JsonConvert" wurde nicht deklariert. Aufgrund der Schutzstufe ist unter Umständen kein Zugriff möglich. GeneralHelpers D:\Programmierung\Tinnitus08\_AllHelpers\GeneralHelpers\System\ObjectX.vb 11

"Formatting" wurde nicht deklariert. Aufgrund der Schutzstufe ist unter Umständen kein Zugriff möglich. GeneralHelpers D:\Programmierung\Tinnitus08\_AllHelpers\GeneralHelpers\System\ObjectX.vb 11

Die Datei "MyControls\CheckMenu.resx" konnte nicht verarbeitet werden, weil sie sich im Internet oder in der Zone eingeschränkter Websites befindet oder die Webmarkierung aufweist. Entfernen Sie die Webmarkierung, wenn Sie diese Dateien verarbeiten möchten. WinFormHelpers

(aktiv) BC2017 Bibliothek "D:\Programmierung\Tinnitus08\_AllHelpers\GeneralHelpers\bin\Debug\GeneralHelpersVb.dll" wurde nicht gefunden Tinnitus D:\Programmierung\Tinnitus08\Tinnitus\Tinnitus\vbc 1

(aktiv) BC2017 Bibliothek "D:\Programmierung\Tinnitus08\_AllHelpers\WinFormHelpers\bin\Debug\WinFormHelpers.dll" wurde nicht gefunden Tinnitus D:\Programmierung\Tinnitus08\Tinnitus\Tinnitus\vbc 1

Die Komponente "Newtonsoft.Json", auf die verwiesen wird, wurde nicht gefunden. GeneralHelpers

(aktiv) BC40056 Der in Imports "Newtonsoft.Json" angegebene Namespace oder Typ enthält keine öffentlichen Member oder kann nicht gefunden werden. Stellen Sie sicher, dass der Namespace oder der Typ definiert ist und mindestens einen öffentlichen Member enthält, und dass der importierte Elementname keine Aliase verwendet. GeneralHelpers D:\Programmierung\Tinnitus08\_AllHelpers\GeneralHelpers\System\ObjectX.vb 4

Hast du einen Tipp, woran es liegen könnte?

ErfinderDesRades · 3. Juli 2024, 20:30

.resx-Dateien werden bei entsprechender Sicherheits-Stufe vom System gesperrt. Da kannste im Explorer nach "*.resx" suchen, und bei allen gefundenen Dateien in den Datei-Eigenschaften iwas mit Internet und "zulassen" klicksen.
Der Json-Kram erfordert, dass du die Nuget-Packete refreshst.
(Allerdings zickt Nuget bei mir gerne herum. Alternativ kannste den Verweis auf NewtonSoft auch rauswerfen, und alle Codestellen löschen, wo iwas mit NewtonSoft und Json vorkommt - weil wird hier garnet gebraucht.)

Ich hoffe, dann gehts, und das andere seien nur FolgeFehler.

tron25 · 3. Juli 2024, 21:58

Den Internetzugriff habe ich bei allen .resx-Dateien angehakt. Dann habe ich auch den nuget-Verweis entfernt. Nun habe ich noch folgende Meldung:

System.BadImageFormatException
HResult=0x8007000B
Nachricht = Es wurde versucht, eine Datei mit einem falschen Format zu laden. (Ausnahme von HRESULT: 0x8007000B)
Quelle = ManagedBass
Stapelüberwachung:
bei ManagedBass.Bass.Init(Int32 Device, Int32 Frequency, DeviceInitFlags Flags, IntPtr Win, IntPtr ClsID)
bei Tinnitus.Program.Main(String[] args) in D:\Programmierung\Tinnitus08\Tinnitus\Tinnitus\Program.vb: Zeile28

Wie kann ich dieses Problem noch lösen?

ErfinderDesRades · 3. Juli 2024, 22:18

da hast du wohl die falsche bass.dll in deim bin\debug - Ordner.
Ich hab die bass.dll ja per Nuget "installiert", und dabei ist auch ein "Native"-Ordner mitgekommen,und aus dem muss die bass.dll kommen.
Bei mir ist das: "...\Tinnitus\packages\BASS.Native.2.4.13.10\build\native\x64\bass.dll"
Die ist 250Kb gross.

Mehrere Töne gleichzeitig abspielen

Haudruferzappeltnoch schrieb:

VB.NET-Quellcode

ErfinderDesRades schrieb:

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

-Franky- schrieb:

Tags

Ähnliche Themen

6 Benutzer haben hier geschrieben