暇だなぁ…
コード: /* マスターボリューム変更
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
暇だなぁ…
[code]/* マスターボリューム変更 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が返る */[/code]
[hide][code] 'テスト(何か再生しながら#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 [/code][/hide]
|