Платные хостинги     Раскрутка сайта     Книги по программированию

Уровень громкости звука на VB, Кто ни будь знает как его менять?

- Кто ни будь знает как его менять? Это сообщение отредактировал Programmer - 6.3.2004, 13:58

- Есть такая функция - апи функция.В MSND-е я нашёл множество функций относящихся к данной проблеме(изменение громкости).Найти их можно если ввести mixerOpen, к примеру.Так вот, я написал прогу (ну не совсем я и не совсем написал, вернее подправил), которая изменяет громкость и как не странно она работает =).Для начала нужно создать новый проджект (на VB естественно), добавить в него одну форму и один модуль. Далее поставить на форму label1, text1, HScroll1. А затем вставить то что я написал ниже ... Удачи!Это вставить в форму:Код Option ExplicitDim hmixer As Long          'mixer handleDim volCtrl As MIXERCONTROL 'waveout volume controlDim rc As Long              'return codeDim ok As Boolean           'boolean return codeDim vol As LongPrivate Sub HS1_Change()    vol = HS1.Value    Text1.Text = CStr(vol * 2)    SetVolumeControl hmixer, volCtrl, vol * 2End SubPrivate Sub Form_Load()    HS1.Max = 32767    HS1.Min = 0    HS1.LargeChange = 4096    HS1.SmallChange = 1024        rc = mixerOpen(hmixer, 0, 0, 0, 0)        If ((MMSYSERR_NOERROR <> rc)) Then        MsgBox "Couldn't open the mixer."        Exit Sub    End If    ok = GetVolumeControl(hmixer, _                MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _                MIXERCONTROL_CONTROLTYPE_VOLUME, _                volCtrl)                    If (ok = True) Then        Label1.Caption = volCtrl.lMinimum & " to " & volCtrl.lMaximum    End IfEnd SubhighlightSyntax('vbZjc4Mz','vb');А это в модуль:Код Option ExplicitPublic Const MMSYSERR_NOERROR = 0Public Const MAXPNAMELEN = 32Public Const MIXER_LONG_NAME_CHARS = 64Public Const MIXER_SHORT_NAME_CHARS = 16Public 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 MIXERCONTROL_CT_CLASS_FADER = &H50000000Public Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000Public Const MIXERCONTROL_CONTROLTYPE_FADER = (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)Public Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)Declare Function mixerClose Lib "winmm.dll" _                (ByVal hmx As Long) As LongDeclare Function mixerGetControlDetails Lib "winmm.dll" _                Alias "mixerGetControlDetailsA" _                (ByVal hmxobj As Long, _                pmxcd As MIXERCONTROLDETAILS, _                ByVal fdwDetails As Long) As LongDeclare Function mixerGetDevCaps Lib "winmm.dll" _                Alias "mixerGetDevCapsA" _                (ByVal uMxId As Long, _                ByVal pmxcaps As MIXERCAPS, _                ByVal cbmxcaps As Long) As LongDeclare Function mixerGetID Lib "winmm.dll" _                (ByVal hmxobj As Long, _                pumxID As Long, _                ByVal fdwId As Long) As LongDeclare Function mixerGetLineControls Lib "winmm.dll" _                Alias "mixerGetLineControlsA" _                (ByVal hmxobj As Long, _                pmxlc As MIXERLINECONTROLS, _                ByVal fdwControls As Long) As LongDeclare Function mixerGetLineInfo Lib "winmm.dll" _                Alias "mixerGetLineInfoA" _                (ByVal hmxobj As Long, _                pmxl As MIXERLINE, _                ByVal fdwInfo As Long) As LongDeclare Function mixerGetNumDevs Lib "winmm.dll" () As LongDeclare Function mixerMessage Lib "winmm.dll" _                (ByVal hmx As Long, _                ByVal uMsg As Long, _                ByVal dwParam1 As Long, _                ByVal dwParam2 As Long) As LongDeclare 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 LongDeclare Function mixerSetControlDetails Lib "winmm.dll" _                (ByVal hmxobj As Long, _                pmxcd As MIXERCONTROLDETAILS, _                ByVal fdwDetails As Long) As LongDeclare 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 LongDeclare Function GlobalLock Lib "kernel32" _                (ByVal hmem As Long) As LongDeclare Function GlobalFree Lib "kernel32" _                (ByVal hmem As Long) As LongType MIXERCAPS    wMid As Integer                   '  manufacturer id    wPid As Integer                   '  product id    vDriverVersion As Long            '  version of the driver    szPname As String * MAXPNAMELEN   '  product name    fdwSupport As Long                '  misc. support bits    cDestinations As Long             '  count of destinationsEnd TypeType MIXERCONTROL    cbStruct As Long           '  size in Byte of MIXERCONTROL    dwControlID As Long        '  unique control id for mixer device    dwControlType As Long      '  MIXERCONTROL_CONTROLTYPE_xxx    fdwControl As Long         '  MIXERCONTROL_CONTROLF_xxx    cMultipleItems As Long     '  if MIXERCONTROL_CONTROLF_MULTIPLE  set    szShortName As String * MIXER_SHORT_NAME_CHARS  ' short name of control    szName As String * MIXER_LONG_NAME_CHARS        ' long name of control    lMinimum As Long           '  Minimum value    lMaximum As Long           '  Maximum value    reserved(10) As Long       '  reserved structure spaceEnd TypeType MIXERCONTROLDETAILS    cbStruct As Long       '  size in Byte of MIXERCONTROLDETAILS    dwControlID As Long    '  control id to get/set details on    cChannels As Long      '  number of channels in paDetails array    item As Long           '  hwndOwner or cMultipleItems    cbDetails As Long      '  size of _one_ details_XX struct    paDetails As Long      '  pointer to array of details_XX structsEnd TypeType MIXERCONTROLDETAILS_UNSIGNED    dwValue As Long        '  value of the controlEnd TypeType MIXERLINE    cbStruct As Long               '  size of MIXERLINE structure    dwDestination As Long          '  zero based destination index    dwSource As Long               '  zero based source index (if source)    dwLineID As Long               '  unique line id for mixer device    fdwLine As Long                '  state/information about line    dwUser As Long                 '  driver specific information    dwComponentType As Long        '  component type line connects to    cChannels As Long              '  number of channels line supports    cConnections As Long           '  number of connections (possible)    cControls As Long              '  number of controls at this line    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 * MAXPNAMELENEnd TypeType MIXERLINECONTROLS    cbStruct As Long       '  size in Byte of MIXERLINECONTROLS    dwLineID As Long       '  line id (from MIXERLINE.dwLineID) MIXER_GETLINECONTROLSF_ONEBYID or    dwControl As Long      '  MIXER_GETLINECONTROLSF_ONEBYTYPE    cControls As Long      '  count of controls pmxctrl points to    cbmxctrl As Long       '  size in Byte of _one_ MIXERCONTROL    pamxctrl As Long       '  pointer to first MIXERCONTROL arrayEnd TypeFunction GetVolumeControl(ByVal hmixer As Long, ByVal componentType As Long, ByVal ctrlType As Long, ByRef mxc As MIXERCONTROL) As BooleanDim mxlc As MIXERLINECONTROLSDim mxl As MIXERLINEDim hmem As LongDim rc As Long    mxl.cbStruct = Len(mxl)    mxl.dwComponentType = componentType    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)        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            GetVolumeControl = True            CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)        Else            GetVolumeControl = False        End If                GlobalFree (hmem)        Exit Function    End If    GetVolumeControl = FalseEnd FunctionFunction SetVolumeControl(ByVal hmixer As Long, mxc As MIXERCONTROL, ByVal volume As Long) As BooleanDim hmem As LongDim mxcd As MIXERCONTROLDETAILSDim vol As MIXERCONTROLDETAILS_UNSIGNEDDim rc As Long    mxcd.item = 0    mxcd.dwControlID = mxc.dwControlID    mxcd.cbStruct = Len(mxcd)    mxcd.cbDetails = Len(vol)    hmem = GlobalAlloc(&H40, Len(vol))    mxcd.paDetails = GlobalLock(hmem)    mxcd.cChannels = 1    vol.dwValue = volume    CopyPtrFromStruct mxcd.paDetails, vol, Len(vol)    rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)    GlobalFree (hmem)        If (MMSYSERR_NOERROR = rc) Then        SetVolumeControl = True    Else        SetVolumeControl = False    End IfEnd FunctionhighlightSyntax('vb1YzUxMj','vb');Там скорее всего можно многое из апи функций убрать, но решать вам.Дальнейшее развитие этой темы можно представить, как пульт управления через LPT или COM порт(или любой способ беспроводного соединения).Ещё раз удачи!Если что, то у меня есть исходник и я могу его выслать на мыло!

- Да, уже нашёл ошибку...На форме нужно переправить HS1 на HScroll1

- Спасибо. Вы мне очень промогли!!!

- Если будут ещё какие-нибудь идеи, то пишите!

Интернет казино     Онлайн игры     Увеличение члена     Купить DVD