コード: 全て選択
/* マスターボリューム変更
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