jclmidi.pas

East make Tray Icon in delphi

    destructor Destroy; override;
    // Channel Voice Messages
    procedure SendNoteOff(Channel: TMIDIChannel; Key: TMIDINote; Velocity: TMIDIDataByte = $40);
    procedure SendNoteOn(Channel: TMIDIChannel; Key: TMIDINote; Velocity: TMIDIDataByte);
    procedure SendPolyphonicKeyPressure(Channel: TMIDIChannel; Key: TMIDINote; Value: TMIDIDataByte);
    procedure SendControlChange(Channel: TMIDIChannel; ControllerNum, Value: TMIDIDataByte);
    procedure SendControlChangeHR(Channel: TMIDIChannel; ControllerNum: TMIDIDataByte; Value: TMIDIDataWord);
    procedure SendSwitchChange(Channel: TMIDIChannel; ControllerNum: TMIDIDataByte; Value: Boolean);
    procedure SendProgramChange(Channel: TMIDIChannel; ProgramNum: TMIDIDataByte);
    procedure SendChannelPressure(Channel: TMIDIChannel; Value: TMIDIDataByte);
    procedure SendPitchWheelChange(Channel: TMIDIChannel; Value: TMIDIDataWord);
    procedure SendPitchWheelPos(Channel: TMIDIChannel; Value: Single);
    // Control Change Messages
    procedure SelectProgram(Channel: TMIDIChannel; BankNum: TMIDIDataWord; ProgramNum: TMIDIDataByte);
    procedure SendModulationWheelChange(Channel: TMIDIChannel; Value: TMidiDataByte);
    procedure SendBreathControlChange(Channel: TMIDIChannel; Value: TMidiDataByte);
    procedure SendFootControllerChange(Channel: TMIDIChannel; Value: TMidiDataByte);
    procedure SendPortamentoTimeChange(Channel: TMIDIChannel; Value: TMidiDataByte);
    procedure SendDataEntry(Channel: TMIDIChannel; Value: TMidiDataByte);
    procedure SendChannelVolumeChange(Channel: TMIDIChannel; Value: TMidiDataByte);
    procedure SendBalanceChange(Channel: TMIDIChannel; Value: TMidiDataByte);
    procedure SendPanChange(Channel: TMIDIChannel; Value: TMidiDataByte);
    procedure SendExpressionChange(Channel: TMIDIChannel; Value: TMidiDataByte);
    // ...high Resolution
    procedure SendModulationWheelChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord);
    procedure SendBreathControlChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord);
    procedure SendFootControllerChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord);
    procedure SendPortamentoTimeChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord);
    procedure SendDataEntryHR(Channel: TMIDIChannel; Value: TMidiDataWord);
    procedure SendChannelVolumeChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord);
    procedure SendBalanceChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord);
    procedure SendPanChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord);
    procedure SendExpressionChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord);
    // Control Change Messages: Switches
    procedure SwitchSustain(Channel: TMIDIChannel; Value: Boolean);
    procedure SwitchPortamento(Channel: TMIDIChannel; Value: Boolean);
    procedure SwitchSostenuto(Channel: TMIDIChannel; Value: Boolean);
    procedure SwitchSoftPedal(Channel: TMIDIChannel; Value: Boolean);
    procedure SwitchLegato(Channel: TMIDIChannel; Value: Boolean);
    procedure SwitchHold2(Channel: TMIDIChannel; Value: Boolean);
    // Channel Mode Messages
    procedure SwitchAllSoundOff(Channel: TMIDIChannel);
    procedure ResetAllControllers(Channel: TMIDIChannel);
    procedure SwitchLocalControl(Channel: TMIDIChannel; Value: Boolean);
    procedure SwitchAllNotesOff(Channel: TMIDIChannel);
    procedure SwitchOmniModeOff(Channel: TMIDIChannel);
    procedure SwitchOmniModeOn(Channel: TMIDIChannel);
    procedure SwitchMonoModeOn(Channel: TMIDIChannel; ChannelCount: Integer);
    procedure SwitchPolyModeOn(Channel: TMIDIChannel);
    //
    procedure SendSingleNoteTuningChange(const TargetDeviceID, TuningProgramNum: TMidiDataByte;
      const TuningData: array of TSingleNoteTuningData);
    function NoteIsOn(Channel: TMIDIChannel; Key: TMIDINote): Boolean;
    procedure SwitchActiveNotesOff(Channel: TMIDIChannel); overload;
    procedure SwitchActiveNotesOff; overload;
    property ActiveNotes[Channel: TMIDIChannel]: TMIDINotes read GetActiveNotes;
    property Name: string read GetName;
    property RunningStatusEnabled: Boolean read GetRunningStatusEnabled write SetRunningStatusEnabled;
  end;

function MIDIOut(DeviceID: Cardinal = 0): IJclMIDIOut;
procedure GetMidiOutputs(const List: TStrings);
function MIDISingleNoteTuningData(Key: TMIDINote; Frequency: Single): TSingleNoteTuningData;
function MIDINoteToStr(Note: TMIDINote): string;

implementation

uses
  SysUtils,
  {$IFDEF MSWINDOWS}
  JclWinMIDI,
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  //JclUnixMIDI,
  {$ENDIF UNIX}
  JclResources;

{$IFDEF UNIX}
procedure ErrorNotImplemented;
begin
  raise EJclInternalError.CreateRes(@RsMidiNotImplemented);
end;
  {$ENDIF UNIX}

function MIDIOut(DeviceID: Cardinal = 0): IJclMIDIOut;
begin
  Result := nil;
  {$IFDEF MSWINDOWS}
  Result := JclWinMIDI.MIDIOut(DeviceID);
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  { TODO -oRobert Rossmair : Unix MIDI Out }
  //Result := JclUnixMIDI.MidiOut(DeviceID);
  ErrorNotImplemented;
  {$ENDIF UNIX}
end;

procedure GetMidiOutputs(const List: TStrings);
begin
  {$IFDEF MSWINDOWS}
  JclWinMIDI.GetMidiOutputs(List);
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  { TODO -oRobert Rossmair : Unix GetMIDIOutputs }
  //JclUnixMIDI.GetMidiOutputs(List);
  ErrorNotImplemented;
  {$ENDIF UNIX}
end;

function MIDISingleNoteTuningData(Key: TMIDINote; Frequency: Single): TSingleNoteTuningData;
var
  F: Cardinal;
begin
  Result.Key := Key;
  F := Trunc(Frequency * (1 shl BitsPerMIDIDataWord));
  Result.Frequency[0] := (F shr BitsPerMIDIDataWord) and MIDIDataMask;
  Result.Frequency[1] := (F shr BitsPerMIDIDataByte) and MIDIDataMask;
  Result.Frequency[2] := F and MIDIDataMask;
end;

procedure CheckMIDIChannelNum(Channel: TMIDIChannel);
begin
  if (Channel < Low(TMIDIChannel)) or (Channel > High(TMIDIChannel)) then
    raise EJclMIDIError.CreateResFmt(@RsMidiInvalidChannelNum, [Channel]);
end;

function MIDINoteToStr(Note: TMIDINote): string;
const
  HalftonesPerOctave = 12;
begin
  case Note mod HalftonesPerOctave of
     0:
       Result := RsOctaveC;
     1:
       Result := RsOctaveCSharp;
     2:
       Result := RsOctaveD;
     3:
       Result := RsOctaveDSharp;
     4:
       Result := RsOctaveE;
     5:
       Result := RsOctaveF;
     6:
       Result := RsOctaveFSharp;
     7:
       Result := RsOctaveG;
     8:
       Result := RsOctaveGSharp;
     9:
       Result := RsOctaveA;
    10:
      Result := RsOctaveASharp;
    11:
      Result := RsOctaveB;
  end;
  Result := Format('%s%d', [Result, Note div HalftonesPerOctave - 2]);
end;

// TJclMIDIOut
destructor TJclMIDIOut.Destroy;
begin
  SwitchActiveNotesOff;
  inherited Destroy;
end;

function TJclMIDIOut.GetActiveNotes(Channel: TMIDIChannel): TMIDINotes;
begin
  CheckMIDIChannelNum(Channel);
  Result := FActiveNotes[Channel];
end;

procedure TJclMIDIOut.SendChannelMessage(Msg: TMIDIStatusByte;
  Channel: TMIDIChannel; Data1, Data2: TMIDIDataByte);
begin
  SendMessage([Msg or (Channel - Low(Channel)), Data1, Data2]);
end;

function TJclMIDIOut.GetRunningStatusEnabled: Boolean;
begin
  Result := FRunningStatusEnabled;
end;

function TJclMIDIOut.NoteIsOn(Channel: TMIDIChannel; Key: TMIDINote): Boolean;
begin
  Result := Key in FActiveNotes[Channel];
end;

procedure TJclMIDIOut.SendNoteOff(Channel: TMIDIChannel; Key: TMIDINote; Velocity: TMIDIDataByte);
begin
  SendChannelMessage(MIDIMsgNoteOff, Channel, Key, Velocity);
  Exclude(FActiveNotes[Channel], Key);
end;

procedure TJclMIDIOut.SendNoteOn(Channel: TMIDIChannel; Key: TMIDINote; Velocity: TMIDIDataByte);
begin
  SendChannelMessage(MIDIMsgNoteOn, Channel, Key, Velocity);
  Include(FActiveNotes[Channel], Key);
end;

procedure TJclMIDIOut.SendPolyphonicKeyPressure(Channel: TMIDIChannel;
  Key: TMIDINote; Value: TMIDIDataByte);
begin
  SendChannelMessage(MIDIMsgPolyKeyPressure, Channel, Key, Value);
end;

procedure TJclMIDIOut.SendControlChange(Channel: TMIDIChannel; ControllerNum, Value: TMIDIDataByte);
begin
  SendChannelMessage(MIDIMsgControlChange, Channel, ControllerNum, Value);
end;

procedure TJclMIDIOut.SendControlChangeHR(Channel: TMIDIChannel; ControllerNum: TMIDIDataByte;
  Value: TMIDIDataWord);
begin
  SendControlChange(Channel, ControllerNum, Value shr BitsPerMIDIDataByte and MIDIDataMask);
  if ControllerNum <= $13 then
    SendControlChange(Channel, ControllerNum or $20, Value and MIDIDataMask);
end;

procedure TJclMIDIOut.SendSwitchChange(Channel: TMIDIChannel; ControllerNum: TMIDIDataByte; Value: Boolean);
const
  DataByte: array [Boolean] of Byte = ($00, $7F);
begin
  SendChannelMessage(MIDIMsgControlChange, Channel, ControllerNum, DataByte[Value]);
end;

procedure TJclMIDIOut.SendProgramChange(Channel: TMIDIChannel; ProgramNum: TMIDIDataByte);
begin
  SendChannelMessage(MIDIMsgProgramChange, Channel, ProgramNum, 0);
end;

procedure TJclMIDIOut.SendChannelPressure(Channel: TMIDIChannel; Value: TMIDIDataByte);
begin
  SendChannelMessage(MIDIMsgChannelKeyPressure, Channel, Value, 0);
end;

procedure TJclMIDIOut.SendPitchWheelChange(Channel: TMIDIChannel; Value: TMIDIDataWord);
begin
  SendChannelMessage(MIDIMsgPitchWheelChange, Channel, Value and MidiDataMask, Value shr BitsPerMIDIDataByte);
end;

procedure TJclMIDIOut.SendPitchWheelPos(Channel: TMIDIChannel; Value: Single);
var
  Temp: TMIDIDataWord;
begin
  if Value < 0 then
    Temp := Round(Value * (1 shl 13))
  else
    Temp := Round(Value * (1 shl 13 - 1));
  SendPitchWheelChange(Channel, Temp);
end;

procedure TJclMIDIOut.SwitchAllSoundOff(Channel: TMIDIChannel);
begin
  SendControlChange(Channel, MIDICCAllSoundOff, 0);
end;

procedure TJclMIDIOut.SwitchLocalControl(Channel: TMIDIChannel; Value: Boolean);
begin
  SendSwitchChange(Channel, MIDICCLocalControl, Value);
end;

procedure TJclMIDIOut.ResetAllControllers(Channel: TMIDIChannel);
begin
  SendControlChange(Channel, MIDICCResetAllControllers, 0);
end;

procedure TJclMIDIOut.SwitchAllNotesOff(Channel: TMIDIChannel);
begin
  CheckMIDIChannelNum(Channel);
  SendControlChange(Channel, MIDICCAllNotesOff, 0);
  FActiveNotes[Channel] := [];
end;

procedure TJclMIDIOut.SetRunningStatusEnabled(const Value: Boolean);
begin
  FMIDIStatus := MIDIInvalidStatus;
  FRunningStatusEnabled := Value;
end;

procedure TJclMIDIOut.SendSingleNoteTuningChange(const TargetDeviceID, TuningProgramNum: TMidiDataByte;
  const TuningData: array of TSingleNoteTuningData);
var
  BufSize, Count: Integer;
  Buf: array of Byte;
begin
  Count := High(TuningData) - Low(TuningData) + 1;
  BufSize := 8 + Count * SizeOf(TSingleNoteTuningData);
  SetLength(Buf, BufSize);
  Buf[0] := MIDIMsgSysEx;      // Universal Real Time SysEx header, first byte
  Buf[1] := $7F;               // second byte
  Buf[2] := TargetDeviceID;    // ID of target device (?)
  Buf[3] := 8;                 // sub-ID#1 (MIDI Tuning)
  Buf[4] := 2;                 // sub-ID#2 (note change)
  Buf[5] := TuningProgramNum;  // tuning program number (0