Это у меня не открывается миди устройство или...
Участников: 3
FreeBasic :: Программирование :: Общее
Страница 1 из 1
Это у меня не открывается миди устройство или...
Добрый день!
Я переписал этот код ОТСЮДА
Вроде все так , но устройство миди открываться не желает. Собственно вопрос , может это у меня звуковуха какая-то хитрая, или я чего напартачил в коде ? Даже если не знаете и не понимаете этого кода, все равно прошу просто запустить его (работает или нет).
Конечно я могу использовать другие методы для работы с миди , но просто задело...
Я переписал этот код ОТСЮДА
Вроде все так , но устройство миди открываться не желает. Собственно вопрос , может это у меня звуковуха какая-то хитрая, или я чего напартачил в коде ? Даже если не знаете и не понимаете этого кода, все равно прошу просто запустить его (работает или нет).
Конечно я могу использовать другие методы для работы с миди , но просто задело...
- Код:
#include "windows.bi"
#include "win/mmsystem.bi"
Type WAVEFORMAT_MIDI
as WAVEFORMATEX wfx
As UINT32 USecPerQuarterNote
As UINT32 TicksPerQuarterNote
End Type
Type WAVEFORMAT_MIDI_MESSAGE
As UINT32 DeltaTicks
as DWORD MidiMsg
End Type
Dim As Ubyte Scale(8) = {63,65,67,68,70,72,74,75}
Dim shared As HANDLE hEvent
sub waveOutProc(hwo As HWAVEOUT ,uMsg As UINT ,dwInstance As DWORD ,dwParam1 As DWORD ,dwParam2 As DWORD )
If uMsg=WOM_DONE Then SetEvent(hEvent)
End Sub
hEvent=CreateEvent( NULL,TRUE,FALSE,NULL)
Dim As WAVEFORMAT_MIDI wfm
wfm.wfx.wFormatTag=&h3000 'WAVE_FORMAT_MIDI
wfm.wfx.nChannels=1
wfm.wfx.nBlockAlign=sizeof(WAVEFORMAT_MIDI_MESSAGE)
wfm.wfx.cbSize=(sizeof(WAVEFORMAT_MIDI)-sizeof(WAVEFORMATEX))
wfm.USecPerQuarterNote=1000000
wfm.TicksPerQuarterNote=100
Dim As MMRESULT Result
Dim As HWAVEOUT hWaveOut
Result = waveOutOpen(@hWaveOut,Cast(UInteger, -1), @wfm,_
Cast(DWORD,@waveOutProc), 0, CALLBACK_FUNCTION) ' error WAVERR_BADFORMAT
if Result<>MMSYSERR_NOERROR Then Beep : End
Dim As Integer i,j
Dim As WAVEFORMAT_MIDI_MESSAGE MidiMessage(16)
for i=0 To 7
j+=2
MidiMessage(j).DeltaTicks=100
MidiMessage(j).MidiMsg=&h1F0090 Or ((Scale(i)) Shl 8)
MidiMessage(j+1).DeltaTicks=100
MidiMessage(j+1).MidiMsg=&h1F0080 Or ((Scale(i)) Shl 8)
Next
Dim As WAVEHDR WaveHdr
WaveHdr.lpData = cast(LPSTR,@MidiMessage(0))
WaveHdr.dwBufferLength = sizeof(MidiMessage)
WaveHdr.dwFlags = 0
Result = waveOutPrepareHeader(hWaveOut,@WaveHdr,sizeof(WaveHdr))
Result = waveOutWrite(hWaveOut,@WaveHdr,sizeof(WaveHdr))
WaitForSingleObject(hEvent,INFINITE)
Result = waveOutUnprepareHeader(hWaveOut,@WaveHdr,sizeof(WaveHdr))
Result = waveOutClose(hWaveOut)
trew- Сообщения : 331
Дата регистрации : 2010-10-14
Re: Это у меня не открывается миди устройство или...
странно, у меня тоже не открывается. я поглядел c код, вроде все так как надо. думаю, что документацию по MidiOut читать нужно. меня самого заинтересовало.
пробовал менять номер устройства с -1 на 0 и 1, пофиг.
точно знаю, что с WaveOut проблем нет, а вот с миди...
можно конечно через mci, но это только для баловства. а вот если какой-нибудь миди редактор делать, лучше на низком уровне программить.
будут идеи, стукну.
пробовал менять номер устройства с -1 на 0 и 1, пофиг.
точно знаю, что с WaveOut проблем нет, а вот с миди...
можно конечно через mci, но это только для баловства. а вот если какой-нибудь миди редактор делать, лучше на низком уровне программить.
будут идеи, стукну.
electrik- Сообщения : 391
Дата регистрации : 2008-09-02
Возраст : 43
Откуда : галактика Млечный путь, система Солнечная, планета Земля, страна россия, город Санкт Петербург
Re: Это у меня не открывается миди устройство или...
electrik пишет:странно, у меня тоже не открывается. я поглядел c код, вроде все так как надо. думаю, что документацию по MidiOut читать нужно. меня самого заинтересовало.
пробовал менять номер устройства с -1 на 0 и 1, пофиг.
точно знаю, что с WaveOut проблем нет, а вот с миди...
можно конечно через mci, но это только для баловства. а вот если какой-нибудь миди редактор делать, лучше на низком уровне программить.
будут идеи, стукну.
Ну что же , может у тебя что получится. Ну а для тех, кому все таки хочется поиграться с миди, можно повертеть этот пример:
- Код:
#include "windows.bi"
#include "win/mmsystem.bi"
Dim shared hMidiOut As hMidiOut
' массив с нотами
Dim shared M(...) as Integer=>{150,49,53,63,61,50,55,60,58,51,55,63,63,50,55,60,58,52,58,55,52,55,55,55,55,58,61,62,56,57}
'Структура для команд
Union midimsg
dw As UInteger
b(2) As UByte
End Union
' проверяем миди устройства в системе
If midiOutGetNumDevs = 0 Then End
' Открываем или создаем устройство миди
midiOutOpen @hMidiOut, -1, 0, 0, 0
Dim d as midimsg ' создаем объект структуры
d.b(2)=64 ' в нашем примере громкость будет постоянной
Dim UB As Integer = UBound(M)' узнаем сколько ячеек в массиве
For i As Integer = 0 To UB
Dim T As Double ' переменная для таймера
d.b(0)=&h80 ' выключаем звучание чтобы не было наложения звука
' отправляем команду выключения
midiOutShortMsg hMidiOut, d.dw
d.b(0)=&h90 ' включаем звук
'устанавливаем инструмент SynthStrings1
midiOutShortMsg hMidiOut, &hC0+&h100*50
d.b(1)=M(i) ' берем ноту из массива
midiOutShortMsg hMidiOut, d.dw ' проигрываем звук
'устанавливаем инструмент Koto
midiOutShortMsg hMidiOut, &hC0+&h100*107
d.b(1)=M(i)' берем ноту из массива
midiOutShortMsg hMidiOut, d.dw ' проигрываем звук
'устанавливаем инструмент SynthDrum
midiOutShortMsg hMidiOut, &hC0+&h100*118
d.b(1)=M(i)' берем ноту из массива
midiOutShortMsg hMidiOut, d.dw ' проигрываем звук
'устанавливаем инструмент BowedPad
midiOutShortMsg hMidiOut, &hC0+&h100*92
d.b(1)=M(i)' берем ноту из массива
midiOutShortMsg hMidiOut, d.dw ' проигрываем звук
If i=UB Then Sleep(650) ' ограничиваем время звучания завершающей ноты
T = Timer
Do: Loop Until Timer >= T + .4 ' время звучания каждой ноты
Next
midiOutClose hMidiOut 'закрываем устройство
/'СПИСОК ИНСТРУМЕНТОВ
0. AcousticGrandPiano скрипка
1. BrightAcousticPiano
2. ElectricGrandPiano
3. HonkyTonkPiano
4. ElectricPiano1
5. ElectricPiano2
6. Harpsichord
7. Clavinet
8. Celesta
9. Glockenspiel
10. MusicBox
11. Vibraphone
12. Marimba
13. Xylophone
14. TubularBells
15. Dulcimer
16. DrawbarOrgan
17. PercussiveOrgan
18. RockOrgan
19. ChurchOrgan
20. ReedOrgan
21. Accordion
22. Harmonica
23. TangoAccordion
24. AcousticNylonGuitar
25. AcousticSteelGuitar
26. JazzElectricGuitar
27. CleanElectricGuitar
28. MutedElectricGuitar
29. OverdrivenGuitar
30. DistortionGuitar
31. GuitarHarmonics
32. AcousticBass
33. FingeredElectricBass
34. PickedElectricBass
35. FretlessBass
36. SlapBass1
37. SlapBass2
38. SynthBass1
39. SynthBass2
40. Violin
41. Viola
42. Cello 43. Contrabass
44. TremoloStrings
45. PizzicatoStrings
46. OrchestralHarp
47. Timpani
48. StringEnsemble1
49. StringEnsemble2
50. SynthStrings1
51. SynthStrings2
52. ChoirAahs
53. VoiceOohs
54. SynthVoice
55. OrchestraHit
56. Trumpet
57. Trombone
58. Tuba
59. MutedTrumpet
60. FrenchHorn
61. BrassSection
62. SynthBrass1
63. SynthBrass2
64. SopranoSax
65. AltoSax
66. TenorSax
67. BaritoneSax
68. Oboe
69. EnglishHorn
70. Bassoon
71. Clarinet
72. Piccolo
73. Flute
74. Recorder
75. PanFlute
76. BlownBottle
77. Shakuhachi
78. Whistle
79. Ocarina
80. SquareLead
81. SawtoothLead
82. CalliopeLead
83. ChiffLead
84. CharangLead
85. VoiceLead 86. FifthsLead
87. BassandLead
88. NewAgePad
89. WarmPad
90. PolySynthPad
91. ChoirPad
92. BowedPad
93. MetallicPad
94. HaloPad
95. SweepPad
96. SynthFXRain
97. SynthFXSoundtrack
98. SynthFXCrystal
99. SynthFXAtmosphere
100. SynthFXBrightness
101. SynthFXGoblins
102. SynthFXEchoes
103. SynthFXSciFi
104. Sitar
105. Banjo
106. Shamisen
107. Koto
108. Kalimba
109. Bagpipe
110. Fiddle
111. Shanai
112. TinkleBell
113. Agogo
114. SteelDrums
115. Woodblock
116. TaikoDrum
117. MelodicTom
118. SynthDrum
119. ReverseCymbal
120. GuitarFretNoise
121. BreathNoise
122. Seashore
123. BirdTweet
124. TelephoneRing
125. Helicopter
126. Applause
127. Gunshot'/
Может что неправильно понял в работе функций, сильно не въезжал...
trew- Сообщения : 331
Дата регистрации : 2010-10-14
Re: Это у меня не открывается миди устройство или...
Здорово, единственное - у меня этот пример в XP играет только через левую колонку.
FreeBasic :: Программирование :: Общее
Страница 1 из 1
Права доступа к этому форуму:
Вы не можете отвечать на сообщения
|
|