unit midi_crossplatform_unit;
//A Basic MIDI unit based on example by Jouni Mensalo © 2024
//Coded by TRon © 2024
//Date: December, 2024
//cross-platform support using rtMidi
//rtmidi header provided by hukka
{$mode ObjFPC}{$H+}
interface
uses
Types, SysUtils, rtMidi,
{ lcl dependencies }
Dialogs;
var
MidiOut : RtMidiOutPtr = nil;
NoteOnMsg : DWORD;
NoteOffMsg : DWORD;
midiopen : boolean;
procedure Change_Instrument(myinstrument: byte);
procedure Midi_Out_Open(PortNumber: integer);
procedure Play_Note(mynote: byte; volume: byte; length: cardinal);
procedure Midi_Out_Close();
procedure NoteOn(mynote: byte; volume: byte );
procedure NoteOff(mynote: byte);
procedure Panic5;
function Midi_Out_GetDeviceNames(Device: RtMidiPtr = nil): TStringDynArray;
function Midi_Out_Available: boolean;
implementation
procedure ShowMessage(aMsg: string);
begin
Dialogs.ShowMessage(aMsg);
end;
procedure Midi_Out_SendMessage(const MidiMsg: array of Byte);
begin
rtmidi_out_send_message(MidiOut, @MidiMsg[0], Length(MidiMsg));
end;
function Midi_Out_Available: boolean;
begin
if (rtmidi_get_port_count(MidiOut) <= 0) then
begin
Midi_Out_Available:=false;
end
else
begin
Midi_Out_Available:=true;
end;
end;
procedure Midi_Out_Open(PortNumber: integer);
begin
rtmidi_open_port(MidiOut, PortNumber, PAnsiChar('cross_platform_midi_port_name'));
midiopen := true;
ShowMessage('MIDI open OK');
end;
procedure Midi_Out_Close();
begin
if midiopen = false then
begin
ShowMessage('MIDI allready closed');
exit;
end;
if midiopen = true then
begin
rtmidi_close_port(MidiOut);
midiopen := false;
ShowMessage('MIDI closed');
end;
end;
procedure Change_Instrument(myinstrument: byte);
begin
//Change instrument
Midi_Out_SendMessage([$C0, myinstrument]);
end;
procedure Play_Note(mynote: byte; volume: byte; length: cardinal);
begin
try
NoteOn(mynote, volume);
Sleep(length);
NoteOff(mynote);
except
on E: Exception do
Showmessage('Error: ' + E.Message);
end;
end;
procedure NoteOn(mynote: byte; volume: byte);
var
NoteOnMsg: TByteDynArray;
begin
try
NoteOnMsg := [$90, mynote, volume];
Midi_Out_SendMessage(NoteOnMsg);
except
on E: Exception do
Showmessage('Error: ' + E.Message);
end;
end;
procedure NoteOff(mynote: byte);
var
NoteOffMsg : TByteDynArray;
begin
try
NoteOffMsg := [$90, mynote, 0];
Midi_Out_SendMessage(NoteOffMsg);
except
on E: Exception do
Showmessage('Error: ' + E.Message);
end;
end;
procedure Panic5;
var
Channel, Note: Byte;
NoteOffMsg: TByteDynArray;
ResetControllerMsg: TByteDynArray;
begin
for Channel := 0 to 15 do
begin
// "Reset All Controllers" (CC 121)for the channel
ResetControllerMsg := [$B0 or Channel, 121, 0];
Midi_Out_SendMessage(ResetControllerMsg);
// Note Off, Velocity 0 for all the notes of the channel
for Note := 0 to 127 do
begin
NoteOffMsg := [$80 or Channel, Note, 0];
Midi_Out_SendMessage(NoteOffMsg);
end;
end;
end;
function Midi_Out_Create(Api: RtMidiApi = RTMIDI_API_UNSPECIFIED; ClientName: string = 'RtMidi Input Client'): RtMidiPtr;
begin
result := rtmidi_out_create(Api, PAnsiChar(ClientName));
end;
procedure Midi_Out_Destroy(Device: RtMidiOutPtr);
begin
rtmidi_out_free(Device);
end;
function Midi_Out_GetDeviceNames(Device: RtMidiPtr = nil): TStringDynArray;
var
i, nPorts: Integer;
AutoCreated: Boolean = False;
Portname: String;
function getPortName(aPortNumber: SizeUInt): string;
var
len : SizeInt;
begin
if assigned(Device) then
begin
rtmidi_get_port_name(Device, aPortNumber, nil, @len);
setlength(result, len);
rtmidi_get_port_name(Device, aPortNumber, @Result[1], @len);
end;
end;
begin
Result := [];
if Device = nil then
begin
AutoCreated := true;
Device := rtmidi_out_create_default();
end;
if (Device = nil) or (not Device^.ok)
then Exit;
nPorts := rtmidi_get_port_count(Device);
for i := 0 to nPorts-1 do
begin
try
Portname := GetPortName(i);
if Portname.IsEmpty
then Continue;
Result := concat(Result, [Portname]);
except
end;
end;
if AutoCreated
then rtmidi_out_free(Device)
end;
initialization
begin
MidiOut := Midi_Out_Create();
end;
finalization
begin
if assigned(MidiOut) then
begin
Midi_Out_Destroy(MidiOut);
MidiOut := nil;
end;
end;
end.