Это у меня не открывается миди устройство или...

Предыдущая тема Следующая тема Перейти вниз

Это у меня не открывается миди устройство или...

Сообщение  trew в Пн Июн 18, 2012 2:52 pm

Добрый день!

Я переписал этот код ОТСЮДА

Вроде все так , но устройство миди открываться не желает. Собственно вопрос , может это у меня звуковуха какая-то хитрая, или я чего напартачил в коде ? Даже если не знаете и не понимаете этого кода, все равно прошу просто запустить его (работает или нет).

Конечно я могу использовать другие методы для работы с миди , но просто задело...



Код:
#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: Это у меня не открывается миди устройство или...

Сообщение  electrik в Сб Июл 07, 2012 12:13 pm

странно, у меня тоже не открывается. я поглядел c код, вроде все так как надо. думаю, что документацию по MidiOut читать нужно. меня самого заинтересовало.
пробовал менять номер устройства с -1 на 0 и 1, пофиг.
точно знаю, что с WaveOut проблем нет, а вот с миди...
можно конечно через mci, но это только для баловства. а вот если какой-нибудь миди редактор делать, лучше на низком уровне программить.
будут идеи, стукну.

electrik

Сообщения : 391
Дата регистрации : 2008-09-02
Возраст : 37
Откуда : галактика Млечный путь, система Солнечная, планета Земля, страна россия, город Санкт Петербург

Посмотреть профиль

Вернуться к началу Перейти вниз

Re: Это у меня не открывается миди устройство или...

Сообщение  trew в Сб Июл 07, 2012 2:52 pm

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: Это у меня не открывается миди устройство или...

Сообщение  DEPOzit в Ср Июл 11, 2012 11:16 am

Здорово, единственное - у меня этот пример в XP играет только через левую колонку.

DEPOzit

Сообщения : 113
Дата регистрации : 2008-05-15
Возраст : 36
Откуда : Смоленская обл.

Посмотреть профиль http://freebasic.ru/

Вернуться к началу Перейти вниз

Re: Это у меня не открывается миди устройство или...

Сообщение  Спонсируемый контент


Спонсируемый контент


Вернуться к началу Перейти вниз

Предыдущая тема Следующая тема Вернуться к началу

- Похожие темы

 
Права доступа к этому форуму:
Вы не можете отвечать на сообщения