PureBasic - форум

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » PureBasic - форум » Программирование на PureBasic » Миди синтезатор


Миди синтезатор

Сообщений 1 страница 27 из 27

1

Хочу спросить а в новые компы и операциоки встраивают микросхему синтезатора или программно драйвер?
Или сейчас через библиотеки другие?

0

2

Sergeihik
теоретически зачем? Примитивное проигрывание midi и так работает, и даже не такое уж примитивное, взависимости от драйвера и программы. Ну а качественное с железной реализацией, для этого наверно существуют специальные аудиокарты и скорее всего внешнее устройство. Зачем в комп пихать то что не будет использоваться на 99%.
Вот пример

0

3

Обращение к midi реализовано через API

Код:
dwDuration.l=550
hMidiOut.l
;--------------------------------------------------
rc.l=midiOutOpen_(@hMidiOut,#MIDI_MAPPER,#Null,0,#CALLBACK_NULL)
If rc=#MMSYSERR_NOERROR
  Restore lpNoteList
  For i=0 To 15
    
    Read.l a.l
    midiOutShortMsg_(hMidiOut,a)
    b.l=a
    If a&$F0=$90
      b&$FFFF0F
      b!128
      Sleep_(dwDuration)
      midiOutShortMsg_(hMidiOut,b)
    EndIf
    
  Next i
  midiOutClose_(hMidiOut)
Else
  Debug "err:"+Str(rc)
EndIf


DataSection
  lpNoteList:
  Data.l $75C0
  Data.l $7f3090   ;two octave scale C to C
  Data.l $7f3290
  Data.l $7f3490
  Data.l $7f3590
  Data.l $7f3790
  Data.l $7f3990
  Data.l $7f3b90
  Data.l $7f3c90
  Data.l $7f3e90
  Data.l $7f4090
  Data.l $7f4190
  Data.l $7f4390
  Data.l $7f4590
  Data.l $7f4790
  Data.l $7f4890
  Data.l 0         ;terminate list with a 0
  

0

4

AZJIO написал(а):

Sergeihik
теоретически зачем? Примитивное проигрывание midi и так работает, и даже не такое уж примитивное, взависимости от драйвера и программы. Ну а качественное с железной реализацией, для этого наверно существуют специальные аудиокарты и скорее всего внешнее устройство. Зачем в комп пихать то что не будет использоваться на 99%.
Вот пример

Да так балуюсь хочу что то наподобие этого сделать https://www.youtube.com/watch?v=bTO6I6RJL_Y

Код:
Structure hMidiOut;тупо для ссылки на процедуры
  hMidiOut.i
EndStructure
;

Structure notaON
  konalkomanda.a
  nomernotON.a
  silaudara.a
  huiznatstarhyibait.a
EndStructure
Structure notaOF
  konalkomanda.a
  nomernotyOf.a
  zatuhanie.a
  huiznatstarhyibait.a
EndStructure

Structure nota
  StructureUnion
    notaON.notaON
    komandanotyON.i
  EndStructureUnion
  ;
  StructureUnion
    notaOF.notaOF
    komandanotyOF.i
  EndStructureUnion
  time_uderganiy_klavihi.i
  time_pause.i
EndStructure

Global Klaviha.nota

Klaviha\notaON\konalkomanda=$90
Klaviha\notaON\silaudara=127
Klaviha\notaOF\konalkomanda=$80
Klaviha\notaOF\zatuhanie=127



#Channel1 = 0

Global hMidiOut.i
Global midiport.i
Procedure Error(funkciy$,ohibka.i)
    Select  ohibka
           Case #MIXERR_BASE
               MessageRequester(funkciy$,"Минимальное значение кода ошибки микшера")   
           Case #MIXERR_INVALLINE
               MessageRequester(funkciy$,"Недопустимый индекс/идентификатор линии")
            Case #MIXERR_INVALCONTROL
              MessageRequester(funkciy$,"Недопустимый индекс/идентификатор элемента управления")
            Case #MIXERR_INVALVALUE
              MessageRequester(funkciy$,"Недопустимое значение элемента управления")
            Case #MIXERR_LASTERROR
               MessageRequester(funkciy$,"Максимальное значение кода ошибки микшера") 
            Case #MMSYSERR_ALLOCATED
               MessageRequester(funkciy$,"Устройство занято другим приложением")
            Case #MMSYSERR_BADDEVICEID
              MessageRequester(funkciy$,"Недопустимый номер устройства")
            Case #MMSYSERR_NOTENABLED
               MessageRequester(funkciy$,"Драйвер не активизирован")  
            Case #MMSYSERR_INVALFLAG
               MessageRequester(funkciy$,"Один или несколько флагов недействительны.")       
            Case #MMSYSERR_INVALHANDLE
               MessageRequester(funkciy$,"Недопустимый дискриптор открытого устройства")  
            Case #MMSYSERR_INVALPARAM
              MessageRequester(funkciy$,"Один или несколько параметров недействительны.")
            Case #MMSYSERR_NODRIVER
              MessageRequester(funkciy$,"Драйвер отсутствует") 
            Case #MMSYSERR_NOMEM
              MessageRequester(funkciy$,"Недостаточно памяти для выделения")
            Case #MMSYSERR_NOTSUPPORTED
              MessageRequester(funkciy$,"Запрошенная функция не поддерживается")
            Case #MMSYSERR_HANDLEBUSY
              MessageRequester(funkciy$,"Над ключом выполняется операция от другой задачи (thread)")
            Case #MMSYSERR_INVALIDALIAS ;13
              
            Case 14;#MMSYSERR_BADDB ;14 
              
            Case 15;#MMSYSERR_KEYNOTFOUND ;15
              
            Case 16;#MMSYSERR_READERROR ;16 
              
            Case 17;#MMSYSERR_WRITEERROR; 17
              
            Case 18;#MMSYSERR_DELETEERROR ;18
              
            Case 19;#MMSYSERR_VALNOTFOUND ;19 
            Case 20;#MMSYSERR_NODRIVERCB	
              ;MessageRequester(funkciy$,"Драйвер не выполнил уведомления (callback)")   
            Case #MMSYSERR_BADERRNUM
              MessageRequester(funkciy$,"Код ошибки вне допустимого диапазона")
             Case #MMSYSERR_ERROR
              MessageRequester(funkciy$,"Неопределенная ошибка")           
          EndSelect
EndProcedure  
Procedure.i midiinit(Konstanta.i)
Protected midi.MIDIOUTCAPS
Protected devnum
#MOD_MIDIPORT =1;Аппаратный порт MIDI.
#MOD_SYNTH =2;Синтезатор
#MOD_SQSYNTH=3;Синтезатор прямоугольных импульсов.
#MOD_FMSYNTH=4;FM-синтезатор.
#MOD_MAPPER =5;Microsoft MIDI маппер.
#MOD_WAVETABLE=6;Аппаратный волновой синтезатор.
#MOD_SWSYNTH=7 ;Программный синтезатор

If midiOutGetNumDevs_();извлекает количество MIDI-устройств вывода,0=нет устройств
For devnum=0 To 7
  If midiOutGetDevCaps_(devnum,@midi,SizeOf(MIDIOUTCAPS))=0
    Debug midi\wTechnology;что есть
    If midi\wTechnology=Konstanta;#MOD_SWSYNTH
      Debug PeekS(@midi\szPname,-1,#PB_Unicode);Название продукта в строке с нулевым символом в конце.
      Debug midi\wVoices;количество голосов
      Debug midi\wNotes ;количество одновременных нот, которые могут быть воспроизведены
      Debug midi\wChannelMask;Портовые устройства, которые передают по всем каналам, устанавливают этот элемент в 0xFFFF. 
      Debug midi\dwSupport;Дополнительный функционал, поддерживаемый устройством(MIDICAPS_VOLUME=1 Поддерживает регулировку громкости.)
      ProcedureReturn devnum
    EndIf
  EndIf
Next
ProcedureReturn 0
EndIf
EndProcedure


Procedure.i midiOutOpen(midiport.i,*hMidiOut.hMidiOut,flagi.i,dwCallback.i=0,CallbackInstance.i=0);открывает выходное MIDI-устройство 
 Protected result.i 
 result=midiOutOpen_(*hMidiOut.hMidiOut,midiport,dwCallback,CallbackInstance,flagi)
 If result=MMSYSERR_NOERROR
   ProcedureReturn 1
 Else
   Error("Error midiOutOpen()",result)
   ProcedureReturn 0
 EndIf  
EndProcedure
Procedure.i midiOutClose(*hMidiOut);получаем дискриптор устройства
 Protected MidiOut.i
 !mov dword eax,[p.p_hMidiOut]
 !mov dword eax,[eax]
 !mov dword [p.v_MidiOut],eax
  If midiOutClose_(MidiOut)=#MMSYSERR_NOERROR
       !mov dword eax,[p.p_hMidiOut]
       !mov dword [eax],0
    ProcedureReturn 1
  Else
    MessageRequester("Error midiOutClose()","INVALIDE_HANDLE hMidiOut")
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure MidiOutMessage(hMidi,iStatus,iChannel,iData1,iData2)
  dwMessage = iStatus | iChannel | (iData1 << 8 ) | (iData2 << 16)
  ProcedureReturn midiOutShortMsg_(hMidi, dwMessage) ;
EndProcedure
Procedure SetInstrument(channel,instrument)
  MidiOutMessage(hMidiOut, $C0,  channel, instrument, 0)
EndProcedure

Procedure pleysound()
 ;Klaviha\notaON\nomernotON=30
  ;Klaviha\notaOF\nomernotyOf=30
  
  For i=0 To 127
  Klaviha\notaON\nomernotON=Random(127)
  Klaviha\notaOF\nomernotyOf=Random(127)
  Klaviha\time_uderganiy_klavihi=Random(150)
  Klaviha\time_pause=Random(150)
  
  
  midiOutShortMsg_(hMidiOut, Klaviha\komandanotyON);нота on
 ; Delay(50)
  Delay(Klaviha\time_uderganiy_klavihi)
  
  midiOutShortMsg_(hMidiOut, Klaviha\komandanotyOF);нота of
  Delay(Klaviha\time_pause)
 Next
EndProcedure

Procedure _Beep(nota,octave=2,Duration=200,pause=0)
nota=nota+0+12*octave
Klaviha\notaON\nomernotON=nota
Klaviha\notaOF\nomernotyOf=nota
Klaviha\time_uderganiy_klavihi=Duration
Klaviha\time_pause=pause

;;Polyphonic Mode On ,проигрывает ноты в канале одновременно

midiOutShortMsg_(hMidiOut, Klaviha\komandanotyON);нота on
Klaviha\notaON\nomernotON=nota-30

midiOutShortMsg_(hMidiOut, Klaviha\komandanotyON)

Klaviha\notaON\nomernotON=nota+50
midiOutShortMsg_(hMidiOut, Klaviha\komandanotyON)

Klaviha\notaON\nomernotON=nota+100
midiOutShortMsg_(hMidiOut, Klaviha\komandanotyON)

Klaviha\notaON\nomernotON=nota+80
midiOutShortMsg_(hMidiOut, Klaviha\komandanotyON)

Klaviha\notaON\nomernotON=nota+23
midiOutShortMsg_(hMidiOut, Klaviha\komandanotyON)

Klaviha\notaON\nomernotON=nota+45
midiOutShortMsg_(hMidiOut, Klaviha\komandanotyON)

Klaviha\notaON\nomernotON=nota-24
midiOutShortMsg_(hMidiOut, Klaviha\komandanotyON)

Klaviha\notaON\nomernotON=nota-24
midiOutShortMsg_(hMidiOut, Klaviha\komandanotyON)

  Delay(Klaviha\time_uderganiy_klavihi)
  
  midiOutShortMsg_(hMidiOut, Klaviha\komandanotyOF);нота of
  MidiOutMessage(hMidiOut,$B0, 0, $7B, 0);All Notes Off
  ;MidiOutMessage(hMidiOut,$B0, 0, 120, 0);All Sounds Off
  Delay(Klaviha\time_pause)

EndProcedure


Procedure pleysound2()
  _Beep(1,6,100)
_Beep(4,5,100)
_Beep(3,5,100)
_Beep(4,5,100)
_Beep(1,5,100)
_Beep(4,5,100)
_Beep(3,5,100)
_Beep(4,5,100)

_Beep(1,6,100)
_Beep(4,5,100)
_Beep(3,5,100)
_Beep(4,5,100)
_Beep(1,5,100)
_Beep(4,5,100)
_Beep(3,5,100)
_Beep(4,5,100)

_Beep(9,5,100)
_Beep(6,5,100)
_Beep(5,5,100)
_Beep(6,5,100)
_Beep(1,5,100)
_Beep(6,5,100)
_Beep(5,5,100)
_Beep(6,5,100)

_Beep(9,5,100)
_Beep(6,5,100)
_Beep(5,5,100)
_Beep(6,5,100)
_Beep(1,5,100)
_Beep(6,5,100)
_Beep(5,5,100)
_Beep(6,5,100)

_Beep(12,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(3,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(6,5,100)

_Beep(12,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(3,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(6,5,100)

_Beep(1,6,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)
_Beep(4,5,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)

_Beep(1,6,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)
_Beep(4,5,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)

_Beep(4,6,100)
_Beep(9,5,100)
_Beep(8,5,100)
_Beep(9,5,100)
_Beep(4,5,100)
_Beep(9,5,100)
_Beep(8,5,100)
_Beep(9,5,100)

_Beep(4,6,100)
_Beep(9,5,100)
_Beep(8,5,100)
_Beep(9,5,100)
_Beep(4,5,100)
_Beep(9,5,100)
_Beep(8,5,100)
_Beep(9,5,100)

_Beep(3,6,100)
_Beep(7,5,100)
_Beep(5,5,100)
_Beep(7,5,100)
_Beep(3,5,100)
_Beep(7,5,100)
_Beep(5,5,100)
_Beep(7,5,100)

_Beep(3,6,100)
_Beep(7,5,100)
_Beep(5,5,100)
_Beep(7,5,100)
_Beep(3,5,100)
_Beep(7,5,100)
_Beep(5,5,100)
_Beep(7,5,100)

_Beep(3,6,100)
_Beep(8,5,100)
_Beep(7,5,100)
_Beep(8,5,100)
_Beep(3,5,100)
_Beep(8,5,100)
_Beep(7,5,100)
_Beep(8,5,100)

_Beep(3,6,100)
_Beep(8,5,100)
_Beep(7,5,100)
_Beep(8,5,100)
_Beep(3,5,100)
_Beep(8,5,100)
_Beep(7,5,100)
_Beep(8,5,100)

_Beep(1,6,100)
_Beep(5,5,100)
_Beep(3,5,100)
_Beep(5,5,100)
_Beep(1,5,100)
_Beep(5,5,100)
_Beep(3,5,100)
_Beep(5,5,100)

_Beep(1,6,100)
_Beep(5,5,100)
_Beep(3,5,100)
_Beep(5,5,100)
_Beep(1,5,100)
_Beep(5,5,100)
_Beep(3,5,100)
_Beep(5,5,100)

_Beep(1,6,100)
_Beep(6,5,100)
_Beep(5,5,100)
_Beep(6,5,100)
_Beep(1,5,100)
_Beep(6,5,100)
_Beep(5,5,100)
_Beep(6,5,100)

_Beep(1,6,100)
_Beep(6,5,100)
_Beep(5,5,100)
_Beep(6,5,100)
_Beep(1,5,100)
_Beep(6,5,100)
_Beep(5,5,100)
_Beep(6,5,100)

_Beep(11,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(3,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(6,5,100)

_Beep(11,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(3,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(6,5,100)

_Beep(11,5,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)
_Beep(4,5,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)

_Beep(11,5,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)
_Beep(4,5,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)

_Beep(9,5,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)
_Beep(4,5,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)

_Beep(9,5,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)
_Beep(4,5,100)
_Beep(8,5,100)
_Beep(6,5,100)
_Beep(8,5,100)

_Beep(9,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(11,4,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)

_Beep(9,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(11,4,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)

_Beep(8,5,100)
_Beep(11,4,100)
_Beep(9,4,100)
_Beep(11,4,100)
_Beep(4,5,100)
_Beep(11,4,100)
_Beep(9,4,100)
_Beep(11,4,100)

_Beep(8,5,100)
_Beep(11,4,100)
_Beep(9,4,100)
_Beep(11,4,100)
_Beep(4,5,100)
_Beep(11,4,100)
_Beep(9,4,100)
_Beep(11,4,100)

_Beep(6,5,100)
_Beep(1,5,100)
_Beep(11,4,100)
_Beep(1,5,100)
_Beep(10,4,100)
_Beep(1,5,100)
_Beep(11,4,100)
_Beep(1,5,100)

_Beep(6,5,100)
_Beep(1,5,100)
_Beep(11,4,100)
_Beep(1,5,100)
_Beep(10,4,100)
_Beep(1,5,100)
_Beep(11,4,100)
_Beep(1,5,100)

_Beep(6,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(12,4,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)

_Beep(6,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(12,4,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)

_Beep(6,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(12,4,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)

_Beep(6,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(12,4,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)

_Beep(4,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(8,4,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(4,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(8,4,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(6,4,100)
_Beep(4,5,100)
_Beep(3,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(3,5,100)
_Beep(4,5,100)

_Beep(6,4,100)
_Beep(4,5,100)
_Beep(3,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(3,5,100)
_Beep(4,5,100)

_Beep(7,4,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(4,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(7,4,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(4,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(4,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(8,4,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(4,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(8,4,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(7,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(10,4,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(7,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(10,4,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(8,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(8,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(9,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(9,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(8,3,1600)

;=========================

_Beep(8,3,100)
_Beep(12,3,100)
_Beep(3,4,100)
_Beep(6,4,100)
_Beep(9,4,100)
_Beep(6,4,100)
_Beep(5,4,100)
_Beep(6,4,100)
_Beep(12,4,100)
_Beep(6,4,100)
_Beep(3,5,100)
_Beep(12,4,100)
_Beep(9,4,100)
_Beep(6,4,100)
_Beep(5,4,100)
_Beep(6,4,100)
_Beep(8,3,100)
_Beep(1,4,100)
_Beep(4,4,100)
_Beep(8,4,100)
_Beep(1,5,100)
_Beep(8,4,100)
_Beep(7,4,100)
_Beep(8,4,100)
_Beep(4,5,100)
_Beep(1,5,100)
_Beep(8,5,100)
_Beep(4,5,100)
_Beep(1,5,100)
_Beep(9,4,100)
_Beep(8,4,100)
_Beep(9,4,100)
_Beep(8,3,100)
_Beep(10,3,100)
_Beep(7,4,100)
_Beep(1,5,100)
_Beep(4,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)
_Beep(7,5,100)
_Beep(1,5,100)
_Beep(10,5,100)
_Beep(7,5,100)
_Beep(4,5,100)
_Beep(1,5,100)
_Beep(12,4,100)
_Beep(1,5,100)

_Beep(8,3,1600)
_Beep(8,4,1600,100)

;=========================


_Beep(3,6,100)
_Beep(1,6,100)
_Beep(3,6,100)
_Beep(4,6,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)
_Beep(10,5,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)

_Beep(3,6,100)
_Beep(12,5,100)
_Beep(10,5,100)
_Beep(12,5,100)
_Beep(8,5,100)
_Beep(12,5,100)
_Beep(10,5,100)
_Beep(12,5,100)

_Beep(1,6,100)
_Beep(10,5,100)
_Beep(8,5,100)
_Beep(10,5,100)
_Beep(7,5,100)
_Beep(10,5,100)
_Beep(8,5,100)
_Beep(10,5,100)

_Beep(12,5,100)
_Beep(8,5,100)
_Beep(7,5,100)
_Beep(8,5,100)
_Beep(3,5,100)

_Beep(8,6,100)
_Beep(6,6,100)
_Beep(8,6,100)
_Beep(9,6,100)
_Beep(6,6,100)
_Beep(4,6,100)
_Beep(6,6,100)
_Beep(3,6,100)
_Beep(6,6,100)
_Beep(4,6,100)
_Beep(6,6,100)

_Beep(8,6,100)
_Beep(4,6,100)
_Beep(3,6,100)
_Beep(4,6,100)
_Beep(1,6,100)
_Beep(4,6,100)
_Beep(3,6,100)
_Beep(4,6,100)

_Beep(6,6,100)
_Beep(3,6,100)
_Beep(1,6,100)
_Beep(3,6,100)
_Beep(12,5,100)
_Beep(3,6,100)
_Beep(1,6,100)
_Beep(3,6,100)

_Beep(4,6,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)
_Beep(8,5,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)

_Beep(9,5,100)
_Beep(6,6,100)
_Beep(4,6,100)
_Beep(6,6,100)
_Beep(8,5,100)
_Beep(4,6,100)
_Beep(3,6,100)
_Beep(4,6,100)
_Beep(6,5,100)
_Beep(3,6,100)
_Beep(1,6,100)
_Beep(3,6,100)
_Beep(4,5,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)
_Beep(9,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(8,5,100)
_Beep(4,5,100)
_Beep(3,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(8,5,100)
_Beep(3,6,100)
_Beep(1,6,100)
_Beep(3,6,100)

_Beep(4,6,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)
_Beep(10,5,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)

_Beep(3,6,100)
_Beep(12,5,100)
_Beep(10,5,100)
_Beep(12,5,100)
_Beep(8,5,100)
_Beep(12,5,100)
_Beep(10,5,100)
_Beep(12,5,100)

_Beep(1,6,100)
_Beep(10,5,100)
_Beep(8,5,100)
_Beep(10,5,100)
_Beep(7,5,100)
_Beep(10,5,100)
_Beep(8,5,100)
_Beep(10,5,100)

_Beep(12,5,100)
_Beep(8,5,100)
_Beep(7,5,100)
_Beep(8,5,100)
_Beep(3,5,100)
_Beep(8,6,100)
_Beep(6,6,100)
_Beep(8,6,100)

_Beep(9,6,100)
_Beep(6,6,100)
_Beep(4,6,100)
_Beep(6,6,100)
_Beep(3,6,100)
_Beep(6,6,100)
_Beep(4,6,100)
_Beep(6,6,100)

_Beep(8,6,100)
_Beep(4,6,100)
_Beep(3,6,100)
_Beep(4,6,100)
_Beep(1,6,100)
_Beep(4,6,100)
_Beep(3,6,100)
_Beep(4,6,100)

_Beep(6,6,100)
_Beep(3,6,100)
_Beep(1,6,100)
_Beep(3,6,100)
_Beep(12,5,100)
_Beep(3,6,100)
_Beep(1,6,100)
_Beep(3,6,100)

_Beep(4,6,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)
_Beep(8,5,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)

_Beep(9,5,100)
_Beep(6,6,100)
_Beep(4,6,100)
_Beep(6,6,100)
_Beep(8,5,100)
_Beep(4,6,100)
_Beep(3,6,100)
_Beep(4,6,100)
_Beep(6,5,100)
_Beep(3,6,100)
_Beep(1,6,100)
_Beep(3,6,100)
_Beep(4,5,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)
_Beep(9,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(8,5,100)
_Beep(4,5,100)
_Beep(3,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)
_Beep(3,5,100)

;=========================


_Beep(8,6,100)
_Beep(6,6,100)
_Beep(8,6,100)

_Beep(9,6,100)
_Beep(6,6,100)
_Beep(4,6,100)
_Beep(6,6,100)
_Beep(3,6,100)
_Beep(6,6,100)
_Beep(4,6,100)
_Beep(6,6,100)

_Beep(8,6,100)
_Beep(4,6,100)
_Beep(3,6,100)
_Beep(4,6,100)
_Beep(1,6,100)
_Beep(4,6,100)
_Beep(3,6,100)
_Beep(4,6,100)

_Beep(6,6,100)
_Beep(3,6,100)
_Beep(1,6,100)
_Beep(3,6,100)
_Beep(12,5,100)
_Beep(3,6,100)
_Beep(1,6,100)
_Beep(3,6,100)

_Beep(4,6,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)
_Beep(8,5,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)

_Beep(9,5,100)
_Beep(6,6,100)
_Beep(4,6,100)
_Beep(6,6,100)
_Beep(8,5,100)
_Beep(4,6,100)
_Beep(3,6,100)
_Beep(4,6,100)
_Beep(6,5,100)
_Beep(3,6,100)
_Beep(1,6,100)
_Beep(3,6,100)
_Beep(4,5,100)
_Beep(1,6,100)
_Beep(12,5,100)
_Beep(1,6,100)
_Beep(9,5,100)
_Beep(6,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(8,5,100)
_Beep(4,5,100)
_Beep(3,5,100)
_Beep(4,5,100)
_Beep(6,5,100)
_Beep(3,5,100)
_Beep(1,5,100)
_Beep(3,5,100)


;=========================

_Beep(1,5,100)
_Beep(1,5,100)
_Beep(1,5,100)
_Beep(8,5,100)
_Beep(8,5,100)
_Beep(8,5,100)
_Beep(11,5,100)
_Beep(11,5,100)
_Beep(11,5,100)
_Beep(1,6,100)
_Beep(1,6,100)
_Beep(1,6,100)
_Beep(5,6,100)
_Beep(5,6,100)
_Beep(5,6,100)


_Beep(5,5,900)

_Beep(1,5,200)
_Beep(3,5,100)
_Beep(5,5,100)
_Beep(6,5,100)
_Beep(8,5,100)
_Beep(9,5,100)
_Beep(11,5,100)
_Beep(1,6,100)

_Beep(9,5,400)
_Beep(8,5,300)
_Beep(6,5,300)
_Beep(8,5,440)

_Beep(5,5,120)
_Beep(1,4,120)
_Beep(6,4,120)
_Beep(9,4,120)
_Beep(1,5,120)
_Beep(6,5,120)
_Beep(8,5,120)

_Beep(6,5,75)
_Beep(5,5,75)
_Beep(6,5,75)
_Beep(8,5,75)
_Beep(9,5,75)
_Beep(8,5,75)
_Beep(6,5,75)
_Beep(4,5,75)
_Beep(3,5,75)
_Beep(4,5,75)
_Beep(6,5,75)
_Beep(3,5,75)
_Beep(4,5,400)

_Beep(6,5,900)
_Beep(12,4,300)
_Beep(5,3,150,50)
_Beep(12,3,300)
_Beep(3,4,300)
_Beep(6,4,300)
_Beep(9,4,300)
_Beep(8,4,300)
_Beep(6,4,300)
_Beep(12,4,300)
_Beep(6,4,300)
_Beep(3,5,300)
_Beep(6,4,300)
_Beep(12,4,300)
_Beep(9,4,300)
_Beep(8,4,300)
_Beep(6,4,300)
_Beep(5,4,300)
_Beep(2,5,300)
_Beep(11,4,300)
_Beep(8,4,300)
_Beep(1,5,300)
_Beep(9,4,300)
_Beep(6,4,300)
_Beep(9,4,300)
_Beep(8,4,300)
_Beep(11,4,300)
_Beep(8,4,300)
_Beep(5,4,300)
_Beep(9,4,300)
_Beep(6,4,300)
_Beep(3,4,300)
_Beep(6,4,300)
_Beep(5,4,300)
_Beep(8,4,300)
_Beep(5,4,300)
_Beep(1,4,300)
_Beep(6,4,300)
_Beep(3,4,300)
_Beep(12,3,300)
_Beep(3,4,300)
_Beep(5,3,150,50)
_Beep(8,3,300)
_Beep(1,4,300)
_Beep(3,4,300)
_Beep(5,4,300)
_Beep(8,4,300)
_Beep(11,4,300)
_Beep(8,4,300)
_Beep(9,4,300)
_Beep(1,5,300)
_Beep(6,5,300)
_Beep(3,5,300)
_Beep(6,5,300)
_Beep(9,5,300)
_Beep(1,6,300)
_Beep(12,5,300)
_Beep(1,6,300)
_Beep(8,5,300)
_Beep(6,5,300)
_Beep(3,5,300)
_Beep(5,5,300)
_Beep(8,4,300)
_Beep(6,4,300)
_Beep(3,4,300)
_Beep(1,4,1200)
  
EndProcedure




OpenWindow(0,0,0,100,180,"",#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
ButtonGadget(0,10,100,92,20,"Пуск трек")
ButtonGadget(1,10,125,92,20,"Стоп трек")

 midiport=midiinit(#MOD_SWSYNTH)
If midiport >-1;есле есть программный синтезатор
  If midiOutOpen(midiport,@hMidiOut,#CALLBACK_NULL)
    
    
    ;MidiOutMessage(hMidiOut,$B0, 0, $7E, #Channel1);ono Mode On,каждая следующая нота выключает предыдущию
   MidiOutMessage(hMidiOut,$B0, #Channel1, $7F, 0);Polyphonic Mode On ,проигрывает ноты в канале одновременно
   ; MidiOutMessage(hMidiOut,$B0, 0, $7C, 0);Omni Mode Off
    MidiOutMessage(hMidiOut,$E0, #Channel1, 50, 127);Pitch Bend Change (смена значения чувствительности Pitch Bend)
    SetInstrument(#Channel1,0);Acoustic Grand Piano
  EndIf

Repeat 
 Select WaitWindowEvent() 
   Case #PB_Event_CloseWindow
       Break
   Case #PB_Event_Gadget 
     Select EventGadget()
       Case 0
         ;pleysound()
         pleysound2()
       Case 1
         MidiOutMessage(hMidiOut,$B0, 0, $7B, 0);All Notes Off
         ;MidiOutMessage(hMidiOut,$B0, 0, 120, 0);All Sounds Off
     EndSelect 
   EndSelect 
ForEver
  midiOutClose(@hMidiOut)
End
EndIf

Вопрос хоть в полифонии и проигрывается много нот одновременно на канале(вроде бы до 32) но всёсравно будет некая задержка,как бы это их через отдельные потоки может,или нет смысла?

0

5

Sergeihik

балуюсь

чтобы остановить трек, нужно запустить в отдельном потоке от событий окна и внутри функции Beep проверять некий флаг остановки, который будет установлен кнопкой в окне.

Чтобы сделать так как на ютубе, надо открыть число каналов по количеству инструментов и в функцию ещё передавать номер канала. Да и вообще надо переделывать вид записи в виде массива данных, так как легко запутаться передавая ноты в общей последовательности в одной куче все инструменты. Возможно надо сделать несколько потоков и счётчик тактов, чтобы ноты включались по времени. Если система подвисла, тоже вопрос, пропустить ноты, что должны были быть проиграны или продолжать от места разморозки то что было на момент заморозки.

Ранее мои темы и ещё

Отредактировано AZJIO (30.07.2021 04:29:16)

0

6

Не знаю, что выйдет из миди, но bytebeat более распространен

Код:
; http://rafb.net/paste/results/wMmfaj42.html
; Author: DarkDragon (updated for PB 4.00 by Andre)
; Date: 19. February 2006
; OS: Windows
; Demo: Yes
#SLen=10000*4*2
Structure WAVE
  wFormatTag.w
  nChannels.w
  nSamplesPerSec.l
  nAvgBytesPerSec.l
  nBlockAlign.w
  wBitsPerSample.w
  cbSize.w
EndStructure
 
Structure WAVE_EX
  RiffSig.l
  RiffCount.l
  WaveSig.l
  fmtSig.l
  TWaveFormat.l
 
  w.WAVE
 
  DataSig.l
  DataCount.l
EndStructure


SampleRate = 11025
Global Dim SoundWaves.b(#SLen)
 
For t=1 To #SLen
  SoundWaves(t) = t&(t>>8);t&t>>4|t>>7|t>>5|t>>14
Next

*m=AllocateMemory( #SLen+SizeOf(WAVE_EX) )

Bits=8
SoundDataSize=#SLen

  If Bits = 0      : Bits = 8	: EndIf
  If Bits > 32    : Bits = 32	: EndIf
 
  	WaveFormatEx.WAVE_EX
 
  	With WaveFormatEx
  	  \RiffSig              = $46464952
	    \RiffCount            = SizeOf(WAVE_EX) + SoundDataSize
  	  \WaveSig              = $45564157
	    \fmtSig               = $20746D66
  	  \TWaveFormat          = SizeOf(WAVE)
 
  	  \w\wFormatTag          =	#WAVE_FORMAT_PCM
  	  \w\nChannels        	=	1
  	  \w\nSamplesPerSec   	=	SampleRate
  	  \w\wBitsPerSample   	=	Bits
  	  \w\nBlockAlign      	=	(WaveFormatEx\w\nChannels * WaveFormatEx\w\wBitsPerSample) /8
  	  \w\nAvgBytesPerSec  	=	WaveFormatEx\w\nSamplesPerSec * WaveFormatEx\w\nBlockAlign
  	  \w\cbSize           	=	0
 
  	  \DataSig              = $61746164
	    \DataCount            = SoundDataSize
	  EndWith
 
  	CopyMemory(@WaveFormatEx, *m,SizeOf(WAVE_EX) )
  
  	CopyMemory(@SoundWaves(), *m+SizeOf(WAVE_EX), #SLen)
  	
  	
  	InitSound()
  	CatchSound(0,*m)
  	
  	PlaySound(0,#PB_Sound_Loop)
  	MessageRequester("Press OK","n-joy",#PB_MessageRequester_Ok)
  	FreeSound(0)
  	
  FreeMemory(*m)

0

7

Рещил почитать пока про формат миди файла,оказалось что данные лежат типа перевёрнутых.ну это пока заголовок изучаю.
вобщем кнопку на загрузку сделал файла

Код:
Structure Midi_zagolovok
  MThd.i;заголовок
  Dlina_zapisi.i;длинна последующая после этих 8 байтов
  Format_midi.w;3 формата 0=данные записаны на одном треке(возможно на 16-и каналах),1-в нескольких отдельных,2-несколько независимых
  NumTrek.w; количество записей MTRK количество треков в файле
  PPQN.w;временные тики
EndStructure 

Procedure Revers_i(*adres)
  !mov dword eax,[p.p_adres]
  !ror word [eax],8
  !ror dword [eax],16
  !ror word [eax],8
EndProcedure
Procedure Revers_w(*adres)
  !mov dword eax,[p.p_adres]
  !ror word [eax],8
EndProcedure
Procedure Open_midi()
 Protected *Midi_zagolovok.Midi_zagolovok
 
  Protected OpenFile.s,TextHnd.l,Textlg.l,*mem
  
  
   OpenFile.s=OpenFileRequester("Открыть файл", "", "*.txt, *.midi|*.txt.midi|All Files|*.*", 0);диалог  
If OpenFile<>"";если имя файла  1 и более символа 
   TextHnd=OpenFile(#PB_Any,OpenFile)        
  

   If TextHnd 
    Textlg=Lof(TextHnd)
    If Textlg>0 
      *mem=AllocateMemory(TextHnd) 
      ReadData(TextHnd,*mem,Textlg) 
      
      *Midi_zagolovok=*mem
      
      Revers_i(@*Midi_zagolovok\Dlina_zapisi)
     ; i=*Midi_zagolovok\Dlina_zapisi
      
      Debug PeekS(@*Midi_zagolovok\MThd,4,#PB_Ascii)
     ; Debug i
      Debug Str(PeekI(@*Midi_zagolovok\Dlina_zapisi))
     ; Debug Str(PeekI(@*Midi_zagolovok\MThd+4))
      
     ;Debug Str(PeekI(@*Midi_zagolovok\Dlina_zapisi+4));следующая запись

      
      ; Debug Str(PeekI(*Midi_zagolovok+8+*Midi_zagolovok\Dlina_zapisi));следующая запись
      
      Revers_w(@*Midi_zagolovok\Format_midi)
      Debug Str(PeekW(@*Midi_zagolovok\Format_midi))
      ;
      Revers_w(@*Midi_zagolovok\NumTrek)
      Debug Str(PeekW(@*Midi_zagolovok\NumTrek))
      ;
      Revers_w(@*Midi_zagolovok\PPQN)
      Debug Str(PeekW(@*Midi_zagolovok\PPQN))
      
      
      
      FreeMemory(*mem)
      CloseFile(TextHnd) 
     EndIf 
    Else 
   MessageRequester("Открытие файла","Не удалось открыть файл!",#MB_OK | #MB_ICONERROR)
  EndIf 
  
  
  
EndIf
  
EndProcedure

Отредактировано Sergeihik (31.07.2021 04:55:44)

0

8

Sergeihik написал(а):

встраивают микросхему синтезатора

А её никогда не встраивали.
Для этого всегда были звуковые карты.
Касаемо операционок, начиная с XP в Винде вполне приличный программный синтезатор.

Если Вас интересует парсинг миди-файла, так это малость не синтез.
Когда-то занимался этим вопросом.
В результате такую вот программулину написАл.

Sergeihik написал(а):

наподобие этого

В таком виде абсолютно бесполезное.

0

9

Паркинг это только. Как понимание как проигрывать данные и на этом выстроить своё нужное в программе,как то так.

0

10

Sergeihik написал(а):

Паркинг это только

Я, когда изучал структуру миди-файлов, уже давно и хорошо был знаком с протоколом МИДИ.
Без предварительной подготовки, боюсь, будет сложновато.
Например, самый распространённый формат миди-файлов (формат 1) сохраняет всю структуру треков секвенсора.
Основа довольно простая: идут временные интервалы (в относительном формате), и далее события, которые надо отправить.
Сложности заключаются в том, что все эти треки надо объединить в единое целое.
Плюс ещё всякая служебная информация.
В сети должно быть подробное описание формата.
Ну, а отправка событий - это уже отдельная тема.

0

11

Sergeihik
Если удастся разобраться в форматах MIDI пиши, я сам горел идеей сделать разбор MIDI-файла, чтобы была возможность в своей программе проиграть некую мелодию, то есть упростить реализацию всякие пичбенды исключить и вывести например чистую мелодию на динамик ПК. Потому что ранее, чтобы для своей функции Beep, чтобы создать мелодию нужно открывать MIDI например в какой нибудь "Cakewalk Music Creator", чтобы визуально видеть длительности/паузы и высоту нот. А мелодии можно найти на midi.ru, кто-то даже время от времени выкладывал пол-гига midi-файлов с midi.ru.

0

12

AZJIO написал(а):

чтобы была возможность в своей программе проиграть некую мелодию

Чем трекерная музыка не подошла?

Код:
If InitSound() = 0
  MessageRequester("Ошибка", "Звуковая система недоступна.") : End
EndIf
FileName$ = OpenFileRequester("","","Музыкальные модули (*.mod, *.xm, *.it)|*.mod;*.xm;*.it", 0)
If FileName$
  If LoadMusic(0, FileName$)
    PlayMusic(0)    
    MessageRequester("PureBasic - Module проигрыватель", "Воспроизведение музыкального модуля...")    
  Else
    MessageRequester("Ошибка", "Не удается загрузить музыкальный модуль или неверный формат модуля.")
  EndIf
EndIf

Несколько файлов для теста. https://dropfiles.ru/download/8d80d40f1 … 346d6.html

0

13

Пётр написал(а):

Чем трекерная музыка не подошла?

Кстати, попадались примеры парсера midi, но на многих файликах просто давились.

0

14

Коллеги, давайте уже отделим мягкое от тёплого.
Есть два больших вопроса:
- Формат миди-файлов
- Воспроизведение миди-сообщений через миди-подсистему операционки.
Что надо?

0

15

Gregory написал(а):

- Воспроизведение миди-сообщений через миди-подсистему операционки.
Что надо?

уже сказано

0

16

Накидал немного кода,проигрывает на канальных сообщениях и треки последовательно пока.

Код:
Structure hMidiOut;тупо для ссылки на процедуры
  hMidiOut.i
EndStructure
;
Structure Mtrk
  Mtrk.i;заголовок блока трека
  Dlina_treka.l;блока mtrk за этими 8 байт заголовка
EndStructure
Structure Midi_zagolovok
  MThd.i;заголовок
  Dlina_zapisi.i;длинна последующая после этих 8 байтов
  Format_midi.w;3 формата 0=данные записаны на одном треке(все сообщения со всех MIDI-каналов в одном треке),1-в нескольких отдельных,2-несколько независимых
  NumTrek.w; количество записей  MTRK, количество блоков (треков) в файле,(первый карта темпа)
  PPQN.w;временные тики 
EndStructure 
Global hMidiOut.i
Global midiport.i
Procedure Error(funkciy$,ohibka.i)
    Select  ohibka
           Case #MIXERR_BASE
               MessageRequester(funkciy$,"Минимальное значение кода ошибки микшера")   
           Case #MIXERR_INVALLINE
               MessageRequester(funkciy$,"Недопустимый индекс/идентификатор линии")
            Case #MIXERR_INVALCONTROL
              MessageRequester(funkciy$,"Недопустимый индекс/идентификатор элемента управления")
            Case #MIXERR_INVALVALUE
              MessageRequester(funkciy$,"Недопустимое значение элемента управления")
            Case #MIXERR_LASTERROR
               MessageRequester(funkciy$,"Максимальное значение кода ошибки микшера") 
            Case #MMSYSERR_ALLOCATED
               MessageRequester(funkciy$,"Устройство занято другим приложением")
            Case #MMSYSERR_BADDEVICEID
              MessageRequester(funkciy$,"Недопустимый номер устройства")
            Case #MMSYSERR_NOTENABLED
               MessageRequester(funkciy$,"Драйвер не активизирован")  
            Case #MMSYSERR_INVALFLAG
               MessageRequester(funkciy$,"Один или несколько флагов недействительны.")       
            Case #MMSYSERR_INVALHANDLE
               MessageRequester(funkciy$,"Недопустимый дискриптор открытого устройства")  
            Case #MMSYSERR_INVALPARAM
              MessageRequester(funkciy$,"Один или несколько параметров недействительны.")
            Case #MMSYSERR_NODRIVER
              MessageRequester(funkciy$,"Драйвер отсутствует") 
            Case #MMSYSERR_NOMEM
              MessageRequester(funkciy$,"Недостаточно памяти для выделения")
            Case #MMSYSERR_NOTSUPPORTED
              MessageRequester(funkciy$,"Запрошенная функция не поддерживается")
            Case #MMSYSERR_HANDLEBUSY
              MessageRequester(funkciy$,"Над ключом выполняется операция от другой задачи (thread)")
            Case #MMSYSERR_INVALIDALIAS ;13
              
            Case 14;#MMSYSERR_BADDB ;14 
              
            Case 15;#MMSYSERR_KEYNOTFOUND ;15
              
            Case 16;#MMSYSERR_READERROR ;16 
              
            Case 17;#MMSYSERR_WRITEERROR; 17
              
            Case 18;#MMSYSERR_DELETEERROR ;18
              
            Case 19;#MMSYSERR_VALNOTFOUND ;19 
            Case 20;#MMSYSERR_NODRIVERCB	
              ;MessageRequester(funkciy$,"Драйвер не выполнил уведомления (callback)")   
            Case #MMSYSERR_BADERRNUM
              MessageRequester(funkciy$,"Код ошибки вне допустимого диапазона")
             Case #MMSYSERR_ERROR
              MessageRequester(funkciy$,"Неопределенная ошибка")           
          EndSelect
EndProcedure  
Procedure.i midiinit(Konstanta.i)
Protected midi.MIDIOUTCAPS
Protected devnum
#MOD_MIDIPORT =1;Аппаратный порт MIDI.
#MOD_SYNTH =2;Синтезатор
#MOD_SQSYNTH=3;Синтезатор прямоугольных импульсов.
#MOD_FMSYNTH=4;FM-синтезатор.
#MOD_MAPPER =5;Microsoft MIDI маппер.
#MOD_WAVETABLE=6;Аппаратный волновой синтезатор.
#MOD_SWSYNTH=7 ;Программный синтезатор

If midiOutGetNumDevs_();извлекает количество MIDI-устройств вывода,0=нет устройств
For devnum=0 To 7
  If midiOutGetDevCaps_(devnum,@midi,SizeOf(MIDIOUTCAPS))=0
    Debug midi\wTechnology;что есть
    If midi\wTechnology=Konstanta;#MOD_SWSYNTH
      Debug PeekS(@midi\szPname,-1,#PB_Unicode);Название продукта в строке с нулевым символом в конце.
      Debug midi\wVoices;количество голосов
      Debug midi\wNotes ;количество одновременных нот, которые могут быть воспроизведены
      Debug midi\wChannelMask;Портовые устройства, которые передают по всем каналам, устанавливают этот элемент в 0xFFFF. 
      Debug midi\dwSupport;Дополнительный функционал, поддерживаемый устройством(MIDICAPS_VOLUME=1 Поддерживает регулировку громкости.)
      ProcedureReturn devnum
    EndIf
  EndIf
Next
ProcedureReturn 0
EndIf
EndProcedure
Procedure.i midiOutOpen(midiport.i,*hMidiOut.hMidiOut,flagi.i,dwCallback.i=0,CallbackInstance.i=0);открывает выходное MIDI-устройство 
 Protected result.i 
 result=midiOutOpen_(*hMidiOut.hMidiOut,midiport,dwCallback,CallbackInstance,flagi)
 If result=MMSYSERR_NOERROR
   ProcedureReturn 1
 Else
   Error("Error midiOutOpen()",result)
   ProcedureReturn 0
 EndIf  
EndProcedure
Procedure.i midiOutClose(*hMidiOut);получаем дискриптор устройства
 Protected MidiOut.i
 !mov dword eax,[p.p_hMidiOut]
 !mov dword eax,[eax]
 !mov dword [p.v_MidiOut],eax
  If midiOutClose_(MidiOut)=#MMSYSERR_NOERROR
       !mov dword eax,[p.p_hMidiOut]
       !mov dword [eax],0
    ProcedureReturn 1
  Else
    MessageRequester("Error midiOutClose()","INVALIDE_HANDLE hMidiOut")
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure Revers_i(*adres)
  !mov dword eax,[p.p_adres]
  !ror word [eax],8
  !ror dword [eax],16
  !ror word [eax],8
EndProcedure
Procedure Revers_w(*adres)
  !mov dword eax,[p.p_adres]
  !ror word [eax],8
EndProcedure

Procedure MidiOutMesage(hMidi,iStatus,iData1,iData2)
  Protected dwMessage.i
  dwMessage = iStatus | (iData1 << 8 ) | (iData2 << 16)
  ProcedureReturn midiOutShortMsg_(hMidi, dwMessage)
EndProcedure

Procedure Open_midi()
 Protected OpenFile.s
 Protected light.l
  
 Protected *Midi_zagolovok.Midi_zagolovok
 Protected *Mtrk.Mtrk
 Protected kolihestvoMtrk.l
 Protected dlinaMtrk.i
 Protected time.w
 
 
 
 Static *mem
 Protected *sobytie
Protected delta_time_sobytie.i
Protected delta_kolihestvoBait.a

Protected baitsobytiy.a
 
    OpenFile.s=OpenFileRequester("Открыть файл", "", "*.midi|*.midi|All Files|*.*", 0);диалог  
If OpenFile<>"";если имя файла  1 и более символа 
 If ReadFile(0, OpenFile)
  light=Lof(0)
  If light>0 
     *mem=AllocateMemory(light)
      Debug *mem
     If *mem
      Debug ReadData(0,*mem,light) 
        CloseFile(0)
        
       ;============================== обработка памяти
        *Midi_zagolovok=*mem
      
        
       
      
      Debug PeekS(@*Midi_zagolovok\MThd,4,#PB_Ascii)
        
       Revers_i(@*Midi_zagolovok\Dlina_zapisi)
      Debug Str(PeekI(@*Midi_zagolovok\Dlina_zapisi))
      ;
      Revers_w(@*Midi_zagolovok\Format_midi)
      Debug Str(PeekW(@*Midi_zagolovok\Format_midi))
      ;
      Revers_w(@*Midi_zagolovok\NumTrek)
      kolihestvoMtrk=PeekW(@*Midi_zagolovok\NumTrek)
      Debug "kolihestvoMtrk  "+Str(kolihestvoMtrk)
      ;Debug Str(PeekW(@*Midi_zagolovok\NumTrek))

          
           
      ;
      ;Debug Str(PeekW(@*Midi_zagolovok\PPQN))
      ;Revers_w(@*Midi_zagolovok\PPQN)
      time=PeekW(@*Midi_zagolovok\PPQN)
     ;Debug time
     ; !shr word[p.v_time],15
      
      If time & $8000;Если старший бит установлен в единицу, то используется абсолютный способ
       ; Debug "tttttttttt"
       ; time=PeekW(@*Midi_zagolovok\PPQN)
       time>>8
       time & $7F;обнулить включая старший бит =количество тиков в четверти(допустим 96)
        ;!shr word[p.v_time],8
        ;time>>8
      EndIf
      Debug time
      ;time*2
      ;Debug Str(PeekW(@*Midi_zagolovok\PPQN))
      
      
      ;
       If PeekS(@*Midi_zagolovok\MThd,4,#PB_Ascii)="MThd"
        
        Select PeekW(@*Midi_zagolovok\Format_midi);format
        
         Case 0
        
         Case 1
;{;format 1      
           


           
           *sobytie=*mem
           *sobytie+14
       cikl3:  
           If kolihestvoMtrk>0
           *Mtrk=*sobytie
            
             Debug PeekS(@*Mtrk\Mtrk,4,#PB_Ascii)
             If PeekS(@*Mtrk\Mtrk,4,#PB_Ascii)="MTrk"
              
                 Revers_i(@*Mtrk\Dlina_treka);могут быть сообщения разной длинны
                 Debug PeekI(@*Mtrk\Dlina_treka)
                 dlinaMtrk=PeekI(@*Mtrk\Dlina_treka)
                 If dlinaMtrk>0
                   *sobytie+8;*Mtrk+8  
          cikl:
                  ;Debug *mem
                   ;Debug PeekA(*sobytie);;следущий байт за заголовком mtrk (пошли события)
                    ;сначала указано время события
                   If PeekA(*sobytie) & $80;время события по дельте времени в одном байте
                     delta_kolihestvoBait=2
                     zikl:
                     *sobytie+1
                     If PeekA(*sobytie) & $80
                       delta_kolihestvoBait+1
                       Goto zikl
                     EndIf
                     *sobytie+1
                   Else;иначе в байтах переменной длинны
                     *sobytie+1
                     delta_kolihestvoBait=1
                   EndIf  
                   Debug "delta_kolihestvoBait  "+Str(delta_kolihestvoBait)
                   
                   If delta_kolihestvoBait=1
                     delta_time_sobytie=PeekA(*sobytie-1)
                   ElseIf delta_kolihestvoBait=2
                     delta_time_sobytie=PeekW(*sobytie-2)
                     !ror word [p.v_delta_time_sobytie],8
                   EndIf  
                   Debug "delta_time_sobytie  "+Str(delta_time_sobytie)
                   
                    ;=========события========
                   baitsobytiy=PeekA(*sobytie);статус байт события  
                 cikl5:  
                   Debug "baitsobytiy  "+Hex(baitsobytiy)

                   If  baitsobytiy=$FF;{;мета события (17-ть мета событий-?)
                        *sobytie+1
                        baitsobytiy=PeekA(*sobytie);
                        Debug "Мета событие  "+Hex(baitsobytiy)
                      If baitsobytiy=0;{;Sequence Number
                        ;Это необязательное мета-событие имеет структуру, показанную на рис. 20. Оно задает номер секвенции (паттерна), на который можно 
                        ;ссылаться в дальнейшем при помощи сообщений MIDI Cueing. В таком виде это мета-событие имеет смысл только для формата 2, поскольку
                        ;в файлах формата 0 и 1 есть только одна секвенция (то есть целая композиция). Событие должно располагаться в начале трека, перед
                        ;любым событием с ненулевым дельта-временем, и перед любым другим MIDI-событием. Если номер секвенции опущен, то считается
                        ;что секвенции (паттерны) следуют в порядке расположения блоков трека в файле. Если необходимо сохранить несколько многотрековых
                        ;композиций в виде группы файлов формата 0 или 1, то событие Sequence Number может использоваться в качестве номера файла.
                        *sobytie+4
                        Goto cikl
                        ;};  
                      ElseIf baitsobytiy=1;{;Text Event
                        Debug "fffffffff111111111_Text Event"
                        Debug PeekA(*sobytie+1)
                        Debug PeekS(*sobytie+2,PeekA(*sobytie+1),#PB_Ascii)
                        *sobytie+PeekA(*sobytie+1)+2
                        Goto cikl
                        ;};
                      ElseIf baitsobytiy=2;{;Содержит заметку об авторских правах. 
                        ;Заметка должна содержать символы "(", "C" и ")", год и владельца авторских прав. Если в одном файле содержатся несколько произведений, все заметки об авторских правах должны быть размещены в начале файла. Заметка должна быть первым событием в первом блоке трека в момент времени 0.
                        *sobytie+PeekA(*sobytie+1)+2
                        Goto cikl
                        ;};
                      ElseIf baitsobytiy=3;{;Содержит название произведения 
                        ;если находится в файле формата 0 или в первом блоке трека в файле формата 1), в остальных случаях — название трека.
                         *sobytie+1
                         Debug PeekA(*sobytie);следующая длина в байтах (название произведения)
                         Debug PeekS(*sobytie+1,PeekA(*sobytie),#PB_Ascii);
                         *sobytie+PeekA(*sobytie)+1
                         Goto cikl;смотрим следующие событие
                         ;};
                      ElseIf baitsobytiy=4;{;Содержит название инструмента, которым должен исполняться трек.
                        Debug "инструмент  "+PeekS(*sobytie+2,PeekA(*sobytie+1),#PB_Ascii)
                        *sobytie+PeekA(*sobytie+1)+2
                        Goto cikl
                        ;};
                      ElseIf baitsobytiy=5;{;Lyric/Display Meta Event.
                        ;Задает слова песни, которые должны быть исполнены в указанное время. Обычно каждый слог представлен отдельным событием Lyric,
                        ;то есть для каждого слога четко задано время исполнения. В 1997 году организация MMA расширила это событие, добавив команды 
                        ;форматирования при выводе текста на экран, поддержку многобайтовой кодировки символов и Unicode, а также информацию о произведении
                        ;(название, композитор, исполнитель). Расширенное мета-событие Lyric предложено называть Lyric/Display Meta Event.
                        *sobytie+PeekA(*sobytie+1)+2
                        Goto cikl
                       ;};
                      ElseIf baitsobytiy=6;{;Marker
                        ;Событие располагается обычно на первом блоке трека в файле формата 1 (или на единственном треке формата 0).
                        ;Определяет позицию внутри произведения и одновременно задает ее имя.
                        *sobytie+PeekA(*sobytie+1)+2
                        Goto cikl
                        ;};
                      ElseIf baitsobytiy=7;{;Задает точку привязки партитуры 
                        ;;Задает точку привязки партитуры к моменту кино-, видео- или сценического действия и одновременно описание момента 
                        ;(например, "Машина въехала в дерево", "Герой получил пощечину").
                        *sobytie+PeekA(*sobytie+1)+2
                        Goto cikl       
                        ;};
                      ElseIf baitsobytiy=8;{;Program Name
                        ;Это мета-событие служит для визуальной ориентировки и информирования пользователя об используемом имени пэтча на данном канале.
                        ;Непосредственно за этим событием должны следовать события Bank Select и Program Change, посредством которым реально выбирается 
                        ;пэтч. Если на протяжении звучания трека на том же MIDI-канале изменяется пэтч, событие 
                        ;Program Name может встречаться перед каждым таким изменением.
                        *sobytie+PeekA(*sobytie+1)+2
                        Goto cikl
                        ;}
                      ElseIf baitsobytiy=9;{;Это мета-событие позволяет в одном MIDI-файле задать несколько устройств воспроизведения (тон-генераторов)
                        ;то есть реализовать более 16 MIDI-каналов.Например, в аранжировке могут быть задействованы два тон-генератора
                        ;первый подключен к порту "MIDI Out 3" интерфейса, второй — к порту "MIDI Out 4"
                        
                        *sobytie+PeekA(*sobytie+1)+2
                        Goto cikl
                        ;};
                      ElseIf baitsobytiy=$20;{;MIDI Channel Prefix
                        ;Поскольку SysEx-события и мета-события не содержат в статус-байте номер MIDI-канала, нужен способ привязки этих событий
                        ;к MIDI-каналу.Событие MIDI Channel Prefix содержит номер MIDI-канала,с которым ассоциируются все последующие SysEx- и мета-события
                        ;Канал, заданный таким образом, остается действительным до следующего нормального MIDI-события (которое содержит номер канала)
                        ;или до следующего мета-события MIDI Channel Prefix.
                        ;Если каждый трек в секвенсоре соответствует одному MIDI-каналу, то при записи аранжировки в формате 0 это мета-событие помогае
                        ;т сохранить связь мета-событий с конкретным треком. Подобная возможность предусмотрена и в формате файлов Yamaha ESEQ.
                        Debug "префикс канала  "+PeekA(*sobytie+2)
                        *sobytie+3
                        Goto cikl
                        ;};
                      ElseIf baitsobytiy=$21;{;MIDI Port
                        ;Это необязательное событие, которое обычно происходит в начале MTrk (т. Е. Перед любым
                        ;ненулевое дельта-время и перед любыми событиями midi) указывает, из какого порта MIDI (т. е.
                        ;buss) MIDI-события в MTrk go. Байт данных pp, это номер порта, где 0
                        ;будет первой шиной MIDI в системе.
                        ;Спецификация MIDI имеет ограничение в 16 MIDI-каналов на вход / выход MIDI (т. Е. Порт, шина,
                        ;jack, или любую другую терминологию, которую вы используете для описания оборудования для одного MIDI-входа /
                        *sobytie+3
                        Goto cikl
                        ;};
                      ElseIf baitsobytiy=$2F;{;End of Track
                        ;Это обязательное мета-событие (рис. 23) указывает момент окончания трека. Должно быть последним событием внутри блока трека. 
                        ;Точный момент окончания трека необходим секвенсорам для возможности воспроизведения трека в цикле или стыковки его с другим треком
                          kolihestvoMtrk-1
                          *sobytie+2 
                          ;Debug "kolihestvoMtrk  "+Str(kolihestvoMtrk)
                          Goto  cikl3
                          ;};
                      ElseIf baitsobytiy=$51;{;Set Tempo,
                        ;Задает текущий темп в необычном измерении — микросекунды на четверть. Представление темпа в виде "время на четверть" 
                        ;вместо "четверть за время" позволяет осуществить точную долговременную синхронизацию при работе по протоколу MTC или SMPTE.
                        ;Так, если число тиков 3240, темп 120 BPM (500000 мкс на четверть), 96 тиков в четверти (96 PPQN), время в миллисекундах 
                        ;равно 3240 x (500000/96(PPQN)) / 1000 = 16875 мс (или 16,875 с).
                        Protected temp.i
                        temp=PeekA(*sobytie+4)|(PeekA(*sobytie+3)<<8)|(PeekA(*sobytie+2)<<16)
                        temp/time;(PPQN)
                        Debug temp
                        *sobytie+5;bait peremennogo razmera i dannye
                        Goto cikl
                        ;}
                      ElseIf baitsobytiy=$54;{;SMPTE Offset
                        ;Это необязательное мета-событие задает время SMPTE, с которого начинается трек. Событие должно располагаться в начале трека
                        ;перед любым другим событием с ненулевым дельта-временем, и перед любым MIDI-событием. В файле формата 1 смещение SMPTE должно 
                        ;храниться с картой темпа на первом треке. Поле ff содержит сотые доли кадра, даже в том случае, если в блоке заголовка определено
                        ;другое количество тиков на кадр.
                        
                        *sobytie+7
                        Goto cikl
                        ;};
                      ElseIf baitsobytiy=$58;{;Time Signature,Событие задает музыкальный размер,
                        
                        *sobytie+6
                        Goto cikl
                        ;};
                      ElseIf baitsobytiy=$59;{;Key Signature 
                        ;Событие задает текущую тональность (точнее, ладотональность — высоту и наклонение лада, мажор/минор)
                        
                        *sobytie+4
                        Goto cikl
                        ;};
                      ElseIf baitsobytiy=$7F;{;Sequencer-Specific Meta-Event
                        ;применяется аналогично системным эксклюзивным сообщениями в протоколе MIDI. То есть, позволяет записывать в MIDI-файл информацию
                        ;специфичную для конкретного секвенсора. Длина события выражается переменным способом. Первый байт данных (или три байта) 
                        ;содержат ID производителя. Остальной формат события определяется конкретным производителем под конкретную программу или семейство
                        ;программ.
                        *sobytie+PeekA(*sobytie+1)+2
                        Goto cikl
                        ;};
                      EndIf
                     ;}; 
                   ElseIf baitsobytiy=$F0;sysEx-сообщение 
                      

                   ElseIf baitsobytiy=>$90 And baitsobytiy<=$9F;{;nota on
                          delta_time_sobytie*temp/1000000
                          Debug delta_time_sobytie
                          Delay(delta_time_sobytie)
                          MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
                          ;Delay(delta_time_sobytie)
                           *sobytie+3
                           Goto cikl
                           ;};
                   ElseIf baitsobytiy=>$80 And baitsobytiy<=$8F;{;nota off
                          delta_time_sobytie*temp/1000000
                          Delay(delta_time_sobytie)
                          MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
                            ;Delay(delta_time_sobytie)
                           *sobytie+3
                           Goto cikl
                           ;};
                   ElseIf baitsobytiy=>$C0 And baitsobytiy<=$CF;{;Событие SetInstrument(установка инструмента в каналы)
                           MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),0);следущий байт собственно номер инструмента
                           Debug Hex(PeekA(*sobytie+1))
                           *sobytie+2
                           Goto cikl
                           ;};
                   ElseIf baitsobytiy=>$A0 And baitsobytiy<=$AF;{;
                          MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
                          *sobytie+3
                          Goto cikl
                          ;};
                   ElseIf baitsobytiy=>$B0 And baitsobytiy<=$BF;{;Специальные канальные сообщения,Задаются контpоллеpами 120..127 и упpавляют обpаботкой сообщений в каналах: 
                           MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
                           *sobytie+3
                           Goto cikl
                           ;};
                   ElseIf baitsobytiy=>$D0 And baitsobytiy<=$DF;{;манипуляция после нажатия клавиши(давление в канале)
                           MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
                           *sobytie+3
                           Goto cikl
                           ;};
                   ElseIf baitsobytiy=>$E0 And baitsobytiy<=$EF;{;Pitch Bend Change (смена значения чувствительности для каналов Pitch Bend)изменение высоты звука
                           MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
                           *sobytie+3
                           Goto cikl
                          ;}; 
                        ;ElseIf baitsobytiy=>$08 And baitsobytiy<=$7f;не ясно что за сообщение(я)типа перевёрнутый статус байт?
                        ; !ror byte[p.v_baitsobytiy],4
                         ; MidiOutMesage(hMidiOut,baitsobytiy,PeekA(*sobytie+1),PeekA(*sobytie+2))
                          
                          ;*sobytie+3
                         ;  Goto cikl5   
                   EndIf


                 EndIf
             EndIf
           EndIf
;};          
         Case 2;format 2
           
        EndSelect
       EndIf 
;============================== 
       Debug *mem
     FreeMemory(*mem)
     EndIf   
   EndIf
 Else 
 MessageRequester("Открытие файла","Не удалось открыть файл!",#MB_OK | #MB_ICONERROR)
 EndIf 
EndIf 
EndProcedure

OpenWindow(0,0,0,100,180,"",#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
ButtonGadget(2,10,5,92,20,"Open midi")

Repeat 
 Select WaitWindowEvent() 
   Case #PB_Event_CloseWindow
       Break
   Case #PB_Event_Gadget 
     Select EventGadget()
       Case 2 
          midiport=midiinit(#MOD_SWSYNTH)
          If midiport>-1;есле есть программный синтезатор
             If midiOutOpen(midiport,@hMidiOut,#CALLBACK_NULL)
               Open_midi()
               midiOutClose(@hMidiOut)
             EndIf
           EndIf  
     EndSelect 
   EndSelect 
ForEver  
End

Миди файлы можно отсюда скачать Ссылка

Отредактировано Sergeihik (29.08.2021 15:38:09)

+1

17

Sergeihik
Не понял, зачем тебе метки Goto? Делаешь цикл, а вместо Goto используешь Continue. Я не разбирался во всех перипетиях кода, но знаю что любой код можно написать правильно, не переходом Goto, а вызовом функции. И это всегда выглядит логичней, потому что ты даёшь пользователю читающему код понять, что это цикловой повтор с прерываниями цикла, а меткой Goto ничего невозможно дать понять.

0

18

В таком варианте тогда будет без конечный цикл с выходом в конце трека и снова возврат на раскрутку трека ,есть там ещё длина трека но я не разбирался там количество команд или длинна байтов вот от этого тоже можно сделать цикл.я же пока хочу понять по командам и времени исполнения ну и типа взять команды в память и оттуда воспроизвести одновременно несколько треков.

0

19

Sergeihik
Может тебе Inc_MIDI.pbi чем-то поможет?

Это же элементарно переписывается в цикл

Код:
zikl:
*sobytie+1
If PeekA(*sobytie) & $80
	delta_kolihestvoBait+1
	Goto zikl
EndIf

*sobytie + 1
While PeekA(*sobytie) & $80
	*sobytie + 1
	delta_kolihestvoBait + 1
Wend

delta_kolihestvoBait - 1 ; переменную можно заранее задать минусанув единицу
Repeat
	*sobytie + 1
	delta_kolihestvoBait + 1
Until Not PeekA(*sobytie) & $80

И никакого возврата с начала не получится, так как это ТОЧНАЯ копия событий с метками.

Код:
If OpenFile<>""
If Asc(OpenFile) ; так проверяет наличие первой буквы в строке

не проверял, но вот набросал на циклах

Код:
Repeat
	If kolihestvoMtrk>0
    *Mtrk=*sobytie
    
    Debug PeekS(@*Mtrk\Mtrk,4,#PB_Ascii)
    If PeekS(@*Mtrk\Mtrk,4,#PB_Ascii)="MTrk"
    	
    	Revers_i(@*Mtrk\Dlina_treka);могут быть сообщения разной длинны
    	Debug PeekI(@*Mtrk\Dlina_treka)
    	dlinaMtrk=PeekI(@*Mtrk\Dlina_treka)
    	If dlinaMtrk>0
        *sobytie+8;*Mtrk+8  
        
        Repeat
        	;Debug *mem
        	;Debug PeekA(*sobytie);;следущий байт за заголовком mtrk (пошли события)
        	;сначала указано время события
        	If PeekA(*sobytie) & $80;время события по дельте времени в одном байте
            delta_kolihestvoBait=1
            Repeat
            	*sobytie + 1
            	delta_kolihestvoBait + 1
            Until Not PeekA(*sobytie) & $80
            *sobytie+1
        	Else;иначе в байтах переменной длинны
            *sobytie+1
            delta_kolihestvoBait=1
        	EndIf  
        	Debug "delta_kolihestvoBait  "+Str(delta_kolihestvoBait)
        	
        	If delta_kolihestvoBait=1
            delta_time_sobytie=PeekA(*sobytie-1)
        	ElseIf delta_kolihestvoBait=2
            delta_time_sobytie=PeekW(*sobytie-2)
            !ror word [p.v_delta_time_sobytie],8
        	EndIf  
        	Debug "delta_time_sobytie  "+Str(delta_time_sobytie)
        	
        	;=========события========
        	baitsobytiy=PeekA(*sobytie);статус байт события  
                    	   ; 	cikl5:  
        	Debug "baitsobytiy  "+Hex(baitsobytiy)
        	
        	
        	Select  baitsobytiy;{;мета события (17-ть мета событий-?)
            Case $FF
            	*sobytie+1
            	baitsobytiy=PeekA(*sobytie);
            	Debug "Мета событие  "+Hex(baitsobytiy)
            	Select baitsobytiy
                Case 0
                	*sobytie+4
                	Continue
                	;};  
                Case 1;{;Text Event
                	Debug "fffffffff111111111_Text Event"
                	Debug PeekA(*sobytie+1)
                	Debug PeekS(*sobytie+2,PeekA(*sobytie+1),#PB_Ascii)
                	*sobytie+PeekA(*sobytie+1)+2
                	Continue
                	;};
                Case 2;{;Содержит заметку об авторских правах. 
                	  ;Заметка должна содержать символы "(", "C" и ")", год и владельца авторских прав. Если в одном файле содержатся несколько произведений, все заметки об авторских правах должны быть размещены в начале файла. Заметка должна быть первым событием в первом блоке трека в момент времени 0.
                	*sobytie+PeekA(*sobytie+1)+2
                	Continue
                	;};
                Case 3;{;Содержит название произведения 
                	  ;если находится в файле формата 0 или в первом блоке трека в файле формата 1), в остальных случаях — название трека.
                	*sobytie+1
                	Debug PeekA(*sobytie);следующая длина в байтах (название произведения)
                	Debug PeekS(*sobytie+1,PeekA(*sobytie),#PB_Ascii);
                	*sobytie+PeekA(*sobytie)+1
                	Continue;смотрим следующие событие
                    	;};
                Case 4    ;{;Содержит название инструмента, которым должен исполняться трек.
                	Debug "инструмент  "+PeekS(*sobytie+2,PeekA(*sobytie+1),#PB_Ascii)
                	*sobytie+PeekA(*sobytie+1)+2
                	Continue
                	;};
                Case 5;{;Lyric/Display Meta Event.
                	*sobytie+PeekA(*sobytie+1)+2
                	Continue
                	;};
                Case 6;{;Marker
                	*sobytie+PeekA(*sobytie+1)+2
                	Continue
                	;};
                Case 7;{;Задает точку привязки партитуры 
                	*sobytie+PeekA(*sobytie+1)+2
                	Continue       
                	;};
                Case 8;{;Program Name
                	*sobytie+PeekA(*sobytie+1)+2
                	Continue
                	;}
                Case 9;{;	
                	*sobytie+PeekA(*sobytie+1)+2
                	Continue
                	;};
                Case $20;{;MIDI Channel Prefix
                	Debug "префикс канала  "+PeekA(*sobytie+2)
                	*sobytie+3
                	Continue
                	;};
                Case $21;{;MIDI Port
                	*sobytie+3
                	Continue
                	;};
                Case $2F;{;End of Track
                	kolihestvoMtrk-1
                	*sobytie+2 
                	;Debug "kolihestvoMtrk  "+Str(kolihestvoMtrk)
                	Break
                	;};
                Case $51;{;Set Tempo,
                	Protected temp.i
                	temp=PeekA(*sobytie+4)|(PeekA(*sobytie+3)<<8)|(PeekA(*sobytie+2)<<16)
                	temp/time;(PPQN)
                	Debug temp
                	*sobytie+5;bait peremennogo razmera i dannye
                	Continue
                	;}
                Case $54;{;SMPTE Offset
                	*sobytie+7
                	Continue
                	;};
                Case $58;{;Time Signature,Событие задает музыкальный размер,
                	
                	*sobytie+6
                	Continue
                	;};
                Case $59;{;Key Signature 
                    ;Событие задает текущую тональность (точнее, ладотональность — высоту и наклонение лада, мажор/минор)
                	
                	*sobytie+4
                	Continue
                	;};
                Case $7F;{;Sequencer-Specific Meta-Event
                	*sobytie+PeekA(*sobytie+1)+2
                	Continue
                	;};
            	EndSelect
            	;}; 
            Case $F0;sysEx-сообщение 
            	
            	
            Case $90 To $9F;{;nota on
            	delta_time_sobytie*temp/1000000
            	Debug delta_time_sobytie
            	Delay(delta_time_sobytie)
            	MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
            	;Delay(delta_time_sobytie)
            	*sobytie+3
            	Continue
            	;};
            Case $80 To $8F;{;nota off
            	delta_time_sobytie*temp/1000000
            	Delay(delta_time_sobytie)
            	MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
            	;Delay(delta_time_sobytie)
            	*sobytie+3
            	Continue
            	;};
            Case $C0 To $CF;{;Событие SetInstrument(установка инструмента в каналы)
            	MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),0);следущий байт собственно номер инструмента
            	Debug Hex(PeekA(*sobytie+1))
            	*sobytie+2
            	Continue
            	;};
            Case $A0 To $AF;{;
            	MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
            	*sobytie+3
            	Continue
            	;};
            Case $B0 To $BF;{;Специальные канальные сообщения,Задаются контpоллеpами 120..127 и упpавляют обpаботкой сообщений в каналах: 
            	MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
            	*sobytie+3
            	Continue
            	;};
            Case $D0 To $DF;{;манипуляция после нажатия клавиши(давление в канале)
            	MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
            	*sobytie+3
            	Continue
            	;};
            Case $E0 To $EF;{;Pitch Bend Change (смена значения чувствительности для каналов Pitch Bend)изменение высоты звука
            	MidiOutMesage(hMidiOut,PeekA(*sobytie),PeekA(*sobytie+1),PeekA(*sobytie+2))
            	*sobytie+3
            	Continue
        	EndSelect
        	Break 2 ; при отсутсвии ожного из событий ранее перечисленных, т.е. закрытия Select выпрыгиваем из 2-х циклов, кстати можно сделать по Default
        ForEver 
        Continue ; для события $2F по Break переходим к началу цикла
    	EndIf
    EndIf
	EndIf
ForEver

Насколько я знал ранее в отличии от меток, цикл надёжно контролируется отладчиком, так как есть начало и конец блока, а в метках прерывание кода неизвестно где с прыжком в неизвестно куда.

Отредактировано AZJIO (04.09.2021 15:17:35)

0

20

Есле цикл то возможно лучше брать длинну трека за основу так как вдруг не окажется байта завершения трека?,но сейчас мне как бы это не принципиально хочется с временем проигрывания разобраться.
PS:Скачал прогу Anvil Studio, в ней можно сохранить треки в формат 0(воспроизведение всех треков(каналов)в один поток).
на раскрутку команд просто поставить case 0,1

Отредактировано Sergeihik (04.09.2021 16:00:13)

0

21

Да ещё для проигрывания и синхронизации как я понял используются высокоточные таймеры для мультимедиа.

Код:
Global TIMECAPS.TIMECAPS
timeGetDevCaps_(@TIMECAPS,SizeOf(TIMECAPS));получает разрешение таймера от минимума до максимума
;Минимальное разрешение таймера в миллисекундах для приложения или драйвера устройства. Меньшее значение указывает более высокое (более точное) разрешение.
Debug TIMECAPS\wPeriodMin
Debug TIMECAPS\wPeriodMax

;Замечания
;Вызовите эту функцию непосредственно перед использованием служб таймера и вызовите функцию timeEndPeriod сразу после завершения использования служб таймера.
timeBeginPeriod_(TIMECAPS\wPeriodMin);запрашивает минимальное разрешение для периодических таймеров.


timeEndPeriod_(TIMECAPS\wPeriodMin);очищает ранее установленное минимальное разрешение таймера.

PS:Из справки.
Эти службы таймера(ну и другие функции) полезны для приложений, которым требуется синхронизация с высоким разрешением. Например, MIDI-секвенсору требуется таймер с высоким разрешением, потому что он должен поддерживать темп MIDI-событий с разрешением в 1 миллисекунду.

Отредактировано Sergeihik (04.09.2021 19:07:31)

0

22

Вобщем справка ссылает ся что time setevent устарела и нужно использовать CreateTimerQueue
какой то код попался и перевёл на скору руку но оказалось нет таких  в пурике функций
буду подгружать и дальше копать и изучать их и некоторые моменты по возвращению значений а то там в первоисточнике типа знак инверсии чтоли стоял на проверку.

Код:
Procedure CALLBACK_TimerRoutine(lpParam, TimerOrWaitFired)

    If (lpParam = NULL)

        ;printf("TimerRoutine lpParam is NULL\n");
         Debug "TimerRoutine lpParam is NULL\n"
    Else
         
      ;// lpParam points To the argument; in this case it is an int

      ;printf("Timer routine called. Parameter is %d.\n", *(int*)lpParam);
        Debug "Timer routine called. Parameter is %d.\n  ,"  +Str(lpParam)
        
        If(TimerOrWaitFired)
         ;printf("The wait timed out.\n");
          Debug "The wait timed out.\n"
        Else
          ;rintf("The wait event was signaled.\n");
          Debug "The wait event was signaled.\n"
        EndIf
    EndIf

    SetEvent_(gDoneEvent);
EndProcedure

Procedure.i main()

   Protected hTimer = #Null;
   Protected hTimerQueue = #Null;
   Protected arg.i = 123;

    ;// Use an event object To track the TimerRoutine execution
    gDoneEvent = CreateEvent_(#Null, #True, #False, #Null);
    If (#Null = gDoneEvent)

        ;printf("CreateEvent failed (%d)\n", GetLastError());
        Debug "CreateEvent failed (%d)\n  "+Str(GetLastError_())
        ProcedureReturn 1;
     EndIf

    ;// Create the timer queue.
   ; hTimerQueue = CreateTimerQueue_();нет штатно функции
    If (#Null = hTimerQueue)
   
        ;printf("CreateTimerQueue failed (%d)\n", GetLastError());
        Debug "CreateEvent failed (%d)\n  "+Str(GetLastError_())
        ProcedureReturn 2;
    EndIf

    ;// Set a timer To call the timer routine in 10 seconds.
    ;If CreateTimerQueueTimer_( @hTimer, hTimerQueue, CALLBACK_TimerRoutine, @arg , 10000, 0, 0);;нет штатно функции
    
        ;printf("CreateTimerQueueTimer failed (%d)\n", GetLastError());
        Debug "CreateEvent failed (%d)\n  "+Str(GetLastError_())
        ProcedureReturn 3;
    ;EndIf

    ;// TODO: Do other useful work here 

    ;printf("Call timer routine in 10 seconds...\n");
    
    Debug "Call timer routine in 10 seconds...\n"

    ;// Wait For the timer-queue thread To complete using an event 
    ;// object. The thread will signal the event at that time.

    If (WaitForSingleObject_(gDoneEvent, INFINITE) <> #WAIT_OBJECT_0)
        ;printf("WaitForSingleObject failed (%d)\n", GetLastError());
        Debug "WaitForSingleObject failed (%d)\n  "+ Str(GetLastError_())
       CloseHandle_(gDoneEvent);
     EndIf
    ;/ Delete all timers in the timer queue.
    If DeleteTimerQueue_(hTimerQueue)
        ;printf("DeleteTimerQueue failed (%d)\n", GetLastError());
        Debug "DeleteTimerQueue failed (%d)\n  "+ Str(GetLastError_())
      EndIf 
      
      ProcedureReturn 0;
EndProcedure

Отредактировано Sergeihik (06.09.2021 20:56:58)

0

23

Sergeihik написал(а):

нужно использовать CreateTimerQueue
какой то код попался и перевёл на скору руку но оказалось нет таких  в пурике функций

Код:
Import ""
  CreateTimerQueue()
  CreateTimerQueueTimer(a,b,c,d,e,f,g)
EndImport

Global cc

Procedure Timer(parameter.i, b.b)
  cc+1
EndProcedure

tq = createtimerqueue()

CreateTimerQueueTimer(@thandle.i, tq, @Timer(), 0, 0, 1, $80)

Delay(10000)
Debug cc

Ещё

Код:
Import "kernel32.lib"
  CreateTimerQueue()
  DeleteTimerQueueTimer(hTimerQueue, hTimer, completionEvent)
  DeleteTimerQueueEx(hTimerQueue, completionEvent)
  ChangeTimerQueueTimer (hTimerQueue, hTimer, dueTime, period)
  CreateTimerQueueTimer(hTimer, hTimerQueue, timerCallback, param, dueTime, period, flags)
EndImport

Global timer_Q1, timer_Q2, timer_Q3,tm.l,tx.l

Procedure timerProc_Q(param.i, timer.i)
  SetGadgetText(1, Str(tm)+"  "+"Timer high priority")
  tm+1                 
EndProcedure

wFlags = #PB_Window_ScreenCentered | #PB_Window_SystemMenu
OpenWindow(0, #PB_Any, #PB_Any, 280, 120, "Windows Queue Timer", wFlags)
TextGadget(1, 50, 20, 200, 30, "Timer 1: ")
TextGadget(2, 50, 50, 200, 30, "Timer 2: ")

timerQueue = CreateTimerQueue()
CreateTimerQueueTimer(@timer_Q1, timerQueue, @timerProc_Q(), 1, 0, 100, 0)
AddWindowTimer(0, 123, 100)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      appQuit = 1
    Case #PB_Event_Timer 
      SetGadgetText(2, Str(tx)+"  "+"Timer low priority") 
      tx+1    
  EndSelect
Until appQuit = 1

DeleteTimerQueueEx(timerQueue, 0)

0

24

Уже видно что он работает как бы из собственного потока,когда будешь перетаскивать окно его основной поток притормозится и таймер соответственно пуриковский ну или тот что работает через сообщения окну замрёт а этот работает.
вобщем надо пробывать встроить в код и посмотреть что получится,код потом опубликую как попробую.

0

25

Sergeihik написал(а):

потока,когда будешь перетаскивать окно его основной поток притормозится и таймер соответственно пуриковский ну или тот что работает через сообщения окну замрёт а этот работает.

Перетащи окно.

Код:
Procedure Timer()
  Static Value
  Value = (Value + 5) % 100
  SetGadgetState(0, Value)
EndProcedure

If OpenWindow(0, 0, 0, 400, 100, "Timer Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ProgressBarGadget(0, 10, 10, 380, 20, 0, 100)
  AddWindowTimer(0, 123, 250)
  BindEvent(#PB_Event_Timer, @Timer(), 0, 123)
  Repeat
    Event = WaitWindowEvent()    
  Until Event = #PB_Event_CloseWindow
EndIf

0

26

Пётр написал(а):

Перетащи окно.

Да и тащить то ненужно,достаточно мышкой пощёлкать и видно как сбивается он притормаживая.

0

27

С временем проигрывания не зря писал что вникаю потихоньку(да ещё этот формат записи путает),вообщем слышно было что некоторые промежутки в проигрывании композиции пролетают.
И неправильный был участок кода определения времени событияэ

Код:
           If PeekA(*sobytie) & $80;время события по дельте времени в одном байте
                     delta_kolihestvoBait=2
                     zikl:
                     *sobytie+1
                     If PeekA(*sobytie) & $80
                       delta_kolihestvoBait+1
                       Goto zikl
                     EndIf
                     *sobytie+1
                   Else;иначе в байтах переменной длинны
                     *sobytie+1
                     delta_kolihestvoBait=1
                   EndIf  
                   Debug "delta_kolihestvoBait  "+Str(delta_kolihestvoBait)
                   
                   If delta_kolihestvoBait=1
                     delta_time_sobytie=PeekA(*sobytie-1)
                   ElseIf delta_kolihestvoBait=2
                     delta_time_sobytie=PeekW(*sobytie-2)
                     !ror word [p.v_delta_time_sobytie],8
                   EndIf  
                   Debug "delta_time_sobytie  "+Str(delta_time_sobytie)

изменил на это

Код:
                     delta_time_sobytie=0
                     ;Debug r
                    cikl8:
                     If *Sobytie\bait1 & $80;есле он не один
                      delta_time_sobytie|(*Sobytie\bait1 & $7F)
                      delta_time_sobytie<<7;сдвинуть на семь бтов под следующий байт
                      *Sobytie+1
                       Goto cikl8
                     Else
                       delta_time_sobytie|*Sobytie\bait1
                       *Sobytie+1
                     EndIf
                   Debug "delta_time_sobytie  "+Str(delta_time_sobytie)

А ну да выкинул функцию peek() и перешёл на структуру с объявлением Protected *sobytie.Sobytie

Код:
Structure Sobytie
  bait1.a
  bait2.a
  bait3.a
  bait4.a
EndStructure

Вобщем код позже.
Хочу ещё попробывать несколько треков ну типа синхронно проиграть по событию тика метронома и просто с задержкой по типу delay() и посмотреть
Так образно накидал метроном

Код:
Import "kernel32.lib"
  CreateTimerQueue()
  DeleteTimerQueueTimer(hTimerQueue, hTimer, completionEvent)
  DeleteTimerQueueEx(hTimerQueue, completionEvent)
  ChangeTimerQueueTimer (hTimerQueue, hTimer, dueTime, period)
  CreateTimerQueueTimer(hTimer, hTimerQueue, timerCallback, param, dueTime, period, flags)
EndImport

Global timer_Q1, timer_Q2

Procedure timerProc_Q1(param.i, timer.i)
  Static tm
  SetGadgetText(1, Str(tm)+"  "+"Timer high priority")
  tm+1
 Beep_(900,100)

EndProcedure
Procedure timerProc_Q2(param.i, timer.i)
  Static tm2
  SetGadgetText(2, Str(tm2)+"  "+"Timer high priority")
  tm2+1
  Beep_(900,100)
EndProcedure

OpenWindow(0, #PB_Any, #PB_Any, 280, 120, "Метроном", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
TextGadget(1, 50, 20, 200, 30, "Timer 1: ")
TextGadget(2, 50, 50, 200, 30, "Timer 2: ")

Global bmp.i=150
bmp=(60000/bmp)
Debug bmp

timerQueue = CreateTimerQueue()
CreateTimerQueueTimer(@timer_Q1, timerQueue, @timerProc_Q1(), 0, 0, bmp, $80|$100)
CreateTimerQueueTimer(@timer_Q2, timerQueue, @timerProc_Q2(), 0, 1000, bmp, $80|$100)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      appQuit = 1
   DeleteTimerQueueEx(timerQueue, 0)
  EndSelect
Until appQuit = 1

Structure Sobytie
  bait1.a
  bait2.a
  bait3.a
  bait4.a
EndStructure
*Sobytie.Sobytie

Global r.i

*mem=AllocateMemory(100)
*Sobytie.Sobytie=*mem
PokeA(*Sobytie,128)
PokeA(*Sobytie+1,129)
PokeA(*Sobytie+2,0)

r=0
Debug r
cikl:
If *Sobytie\bait1 & $80;есле он не один
r|(*Sobytie\bait1 & $7F)
 
r<<7;сдвинуть на семь бтов под следующий байт
*Sobytie+1
;; r|*Sobytie\bait1;добавляем второй байт
Debug r
 Goto cikl

  Else
   r|*Sobytie\bait1
  *Sobytie+1
EndIf
    
Debug r

FreeMemory(*mem)

Отредактировано Sergeihik (Вчера 20:43:08)

0


Вы здесь » PureBasic - форум » Программирование на PureBasic » Миди синтезатор