ab.com コミュニティ https://www.activebasic.com/forum/ |
|
マスターボリューム変更 https://www.activebasic.com/forum/viewtopic.php?t=1880 |
ページ 1 / 1 |
作成者: | ゲストさん [ 2007年3月25日(日) 07:58 ] |
記事の件名: | マスターボリューム変更 |
暇だなぁ… コード: /* マスターボリューム変更 SetMasterVolume(nvol As Long) As Long nvol 変更後のボリュームを百分率で指定 戻り値 成功でTRUE、失敗でFALSEが返る GetMasterVolume() As Long 戻り値 成功でボリューム(百分率)、失敗で-1が返る ↑の二つは百分率に直す計算で誤差がでる SetMasterVolumeDetail(nvol As DWord) As Long nvol 変更後のボリュームを指定 戻り値 成功でTRUE、失敗でFALSEが返る nvolの最大値は大概65535.GetMasterVolumeMaximumで取得できる GetMasterVolumeDetail(ByRef nvol As DWord) As Long nvol 現在のボリュームを受け取るDWord型変数 戻り値 成功でTRUE、失敗でFALSEが返る GetMasterVolumeMaximum(nvol As DWord) As Long nvol ボリュームの最大値を受け取るDWord型変数 戻り値 成功でTRUE、失敗でFALSEが返る */ [ここをクリックすると内容が表示されます]
コード: 'テスト(何か再生しながら#N88BASICで試しましょう) Dim mv As DWord Print SetMasterVolume(19) Print GetMasterVolume() Print SetMasterVolumeDetail(35534) Print GetMasterVolumeDetail(mv),mv Print GetMasterVolumeMaximum(mv),mv Function SetMasterVolumeDetail(nvol As DWord) As Long Dim hmixer As HANDLE If mixerOpen(hmixer,0,0,0,0)<>MMSYSERR_NOERROR Then SetMasterVolumeDetail = FALSE Exit Function End If Dim mxl As MIXERLINE mxl.cbStruct = SizeOf(MIXERLINE) mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS If mixerGetLineInfo(hmixer,mxl,MIXER_OBJECTF_HMIXER Or MIXER_GETLINEINFOF_COMPONENTTYPE)<>MMSYSERR_NOERROR Then SetMasterVolumeDetail = FALSE mixerClose(hmixer) Exit Function End If Dim mxc As MIXERCONTROL Dim mxlc As MIXERLINECONTROLS mxlc.cbStruct = sizeof(MIXERLINECONTROLS) mxlc.dwLineID = mxl.dwLineID mxlc.dwControlType = MIXERCONTROL_CONTROLTYPE_VOLUME mxlc.cControls = 1 mxlc.cbmxctrl = sizeof(MIXERCONTROL) mxlc.pamxctrl = VarPtr(mxc) If mixerGetLineControls(hmixer,mxlc,MIXER_OBJECTF_HMIXER Or MIXER_GETLINECONTROLSF_ONEBYTYPE)<>MMSYSERR_NOERROR Then SetMasterVolumeDetail = FALSE mixerClose(hmixer) Exit Function End If If mxc.dwMaximum<nvol Then SetMasterVolumeDetail = FALSE mixerClose(hmixer) Exit Function End If Dim volume As MIXERCONTROLDETAILS_UNSIGNED Dim mxcd As MIXERCONTROLDETAILS volume.dwValue = nvol mxcd.cbStruct = SizeOf(MIXERCONTROLDETAILS) mxcd.dwControlID = mxc.dwControlID mxcd.cChannels = 1 mxcd.cMultipleItems = 0 mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_UNSIGNED) mxcd.paDetails = VarPtr(volume) If mixerSetControlDetails(hmixer,mxcd,MIXER_OBJECTF_HMIXER Or MIXER_SETCONTROLDETAILSF_VALUE)=MMSYSERR_NOERROR Then SetMasterVolumeDetail = TRUE Else SetMasterVolumeDetail = FALSE End If mixerClose(hmixer) End Function Function GetMasterVolumeDetail(ByRef nvol As DWord) As Long If VarPtr(nvol)=NULL Then GetMasterVolumeDetail = FALSE Exit Function End If Dim hmixer As HANDLE If mixerOpen(hmixer,0,0,0,0)<>MMSYSERR_NOERROR Then GetMasterVolumeDetail = FALSE Exit Function End If Dim mxl As MIXERLINE mxl.cbStruct = SizeOf(MIXERLINE) mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS If mixerGetLineInfo(hmixer,mxl,MIXER_OBJECTF_HMIXER Or MIXER_GETLINEINFOF_COMPONENTTYPE)<>MMSYSERR_NOERROR Then GetMasterVolumeDetail = FALSE mixerClose(hmixer) Exit Function End If Dim mxc As MIXERCONTROL Dim mxlc As MIXERLINECONTROLS mxlc.cbStruct = sizeof(MIXERLINECONTROLS) mxlc.dwLineID = mxl.dwLineID mxlc.dwControlType = MIXERCONTROL_CONTROLTYPE_VOLUME mxlc.cControls = 1 mxlc.cbmxctrl = sizeof(MIXERCONTROL) mxlc.pamxctrl = VarPtr(mxc) If mixerGetLineControls(hmixer,mxlc,MIXER_OBJECTF_HMIXER Or MIXER_GETLINECONTROLSF_ONEBYTYPE)<>MMSYSERR_NOERROR Then GetMasterVolumeDetail = FALSE End If Dim volume As MIXERCONTROLDETAILS_UNSIGNED Dim mxcd As MIXERCONTROLDETAILS mxcd.cbStruct = SizeOf(MIXERCONTROLDETAILS) mxcd.dwControlID = mxc.dwControlID mxcd.cChannels = 1 mxcd.cMultipleItems = 0 mxcd.cbDetails = sizeof(MIXERCONTROLDETAILS_UNSIGNED) mxcd.paDetails = VarPtr(volume) If mixerGetControlDetails(hmixer,mxcd,MIXER_OBJECTF_HMIXER Or MIXER_GETCONTROLDETAILSF_VALUE)=MMSYSERR_NOERROR Then nvol = volume.dwValue GetMasterVolumeDetail = TRUE Else GetMasterVolumeDetail = FALSE End If mixerClose(hmixer) End Function Function GetMasterVolumeMaximum(ByRef maxvol As DWord) As Long If VarPtr(maxvol)=NULL Then GetMasterVolumeMaximum = FALSE Exit Function End If Dim hmixer As HANDLE If mixerOpen(hmixer,0,0,0,0)<>MMSYSERR_NOERROR Then GetMasterVolumeMaximum = FALSE Exit Function End If Dim mxl As MIXERLINE mxl.cbStruct = SizeOf(MIXERLINE) mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS If mixerGetLineInfo(hmixer,mxl,MIXER_OBJECTF_HMIXER Or MIXER_GETLINEINFOF_COMPONENTTYPE)<>MMSYSERR_NOERROR Then GetMasterVolumeMaximum = FALSE mixerClose(hmixer) Exit Function End If Dim mxc As MIXERCONTROL Dim mxlc As MIXERLINECONTROLS mxlc.cbStruct = sizeof(MIXERLINECONTROLS) mxlc.dwLineID = mxl.dwLineID mxlc.dwControlType = MIXERCONTROL_CONTROLTYPE_VOLUME mxlc.cControls = 1 mxlc.cbmxctrl = sizeof(MIXERCONTROL) mxlc.pamxctrl = VarPtr(mxc) If mixerGetLineControls(hmixer,mxlc,MIXER_OBJECTF_HMIXER Or MIXER_GETLINECONTROLSF_ONEBYTYPE)=MMSYSERR_NOERROR Then maxvol = mxc.dwMaximum GetMasterVolumeMaximum = TRUE Else GetMasterVolumeMaximum = FALSE End If mixerClose(hmixer) End Function Function SetMasterVolume(nvol As Long) As Long If nvol<0 Or nvol>100 Then SetMasterVolume = FALSE Exit Function End If Dim maxvol As DWord SetMasterVolume = FALSE If GetMasterVolumeMaximum(maxvol)=TRUE Then If SetMasterVolumeDetail((maxvol*nvol/100) As DWord)=TRUE Then SetMasterVolume = TRUE End If End If End Function Function GetMasterVolume() As Long Dim maxvol As DWord,nvol As DWord If GetMasterVolumeDetail(nvol)=TRUE And GetMasterVolumeMaximum(maxvol)=TRUE Then GetMasterVolume = (nvol*100/maxvol) As Long Else GetMasterVolume = -1 End If End Function '////////////////////////////////////// ' ここからAPIと構造体の定義 '////////////////////////////////////// Declare Function mixerOpen Lib "winmm" (ByRef hmx As HANDLE,uMxId As DWord,dwCallback As DWord,dwInstance As DWord,fdwOpen As DWord) As Long Declare Function mixerClose Lib "winmm" (hmx As HANDLE) As Long Declare Function mixerGetLineInfo Lib "winmm" Alias "mixerGetLineInfoW" (hmxobj As HANDLE,ByRef pmxl As MIXERLINE,fdwInfo As DWord) As Long Declare Function mixerGetLineControls Lib "winmm" Alias "mixerGetLineControlsW" (hmxobj As HANDLE,ByRef pmxlc As MIXERLINECONTROLS,fdwControls As DWord) As Long Declare Function mixerGetControlDetails Lib "winmm" Alias "mixerGetControlDetailsW" (hmxobj As HANDLE,ByRef pmxcd As MIXERCONTROLDETAILS,fdwDetails As DWord) As Long Declare Function mixerSetControlDetails Lib "winmm" (hmxobj As HANDLE,ByRef pmxcd As MIXERCONTROLDETAILS,fdwDetails As DWord) As Long Const MMSYSERR_NOERROR = 0 Const MIXER_OBJECTF_HANDLE = &H80000000 Const MIXER_OBJECTF_MIXER = &H00000000 Const MIXER_OBJECTF_HMIXER = MIXER_OBJECTF_HANDLE Or MIXER_OBJECTF_MIXER Const MIXER_GETLINEINFOF_COMPONENTTYPE = 3 Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H00000002 Const MIXER_GETCONTROLDETAILSF_VALUE = &H00000000 Const MIXER_SETCONTROLDETAILSF_VALUE = &H00000000 Const MIXERCONTROL_CONTROLTYPE_VOLUME = &H50030001 Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H00000000 Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = MIXERLINE_COMPONENTTYPE_DST_FIRST + 4 Const MIXER_SHORT_NAME_CHARS = 16 Const MIXER_LONG_NAME_CHARS = 64 Const MAXPNAMELEN = 32 Type MIXERLINE cbStruct As DWord dwDestination As DWord dwSource As DWord dwLineID As DWord fdwLine As DWord dwUser As DWord dwComponentType As DWord cChannels As DWord cConnections As DWord cControls As DWord szShortName[MIXER_SHORT_NAME_CHARS-1] As Word szName[MIXER_LONG_NAME_CHARS-1] As Word dwType As DWord dwDeviceID As DWord wMid As Word wPid As Word vDriverVersion As DWord szPname[MAXPNAMELEN-1] As Word End Type Type MIXERCONTROL cbStruct As DWord dwControlID As DWord dwControlType As DWord fdwControl As DWord cMultipleItems As DWord szShortName[MIXER_SHORT_NAME_CHARS-1] As Word szName[MIXER_LONG_NAME_CHARS-1] As Word dwMinimum As DWord dwMaximum As DWord dwReserved1[3] As DWord Metrics As DWord dwReserved2[4] As DWord End Type Type MIXERLINECONTROLS cbStruct As DWord dwLineID As DWord dwControlType As DWord cControls As DWord cbmxctrl As DWord pamxctrl As *MIXERCONTROL End Type Type MIXERCONTROLDETAILS cbStruct As DWord dwControlID As DWord cChannels As DWord cMultipleItems As DWord cbDetails As DWord paDetails As VoidPtr End Type Type MIXERCONTROLDETAILS_UNSIGNED dwValue As DWord End Type |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |