Recent

Author Topic: MIDI instrument player for Lazarus demo  (Read 747 times)

finlazarus

  • New Member
  • *
  • Posts: 16
MIDI instrument player for Lazarus demo
« on: December 15, 2024, 02:27:09 am »
Hello everyone!

Here's a simple demo that plays PC sound card MIDI instruments directly.

Playing the instrument with a mouse has been implemented as a model with a few buttons, as well as playing a MIDI instrument from the keyboard with a few keys.

A MIDI unit includes only the basic commands: Open and close a MIDI device, Note on and Note off commands, Switch instruments, and select a MIDI device.

Also comes with a couple of subroutines that play music by controlling the MIDI instuments on the sound card with code.

The project is attached (zipped).

Unfortunately, only for Windows at the moment. I wonder if there is for  Mac, Linux, etc. a system level library like Windows's MMSYSTEM? I would like to have suggestions on how to run this code on non-Windows systems.

All feedback is welcome!

TRon

  • Hero Member
  • *****
  • Posts: 3976
Re: MIDI instrument player for Lazarus demo
« Reply #1 on: December 15, 2024, 02:51:53 am »
As already stated by user hukka when asked the same question, librtmidi is a cross-platform library. hukka mentioned it explicitly because he provided FPC header bindings as well.

Note on, note off example for rtmidi (similar as in your example project but, written in c) can be read here.


edit
Sorry, but I can't be arsed to put up the 'fixed' rtMidi unit from hukka without becoming sleeping beauty (do note that his unit header is targeted at an older version of the rtmidi library).

Code: Pascal  [Select][+][-]
  1. unit midi_crossplatform_unit;
  2. //A Basic MIDI unit based on example by Jouni Mensalo © 2024
  3. //Coded by TRon © 2024
  4. //Date: December, 2024
  5. //cross-platform support using rtMidi
  6. //rtmidi header provided by hukka
  7.  
  8. {$mode ObjFPC}{$H+}
  9.  
  10. interface
  11.  
  12. uses
  13.   Types, SysUtils, rtMidi,
  14.   { lcl dependencies }
  15.   Dialogs;
  16.  
  17. var
  18.   MidiOut    : RtMidiOutPtr = nil;
  19.   NoteOnMsg  : DWORD;
  20.   NoteOffMsg : DWORD;
  21.   midiopen   : boolean;
  22.   procedure Change_Instrument(myinstrument: byte);
  23.   procedure Midi_Out_Open(PortNumber: integer);
  24.   procedure Play_Note(mynote: byte; volume: byte; length: cardinal);
  25.   procedure Midi_Out_Close();
  26.   procedure NoteOn(mynote: byte; volume: byte );
  27.   procedure NoteOff(mynote: byte);
  28.   procedure Panic5;
  29.   function  Midi_Out_GetDeviceNames(Device: RtMidiPtr = nil): TStringDynArray;
  30.   function  Midi_Out_Available: boolean;
  31.  
  32. implementation
  33.  
  34. procedure ShowMessage(aMsg: string);
  35. begin
  36.   Dialogs.ShowMessage(aMsg);
  37. end;
  38.  
  39. procedure Midi_Out_SendMessage(const MidiMsg: array of Byte);
  40. begin
  41.   rtmidi_out_send_message(MidiOut, @MidiMsg[0], Length(MidiMsg));
  42. end;
  43.  
  44. function  Midi_Out_Available: boolean;
  45. begin
  46.   if (rtmidi_get_port_count(MidiOut) <= 0) then
  47.   begin
  48.     Midi_Out_Available:=false;
  49.   end
  50.   else
  51.   begin
  52.     Midi_Out_Available:=true;
  53.   end;
  54. end;
  55.  
  56. procedure Midi_Out_Open(PortNumber: integer);
  57. begin
  58.   rtmidi_open_port(MidiOut, PortNumber, PAnsiChar('cross_platform_midi_port_name'));
  59.   midiopen := true;
  60.   ShowMessage('MIDI open OK');
  61. end;
  62. procedure Midi_Out_Close();
  63. begin
  64.   if  midiopen = false then
  65.    begin
  66.    ShowMessage('MIDI allready closed');
  67.    exit;
  68.    end;
  69.  
  70. if  midiopen = true then
  71.  begin
  72.   rtmidi_close_port(MidiOut);
  73.   midiopen := false;
  74.   ShowMessage('MIDI closed');
  75.  end;
  76. end;
  77.  
  78. procedure Change_Instrument(myinstrument: byte);
  79. begin
  80. //Change instrument
  81.  Midi_Out_SendMessage([$C0, myinstrument]);
  82.  
  83. end;
  84.  
  85. procedure Play_Note(mynote: byte; volume: byte; length: cardinal);
  86. begin
  87.   try
  88.  
  89.     NoteOn(mynote, volume);
  90.  
  91.     Sleep(length);
  92.  
  93.     NoteOff(mynote);
  94.  
  95.   except
  96.     on E: Exception do
  97.       Showmessage('Error: ' + E.Message);
  98.   end;
  99.  
  100.  
  101. end;
  102.  
  103.  procedure NoteOn(mynote: byte; volume: byte);
  104. var
  105.   NoteOnMsg: TByteDynArray;
  106. begin
  107.   try
  108.     NoteOnMsg := [$90, mynote, volume];
  109.     Midi_Out_SendMessage(NoteOnMsg);
  110.  
  111.   except
  112.     on E: Exception do
  113.       Showmessage('Error: ' + E.Message);
  114.   end;
  115.  
  116. end;
  117. procedure NoteOff(mynote: byte);
  118. var
  119.   NoteOffMsg : TByteDynArray;
  120. begin
  121.   try
  122.      NoteOffMsg := [$90, mynote, 0];
  123.     Midi_Out_SendMessage(NoteOffMsg);
  124.  
  125.   except
  126.     on E: Exception do
  127.       Showmessage('Error: ' + E.Message);
  128.   end;
  129.  
  130.  
  131. end;
  132.  
  133. procedure Panic5;
  134. var
  135.   Channel, Note: Byte;
  136.   NoteOffMsg: TByteDynArray;
  137.   ResetControllerMsg: TByteDynArray;
  138. begin
  139.   for Channel := 0 to 15 do
  140.   begin
  141.     // "Reset All Controllers" (CC 121)for the channel
  142.     ResetControllerMsg := [$B0 or Channel, 121, 0];
  143.     Midi_Out_SendMessage(ResetControllerMsg);
  144.  
  145.     // Note Off, Velocity 0 for all the notes of the channel
  146.     for Note := 0 to 127 do
  147.     begin
  148.       NoteOffMsg := [$80 or Channel, Note, 0];
  149.       Midi_Out_SendMessage(NoteOffMsg);
  150.     end;
  151.   end;
  152.  
  153. end;
  154.  
  155.  
  156. function Midi_Out_Create(Api: RtMidiApi = RTMIDI_API_UNSPECIFIED; ClientName: string = 'RtMidi Input Client'): RtMidiPtr;
  157. begin
  158.   result := rtmidi_out_create(Api, PAnsiChar(ClientName));
  159. end;
  160.  
  161. procedure Midi_Out_Destroy(Device: RtMidiOutPtr);
  162. begin
  163.   rtmidi_out_free(Device);
  164. end;
  165.  
  166. function Midi_Out_GetDeviceNames(Device: RtMidiPtr = nil): TStringDynArray;
  167. var
  168.   i, nPorts: Integer;
  169.   AutoCreated: Boolean = False;
  170.   Portname: String;
  171.  
  172.   function getPortName(aPortNumber: SizeUInt): string;
  173.   var
  174.     len : SizeInt;
  175.   begin
  176.     if assigned(Device) then
  177.     begin
  178.       rtmidi_get_port_name(Device, aPortNumber, nil, @len);
  179.       setlength(result, len);
  180.       rtmidi_get_port_name(Device, aPortNumber, @Result[1], @len);
  181.     end;
  182.   end;
  183.  
  184. begin
  185.   Result := [];
  186.  
  187.   if Device = nil then
  188.   begin
  189.     AutoCreated := true;
  190.     Device := rtmidi_out_create_default();
  191.   end;
  192.  
  193.   if (Device = nil) or (not Device^.ok)
  194.     then Exit;
  195.  
  196.   nPorts := rtmidi_get_port_count(Device);
  197.  
  198.   for i := 0 to nPorts-1 do
  199.   begin
  200.     try
  201.       Portname := GetPortName(i);
  202.       if Portname.IsEmpty
  203.         then Continue;
  204.       Result := concat(Result, [Portname]);
  205.     except
  206.     end;
  207.   end;
  208.  
  209.   if AutoCreated
  210.     then rtmidi_out_free(Device)
  211. end;
  212.  
  213.  
  214. initialization
  215.  
  216. begin
  217.   MidiOut := Midi_Out_Create();
  218. end;
  219.  
  220.  
  221. finalization
  222.  
  223. begin
  224.   if assigned(MidiOut) then
  225.   begin
  226.     Midi_Out_Destroy(MidiOut);
  227.     MidiOut := nil;
  228.   end;
  229. end;
  230.  
  231. end.
  232.  

Thank you for the nice example finlazarus.
« Last Edit: January 04, 2025, 03:28:27 am by TRon »
I do not have to remember anything anymore thanks to total-recall.

 

TinyPortal © 2005-2018