ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2017年9月22日(金) 11:40

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 1 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 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が返る
*/
[hide]
コード:
'テスト(何か再生しながら#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
[/hide]


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 1 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[1人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke