Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS MacCF Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /MacCF/MIDI/MIDI Send Keys
This example is the version from Sun, 17th Mar 2012.
Project "MIDI Send Keys.xojo_binary_project"
FileTypes
Filetype text
End FileTypes
Class Window1 Inherits Window
Control destbox Inherits ListBox
ControlInstance destbox Inherits ListBox
EventHandler Sub Change()
dim o as MIDIObjectMBS
'outport.disconnectSource currentDest
msg "outport.disconnectSource "+str(outport.Lasterror)
if me.listindex >=0 then
currentDest = realDestinations(me.listindex)
'outport.connectSource currentDest
msg "outport.connectSource "+str(outport.Lasterror)
else
currentDest = nil
end
End EventHandler
End Control
Control notes Inherits BevelButton
ControlInstance notes(0) Inherits BevelButton
ControlInstance notes(1) Inherits BevelButton
ControlInstance notes(2) Inherits BevelButton
ControlInstance notes(3) Inherits BevelButton
ControlInstance notes(4) Inherits BevelButton
ControlInstance notes(5) Inherits BevelButton
ControlInstance notes(6) Inherits BevelButton
ControlInstance notes(7) Inherits BevelButton
ControlInstance notes(8) Inherits BevelButton
ControlInstance notes(9) Inherits BevelButton
ControlInstance notes(10) Inherits BevelButton
ControlInstance notes(11) Inherits BevelButton
ControlInstance notes(12) Inherits BevelButton
EventHandler Function MouseDown(index as Integer, X As Integer, Y As Integer) As Boolean
me.value = true
SendNoteOn(index)
return true
End EventHandler
EventHandler Function MouseUp(index as Integer, X As Integer, Y As Integer) As Boolean
me.value = false
SendNoteOff(index)
return true
End EventHandler
End Control
Control Error Inherits ListBox
ControlInstance Error Inherits ListBox
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
EventHandler Sub Close()
client.close
End EventHandler
EventHandler Sub Open()
InitMIDI
End EventHandler
Function GetDeviceNames(ep as MIDIEndpointMBS) As string
dim externalIDs as CFBinaryDataMBS
dim theID as integer
dim i, j, l as integer
dim mb as memoryBlock
dim o as MIDIObjectMBS
dim s as string
dim names(0) as string
dim displayName as string
dim n as integer
externalIDs = ep.BinaryProperty(ep.kMIDIPropertyConnectionUniqueID)
if externalIDs <> nil then
l = externalIDs.len
mb = externalIDs.Mem
for i = 0 to externalIDs.len-1 step 4
theID = mb.Long(i)
if theID <> 0 then
o = client.FindObjectByUniqueID(theID)
if o <> nil then
names.append o.stringProperty(o.kMIDIPropertyName).str
exit
end
end
next
n = UBound(names)
if n > 0 then
displayName = ""
for i = 1 to n
displayName = displayName + names(i)
if i < n then
displayName = displayName + ", "
end
next
'realDObjects.append o
return displayName
end
end
return ""
End Function
Sub InitMIDI()
dim i as integer
client = new MIDIClientMBS
client.init(NewCFStringMBS("CoreMIDI"))
if client.handle=0 then
msgbox "Couldn't create a MIDI Client..."
quit
end
outport = new MIDIPortMBS
client.CreateOutputPort(NewCFStringMBS("outport"), outport)
SetupDestinations
End Sub
Sub Msg(s as string)
Error.InsertRow 0,s
End Sub
Sub SendNoteOff(noteValue as integer)
dim pack as MIDIPacketMBS
dim list as MIDIPacketListMBS
dim packs(-1) as MIDIPacketMBS
dim num as integer
dim data as memoryBlock
pack = new MIDIPacketMBS
list = new MIDIPacketListMBS
data = newmemoryBlock(3)
data.byte(0) = &h80 'note off
data.byte(1) = noteValue + 48 'take it up a few octaves
data.byte(2) = &h7C 'velocity
pack.datamemory = data
pack.timeStamp = nil 'now
packs.append pack
if not list.FillList(packs) then
msgBox "bad"
end
client.Send(outport, currentDest, list)
Msg "client.Send off "+str(client.Lasterror)
End Sub
Sub SendNoteOn(noteValue as integer)
dim pack as MIDIPacketMBS
dim list as MIDIPacketListMBS
dim packs(-1) as MIDIPacketMBS
dim num as integer
dim data as memoryBlock
pack = new MIDIPacketMBS
list = new MIDIPacketListMBS
data = newmemoryBlock(3)
data.byte(0) = &h90 'note on
data.byte(1) = noteValue + 48 'take it up a few octaves
data.byte(2) = &h7C 'velocity
pack.datamemory = data
pack.timeStamp = nil 'now
packs.append pack
if not list.FillList(packs) then
msgBox "bad"
end
client.Send(outport, currentDest, list)
Msg "client.Send on "+str(client.Lasterror)
End Sub
Sub SetupDestinations()
dim i, n as integer
dim dest as MIDIEndpointMBS
dim s as string
dim name, model as string
'this is a better way to create a destination list
'rather than presenting the destinations to the user,
'we try to tell them what's connected where
'of course, this is really dependent on AudioMIDI Setup
redim realDestinations(-1)
destbox.deleteAllRows
n = client.NumberOfDestinations
if n <> 0 then
for i = 0 to n-1
dest = client.getDestination(i)
name =CFString(dest.stringProperty(dest.kMIDIPropertyName))
model=CFString(dest.stringProperty(dest.kMIDIPropertyModel))
s = GetDeviceNames(dest)
if s = "" then
destbox.addrow model+":"+name
realDestinations.append dest
else
destbox.addrow model+":"+name+":"+s
realDestinations.append dest
end
next
end
destbox.ListIndex=0
End Sub
Property client As MIDIClientMBS
Property currentDest As MIDIEndpointMBS
Property outport As MIDIPortMBS
Property realDestinations() As MIDIEndpointMBS
End Class
MenuBar MenuBar1
MenuItem UntitledMenu1 = ""
MenuItem FileMenu = "&File"
MenuItem FileQuit = "Quit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu0 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
End MenuBar
Class App Inherits Application
End Class
Module Util
Function CFString(c as cfstringMBS) As string
if c<>nil then
Return c.str
end if
Exception
End Function
End Module
End Project
See also:
The items on this page are in the following plugins: MBS MacCF Plugin.
