タイトル | WAVEOUTのボリュームコントロールを調整する |
対象言語 | VB4.0, Access95以降 |
動作確認OS | Windows95,98,NT4.0 |
使用関数 | waveOutSetVolumewave OutGetVolume waveOutGetDevCaps waveOutGetNumDevs |
改築日 | 1999/07/28(1998/12/1) |
Source Download |
WAVEOUTのボリュームを変更します。 WAVEファイルを再生している時に試してみてください。 設定範囲はマシンの環境によって変わります。 |
![]() |
1. フォームを作成しコマンドボタン(Command1,Command2)を貼り付けてください。 Option Explicit Private Sub Form_Load() Dim vol As Long vol = Y_GetWaveOutVolume() '左の音量を取得 Text1 = Val("&H" + Right$("00000000" + Hex$(vol), 4) + "&") HScroll1 = Text1 - 32768 'VolemeControlを起動 If Dir(Environ("windir") & "\Sndvol32.exe") <> vbNullString Then Call Shell("Sndvol32.exe", 1) End If End Sub Private Sub HScroll1_Change() Dim strbuf As String Dim vol As Long Text1 = HScroll1 + 32768 If Val(Text1) > &HFFFF& Or Val(Text1) < 0 Then Call MsgBox("0 〜 65535 までの範囲の値を入力してよぉ (ToT)") Else strbuf = Right$("0000" + Hex$(Val(Text1)), 4) vol = Val("&H" + strbuf + strbuf) Call Y_SetWaveOutVolume(vol) End If End Sub |
2.モジュールウインドウを作成し、下のソースを入力してください。 Option Explicit 'WaveOutデバイスの機能を取得する Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" _ (ByVal uDeviceID As Long, lpCaps As WAVEOUTCAPS, ByVal uSize As Long) As Long 'このマシンで使用出来るWaveOutデバイスの数を取得する Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long 'WaveOutデバイスの音量を取得する Declare Function waveOutGetVolume Lib "winmm.dll" _ (ByVal uDeviceID As Long, lpdwVolume As Long) As Long 'WaveOutデバイスの音量を設定する Declare Function waveOutSetVolume Lib "winmm.dll" _ (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long Public Const MAXPNAMELEN = 32 Type WAVEOUTCAPS wMid As Integer 'WaveFormAudioDeviceDriverのメーカー識別子 wPid As Integer 'WaveFormAudioDeviceの製品識別子 vDriverVersion As Long 'ドライバーのバージョン(上位バイト:メジャー 下位バイト:マイナー) szPname As String * MAXPNAMELEN 'WaveFormAudioDeviceの製品名 dwFormats As Long 'サポートされている標準フォーマット wChannels As Integer 'サポートされている入力チャネル番号(1:モノラル 2:ステレオ) wReserved As Integer '予約 dwSupport As Long 'サポートされているオプション機能 End Type 'dwSupportの設定値 Public Const WAVECAPS_LRVOLUME = &H8 '左右両方の音量コントロールをサポート Public Const WAVECAPS_PITCH = &H1 'ピッチコントロールをサポート Public Const WAVECAPS_PLAYBACKRATE = &H2 '再生レートコントロールをサポート Public Const WAVECAPS_SYNC = &H10 'ドライバは同期的であり、バッファの再生中はブロックする Public Const WAVECAPS_VOLUME = &H4 '音量コントロールをサポート Public Const MMSYSERR_NOERROR = 0 ' no error Public Function Y_GetWaveOutVolume() As Long '*********************************************************** '機能 : WaveOutの現在のボリューム音量を取得する '戻り値: WaveOutの音量数値 (&H0〜 &HFFFFFFFF) ' 上位 16Bit 右音量 下位 16Bit 左音量 ' モノラルの場合、下位 16Bitのみ '*********************************************************** Dim DevCnt As Long Dim DevID As Long Dim caps As WAVEOUTCAPS Dim longret As Long Dim vol As Long 'WaveOutオーディオデバイスの数を取得する DevCnt = waveOutGetNumDevs() 'WaveOutを検索 If DevCnt <> 0 Then For DevID = 0 To DevCnt - 1 longret = waveOutGetDevCaps(DevID, caps, CLng(Len(caps))) If longret = MMSYSERR_NOERROR And (caps.dwSupport And WAVECAPS_VOLUME) <> 0 Then 'WaveOutのボリューム音量を取得する If waveOutGetVolume(DevID, vol) = MMSYSERR_NOERROR Then Y_GetWaveOutVolume = vol End If Exit Function End If Next End If End Function Public Sub Y_SetWaveOutVolume(vol As Long) '*********************************************************** '機能 : WaveOutのボリューム音量を設定する '引数 : vol 音量数値 (&H0〜 &HFFFFFFFF) ' 上位 16Bit 右音量 下位 16Bit 左音量 ' モノラルの場合、下位 16Bitのみ設定する '*********************************************************** Dim DevCnt As Long Dim DevID As Long Dim caps As WAVEOUTCAPS Dim longret As Long 'WaveOutオーディオデバイスの数を取得する DevCnt = waveOutGetNumDevs() 'WaveOutを検索 If DevCnt <> 0 Then For DevID = 0 To DevCnt - 1 longret = waveOutGetDevCaps(DevID, caps, CLng(Len(caps))) If longret = MMSYSERR_NOERROR And (caps.dwSupport And WAVECAPS_VOLUME) <> 0 Then 'ボリュームを設定する longret = waveOutSetVolume(DevID, vol) Exit Sub End If Next End If End Sub |
Copyright (C)1997-2001 空耳工房 MY2Project All rights reserved. |