ToolTipText = "Links all selected faders to SBM fader"
Top = 1830
Width = 225
End
Begin ComctlLib.Slider Slider6
Height = 1260
Left = 60
TabIndex = 89
Top = 510
Width = 600
_ExtentX = 1058
_ExtentY = 2223
_Version = 327682
Orientation = 1
LargeChange = 200
Max = 65535
SelStart = 32768
TickStyle = 1
TickFrequency = 3265
Value = 32768
End
Begin VB.Label Label11
Alignment = 2 'Center
AutoSize = -1 'True
BackColor = &H8000000B&
BackStyle = 0 'Transparent
Caption = "SBM"
ForeColor = &H00000000&
Height = 195
Left = 300
TabIndex = 90
Top = 1830
Width = 375
End
End
Begin VB.CommandButton eject0
Caption = "Eject"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 9150
Style = 1 'Graphical
TabIndex = 7
Top = 735
Width = 735
End
Begin VB.CommandButton eject1
Caption = "Close"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 9150
Style = 1 'Graphical
TabIndex = 8
Top = 735
Width = 735
End
Begin VB.CommandButton Command2
BackColor = &H00FFFF00&
Caption = "MIXER"
Height = 330
Left = 8370
Style = 1 'Graphical
TabIndex = 6
Top = 750
Visible = 0 'False
Width = 195
End
Begin VB.Frame Frame14
Height = 765
Left = 2940
TabIndex = 91
Top = -60
Width = 4155
Begin VB.TextBox timeWindow
Alignment = 2 'Center
BackColor = &H80000008&
BeginProperty Font
Name = "Arial"
Size = 20.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 570
Left = 90
Locked = -1 'True
TabIndex = 92
TabStop = 0 'False
Top = 150
Width = 3975
End
End
Begin VB.Frame Frame16
Height = 765
Left = 7140
TabIndex = 93
Top = -60
Width = 2865
Begin VB.TextBox CD
Alignment = 2 'Center
BackColor = &H00000000&
ForeColor = &H0000FFFF&
Height = 285
Left = 60
Locked = -1 'True
TabIndex = 98
TabStop = 0 'False
Text = "CD Player"
Top = 450
Width = 2745
End
Begin VB.Label tracktime
Alignment = 2 'Center
BackColor = &H80000008&
BorderStyle = 1 'Fixed Single
ForeColor = &H0000FFFF&
Height = 270
Left = 60
TabIndex = 94
Top = 150
Width = 2745
End
End
Begin VB.Frame Frame17
Height = 765
Left = 30
TabIndex = 95
Top = -60
Width = 2865
Begin VB.Label totalplay
Alignment = 2 'Center
BackColor = &H80000008&
BorderStyle = 1 'Fixed Single
ForeColor = &H0000FFFF&
Height = 270
Left = 60
TabIndex = 97
Top = 150
Width = 2745
End
Begin VB.Label trtime
Alignment = 2 'Center
BackColor = &H80000008&
BorderStyle = 1 'Fixed Single
ForeColor = &H0000FFFF&
Height = 270
Left = 60
TabIndex = 96
Top = 450
Width = 2745
End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim volR As Long
Dim volL As Long
Dim volume As Long
Dim mute As MIXERCONTROL
Dim unmute As MIXERCONTROL
Dim hmixer As Long ' mixer handle
Dim VolCtrl As MIXERCONTROL ' master volume control
Dim WavCtrl As MIXERCONTROL ' wave output volume control
Dim CDVol As MIXERCONTROL ' CD Volume
Dim LineVol As MIXERCONTROL ' Line/In Volume
Dim MBOOST As MIXERCONTROL ' Microphone Volume
Dim PSPKVol As MIXERCONTROL ' PcSpeaker Volume
Dim AUXVol As MIXERCONTROL ' Auxillary Volume
Dim TADVol As MIXERCONTROL ' TAD-In Volume
Dim MIDIVol As MIXERCONTROL ' Midi Volume
Dim I25InVol As MIXERCONTROL ' I25In Volume
Dim Treble As MIXERCONTROL
Dim Bass As MIXERCONTROL
Dim rc As Long ' return code
Dim ok As Boolean ' boolean return code
Dim fastForwardSpeed As Long ' seconds to seek for ff/rew
Dim fPlaying As Boolean ' true if CD is currently playing
Dim fCDLoaded As Boolean ' true if CD is the the player
Dim numTracks As Integer ' number of tracks on audio CD
Dim trackLength() As String ' array containing length of each track
Dim track As Integer ' current track
Dim min As Integer ' current minute on track
Dim SEC As Integer ' current second on track
Dim cmd As String ' string to hold mci command strings
' Send a MCI command string
' If fShowError is true, display a message box on error
Private Function SendMCIString(cmd As String, fShowError As Boolean) As Boolean
Static rc As Long
Static errStr As String * 200
rc = mciSendString(cmd, 0, 0, hWnd)
If (fShowError And rc <> 0) Then
mciGetErrorString rc, errStr, Len(errStr)
SendMCIString "close all", False
cmd = "close all"
SendMCIString cmd, True
Unload Form4
End If
SendMCIString = (rc = 0)
End Function
Private Sub Check11_Click()
If Check11.Value = 1 Then
Check1.Value = 1
Check2.Value = 1
Check3.Value = 1
Check4.Value = 1
Check5.Value = 1
Check6.Value = 1
Check7.Value = 1
Check8.Value = 1
Check9.Value = 1
Check10.Value = 1
End If
If Check11.Value = 0 Then
Check1.Value = 0
Check2.Value = 0
Check3.Value = 0
Check4.Value = 0
Check5.Value = 0
Check6.Value = 0
Check7.Value = 0
Check8.Value = 0
Check9.Value = 0
Check10.Value = 0
End If
End Sub
Private Sub Command1_Click()
SendMCIString "close all", False
cmd = "close all"
SendMCIString cmd, True
'Index.Enabled = True
Unload Form4
End Sub
Private Sub Command2_Click()
'Open the mixer with deviceID 0.
rc = mixerOpen(hmixer, 0, 0, 0, 0)
If ((MMSYSERR_NOERROR <> rc)) Then
MsgBox "Couldn't open the mixer please check if a audio mixer is installed then retry."
Exit Sub
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
MIXERCONTROL_CONTROLTYPE_VOLUME, VolCtrl)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, VolCtrl)
If volume <> -1 Then
txtMasterVolume.Text = volume \ 6553
sliderMasterVolume.Value = 65535 - volume
End If
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_WAVEDSVol, _
MIXERCONTROL_CONTROLTYPE_VOLUME, WavCtrl)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, WavCtrl)
If volume <> -1 Then
txtWaveOutVolume.Text = volume \ 6553
sliderWaveOutVolume.Value = 65535 - volume
End If
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_MBOOST, _
MIXERCONTROL_CONTROLTYPE_VOLUME, MBOOST)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, MBOOST)
If volume <> -1 Then
Text2.Text = volume \ 6553
Slider2.Value = 65535 - volume
End If
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_CDVol, _
MIXERCONTROL_CONTROLTYPE_VOLUME, CDVol)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, CDVol)
If volume <> -1 Then
Text1.Text = volume \ 6553
Slider1.Value = 65535 - volume
End If
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_src_AUXVol, _
MIXERCONTROL_CONTROLTYPE_VOLUME, AUXVol)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, AUXVol)
If volume <> -1 Then
Text3.Text = volume \ 6553
Slider3.Value = 65535 - volume
End If
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_TADVol, _
MIXERCONTROL_CONTROLTYPE_VOLUME, TADVol)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, TADVol)
If volume <> -1 Then
Text4.Text = volume \ 6553
Slider4.Value = 65535 - volume
End If
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_MIDIVol, _
MIXERCONTROL_CONTROLTYPE_VOLUME, MIDIVol)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, MIDIVol)
If volume <> -1 Then
Text5.Text = volume \ 6553
Slider5.Value = 65535 - volume
End If
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_PSPKVol, _
MIXERCONTROL_CONTROLTYPE_VOLUME, PSPKVol)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, PSPKVol)
If volume <> -1 Then
Text7.Text = volume \ 6553
Slider7.Value = 65535 - volume
End If
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_I25InVol, _
MIXERCONTROL_CONTROLTYPE_VOLUME, I25InVol)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, I25InVol)
If volume <> -1 Then
Text8.Text = volume \ 6553
Slider8.Value = 65535 - volume
End If
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_LINEVol, _
MIXERCONTROL_CONTROLTYPE_VOLUME, LineVol)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, LineVol)
If volume <> -1 Then
Text9.Text = volume \ 6553
Slider9.Value = 65535 - volume
End If
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
MIXERCONTROL_CONTROLTYPE_BASS, Bass)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, Bass)
If volume <> -1 Then
BassText.Text = volume \ 6553
BassSlider.Value = 65535 - volume
End If
End If
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
MIXERCONTROL_CONTROLTYPE_TREBLE, Treble)
If (ok = True) Then
volume = GetVolumeControlValue(hmixer, Treble)
If volume <> -1 Then
Treblesliderte.Text = volume \ 6553
trebleslider.Value = 65535 - volume
End If
End If
End Sub
Private Sub Form_Load()
MsgBox "If you have any comments please email me at micracom2@hotmail.com This program still needs work and if any one can make the balance work correctly I would like to know how it was done."
If (App.PrevInstance = True) Then
End
End If
' Initialize variables
Timer1.Enabled = False
fastForwardSpeed = 5
fCDLoaded = False
' If the cd is being used, then quit
If (SendMCIString("open cdaudio alias cd wait shareable", True) = False) Then
timeWindow.Text = "Cd in use"
End
End If
SendMCIString "set cd time format tmsf wait", True
Timer1.Enabled = True
Command2_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Index.Enabled = True
SendMCIString "close all", False
End Sub
Private Sub Option1_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
MIXERCONTROL_CONTROLTYPE_MUTE, mute)
SetMuteControl hmixer, mute, 1
End Sub
Private Sub Option10_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_MIDIVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, unmute)
unSetMuteControl hmixer, unmute, 1
End Sub
Private Sub Option17_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_PSPKVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, mute)
SetMuteControl hmixer, mute, 1
End Sub
Private Sub Option18_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_PSPKVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, unmute)
unSetMuteControl hmixer, unmute, 1
End Sub
Private Sub Option19_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_I25InVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, unmute)
unSetMuteControl hmixer, unmute, 1
End Sub
Private Sub Option20_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_I25InVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, mute)
SetMuteControl hmixer, mute, 1
End Sub
Private Sub Option9_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_MIDIVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, mute)
SetMuteControl hmixer, mute, 1
End Sub
Private Sub Option11_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_TADVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, unmute)
unSetMuteControl hmixer, unmute, 1
End Sub
Private Sub Option12_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_TADVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, mute)
SetMuteControl hmixer, mute, 1
End Sub
Private Sub Option13_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_CDVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, unmute)
unSetMuteControl hmixer, unmute, 1
End Sub
Private Sub Option14_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_CDVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, mute)
SetMuteControl hmixer, mute, 1
End Sub
Private Sub Option15_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_src_AUXVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, mute)
SetMuteControl hmixer, mute, 1
End Sub
Private Sub Option16_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_src_AUXVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, unmute)
unSetMuteControl hmixer, unmute, 1
End Sub
Private Sub Option2_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
MIXERCONTROL_CONTROLTYPE_MUTE, unmute)
unSetMuteControl hmixer, unmute, 1
End Sub
Private Sub Option3_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_WAVEDSVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, mute)
SetMuteControl hmixer, mute, 1
End Sub
Private Sub Option4_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_WAVEDSVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, mute)
unSetMuteControl hmixer, mute, 1
End Sub
Private Sub Option5_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_LINEVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, mute)
SetMuteControl hmixer, mute, 1
End Sub
Private Sub Option6_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_LINEVol, _
MIXERCONTROL_CONTROLTYPE_MUTE, unmute)
unSetMuteControl hmixer, unmute, 1
End Sub
Private Sub Option7_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_MBOOST, _
MIXERCONTROL_CONTROLTYPE_MUTE, unmute)
unSetMuteControl hmixer, unmute, 1
End Sub
Private Sub Option8_Click()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_MBOOST, _
MIXERCONTROL_CONTROLTYPE_MUTE, mute)
SetMuteControl hmixer, mute, 1
End Sub
Function Errora()
MsgBox "Your sound card does not support a bass control"
End Function
Private Sub Slider19_Scroll()
volL = CLng(32767.5 - Slider19)
volR = CLng(32767.5 + Slider19)
SetPANControl hmixer, VolCtrl, volL, volR
End Sub
Private Sub trebleslider_Scroll()
ok = GetMixerControl(hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
MIXERCONTROL_CONTROLTYPE_TREBLE, Treble)
If ok = False Then
Errora
Exit Sub
End If
volume = 65535 - CLng(trebleslider.Value)
Treblesliderte.Text = volume \ 6553
SetVolumeControl hmixer, Treble, volume
End Sub
Private Sub BassSlider_Scroll()
volume = 65535 - CLng(BassSlider.Value)
BassText.Text = volume \ 6553
SetVolumeControl hmixer, Bass, volume
End Sub
' Play the CD
Private Sub Play_Click()
SendMCIString "play cd", True
fPlaying = True
CD.Text = "Playing"
End Sub
Private Sub Slider6_scroll()
Dim link As Long
link = 65535 - CLng(Slider6.Value)
If Check2.Value = 1 Then
Slider1.Value = Slider6.Value
Text1.Text = link \ 6553
SetVolumeControl hmixer, CDVol, link
End If
If Check4.Value = 1 Then
Slider2.Value = Slider6.Value
Text2.Text = link \ 6553
SetVolumeControl hmixer, MBOOST, link
End If
If Check5.Value = 1 Then
Slider3.Value = Slider6.Value
Text3.Text = link \ 6553
SetVolumeControl hmixer, AUXVol, link
End If
If Check7.Value = 1 Then
Slider4.Value = Slider6.Value
Text4.Text = link \ 6553
SetVolumeControl hmixer, TADVol, link
End If
If Check8.Value = 1 Then
Slider5.Value = Slider6.Value
Text5.Text = link \ 6553
SetVolumeControl hmixer, MIDIVol, link
End If
If Check10.Value = 1 Then
Slider7.Value = Slider6.Value
Text7.Text = link \ 6553
SetVolumeControl hmixer, PSPKVol, link
End If
If Check9.Value = 1 Then
Slider8.Value = Slider6.Value
Text8.Text = link \ 6553
SetVolumeControl hmixer, I25InVol, link
End If
If Check3.Value = 1 Then
Slider9.Value = Slider6.Value
Text9.Text = link \ 6553
SetVolumeControl hmixer, LineVol, link
End If
If Check1.Value = 1 Then
sliderMasterVolume.Value = Slider6.Value
txtMasterVolume.Text = link \ 6553
SetVolumeControl hmixer, VolCtrl, link
End If
If Check6.Value = 1 Then
sliderWaveOutVolume.Value = Slider6.Value
txtWaveOutVolume.Text = link \ 6553
SetVolumeControl hmixer, WavCtrl, link
End If
End Sub
' Stop the CD play
Private Sub stopbtn_Click()
SendMCIString "stop cd wait", True
cmd = "seek cd to " & track
SendMCIString cmd, True
fPlaying = False
CD.Text = "Stopped"
Update
End Sub
' Pause the CD
Private Sub pause_Click()
SendMCIString "pause cd", True
fPlaying = False
CD.Text = "Cd Paused"
Update
End Sub
' Eject the CD
Private Sub Eject0_Click()
SendMCIString "set cd door open", True
CD.Text = "Insert CD"
eject1.Visible = True
eject0.Visible = False
Update
End Sub
Private Sub Eject1_Click()
CD.Text = "Please wait"
SendMCIString "set cd door closed", True
eject0.Visible = True
eject1.Visible = False
Update
End Sub
' Fast forward
Private Sub ff_Click()
Dim s As String * 40
SendMCIString "set cd time format milliseconds", True
mciSendString "status cd position wait", s, Len(s), 0
If (fPlaying) Then
cmd = "play cd from " & CStr(CLng(s) + fastForwardSpeed * 1000)
cmd = "seek cd to " & CStr(CLng(s) + fastForwardSpeed * 1000)
End If
mciSendString cmd, 0, 0, 0
SendMCIString "set cd time format tmsf", True
Update
End Sub
' Rewind the CD
Private Sub rew_Click()
Dim s As String * 40
SendMCIString "set cd time format milliseconds", True
mciSendString "status cd position wait", s, Len(s), 0
If (fPlaying) Then
cmd = "play cd from " & CStr(CLng(s) - fastForwardSpeed * 1000)
cmd = "seek cd to " & CStr(CLng(s) - fastForwardSpeed * 1000)
End If
mciSendString cmd, 0, 0, 0
SendMCIString "set cd time format tmsf", True
Update
End Sub
' Forward track
Private Sub ftrack_Click()
If (track < numTracks) Then
If (fPlaying) Then
cmd = "play cd from " & track + 1
SendMCIString cmd, True
Else
cmd = "seek cd to " & track + 1
SendMCIString cmd, True
End If
SendMCIString "seek cd to 1", True
End If
Update
End Sub
' Go to previous track
Private Sub btrack_Click()
Dim from As String
If (min = 0 And SEC = 0) Then
If (track > 1) Then
from = CStr(track - 1)
Else
from = CStr(numTracks)
End If
from = CStr(track)
End If
If (fPlaying) Then
cmd = "play cd from " & from
SendMCIString cmd, True
cmd = "seek cd to " & from
SendMCIString cmd, True
End If
Update
End Sub
' Update the display and state variables
Private Sub Update()
Static s As String * 30
' Check if CD is in the player
mciSendString "status cd media present", s, Len(s), 0
If (CBool(s)) Then
' Enable all the controls, get CD information
If (fCDLoaded = False) Then
mciSendString "status cd number of tracks wait", s, Len(s), 0
numTracks = CInt(Mid$(s, 1, 2))
eject0.Visible = True
eject1.Visible = False
CD.Text = "Cd Ready"
' If CD only has 1 track, then it's probably a data CD
If (numTracks = 1) Then
CD.Text = "Not audio"
Exit Sub
End If
mciSendString "status cd length wait", s, Len(s), 0
(.txt)