Доброго времени суток всем! Никто не подскажет как через VBA проверять громкость канала микшера: "MIDI Synth"? При нулевой громкости перемещать ползунок в положение максимум? Иными словами как достучаться до: Панель управления/Звуки и аудио устройства/Громкость микшера(Дополнительно..)/Play Control/MIDI Synth?
А то сделал музыкальную программу в Excel - включаю Форму "MIDI Синтезатор" но при нажатии на клавиши звука из динамиков не слышно и приходится "ручками" все время выкручивать громкость на максимум....
"Послушайте! Ведь, если звезды зажигают - значит - это кому-нибудь нужно? Значит - кто-то хочет, чтобы они были?" В.В. Маяковский
Программа запросто читает ноты с листа Excel и тут же создает а затем проигрывает файл MIDI... При этом присутствует визуализация красивое меню и т.д. и т.п. К сожалению Си++ и Assembler пока не освоил...
Declare Function auxSetVolume Lib "winmm" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Sub SetVol()
Dim retVal As Long
retVal = auxSetVolume(0, &H80008000)
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Не могли бы прояснить ситуацию... Я создал модуль с вашим кодом... Запускаю этот модуль перед открытием формы управляющей MIDI звуком, но звук к сожалению все равно ручками приходится налаживать... Может что-то не так делаю...
Так будет надежнее, громкость MIDI устанавливается от 0 до 100
Код
Sub Test1()
SetMidi 75
End Sub
Sub SetMidi(Volume)
' Установка громкости MIDI от 0 до 100
Dim o As Object, f As String
Set o = CreateObject("WMPlayer.OCX")
If Volume > 100 Then Volume = 100
If Volume < 0 Then Volume = 0
o.settings.Volume = Volume
o.settings.balance = 0
With CreateObject("Scripting.FileSystemObject")
f = .BuildPath(.GetSpecialFolder(2), "MidiVol.mid")
.CreateTextFile(f, 1).Write "MThd" & String(3, 0) & Chr(6) & String(5, 0) & "0"
o.URL = f
While o.playState = 9: DoEvents: Wend
o.Close
.DeleteFile f
End With
Set o = Nothing
End Sub
Может я не совсем ясно пояснил... Звук MIDI прекрасно проигрывается в WMP плеере... здесь все ок... А вот при загрузке формы которая вытягивает из библиотеки winmm.dll MIDI-шные звуки почему то частенько бывают сбои (через раз по каким то причинам ползунок "MIDI Synth" микшера Windows оказывается на нуле... Вот что происходит при открытии моей формы...
Код
Private Declare Function midiOutOpen Lib "winmm.dll" _
(lphMidiOut As Long, ByVal uDeviceID As Long, ByVal _
dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function midiOutClose Lib "winmm.dll" _
(ByVal hMidiOut As Long) As Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" _
(ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Private Declare Function midiOutSetVolume Lib "winmm.dll" _
(ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Dim hMidiOut As Long
Dim Note As Long
Dim Swar As String
Dim T As Single
Dim i As Byte
Private Sub PlayNote()
On Error Resume Next
If NoSound = True Then Exit Sub
'Вычисляем числовые коффициенты на каждый голос
'hi = Velocity * 256 * 256 'числовой параметр, где Velocity = 127 это громкость
If CheckVox1.Value = True Then _
dx = (Vox1.Value * 256) + 8323264 'число 1-й голос = (Vox * 256) + 192 + hi, где Vox это номер инструмента библиотеки MIDI
If CheckVox2.Value = True Then _
dy = (Vox2.Value * 256) + 8323264 'число 2-й голос
If CheckVox3.Value = True Then _
dz = (Vox3.Value * 256) + 8323264 'число 3-й голос
midiOutClose hMidiOut
midiOutOpen hMidiOut, 0, 0, 0, 0
midiOutShortMsg hMidiOut, dx 'запускаем 1-й голос
midiOutShortMsg hMidiOut, Note 'запускаем ноту
midiOutShortMsg hMidiOut, dy 'запускаем 2-й голос
midiOutShortMsg hMidiOut, Note 'запускаем ноту
midiOutShortMsg hMidiOut, dz 'запускаем 3-й голос
midiOutShortMsg hMidiOut, Note 'запускаем ноту
T = Timer
Do: DoEvents: Loop Until Timer > T + Time.Value
midiOutClose hMidiOut
End Sub