タイトル 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.