Code: Alles auswählen
; MIDI-Connecter
; by NicTheQuick
Procedure MIDIRequester(*OutDevice.l, *InDevice.l)
#MOD_WAVETABLE = 6
#MOD_SWSYNTH = 7
#MIDIRequ_InSet = 2
#MIDIRequ_OutSet = 1
#Width = 400
If OpenWindow(0, 0, 0, #Width, 270, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "MIDI-Requester")
If CreateGadgetList(WindowID())
#Column = (#Width - 20) / 2
#Offset = (#Width / 2) + 5
TextGadget(0, 5, 5, #Column, 18, "Output-Device:", #PB_Text_Center | #PB_Text_Border)
ListViewGadget(2, 5, 23, #Column, 100)
MaxOutDev.l = midiOutGetNumDevs_()
InfoOut.MIDIOUTCAPS
If MaxOutDev
For a.l = -1 To MaxOutDev - 1
midiOutGetDevCaps_(a, InfoOut, SizeOf(MIDIOUTCAPS))
AddGadgetItem(2, -1, PeekS(@InfoOut\szPname[0], 32))
Next
Else
AddGadgetItem(2, -1, "(no output device)")
DisableGadget(2, 1)
EndIf
TextGadget(1, #Offset, 5, #Column, 18, "Input-Device:", #PB_Text_Center | #PB_Text_Border)
ListViewGadget(3, #Offset, 23, #Column, 100)
MaxInDev.l = midiInGetNumDevs_()
InfoIn.MIDIINCAPS
If MaxInDev
For a.l = 0 To MaxInDev - 1
midiInGetDevCaps_(a, InfoIn, SizeOf(MIDIINCAPS))
AddGadgetItem(3, -1, PeekS(@InfoIn\szPname[0], 32))
Next
Else
AddGadgetItem(3, -1, "(no input device)")
DisableGadget(3, 1)
EndIf
ButtonGadget(4, 5, 240, #Column, 24, "&OK")
ButtonGadget(5, #Offset, 240, #Column, 24, "&Cancel")
Frame3DGadget(6, 5, 130, #Width - 10, 100, "Info of Output-Device", 0)
TextGadget(7, 10, 145, #Width - 20, 18, "Version:")
TextGadget(8, 10, 165, #Width - 20, 18, "Technology:")
TextGadget(9, 10, 185, #Width - 20, 18, "Max. Voices:")
TextGadget(10, 10, 205, #Width - 20, 18, "Polyphonie:")
OutDev.l = 0
InDev.l = 0
Quit.l = #False
Ok.l = #False
Repeat
If GetGadgetState(2) > -1 Or GetGadgetState(3) > -1
DisableGadget(4, 0)
Else
DisableGadget(4, 1)
EndIf
If InDev.l <> GetGadgetState(3)
InDev.l = GetGadgetState(3)
EndIf
If GetGadgetState(2) <> OutDev
OutDev.l = GetGadgetState(2)
midiOutGetDevCaps_(OutDev - 1, InfoOut, SizeOf(MIDIOUTCAPS))
SetGadgetText(7, "Version: " + Str(InfoOut\vDriverVersion >> 8) + "." + Str(InfoOut\vDriverVersion & FF))
Select InfoOut\wTechnology
Case #MOD_MIDIPORT : TmpS.s = "Hardware Port"
Case #MOD_SYNTH : TmpS.s = "Synthesizer"
Case #MOD_SQSYNTH : TmpS.s = "Square Wave Synthesizer"
Case #MOD_FMSYNTH : TmpS.s = "FM Synthesizer"
Case #MOD_MAPPER : TmpS.s = "Microsoft MIDI Mapper"
Case #MOD_WAVETABLE : TmpS.s = "Hardware Wavetable Synthesizer"
Case #MOD_SWSYNTH : TmpS.s = "Software Synthesizer"
Default: TmpS.s = "(Error Code " + Str(InfoOut\wTechnology) + ")"
EndSelect
SetGadgetText(8, "Technology: " + TmpS)
If InfoOut\wVoices = 0 : TmpS.s = "inf" : Else : TmpS.s = Str(InfoOut\wVoices) : EndIf
SetGadgetText(9, "Max. Voices: " + TmpS)
If InfoOut\wNotes = 0 : TmpS.s = "inf" : Else : TmpS.s = Str(InfoOut\wNotes) : EndIf
SetGadgetText(10, "Polyphonie: " + TmpS)
EndIf
EventID.l = WaitWindowEvent()
Select EventID
Case #PB_EventCloseWindow
Quit = #True
Ok = #False
Case #PB_EventGadget
Select EventGadgetID()
Case 4
PokeL(*OutDevice, OutDev - 1)
PokeL(*InDevice, InDev)
Quit = #True
Ok = 3
If (OutDev = -1 Or CountGadgetItems(2) = 0) And Ok & #MIDIRequ_OutSet : Ok ! #MIDIRequ_OutSet : EndIf
If (InDev = -1 Or CountGadgetItems(3) = 0) And Ok & #MIDIRequ_InSet : Ok ! #MIDIRequ_InSet : EndIf
Case 5
Quit = #True
Ok = #False
EndSelect
EndSelect
Until Quit
CloseWindow(0)
ProcedureReturn Ok
Else
End
EndIf
Else
End
EndIf
EndProcedure
Structure MIDIData
Channel.b
Note.b
Velocity.b
Null.b
EndStructure
;Channel from 0 to 15 (Kanal)
;Note from 0 to 127 (Note)
;Velocity from 0 to 127 (Anschlagstärke)
;Controller from 0 to 127 (Effekte, usw., siehe unten im Quellcode)
;Instr from 0 to 127
;PitchWhell from 0 to 32768
Procedure ProgramChange(Channel.b, Instr.b)
Shared HandleOut
Protected NoteDat.MIDIData
NoteDat\Channel = $C0 + Channel
NoteDat\Note = Instr
If midiOutShortMsg_(HandleOut, PeekW(NoteDat)) = #MMSYSERR_NOERROR : Debug "Kanal gewechselt..." : EndIf
EndProcedure
Procedure NoteOn(Channel.b, Note.b, Velocity.b)
Shared HandleOut
Protected NoteDat.MIDIData
NoteDat\Channel = $90 + Channel
NoteDat\Note = Note
NoteDat\Velocity = Velocity
NoteDat\Null = #Null
If midiOutShortMsg_(HandleOut, PeekL(NoteDat)) = #MMSYSERR_NOERROR : Debug "Ton gestartet..." : EndIf
EndProcedure
Procedure NoteOff(Channel.b, Note.b, Velocity.b)
Shared HandleOut
Protected NoteDat.MIDIData
NoteDat\Channel = $80 + Channel
NoteDat\Note = Note
NoteDat\Velocity = Velocity
NoteDat\Null = #NULL
midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure NoteOffAlternate(Channel.b, Note.b, Velocity.b)
Shared HandleOut
Protected NoteDat.MIDIData
NoteDat\Channel = $90 + Channel
NoteDat\Note = Note
NoteDat\Velocity = 0
NoteDat\Null = #NULL
midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure AllNotesOff(Channel.b)
Shared HandleOut
Protected NoteDat.MIDIData
NoteDat\Channel = $B0 + Channel
NoteDat\Note = $7B
NoteDat\Velocity = 0
NoteDat\Null = #NULL
midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure ChangeController(Channel.b, Controller.b, Value.b)
Shared HandleOut
Protected NoteDat.MIDIData
NoteDat\Channel = $B0 + Channel
NoteDat\Note = Controller
NoteDat\Velocity = Value
NoteDat\Null = #NULL
midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure ChannelPressure(Channel.b, Value.b)
Shared HandleOut
Protected NoteDat.MIDIData
NoteDat\Channel = $D0 + Channel
NoteDat\Note = Value
NoteDat\Velocity = #NULL
NoteDat\Null = #NULL
midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure KeyAftertouch(Channel.b, Note.b, Value.b)
Shared HandleOut
Protected NoteDat.MIDIData
NoteDat\Channel = $A0 + Channel
NoteDat\Note = Note
NoteDat\Velocity = Value
NoteDat\Null = #NULL
midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure PitchWheel(Channel.b, Value.w)
Shared HandleOut
Protected NoteDat.MIDIData
NoteDat\Channel = $E0 + Channel
NoteDat\Null = #Null
PokeW(@NoteDat\Note, Value)
midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Dim Controller.s(127)
Procedure InitController()
Protected a.l
Restore ControllerNames
For a = 0 To 127
Read Controller(a)
Next
EndProcedure
Procedure.s GetControllerName(Number.l)
If Number >= 0 And Number <= 127
ProcedureReturn RSet(Str(Number), 3, "0") + " " + Controller(Number)
EndIf
EndProcedure
;- MAINPROGRAM
Procedure MidiInProc(hMidiIn.l, wMsg.l, dwInstance.l, dwParam1.l, dwParam2.l)
Protected Status.l, OnOf.l, NoteNr.l, Velocity.l
Select wMsg
Case #MM_MIM_OPEN
Debug "open"
Case #MM_MIM_CLOSE
Debug "close"
Case #MM_MIM_DATA
Status = dwParam1 & $FF
If Status < $F0
Select Status / 16
Case $8
Debug "Note On"
Debug " Kanal: " + Str(dwParam1 & $F)
Debug " Note: " + Str((dwParam1 >> 8) & $FF)
Debug " Velocity: " + Str((dwParam1 >> 16) & $FF)
Case $9
If dwParam1 & $FF0000
Debug "Note On"
Else
Debug "Note Off"
EndIf
Debug " Kanal: " + Str(dwParam1 & $F)
Debug " Note: " + Str((dwParam1 >> 8) & $FF)
Debug " Velocity: " + Str((dwParam1 >> 16) & $FF)
Case $A
Debug "Key Aftertouch"
Debug " Kanal: " + Str(dwParam1 & $F)
Debug " Note: " + Str((dwParam1 >> 8) & $FF)
Debug " Value: " + Str((dwParam1 >> 16) & $FF)
Case $B
Debug "Controller Change"
Debug " Kanal: " + Str(dwParam1 & $F)
Debug " Controller: " + GetControllerName((dwParam1 >> 8) & $FF)
Debug " Wert: " + Str((dwParam1 >> 16) & $FF)
Case $C
Debug "Program Change"
Debug " Kanal: " + Str(dwParam1 & $F)
Debug " Instrument: " + Str((dwParam1 >> 8 ) & $FF)
Case $D
Debug "Channel Pressure"
Debug " Kanal: " + Str(dwParam1 & $F)
Debug " Value: " + Str((dwParam1 >> 8) & $FF)
Case $E
Debug "Pitch Wheel"
Debug " Kanal: " + Str(dwParam1 & $F)
Debug " Value: " + Str((dwParam >> 16) & $FFFF)
Default
Debug Hex(Status)
EndSelect
EndIf
Case #MM_MIM_LONGDATA
Debug "Longdata: " + RSet(Hex(dwParam1), 2, "0") + RSet(Hex(dwParam2), 2, "0")
Case #MM_MIM_ERROR
Debug "Error: " + RSet(Hex(dwParam1), 2, "0") + RSet(Hex(dwParam2), 2, "0")
Case #MM_MIM_LONGERROR
Debug "LongError"
Default
Debug "???"
EndSelect
EndProcedure
InitController()
OutDevice.l
InDevice.l
MIDIResult.l = MIDIRequester(@OutDevice, @InDevice)
If MIDIResult & #MIDIRequ_InSet
hMidiIn.l
If midiInOpen_(@hMidiIn, InDevice, @MidiInProc(), 0, #CALLBACK_FUNCTION) = #MMSYSERR_NOERROR
Debug "OPEN: MidiIn"
If midiInStart_(hMidiIn) = #MMSYSERR_NOERROR
Debug "START: MidiIn"
EndIf
EndIf
EndIf
If MIDIResult & #MIDIRequ_OutSet
hMidiOut.l
If midiOutOpen_(@hMidiOut, OutDevice, 0, 0, 0) = 0
Debug "OPEN: MidiOut"
EndIf
EndIf
If hMidiIn And hMidiOut
If midiConnect_(hMidiIn, hMidiOut, 0) = 0
EndIf
EndIf
If OpenWindow(0, 0, 0, 400, 300, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "WaitWindow")
Repeat
EventID.l = WaitWindowEvent()
Until EventID = #PB_EventCloseWindow
EndIf
midiDisconnect_(hMidiIn, hMidiOut, 0)
While midiInClose_(hMidiIn) = #MIDIERR_STILLPLAYING : Wend
While midiOutClose_(hMidiOut) = #MIDIERR_STILLPLAYING : Wend
DataSection
ControllerNames:
Data.s "Bank Select", "Modulation", "Breath Controller", "", "4 (0x04) Foot Controller" ;0 - 4
Data.s "Portamento time", "Data Entry (MSB)", "Main Volume", "Balance", "", "Pan" ;5 - 10
Data.s "Expression Controller", "Effect Control 1", "Effect Control 2", "", "" ;11 - 15
Data.s "General-Purpose Controllers 1", "General-Purpose Controllers 2", "General-Purpose Controllers 3" ;16 - 18
Data.s "General-Purpose Controllers 4", "", "", "", "", "", "", "", "", "", "", "", "" ;19 - 31
Data.s "LSB for Controller 0", "LSB for Controller 1", "LSB for Controller 2", "LSB for Controller 3" ;32 - 35
Data.s "LSB for Controller 4", "LSB for Controller 5", "LSB for Controller 6", "LSB for Controller 7" ;36 - 39
Data.s "LSB for Controller 8", "LSB for Controller 9", "LSB for Controller 10", "LSB for Controller 11" ;40 - 43
Data.s "LSB for Controller 12", "LSB for Controller 13", "LSB for Controller 14", "LSB for Controller 15" ;44 - 47
Data.s "LSB for Controller 16", "LSB for Controller 17", "LSB for Controller 18", "LSB for Controller 19" ;48 - 51
Data.s "LSB for Controller 20", "LSB for Controller 21", "LSB for Controller 22", "LSB for Controller 23" ;52 - 55
Data.s "LSB for Controller 24", "LSB for Controller 25", "LSB for Controller 26", "LSB for Controller 27" ;56 - 59
Data.s "LSB for Controller 28", "LSB for Controller 29", "LSB for Controller 30", "LSB for Controller 31" ;60 - 63
Data.s "Damper pedal (sustain)", "Portamento", "Sostenuto", "Soft Pedal", "Legato Footswitch" ;64 - 68
Data.s "Hold 2", "Sound Controller 1 (Default: Timber Variation)" ;69 - 70
Data.s "Sound Controller 2 (Default: Timber/Harmonic Content)" ;71 - 71
Data.s "Sound Controller 3 (Default: Release time)", "Sound Controller 4 (Default: Attack time)" ;72 - 73
Data.s "Sound Controller 6", "Sound Controller 7", "Sound Controller 8", "Sound Controller 9" ;74 - 77
Data.s "Sound Controller 10", "", "General-Purpose Controllers 5", "General-Purpose Controllers 6" ;78 - 81
Data.s "General-Purpose Controllers 7", "General-Purpose Controllers 8", "Portamento Control" ;82 - 84
Data.s "", "", "", "", "", "", "Effects 1 Depth (formerly External Effects Depth)" ;85 - 91
Data.s "Effects 2 Depth (formerly Tremolo Depth)", "Effects 3 Depth (formerly Chorus Depth)" ;92 - 93
Data.s "Effects 4 Depth (formerly Celeste Detune)", "Effects 5 Depth (formerly Phaser Depth)" ;94 - 95
Data.s "Data Increment", "Data Decrement", "Non-Registered Parameter Number (LSB)" ;96 - 98
Data.s "Non-Registered Parameter Number (MSB)", "Registered Parameter Number (LSB)" ;99 - 100
Data.s "Registered Parameter Number (MSB)", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "" ;101 - 116
Data.s "", "", "", "", "Mode Messages", "Mode Messages", "Mode Messages", "Mode Messages" ;117 - 124
Data.s "Mode Messages", "Mode Messages", "Mode Messages" ;125 - 127
EndDataSection
Der hat damals unter Windows 2000 super funktioniert. Mittlerweile würde ich ihn ganz anders schreiben, aber da ich kein Windows zur Hand habe, kann ich dir auch gerade nicht wirklich helfen. Falls die API-Befehle gleich geblieben sind, sollte es aber ein leichtes sein alles wieder unter dem neusten PB korrekt ans Laufen zu kriegen.