Results 1 to 3 of 3

Thread: Controling volume in VB?

  1. #1

    Thread Starter
    New Member
    Join Date
    Nov 1999
    Posts
    2

    Post

    Does anyone know how to change or control the system's volume with code? Withou having to open the volume control window, i'd like to raise or lower thevolume of the system, or even better of each individual device (CD Audio, Wav, MIDI etc..)

  2. #2
    Hyperactive Member
    Join Date
    Sep 1999
    Posts
    305

    Post

    It took me a long time to get this, but here it is for you. It's probably a little confusing, so if you have any problems, email me. First put the stuff in the module and form and mess with it. You should catch on to it.

    Good luck
    bob
    bobbaddeley@hotmail.com

    Put this in a module. Where it says Public Const MIXERLINE_COMPONENTTYPE_SRC_something =(MIXERLINE_COMPONENTTYPE_SRC_FIRST + a number) feel free to put in whatever you want to make it work. you'll have to fiddle with them to get the particular things you want changed to change.
    Option Explicit
    Public hmem 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_SETCONTROLDETAILSF_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 MIXERLINE_COMPONENTTYPE_SRC_CD = _
    (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 5)
    Public Const MIXERLINE_COMPONENTTYPE_SRC_PC = _
    (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 10)
    Public Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
    Public Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
    Public Const MIXERCONTROL_CONTROLTYPE_FADER = _
    (MIXERCONTROL_CT_CLASS_FADER Or _
    MIXERCONTROL_CT_UNITS_UNSIGNED)
    Public Const MIXERCONTROL_CONTROLTYPE_VOLUME = _
    (MIXERCONTROL_CONTROLTYPE_FADER + 1)

    Public Type MIXERCONTROLDETAILS
    cbStruct As Long
    dwControlID As Long
    cChannels As Long
    item As Long
    cbDetails As Long
    paDetails As Long
    End Type

    Public Type MIXERCONTROLDETAILS_UNSIGNED
    dwValue As Long
    End Type

    Public 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

    Public Type MIXERLINECONTROLS
    cbStruct As Long
    dwLineID As Long
    dwControl As Long
    cControls As Long
    cbmxctrl As Long
    pamxctrl As Long
    End Type

    Public 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
    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
    Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" _
    (ByVal ptr As Long, struct As Any, ByVal cb As Long)
    Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" _
    (struct As Any, ByVal ptr As Long, ByVal cb 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 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

    Public lFlags As Long
    Public lDeviceID As Long

    Public Declare Function mciSendCommand Lib "winmm.dll" _
    Alias "mciSendCommandA" (ByVal wDeviceID As Long, _
    ByVal uMessage As Long, ByVal dwParam1 As Long, _
    ByRef dwParam2 As Any) As Long

    Public Declare Function mciGetErrorString Lib "winmm.dll" _
    Alias "mciGetErrorStringA" (ByVal dwError As Long, _
    ByVal lpstrBuffer As String, _
    ByVal uLength As Long) As Long

    Public Function fGetVolumeControl(ByVal hmixer As Long, _
    ByVal componentType As Long, ByVal ctrlType As Long, _
    ByRef mxc As MIXERCONTROL) As Boolean
    Dim mxlc As MIXERLINECONTROLS
    Dim mxl As MIXERLINE
    Dim hmem As Long
    Dim rc As Long

    mxl.cbStruct = Len(mxl)
    mxl.dwComponentType = componentType
    rc = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)
    If MMSYSERR_NOERROR = rc Then
    With mxlc
    .cbStruct = Len(mxlc)
    .dwLineID = mxl.dwLineID
    .dwControl = ctrlType
    .cControls = 1
    .cbmxctrl = Len(mxc)
    End With
    hmem = GlobalAlloc(&H40, Len(mxc))
    mxlc.pamxctrl = GlobalLock(hmem)
    mxc.cbStruct = Len(mxc)
    rc = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)
    If MMSYSERR_NOERROR = rc Then
    fGetVolumeControl = True
    Call CopyStructFromPtr(mxc, mxlc.pamxctrl, Len(mxc))
    Else
    fGetVolumeControl = False
    End If
    Call GlobalFree(hmem)
    Exit Function
    End If
    fGetVolumeControl = False
    End Function

    Put this in the form code with 5 scroll bars; one for main volume, mic, line, pc, and CD.

    Option Explicit
    Dim hmixer As Long
    Dim volCtrl As MIXERCONTROL

    Private Function fSetVolumeControl(ByVal hmixer As Long, _
    mxc As MIXERCONTROL, ByVal volume As Long) As Boolean
    Dim rc As Long
    Dim mxcd As MIXERCONTROLDETAILS
    Dim vol As MIXERCONTROLDETAILS_UNSIGNED
    With mxcd
    .item = 0
    .dwControlID = mxc.dwControlID
    .cbStruct = Len(mxcd)
    .cbDetails = Len(vol)
    End With
    hmem = GlobalAlloc(&H40, Len(vol))
    mxcd.paDetails = GlobalLock(hmem)
    mxcd.cChannels = 1
    vol.dwValue = volume
    Call CopyPtrFromStruct(mxcd.paDetails, vol, Len(vol))
    rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
    Call GlobalFree(hmem)

    If MMSYSERR_NOERROR = rc Then
    fSetVolumeControl = True
    Else
    fSetVolumeControl = False
    End If
    End Function

    Private Sub vScroll1_Change()
    Dim lVol As Long
    Dim bOK As Integer
    bOK = fGetVolumeControl(hmixer, _
    MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
    MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)
    lVol = CLng(VScroll1.Value) * 2
    Call fSetVolumeControl(hmixer, volCtrl, lVol)
    End Sub

    Private Sub vScroll1_Scroll()
    Dim lVol As Long
    Dim bOK As Integer
    bOK = fGetVolumeControl(hmixer, _
    MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
    MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)
    lVol = CLng(VScroll1.Value) * 2
    Call fSetVolumeControl(hmixer, volCtrl, lVol)
    End Sub

    Private Sub vScroll2_Change()
    Dim lVol As Long
    Dim bOK As Integer
    bOK = fGetVolumeControl(hmixer, _
    MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, _

  3. #3
    Junior Member
    Join Date
    Jan 1999
    Posts
    26

    Post


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width