hier war das Thema Midi gerade so präsent, daher hier einmal eine allgemeine Thread/Async-Frage (mit Bezug auf Musik).
Wie könnte man so etwas (am besten) asynchron hinbekommen.
(Also ohne das Delay)
Code: Alles auswählen
;Einrücken: Strg + I
;Nur ein kleiner Testcode
EnableExplicit
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Global.i hMidiOut
Procedure MidiOutMessage(hMidi,iStatus,iChannel,iData1,iData2)
Protected.i dwMessage
dwMessage = iStatus | iChannel | (iData1 << 8 ) | (iData2 << 16)
ProcedureReturn midiOutShortMsg_(hMidi, dwMessage)
EndProcedure
Procedure SetInstrumentPerChannel(channel, instrument)
MidiOutMessage(hMidiOut, $C0, channel, instrument, 0)
EndProcedure
Procedure StopNote(channel, note)
MidiOutMessage(hMidiOut, $90, channel, Note, 0)
EndProcedure
Procedure PlayNote(channel, note, volume)
MidiOutMessage(hMidiOut, $90, channel, note , volume)
EndProcedure
Define midi.MIDIOUTCAPS, devices, devnum, midiport
devices = midiOutGetNumDevs_()
For devnum = - 1 To devices - 1
If midiOutGetDevCaps_(devnum,@midi,SizeOf(MIDIOUTCAPS))=0
If midi\wVoices > 0
midiport=devnum
EndIf
EndIf
Next
Define *hMidiOut
If midiOutOpen_(@hMidiOut,midiport,0,0,0) <> #MMSYSERR_NOERROR
MessageRequester("Fehler", "Keine Midi-Ausgabe möglich.", #PB_MessageRequester_Error)
End
EndIf
Procedure Decode_MidiString(channel.i, MidiStr.s, bpm.i = 120, volume.i = 50)
Protected.i index = 1
Protected.s nstr, ns, ds, ts
Protected.i note, octave, dots, i
Protected.f duration, bps, beat, mbeats
If channel = 0
ProcedureReturn -1
Debug "Kanal muss größer 0 sein."
EndIf
bps.f = bpm / 60
beat.f = (1 / bps) * 1000
Repeat
nstr = StringField(MidiStr, index, "/")
If nstr <> #Null$
ns = StringField(nstr, 1, ":")
octave = Val(StringField(nstr, 2, ":"))
ds = StringField(nstr, 3, ":")
ts = Right(nstr, 1) ;Um den Takt zu ermitteln.
Select UCase(ns)
Case "C"
note = 0
Case "#C", "bD"
note = 1
Case "D"
note = 2
Case "#D", "bE"
note = 3
Case "E"
note = 4
Case "F"
note = 5
Case "#F", "bG"
note = 6
Case "G"
note = 7
Case "#G", "bA"
note = 8
Case "A"
note = 9
Case "#A", "bB", "bH"
note = 10
Case "B", "H"
note = 11
Case "R" ;Pause
note = 255
Default
MessageRequester("Fehler", ~"Eine ungültige Note eingegeben.\nDie Eingabe: \""+ns+~"\" ist ungültig.", #PB_MessageRequester_Error)
ProcedureReturn -1
EndSelect
note = (octave * 12) + note
Select UCase(Left(ds, 1))
Case "Q"
duration = 1 ;Viertel-Note
Case "H"
duration = 2 ;Halbe-Note
Case "W"
duration = 4 ;Ganze-Note
Case "E"
duration = 0.5 ;Achtel-Note
Case "S"
duration = 0.25 ;Sechzehntel-Note
Case "T"
duration = 0.125 ;Zweiunddreißigstel-Note
Case "F"
duration = 0.0625 ;Vierundsechzigstel-Note
Default
MessageRequester("Fehler", ~"Eine ungültige Notenlänge angegeben.\nDie Eingabe: \""+ds+~"\" ist ungültig.", #PB_MessageRequester_Error)
ProcedureReturn -1
EndSelect
dots = CountString(UCase(ds), "D")
If duration > 0 And Len(ds) > 1 And dots > 0 And (dots = Len(ds)-1)
For i=1 To dots
duration * 1.5
Next
ElseIf duration > 0 And Len(ds) > 1 And (dots <> Len(ds)-1)
MessageRequester("Fehler", ~"Eine ungültige Punktierung angegeben.\nDie Eingabe: \""+UCase(ds)+~"\" ist ungültig.", #PB_MessageRequester_Error)
ProcedureReturn -1
EndIf
mbeats = mbeats + duration
If note < 255
PlayNote(channel, note, volume)
Delay(beat * duration)
StopNote(channel, note)
EndIf
If ts = "|"
Debug "Count: " + StrF(mbeats)
mbeats = 0
EndIf
EndIf
index + 1
Until nstr = ""
EndProcedure
;-GUI
Global evt
If OpenWindow(0, 0, 0, 100, 100, "Midi-Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
StartDrawing(WindowOutput(0))
DrawText(10, 10, "Bitte warten!")
StopDrawing()
;...
SetInstrumentPerChannel(1, 10)
;SetInstrumentPerChannel(2, 1)
Decode_MidiString(1, "g:6:q/a:6:q/b:6:q/c:7:q/d:7:q/e:7:q/#f:7:q:|/g:7:q", 120, 100)
;...
Repeat
evt = WaitWindowEvent()
;....
Until evt = #PB_Event_CloseWindow
EndIf
midiOutClose_(@hMidiOut)
CompilerElse
MessageRequester("Fehler", ~"Dieser Code läuft nur unter Windows.\nDanke für Ihr Verständnis.", #PB_MessageRequester_Error)
CompilerEndIf
