Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Volume Control Component

Status
Not open for further replies.
Modex

Modex

Programmer
Joined
Sep 15, 2002
Messages
155
Location
GB
Hi all,

Does anyone know of an Active X or some other type of control that can go onto an ACCESS 2000 form that would allow the user to raise and lower the volume of music playing.

I know you can click on the speaker icon in the taskbar, but for asthetics I would like a control on a form.

Any ideas?

Many thanks


ModeX
 
Sort by date Sort by votes
How are ya Modex . . . . .

Have a look at ActiveX Volume Control, look for Volume.zip down the right side.

Its a good control, just not free! . . . you can test the sample to see if you like it!

It puts an non-visible control on the form. You can control both Left/Right channels. I used it on an application some time ago, and used the Slider AxtiveX control to manipulate it.

Curious though . . . . are users so lazy they just can't adjust the speaker volume?

Calvin.gif
See Ya! . . . . . .
 
Upvote 0 Downvote
Hi Ya Aceman1,

Thanks for the info, I did have a look at this and it looks pretty good, however I only really wanted a very simple little slider to go on the form and as its just a personal project, I really dont want to shell out $40.00 for a whim.

I suppose I'll have to continue to search the web and maybe a little freebie active X component may be lurking somewhere.

But, having said that, thanks for your pointer, much appreciated

Cheers

ModeX
 
Upvote 0 Downvote
Microsoft exposed the mixer component in the winmm.dll, which can be coded using the API. It's not a simple API to manipulate, and most of the examples floating around the Web are written in C because of the need to pass structure pointers in the API calls. I did some research into the possibility of writing a simple wrapper class that could manipulate the mixer component because I have a project that incorporates music and I was curious how difficult it would be.

I wouldn't spend $40 bucks on a control...but I would spend 2 days writing code [lol]. I wrote a simple class module that can be used to work with the mixer from an Access form. I only implemented the ability to set/get the master volume, get/set the balance of the master volume, and toggle the mute for the master volume. I'm not sure whether the class will work as-is with the other mixer controls, but that's another project. I tested the code on a WinXP Pro box running Access 2000.

First I'll post the class module and then the form code I used to instantiate the class:
Code: 
[green]'@--------------------------------------------------------------@
'@
'@  §lamKeys §oftware 2005® (VBSlammer)
'@
'@              :
'@  @FILENAME   :   -clsMixer.cls
'@  @CREATED    :   -2/13/2005 8:34:06 PM
'@  @PURPOSE    :   -Select different mixer control types
'@              :   -Set Mode: Real or Percentage
'@              :   -Get control and channel names
'@              :   -Set / Get master volume or balance volumes
'@              :   -Toggle Mute settings
'@              :
'@  @USAGE      :   Dim mMixer As New clsMixer
'@              :   mMixer.ModeType = PercentageMode
'@              :
'@              :   With mMixer
'@              :     If (.SelectMixerControl(SpeakersOut, Volume) = True) Then
'@              :         ' uniform method
'@              :       .VolumeLevel = 90
'@              :         
'@              :       .GetChannelVolumes()
'@              :
'@              :       Debug.Print "L=" & .LeftChannelVolume
'@              :       Debug.Print "R=" & .RightChannelVolume
'@              :         ' balance method
'@              :       .SetChannelVolumes 100, 40
'@              :     End If
'@              :     If (.SelectMixerControl(SpeakersOut, Mute) = True) Then
'@              :       .SetMute True
'@              :     End If
'@              :   End With
'@              :
'@              :
'@  @REFERENCES :   -winmm.dll (win32 system library).
'@              :
'@  @NOTES      :   -ComponentTypes enum exposes objects not tested or
'@              :   -implemented in this module.
'@              :
'@  @NOTICE     :   -Open Source for public use - no warranty implied.
'@              :   -Include this header with distributed source.
'@              :
'@--------------------------------------------------------------@[/green]

Option Compare Database
Option Explicit

[green]'@---------------------- API FUNCTIONS -------------------------@[/green]

Private 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
Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias _
    "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, _
    ByVal fdwInfo As Long) As Long
Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias _
    "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, _
    ByVal fdwControls As Long) As Long
Private Declare Function mixerGetControlDetails Lib "winmm.dll" Alias _
    "mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, _
    ByVal fdwDetails As Long) As Long
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj _
    As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Private Declare Function mixerClose Lib "winmm.dll" (ByVal hmx As Long) As Long

[green]'@---------------------- ENUMERATIONS -------------------------@[/green]

Public Enum MixerConstants
  ErrorSuccess = &H0
  MaxPtrNameLength = &H20
  LongNameChars = &H40
  ShortNameChars = &H10
  GetLineInfoComponentType = &H3&
  GetLineControlsOneByType = &H2&
  ControlUniform = &H1&
  SetControlDetailsValue = &H0&
  GetControlDetailsValue = &H0&
  ClassFader = &H50000000
  UnitsUnsigned = &H30000
  MctFader = &H50030000
  ClassSwitch = &H20000000
  UnitsBoolean = &H10000
  MctBoolean = &H20010000
  ObjectHmixer = &H80000000
End Enum

Public Enum MixerErrors
  ErrorBase = &H400
  InvalidControl = &H401
  InvalidLine = &H400
  InvalidValue = &H402
  LastError = &H402
End Enum

Public Enum ComponentTypes
  DigitalOut = &H1
  LineOut = &H2
  MonitorOut = &H3
  SpeakersOut = &H4
  HeadphonesOut = &H5
  TelephoneOut = &H6
  WaveOut = &H7
  VoiceInOut = &H8
  DigitalIn = &H1001
  LineIn = &H1002
  MicrophoneIn = &H1003
  SynthesizerIn = &H1004
  CompactDiscIn = &H1005
  TelephoneIn = &H1006
  PCSpeakerIn = &H1007
  WaveIn = &H1008
  AuxiliaryIn = &H1009
  AnalogIn = &H100A
End Enum

Public Enum SoundControls
  Loudness = &H20010004
  Mute = &H20010002
  StereoEnhance = &H20010005
  Mono = &H20010003
  Pan = &H40020001
  Fader = &H50030000
  Volume = &H50030001
  Bass = &H50030002
  Treble = &H50030003
  Equalizer = &H50030004
End Enum

Public Enum ClassErrors
  InvalidOperation = &H9
  InvalidVolume = &H10
  MixerNotFound = &H100
  NoGetVolume = &H101
  NoControlDetails = &H102
  NoLineControls = &H103
  NoLineInfo = &H104
  NoSetVolume = &H105
  Not2Channels = &H106
End Enum

Public Enum CompareResults
  LeftIsLarger = &H1
  RightIsLarger = &H2
  BothEqual = &H3
End Enum

Public Enum ModeTypes
  RealMode = &H1
  PercentageMode = &H2
End Enum

[green]'@-------------------------- TYPES -----------------------------@[/green]

Private Type CLASSERRORSTRINGS
  InvalidOperation As String
  InvalidVolume As String
  MixerNotFound As String
  NoGetVolume As String
  NoControlDetails As String
  NoLineControls As String
  NoLineInfo As String
  NoSetVolume As String
  Not2Channels As String
End Type

Private 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(1 To ShortNameChars) As Byte
  szName(1 To LongNameChars) As Byte
  dwType As Long
  dwDeviceID As Long
  wMid  As Integer
  wPid As Integer
  vDriverVersion As Long
  szPname(1 To MaxPtrNameLength) As Byte
End Type

Private Type MIXERCONTROL
  cbStruct As Long
  dwControlID As Long
  dwControlType As Long
  fdwControl As Long
  cMultipleItems As Long
  szShortName(1 To ShortNameChars) As Byte
  szName(1 To LongNameChars) As Byte
  Bounds(1 To 6) As Long
  Metrics(1 To 6) As Long
End Type

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

Private Type MIXERCONTROLDETAILS_UNSIGNED
  dwValue As Long
End Type

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

[green]'@------------------------- EVENTS -----------------------------@[/green]

Public Event ErrorOccurred(ByVal ErrNum As ClassErrors, ByVal strMessage As String)
Public Event ValueChanged(ByVal NewValue As Long, ByVal strChannel As String)
Public Event BalanceChanged(ByVal LeftChannel As Long, ByVal RightChannel As Long)

[green]'@------------------------ VARIABLES ---------------------------@[/green]

Private mlngMixer As Long
Private mMixerControl As MIXERCONTROL
Private mMixerControlDetails As MIXERCONTROLDETAILS
Private mMixerLineControls As MIXERLINECONTROLS
Private mMixerLine As MIXERLINE
Private mErrorStrings As CLASSERRORSTRINGS
Private mModeType As ModeTypes
Private mlngValue As Long
Private mlngLeftValue As Long
Private mlngRightValue As Long
Private mlngMinValue As Long
Private mlngMaxValue As Long
Private mlngSteps As Long
Private mstrChannelName As String
Private mstrControlName As String

[green]'@----------------------- CONSTRUCTOR --------------------------@[/green]

Private Sub Class_Initialize()
  With mErrorStrings
    .InvalidOperation = "The requested operation is invalid for requested component"
    .InvalidVolume = "Volume level must be set between {%1} and {%2}"
    .MixerNotFound = "Could not initialize the mixer control"
    .NoGetVolume = "Could not retrieve the current volume setting"
    .NoControlDetails = "Could not retrieve control details"
    .NoLineControls = "Could not retrieve line controls for requested component"
    .NoLineInfo = "Could not get line info for requested component"
    .NoSetVolume = "Could not set the volume level"
    .Not2Channels = "Cannot set L/R volumes, control does not have 2 channels"
  End With
  InitProperties
End Sub

[green]'@------------------------ DESTRUCTOR --------------------------@[/green]

Private Sub Class_Terminate()
  If CBool(mlngMixer) = True Then
    mixerClose mlngMixer
  End If
End Sub

[green]'@------------------------ PROPERTIES --------------------------@[/green]

Public Property Get ModeType() As ModeTypes
  ModeType = mModeType
End Property
[green]'@--------------------------------------------------------------@[/green]
Public Property Let ModeType(ByVal mMode As ModeTypes)
  mModeType = mMode
End Property
[green]'@--------------------------------------------------------------@[/green]
Public Property Get ControlName() As String
  ControlName = StripNulls(mstrControlName)
End Property
[green]'@--------------------------------------------------------------@[/green]
Public Property Get ChannelName() As String
  ChannelName = StripNulls(mstrChannelName)
End Property
[green]'@--------------------------------------------------------------@[/green]
Public Property Get MinimumLevel() As Long
  Select Case ModeType
    Case RealMode
      MinimumLevel = mlngMinValue
    Case PercentageMode
      MinimumLevel = ConvertToPercentage(mlngMinValue)
  End Select
End Property
[green]'@--------------------------------------------------------------@[/green]
Public Property Get MaximumLevel() As Long
  Select Case ModeType
    Case RealMode
      MaximumLevel = mlngMaxValue
    Case PercentageMode
      MaximumLevel = ConvertToPercentage(mlngMaxValue)
  End Select
End Property
[green]'@--------------------------------------------------------------@[/green]
Public Property Get Steps() As Long
On Error Resume Next
  Select Case ModeType
    Case RealMode
      Steps = mlngSteps
    Case PercentageMode
      Steps = 100 / mlngSteps
  End Select
End Property
[green]'@--------------------------------------------------------------@[/green]
Public Property Get IncrementValue() As Single
On Error Resume Next
  Select Case ModeType
    Case RealMode
      IncrementValue = mlngMaxValue / mlngSteps
    Case PercentageMode
      IncrementValue = 100 / mlngSteps
  End Select
End Property
[green]'@--------------------------------------------------------------@[/green]
Public Property Get LeftChannelVolume() As Long
  Select Case ModeType
    Case RealMode
      LeftChannelVolume = mlngLeftValue
    Case PercentageMode
      LeftChannelVolume = ConvertToPercentage(mlngLeftValue)
  End Select
End Property
[green]'@--------------------------------------------------------------@[/green]
Public Property Get RightChannelVolume() As Long
  Select Case ModeType
    Case RealMode
      RightChannelVolume = mlngRightValue
    Case PercentageMode
      RightChannelVolume = ConvertToPercentage(mlngRightValue)
  End Select
End Property
[green]'@--------------------------------------------------------------@[/green]
Public Property Get VolumeLevel() As Long
On Error Resume Next
  Dim lngReturn As Long
  
  If CBool(mlngMixer) = False Then
    RaiseEvent ErrorOccurred(MixerNotFound, mErrorStrings.MixerNotFound)
    Exit Property
  End If
  
  With mMixerControlDetails
    .cbStruct = Len(mMixerControlDetails)
    .item = 0
    .dwControlID = mMixerControl.dwControlID
    .cChannels = 1
    .cbDetails = Len(mlngValue)
    .paDetails = VarPtr(mlngValue)
  End With
  
  lngReturn = mixerGetControlDetails(mlngMixer, mMixerControlDetails, MixerConstants.GetControlDetailsValue)
  If lngReturn <> MixerConstants.ErrorSuccess Then
    RaiseEvent ErrorOccurred(NoControlDetails, mErrorStrings.NoControlDetails)
    Exit Property
  End If
  
  Select Case ModeType
    Case RealMode
      VolumeLevel = mlngValue
    Case PercentageMode
      VolumeLevel = ConvertToPercentage(mlngValue)
  End Select
  
End Property
[green]'@--------------------------------------------------------------@[/green]
Public Property Let VolumeLevel(ByVal VolumeLevel As Long)
On Error Resume Next
  Dim lngReturn As Long
  Dim strMsg As String

  If CBool(mlngMixer) = False Then
    RaiseEvent ErrorOccurred(MixerNotFound, mErrorStrings.MixerNotFound)
    Exit Property
  End If
  
  If mMixerLine.cChannels = 2 Then
    [green]' unless the right and left channels are equal, which only occurs when
    ' balance is at dead center, setting the volume will cause a uniform
    ' level change for all channels. To avoid this, transfer the change
    ' to the SetChannelVolumes() method to preserve channel proportions.[/green]
    Call GetChannelVolumes
    If (mlngLeftValue <> mlngRightValue) Then
      Call AdjustChannelVolumes(AutoConvertToAPI(VolumeLevel))
      Call SetChannelVolumes(LeftChannelVolume, RightChannelVolume)
      Exit Property
    End If
  End If
  
  Select Case ModeType
    Case RealMode
      If Not (VolumeLevel >= mlngMinValue And VolumeLevel <= mlngMaxValue) Then
        strMsg = mErrorStrings.InvalidVolume
        strMsg = Replace(strMsg, "{%1}", mlngMinValue)
        strMsg = Replace(strMsg, "{%2}", mlngMaxValue)
        RaiseEvent ErrorOccurred(InvalidVolume, strMsg)
        Exit Property
      End If
      mlngValue = VolumeLevel
    Case PercentageMode
      If Not (VolumeLevel >= 0 And VolumeLevel <= 100) Then
        strMsg = mErrorStrings.InvalidVolume
        strMsg = Replace(strMsg, "{%1}", 0)
        strMsg = Replace(strMsg, "{%2}", 100)
        RaiseEvent ErrorOccurred(InvalidVolume, strMsg)
        Exit Property
      End If
      mlngValue = ConvertToReal(VolumeLevel)
  End Select
  
  With mMixerControlDetails
    .cbStruct = Len(mMixerControlDetails)
    .item = 0
    .dwControlID = mMixerControl.dwControlID
    .cChannels = 1
    .cbDetails = Len(mlngValue)
    .paDetails = VarPtr(mlngValue)
  End With
  
  lngReturn = mixerSetControlDetails(mlngMixer, mMixerControlDetails, MixerConstants.SetControlDetailsValue)
  If lngReturn <> MixerConstants.ErrorSuccess Then
    RaiseEvent ErrorOccurred(NoSetVolume, mErrorStrings.NoSetVolume)
  Else
    RaiseEvent ValueChanged(VolumeLevel, ChannelName)
  End If
  
End Property

[green]'@--------------------- PUBLIC METHODS -------------------------@[/green]

Public Function SelectMixerControl(ByVal compType As ComponentTypes, ByVal sndCtl As SoundControls) As Boolean
On Error GoTo ErrHandler
  Dim lngReturn As Long
  
  InitProperties
 
  If CBool(mlngMixer) = False Then
    RaiseEvent ErrorOccurred(MixerNotFound, mErrorStrings.MixerNotFound)
    Exit Function
  End If
  
  With mMixerLine
    .cbStruct = Len(mMixerLine)
    .dwComponentType = compType
  End With
    
  lngReturn = mixerGetLineInfo(mlngMixer, mMixerLine, MixerConstants.GetLineInfoComponentType)
  If lngReturn <> MixerConstants.ErrorSuccess Then
    RaiseEvent ErrorOccurred(NoLineInfo, mErrorStrings.NoLineInfo)
    Exit Function
  End If
  
  mstrControlName = StrConv(mMixerLine.szName, vbUnicode)
  
  With mMixerLineControls
    .cbStruct = Len(mMixerLineControls)
    .dwLineID = mMixerLine.dwLineID
    .dwControl = sndCtl
    .cControls = mMixerLine.cControls
    .cbmxctrl = Len(mMixerControl)
    .pamxctrl = VarPtr(mMixerControl)
  End With
  
  lngReturn = mixerGetLineControls(mlngMixer, mMixerLineControls, MixerConstants.GetLineControlsOneByType)
  If lngReturn <> MixerConstants.ErrorSuccess Then
    RaiseEvent ErrorOccurred(NoLineControls, mErrorStrings.NoLineControls)
    Exit Function
  End If
  
  With mMixerControl
    .cbStruct = Len(mMixerControl)
    mlngMinValue = .Bounds(1)
    mlngMaxValue = .Bounds(2)
    mlngSteps = .Metrics(1)
    mstrChannelName = StrConv(.szName, vbUnicode)
  End With
  
  SelectMixerControl = True

ExitHere:
  Exit Function
ErrHandler:
  Debug.Print Err, Err.Description
  Resume ExitHere
End Function
[green]'@--------------------------------------------------------------@[/green]
Public Function SetChannelVolumes(ByVal LeftValue As Long, ByVal RightValue As Long) As Boolean
On Error GoTo ErrHandler
  Dim lngReturn As Long
  Dim CtlChannelValues(0 To 1) As MIXERCONTROLDETAILS_UNSIGNED
  
  If mMixerLine.cChannels <> 2 Then
    RaiseEvent ErrorOccurred(Not2Channels, mErrorStrings.Not2Channels)
    Exit Function
  End If
  
  Select Case ModeType
    Case RealMode
      mlngLeftValue = LeftValue
      mlngRightValue = RightValue
    Case PercentageMode
      mlngLeftValue = ConvertToReal(LeftValue)
      mlngRightValue = ConvertToReal(RightValue)
  End Select
  
  CtlChannelValues(0).dwValue = mlngLeftValue
  CtlChannelValues(1).dwValue = mlngRightValue
  
  With mMixerControlDetails
    .cbStruct = Len(mMixerControlDetails)
    .item = 0
    .dwControlID = mMixerControl.dwControlID
    .cChannels = 2
    .cbDetails = Len(CtlChannelValues(0))
    .paDetails = VarPtr(CtlChannelValues(0))
  End With
  
  lngReturn = mixerSetControlDetails(mlngMixer, mMixerControlDetails, _
                                    MixerConstants.SetControlDetailsValue)
  If lngReturn <> MixerConstants.ErrorSuccess Then
    RaiseEvent ErrorOccurred(NoSetVolume, mErrorStrings.NoSetVolume)
  Else
    RaiseEvent BalanceChanged(LeftChannelVolume, RightChannelVolume)
  End If
  
  SetChannelVolumes = True
  
ExitHere:
  Exit Function
ErrHandler:
  Debug.Print Err, Err.Description
  Resume ExitHere
End Function
[green]'@--------------------------------------------------------------@[/green]
Public Function GetChannelVolumes() As Boolean
On Error GoTo ErrHandler
  Dim lngReturn As Long
  Dim CtlChannelValues(0 To 1) As MIXERCONTROLDETAILS_UNSIGNED
  
  If mMixerLine.cChannels <> 2 Then
    RaiseEvent ErrorOccurred(Not2Channels, mErrorStrings.Not2Channels)
    Exit Function
  End If

  CtlChannelValues(0).dwValue = 0
  CtlChannelValues(1).dwValue = 0
  
  With mMixerControlDetails
    .cbStruct = Len(mMixerControlDetails)
    .item = 0
    .dwControlID = mMixerControl.dwControlID
    .cChannels = 2
    .cbDetails = Len(CtlChannelValues(0))
    .paDetails = VarPtr(CtlChannelValues(0))
    Debug.Assert (.cChannels = 2)
  End With
  
  lngReturn = mixerGetControlDetails(mlngMixer, mMixerControlDetails, _
                                    MixerConstants.SetControlDetailsValue)
  If lngReturn <> MixerConstants.ErrorSuccess Then
    RaiseEvent ErrorOccurred(NoSetVolume, mErrorStrings.NoSetVolume)
  End If
  
  mlngLeftValue = CtlChannelValues(0).dwValue
  mlngRightValue = CtlChannelValues(1).dwValue
  
  GetChannelVolumes = True
  
ExitHere:
  Exit Function
ErrHandler:
  Debug.Print Err, Err.Description
  Resume ExitHere
End Function
[green]'@--------------------------------------------------------------@[/green]
Public Sub SetMute(ByVal blnState As Boolean)
  If InStr(ChannelName, "Mute") > 0 Then
    If blnState = True Then
      VolumeLevel = MaximumLevel
    Else
      VolumeLevel = MinimumLevel
    End If
  Else
    RaiseEvent ErrorOccurred(InvalidOperation, mErrorStrings.InvalidOperation)
  End If
End Sub
[green]'@--------------------------------------------------------------@[/green]
Public Function ConvertToReal(ByVal PercentValue As Long) As Long
On Error Resume Next
  ConvertToReal = PercentValue * ((mlngMaxValue - mlngMinValue) / 100)
End Function
[green]'@--------------------------------------------------------------@[/green]
Public Function ConvertToPercentage(ByVal RealValue As Long) As Long
On Error Resume Next
  ConvertToPercentage = (RealValue / (mlngMaxValue - mlngMinValue)) * 100
End Function
[green]'@--------------------------------------------------------------@[/green]
Public Function CompareLevels(ByVal LeftChannel As Long, ByVal RightChannel As Long) As CompareResults
  If LeftChannel > RightChannel Then
    CompareLevels = LeftIsLarger
  ElseIf RightChannel > LeftChannel Then
    CompareLevels = RightIsLarger
  Else
    CompareLevels = BothEqual
  End If
End Function

[green]'@--------------------- PRIVATE METHODS ------------------------@[/green]

Private Sub InitProperties()
  If CBool(mlngMixer) = False Then
    mixerOpen mlngMixer, 0, 0, 0, 0
  End If
  mlngValue = 0
  mlngMinValue = 0
  mlngMaxValue = 0
  mlngLeftValue = 0
  mlngRightValue = 0
  mlngSteps = 0
  mstrChannelName = vbNullString
  mstrControlName = vbNullString
  mModeType = PercentageMode 'default mode
End Sub
[green]'@--------------------------------------------------------------@[/green]
Private Function AutoConvertToAPI(ByVal CurrentValue As Long) As Long
  Select Case ModeType
    Case RealMode
      AutoConvertToAPI = CurrentValue
    Case PercentageMode
      AutoConvertToAPI = ConvertToReal(CurrentValue)
  End Select
End Function
[green]'@--------------------------------------------------------------@[/green]
Private Function AutoConvertFromAPI(ByVal CurrentValue As Long) As Long
  Select Case ModeType
    Case RealMode
      AutoConvertFromAPI = CurrentValue
    Case PercentageMode
      AutoConvertFromAPI = ConvertToPercentage(CurrentValue)
  End Select
End Function
[green]'@--------------------------------------------------------------@[/green]
Private Sub AdjustChannelVolumes(ByVal VolumeLevel As Long)
On Error Resume Next
  Dim lngOldVolume As Long
  
  Select Case CompareLevels(mlngLeftValue, mlngRightValue)
    Case LeftIsLarger
      lngOldVolume = mlngLeftValue
      mlngLeftValue = VolumeLevel
      mlngRightValue = mlngRightValue * (VolumeLevel / lngOldVolume)
    Case RightIsLarger
      lngOldVolume = mlngRightValue
      mlngRightValue = VolumeLevel
      mlngLeftValue = mlngLeftValue * (VolumeLevel / lngOldVolume)
    Case BothEqual
      mlngLeftValue = VolumeLevel
      mlngRightValue = VolumeLevel
  End Select
End Sub
[green]'@--------------------------------------------------------------@[/green]
Private Function StripNulls(ByVal strRaw As String) As String
  Dim lngIndex As Long
  lngIndex = InStr(strRaw, Chr(0))
  
  If lngIndex > 0 Then
    StripNulls = Left$(strRaw, lngIndex - 1)
  Else
    StripNulls = strRaw
  End If
End Function

[green]'@---------------------- END OF CLASS --------------------------@[/green]

The form I tested used an ActiveX Slider control for the volume (0 to 100) and a Microsoft Forms Scrollbar (0 to 200) for the balance. I declared the class "WithEvents" so I could use its events to notify me when values were changed. Here's what it looks like:
Code: 
Option Compare Database
Option Explicit

Private WithEvents mMixer As clsMixer
Private mblnRepainting As Boolean

Private Sub Form_Load()
  Set mMixer = New clsMixer
  mMixer.ModeType = PercentageMode
  Call UpdateUI
End Sub
[green]'@--------------------------------------------------------------@[/green]
Private Sub scbrBalance_Change()
  Dim lngLeft As Long
  Dim lngRight As Long
  Dim lngVolume As Long
  
  If Not mblnRepainting Then
    With mMixer
      If (.SelectMixerControl(SpeakersOut, Volume) = True) Then
        lngVolume = .VolumeLevel
        Select Case scbrBalance.Value
          Case Is > 100
            lngRight = lngVolume
            lngLeft = (200 - scbrBalance.Value) * (lngVolume / 100)
          Case Is < 100
            lngLeft = lngVolume
            lngRight = scbrBalance.Value * (lngVolume / 100)
          Case 100
            lngLeft = lngVolume
            lngRight = lngVolume
        End Select
        .SetChannelVolumes lngLeft, lngRight
      End If
    End With
  End If
End Sub
[green]'@--------------------------------------------------------------@[/green]
Private Sub sldVolume_Change()
  If Not mblnRepainting Then
    With mMixer
      If (.SelectMixerControl(SpeakersOut, Volume) = True) Then
        .VolumeLevel = sldVolume.Value
      End If
    End With
  End If
End Sub
[green]'@--------------------------------------------------------------@[/green]
Private Sub chkMute_AfterUpdate()
  If Not mblnRepainting Then
    With mMixer
      If (.SelectMixerControl(SpeakersOut, Mute) = True) Then
        .SetMute CBool(chkMute.Value)
      End If
    End With
  End If
End Sub
[green]'@--------------------------------------------------------------@[/green]
Private Sub UpdateUI()
  Dim lngLeft As Long
  Dim lngRight As Long
  Dim lngVolume As Long
  
  mblnRepainting = True

  With mMixer
    If (.SelectMixerControl(SpeakersOut, Volume) = True) Then
      lblControlName.Caption = .ControlName
      lngVolume = .VolumeLevel
      sldVolume.Value = lngVolume
      lblVolume.Caption = lngVolume
      lblMaximum.Caption = .MaximumLevel
      lblMinimum.Caption = .MinimumLevel
      If (.GetChannelVolumes() = True) Then
        lngLeft = .LeftChannelVolume
        lngRight = .RightChannelVolume
        If (lngLeft = lngVolume) And (lngRight = lngVolume) Then
          scbrBalance.Value = 100
        Else
          If lngRight = lngVolume Then
            scbrBalance.Value = 200 - (lngLeft * (100 / lngVolume))
          ElseIf lngLeft = lngVolume Then
            scbrBalance.Value = lngRight * (100 / lngVolume)
          End If
        End If
        lblLeft.Caption = lngLeft
        lblRight.Caption = lngRight
      End If
    End If
    
    If (.SelectMixerControl(SpeakersOut, Mute) = True) Then
      chkMute.Value = Not (.VolumeLevel = .MinimumLevel)
    End If
  End With
  
  mblnRepainting = False
  
End Sub

[green]'@--------------------- Mixer Class Events ---------------------@[/green]

Private Sub mMixer_ValueChanged(ByVal NewValue As Long, ByVal strChannel As String)
  Call UpdateUI
End Sub
[green]'@--------------------------------------------------------------@[/green]
Private Sub mMixer_BalanceChanged(ByVal LeftChannel As Long, ByVal RightChannel As Long)
  Call UpdateUI
End Sub
[green]'@--------------------------------------------------------------@[/green]
Private Sub mMixer_ErrorOccurred(ByVal ErrNum As ClassErrors, ByVal strMessage As String)
  MsgBox "Mixer Error " & CStr(CLng(ErrNum)) & " - " & strMessage, _
         vbExclamation + vbOKOnly, "Mixer Control"
End Sub

[green]'@-------------------------- EOF -------------------------------@[/green]
The code should be self-explanatory; if anyone gives it a try it would be helpful to post your results back here so we know what works and what doesn't.

Suggestions welcome [idea]

VBSlammer
redinvader3walking.gif

"You just have to know which screws to turn." - Professor Bob
 
Upvote 0 Downvote
I noticed a bug in the [tt]InitProperties()[/tt] private sub routine - it resets the mode type which should not happen there. The default mode should be set in the [tt]Class_Initialize()[/tt] event, so the following line of code should be moved to the Class_Initialize() event:
Code: 
mModeType = PercentageMode [green]'default mode[/green]

VBSlammer
redinvader3walking.gif

"You just have to know which screws to turn." - Professor Bob
 
Upvote 0 Downvote
VBSlammer.

Wow, nice code. Totally impressed.
 
Upvote 0 Downvote
A couple more bugs I noticed that could cause an incorrect return value:
Code: 
[green]'SetChannelVolumes() function:[/green]
If lngReturn <> MixerConstants.ErrorSuccess Then
  RaiseEvent ErrorOccurred(NoSetVolume, mErrorStrings.NoSetVolume)
  [highlight]Exit Function[/highlight]   [blue]'<--- add[/blue]
Else
  RaiseEvent BalanceChanged(LeftChannelVolume, RightChannelVolume)
End If


[green]'GetChannelVolumes() function:[/green]
If lngReturn <> MixerConstants.ErrorSuccess Then
  RaiseEvent ErrorOccurred(NoSetVolume, mErrorStrings.NoSetVolume)
  [highlight]Exit Function[/highlight]   [blue]'<--- add[/blue]
Else
  RaiseEvent BalanceChanged(LeftChannelVolume, RightChannelVolume)
End If








VBSlammer
redinvader3walking.gif

"You just have to know which screws to turn." - Professor Bob
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Kennelbloke
  • Locked
  • Solved
Refer to Navigation Control Subform Record
Replies
8
Views
1K
Kennelbloke
Kennelbloke
JimStrand
  • Locked
  • Question Question
Trying to Use Form Control as Variable in Report Control Source
Replies
5
Views
921
Andrzejek
Andrzejek
JimStrand
  • Locked
  • Question Question
Using Report Header (Form control) as Variable in Report Expression
Replies
11
Views
2K
dhookom
dhookom
lameid
  • Locked
  • Question Question
Error creating object in Class module - 429 ActiveX component can't create object
Replies
10
Views
744
lameid
lameid
Aximboy
  • Locked
  • Question Question
How do I reference a control in an active subform?
Replies
2
Views
474
Aximboy
Aximboy

Part and Inventory Search

Sponsor

Back
Top