Volumeregeling voor opnemen onder VB: hoe?

[Verwijderd]

Weet iemand hoe ik onder Visual Basic 6 het opneemgedeelte van de volumeregeling van Windows kan aansturen? Het enige wat ik wil is de line in van de geluidskaart (die als recording device ge"select" staat) aan en uit zetten vanuit VB. Ik heb heel MSDN van Microsoft al afgestruind, maar ik kom alleen maar uit op één website waar staat hoe het zou moeten, en daar is geen sample project te vinden, alleen maar een lange tekst waar ik geen wijs uit kan.

Wie o wie?

[Super_ik]

ook gezocht op sites waar sources worden aangeboden van allerhande programma's
met google zijn deze sites makkelijk te vinden. dan staat er op de site meestal wel een vaag progje waarin zit wat jij wil en kun je t eruit halen

[MissingDog]

kan je niet iets met DirectSound doen? Er zijn hier vast wel samples en uitleg over.

Of kijk eens in de Win32 API, staat ook genoeg in denk ik, zal even kijken of ik zo 123 een voorbeeld kan vinden hier.

code:

'This project needs a module and a form
'The form must contain two labels, two progressbars, a timer and a checkbox

'Paste this code into the form
Dim hmixer As Long                  ' mixer handle
Dim inputVolCtrl As MIXERCONTROL    ' waveout volume control
Dim outputVolCtrl As MIXERCONTROL   ' microphone volume control
Dim rc As Long                      ' return code
Dim ok As Boolean                   ' boolean return code

Dim mxcd As MIXERCONTROLDETAILS         ' control info
Dim vol As MIXERCONTROLDETAILS_SIGNED   ' control's signed value
Dim volume As Long                      ' volume value
Dim volHmem As Long                     ' handle to volume memory
Private Sub Form_Load()
   'KPD-Team 1999
   'URL: http://www.allapi.net/
   'E-Mail: [e-mail]
   Me.ScaleMode = vbTwips
   Me.Caption = "Volume meter"
   Label1.Move 0, 0
   Label1.AutoSize = True
   Label1.Caption = "Input level"
   Label2.Move 0, 4 * Label1.Height
   Label2.AutoSize = True
   Label2.Caption = "Output level"
   ProgressBar1.Move Label1.Width * 2, 0, 3375
   ProgressBar2.Move Label1.Width * 2, Label2.Top, 3375
   Check1.Move ProgressBar1.Left, ProgressBar1.Height
   Check1.Caption = "Get Input"
   Me.Move Me.Left, Me.Top, ProgressBar1.Width + ProgressBar1.Left + 10 * Screen.TwipsPerPixelX, ProgressBar2.Top + ProgressBar2.Height + 30 * Screen.TwipsPerPixelY
   Timer1.Interval = 50
   Timer1.Enabled = True

   ' Open the mixer specified by DEVICEID
   rc = mixerOpen(hmixer, DEVICEID, 0, 0, 0)

   If ((MMSYSERR_NOERROR <> rc)) Then
       MsgBox "Couldn't open the mixer."
       Exit Sub
   End If

   ' Get the input volume meter
   ok = GetControl(hmixer, MIXERLINE_COMPONENTTYPE_DST_WAVEIN, MIXERCONTROL_CONTROLTYPE_PEAKMETER, inputVolCtrl)

   If (ok <> True) Then
       ok = GetControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, MIXERCONTROL_CONTROLTYPE_PEAKMETER, inputVolCtrl)
   End If

   If (ok = True) Then
      ProgressBar1.Min = 0
      ProgressBar1.Max = inputVolCtrl.lMaximum
   Else
      ProgressBar1.Enabled = False
      MsgBox "Couldn't get wavein meter"
   End If

   ' Get the output volume meter
   ok = GetControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT, MIXERCONTROL_CONTROLTYPE_PEAKMETER, outputVolCtrl)

   If (ok = True) Then
      ProgressBar2.Min = 0
      ProgressBar2.Max = outputVolCtrl.lMaximum
   Else
      ProgressBar2.Enabled = False
      MsgBox "Couldn't get waveout meter"
   End If

   ' Initialize mixercontrol structure
   mxcd.cbStruct = Len(mxcd)
   volHmem = GlobalAlloc(&H0, Len(volume))  ' Allocate a buffer for the volume value
   mxcd.paDetails = GlobalLock(volHmem)
   mxcd.cbDetails = Len(volume)
   mxcd.cChannels = 1

End Sub
Private Sub Check1_Click()
   If (Check1.Value = 1) Then
      StartInput  ' Start receiving audio input
   Else
      StopInput   ' Stop receiving audio input
   End If
End Sub
Private Sub Timer1_Timer()

   On Error Resume Next

   ' Process sound buffer if recording
   If (fRecording) Then
      For i = 0 To (NUM_BUFFERS - 1)
         If inHdr(i).dwFlags And WHDR_DONE Then
            rc = waveInAddBuffer(hWaveIn, inHdr(i), Len(inHdr(i)))
         End If
      Next
   End If

   ' Get the current input level
   If (ProgressBar1.Enabled = True) Then
      mxcd.dwControlID = inputVolCtrl.dwControlID
      mxcd.item = inputVolCtrl.cMultipleItems
      rc = mixerGetControlDetails(hmixer, mxcd, MIXER_GETCONTROLDETAILSF_VALUE)
      CopyStructFromPtr volume, mxcd.paDetails, Len(volume)
      If (volume < 0) Then
         volume = -volume
         End If
      ProgressBar1.Value = volume
   End If

   ' Get the current output level
   If (ProgressBar2.Enabled = True) Then
      mxcd.dwControlID = outputVolCtrl.dwControlID
      mxcd.item = outputVolCtrl.cMultipleItems
      rc = mixerGetControlDetails(hmixer, mxcd, MIXER_GETCONTROLDETAILSF_VALUE)
      CopyStructFromPtr volume, mxcd.paDetails, Len(volume)

      If (volume < 0) Then volume = -volume

      ProgressBar2.Value = volume
   End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
   If (fRecording = True) Then
       StopInput
   End If
   GlobalFree volHmem
End Sub

'Paste this code into the module
Public Const CALLBACK_FUNCTION = &H30000
Public Const MM_WIM_DATA = &H3C0
Public Const WHDR_DONE = &H1         '  done bit
Public Const GMEM_FIXED = &H0         ' Global Memory Flag used by GlobalAlloc functin

Type WAVEHDR
   lpData As Long
   dwBufferLength As Long
   dwBytesRecorded As Long
   dwUser As Long
   dwFlags As Long
   dwLoops As Long
   lpNext As Long
   Reserved As Long
End Type
Type WAVEINCAPS
   wMid As Integer
   wPid As Integer
   vDriverVersion As Long
   szPname As String * 32
   dwFormats As Long
   wChannels As Integer
End Type
Type WAVEFORMAT
   wFormatTag As Integer
   nChannels As Integer
   nSamplesPerSec As Long
   nAvgBytesPerSec As Long
   nBlockAlign As Integer
   wBitsPerSample As Integer
   cbSize As Integer
End Type

Declare Function waveInOpen Lib "winmm.dll" (lphWaveIn As Long, ByVal uDeviceID As Long, lpFormat As WAVEFORMAT, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Declare Function waveInPrepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function waveInReset Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveInStart Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveInStop Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveInUnprepareHeader Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long
Declare Function waveInClose Lib "winmm.dll" (ByVal hWaveIn As Long) As Long
Declare Function waveInGetDevCaps Lib "winmm.dll" Alias "waveInGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As WAVEINCAPS, ByVal uSize As Long) As Long
Declare Function waveInGetNumDevs Lib "winmm.dll" () As Long
Declare Function waveInGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As Long
Declare Function waveInAddBuffer Lib "winmm.dll" (ByVal hWaveIn As Long, lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long

Public Const MMSYSERR_NOERROR = 0
Public Const MAXPNAMELEN = 32

Public Const MIXER_LONG_NAME_CHARS = 64
Public Const MIXER_SHORT_NAME_CHARS = 16
Public Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Public Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
Public Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&

Public Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Public Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000&
Public Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
Public Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3)
Public Const MIXERLINE_COMPONENTTYPE_SRC_LINE = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2)

Public Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
Public Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
Public Const MIXERCONTROL_CT_UNITS_SIGNED = &H20000
Public Const MIXERCONTROL_CT_CLASS_METER = &H10000000
Public Const MIXERCONTROL_CT_SC_METER_POLLED = &H0&
Public Const MIXERCONTROL_CONTROLTYPE_FADER = (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)
Public Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)
Public Const MIXERLINE_COMPONENTTYPE_DST_WAVEIN = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 7)
Public Const MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 8)
Public Const MIXERCONTROL_CONTROLTYPE_SIGNEDMETER = (MIXERCONTROL_CT_CLASS_METER Or MIXERCONTROL_CT_SC_METER_POLLED Or MIXERCONTROL_CT_UNITS_SIGNED)
Public Const MIXERCONTROL_CONTROLTYPE_PEAKMETER = (MIXERCONTROL_CONTROLTYPE_SIGNEDMETER + 1)

Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long
Declare Function mixerGetControlDetails Lib "winmm.dll" Alias "mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Declare Function mixerGetDevCaps Lib "winmm.dll" Alias "mixerGetDevCapsA" (ByVal uMxId As Long, ByVal pmxcaps As MIXERCAPS, ByVal cbmxcaps As Long) As Long
Declare Function mixerGetID Lib "winmm.dll" (ByVal hmxobj As Long, pumxID As Long, ByVal fdwId As Long) As Long
Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
Declare Function mixerGetLineControls Lib "winmm.dll" Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long
Declare Function mixerMessage Lib "winmm.dll" (ByVal hmx As Long, ByVal uMsg As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long) As Long
Declare Function mixerOpen Lib "winmm.dll" (phmx As Long, ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal fdwOpen As Long) As Long
Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long

Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long

Type MIXERCAPS
   wMid As Integer
   wPid As Integer
   vDriverVersion As Long
   szPname As String * MAXPNAMELEN
   fdwSupport As Long
   cDestinations As Long
End Type
Type MIXERCONTROL
   cbStruct As Long
   dwControlID As Long
   dwControlType As Long
   fdwControl As Long
   cMultipleItems As Long
   szShortName As String * MIXER_SHORT_NAME_CHARS
   szName As String * MIXER_LONG_NAME_CHARS
   lMinimum As Long
   lMaximum As Long
   Reserved(10) As Long
End Type
Type MIXERCONTROLDETAILS
   cbStruct As Long
   dwControlID As Long
   cChannels As Long
   item As Long
   cbDetails As Long
   paDetails As Long
End Type
Type MIXERCONTROLDETAILS_SIGNED
   lValue As Long
End Type
Type MIXERLINE
   cbStruct As Long
   dwDestination As Long
   dwSource As Long
   dwLineID As Long
   fdwLine As Long
   dwUser As Long
   dwComponentType As Long
   cChannels As Long
   cConnections As Long
   cControls As Long
   szShortName As String * MIXER_SHORT_NAME_CHARS
   szName As String * MIXER_LONG_NAME_CHARS
   dwType As Long
   dwDeviceID As Long
   wMid  As Integer
   wPid As Integer
   vDriverVersion As Long
   szPname As String * MAXPNAMELEN
End Type
Type MIXERLINECONTROLS
   cbStruct As Long
   dwLineID As Long
   dwControl As Long
   cControls As Long
   cbmxctrl As Long
   pamxctrl As Long
End Type

Public i As Integer, j As Integer, rc As Long, msg As String * 200, hWaveIn As Long
Public Const NUM_BUFFERS = 2
Public format As WAVEFORMAT, hmem(NUM_BUFFERS) As Long, inHdr(NUM_BUFFERS) As WAVEHDR
Public Const BUFFER_SIZE = 8192
Public Const DEVICEID = 0
Public fRecording As Boolean
Function GetControl(ByVal hmixer As Long, ByVal componentType As Long, ByVal ctrlType As Long, ByRef mxc As MIXERCONTROL) As Boolean
' This function attempts to obtain a mixer control. Returns True if successful.

   Dim mxlc As MIXERLINECONTROLS
   Dim mxl As MIXERLINE
   Dim hmem As Long
   Dim rc As Long

   mxl.cbStruct = Len(mxl)
   mxl.dwComponentType = componentType

   ' Obtain a line corresponding to the component type
   rc = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)

   If (MMSYSERR_NOERROR = rc) Then
      mxlc.cbStruct = Len(mxlc)
      mxlc.dwLineID = mxl.dwLineID
      mxlc.dwControl = ctrlType
      mxlc.cControls = 1
      mxlc.cbmxctrl = Len(mxc)

      ' Allocate a buffer for the control
      'hmem = GlobalAlloc(&H40, Len(mxc))
      hmem = GlobalAlloc(GMEM_FIXED, Len(mxc))
      mxlc.pamxctrl = GlobalLock(hmem)
      mxc.cbStruct = Len(mxc)

      ' Get the control
      rc = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)

      If (MMSYSERR_NOERROR = rc) Then
         GetControl = True

         ' Copy the control into the destination structure
         CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
      Else
         GetControl = False
      End If
      GlobalFree (hmem)
      Exit Function
   End If

   GetControl = False
End Function
' Function to process the wave recording notifications.
Sub waveInProc(ByVal hwi As Long, ByVal uMsg As Long, ByVal dwInstance As Long, ByRef hdr As WAVEHDR, ByVal dwParam2 As Long)
   If (uMsg = MM_WIM_DATA) Then
      If fRecording Then
         rc = waveInAddBuffer(hwi, hdr, Len(hdr))
      End If
   End If
End Sub
' This function starts recording from the soundcard. The soundcard must be recording in order to
' monitor the input level. Without starting the recording from this application, input level
' can still be monitored if another application is recording audio
Function StartInput() As Boolean

    If fRecording Then
        StartInput = True
        Exit Function
    End If

    format.wFormatTag = 1
    format.nChannels = 1
    format.wBitsPerSample = 8
    format.nSamplesPerSec = 8000
    format.nBlockAlign = format.nChannels * format.wBitsPerSample / 8
    format.nAvgBytesPerSec = format.nSamplesPerSec * format.nBlockAlign
    format.cbSize = 0

    For i = 0 To NUM_BUFFERS - 1
        hmem(i) = GlobalAlloc(&H40, BUFFER_SIZE)
        inHdr(i).lpData = GlobalLock(hmem(i))
        inHdr(i).dwBufferLength = BUFFER_SIZE
        inHdr(i).dwFlags = 0
        inHdr(i).dwLoops = 0
    Next

    rc = waveInOpen(hWaveIn, DEVICEID, format, 0, 0, 0)
    If rc <> 0 Then
        waveInGetErrorText rc, msg, Len(msg)
        MsgBox msg
        StartInput = False
        Exit Function
    End If

    For i = 0 To NUM_BUFFERS - 1
        rc = waveInPrepareHeader(hWaveIn, inHdr(i), Len(inHdr(i)))
        If (rc <> 0) Then
            waveInGetErrorText rc, msg, Len(msg)
            MsgBox msg
        End If
    Next

    For i = 0 To NUM_BUFFERS - 1
        rc = waveInAddBuffer(hWaveIn, inHdr(i), Len(inHdr(i)))
        If (rc <> 0) Then
            waveInGetErrorText rc, msg, Len(msg)
            MsgBox msg
        End If
    Next

    fRecording = True
    rc = waveInStart(hWaveIn)
    StartInput = True
End Function
' Stop receiving audio input on the soundcard
Sub StopInput()

    fRecording = False
    waveInReset hWaveIn
    waveInStop hWaveIn
    For i = 0 To NUM_BUFFERS - 1
        waveInUnprepareHeader hWaveIn, inHdr(i), Len(inHdr(i))
        GlobalFree hmem(i)
    Next
    waveInClose hWaveIn
End Sub

Bron: AllAPI.net API-Guide 3.6 (helaas niet langer in ontwikkeling)

[ Voor 212% gewijzigd door MissingDog op 12-05-2003 20:43 ]

[Verwijderd]

Ik kan weinig bruikbare voorbeelden vinden helaas .

[Verwijderd]

MissingDog schreef op 12 May 2003 @ 20:35:

code:

'Example submitted by Danjel Nyberg
'It needs a textbox (Text1) and two command buttons (Command1, Command2)
Private Declare Function waveOutSetVolume Lib "Winmm" (ByVal wDeviceID As Integer, ByVal dwVolume As Long) As Integer
Private Declare Function waveOutGetVolume Lib "Winmm" (ByVal wDeviceID As Integer, dwVolume As Long) As Integer
Private Sub Command1_Click()
    Dim a, i As Long
    Dim tmp As String
    a = waveOutGetVolume(0, i)
    tmp = "&h" & Right(Hex$(i), 4)
    Text1 = CLng(tmp)
End Sub
Private Sub Command2_Click()
    Dim a, i As Long
    Dim tmp, vol As String
    vol = Text1
    tmp = Right((Hex$(vol + 65536)), 4)
    vol = CLng("&H" & tmp & tmp)
    a = waveOutSetVolume(0, vol)
End Sub

Dat is alleen voor de playback van de volumeregeling. Ik ben op zoek naar iets voor de schuiven in het "opneem" (ofwel "record") gedeelte van de volumeregeling.

[MissingDog]

Om mijzelf ff te quoten uit dat lange verhaal:

'This project needs a module and a form
'The form must contain two labels, two progressbars, a timer and a checkbox

'Paste this code into the form
Dim hmixer As Long ' mixer handle
Dim inputVolCtrl As MIXERCONTROL ' waveout volume control
Dim outputVolCtrl As MIXERCONTROL ' microphone volume control
Dim rc As Long ' return code
Dim ok As Boolean ' boolean return code

[Verwijderd]

Dat regelt volgens mij niet de recording, alleen de playback van de microfoon.

[MissingDog]

Ik gaat weer ff verder zoeken voor u en ook even VB6 installen, kijken of ik er ff snel iets uit kan gooien met directsound, weet dat het wel kan in elk geval.

[Verwijderd]

Graag.

<edit>
Het gaat er dus puur om dat ik de schuif van de line in van de geluidskaart voor het OPNEMEN van geluid in zijn geheel open en dicht kan zetten.
</edit>

[ Voor 94% gewijzigd door Verwijderd op 12-05-2003 20:51 ]

[Verwijderd]

Als ik het te gebruiken recording device kan veranderen is het natuurlijk ook goed, het gaat er maar om dat er via de line in niks opgenomen wordt...

[MissingDog]

probeer anders deze ActiveX control eens, gevonden via Google

http://www.downlinx.com/proghtml/187/18769.htm

[Verwijderd]

We zijn er uit. Bedankt!

[MissingDog]

Verwijderd schreef op 12 May 2003 @ 22:35:
We zijn er uit. Bedankt!

Hoe heb je het uiteindelijk voor elkaar gekregen?

[Verwijderd]

MissingDog schreef op 12 May 2003 @ 22:37:
[...]
Hoe heb je het uiteindelijk voor elkaar gekregen?

Dat is een heel verhaal. Uiteindelijk hebben we m.b.v. de sGuard OCX-control een lijstje van "opneem"-apparaten op het scherm getoverd in ons programma. Daarna kun je er eentje door de gebruiker laten kiezen. Je kunt dan de "line id" uitlezen (dit zijn erg wazige, grote, niet-opvolgende getallen), en daarvan het volume instellen.

Tot overmaat van ramp kwamen we er achter dat het apparaat wat aan de line in van de geluidskaart hangt ook d.m.v. een +5V spanning te "muten" was.

Anyway, toch bedankt!