Platforms to show: All Mac Windows Linux Cross-Platform
/MacCF/MIDI/Event Benchmark/MIDI Send
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/Event Benchmark/MIDI Send
This example is the version from Thu, 3rd Oct 2012.
Project "MIDI Send.xojo_binary_project"
FileTypes
Filetype text
End FileTypes
Class Window1 Inherits Window
Control Timer1 Inherits Timer
ControlInstance Timer1 Inherits Timer
EventHandler Sub Action()
counter = counter + 1
SendNoteOn(counter mod 13)
SendNoteOff(counter mod 13)
End EventHandler
End Control
Control Label1 Inherits Label
ControlInstance Label1 Inherits Label
End Control
Control Timer2 Inherits Timer
ControlInstance Timer2 Inherits Timer
EventHandler Sub Action()
label1.text = str(counter*2)
End EventHandler
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
if currentDest = nil then
MsgBox "Please launch other app first."
quit
end if
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)
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)
End Sub
Sub SetupDestinations()
dim i, n as integer
dim dest as MIDIEndpointMBS
dim s as string
dim name, model as string
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 instr(name, "MyDestination") > 0 then
currentDest = dest
end if
next
end
End Sub
Property client As MIDIClientMBS
Property counter As Integer
Property currentDest As MIDIEndpointMBS
Property outport As MIDIPortMBS
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.