{

  ---TZMidi---

  -wandelt eine Zahlen-Reihe in Midi-Events
  -Parameter (Properties) ermöglichen die Einflußnahme auf das Ergebnis


}


unit Value2MidiEvent;

interface

uses
  classes, dialogs, SysUtils, AllgLib, Math;

type
  TZMidi = class(TComponent)

  private
    HKopf     : string;
    DKopf     : string;
    DKopf21   : string;
    DKopf22   : string;
    extra     : integer;
    Schluss   : string;
    CopyRight1: string;
    CopyRight2: string;

    TrackNameLaenge : integer;
    TrackLaenge     : integer;
    TrackNameIntern : string;
    EventDelta      : integer;{EventZeit relativ zum VorgängerEvent}

    Anschlag   : string;
    Hoehe      : string;
    Param      : string;
    Controller : string;
    tab4       : string;
    tab2       : string;

    SaveDialog1: TSaveDialog;
    anzahl,fak:integer;

    {--- Property-Variablen ---}

    {Midi-File Name}
    TrackNameStr   : String;
    TrackNameHex   : string;
    FMidiCh        : integer;
    FEventZeit     : integer;
    FCtrlNr        : string;
    FCtrlChange,
    FNote          : boolean;
    FMidiBereich   : integer;
    Fpause,
    Ffill          : boolean;
    FHighPassEvent : integer;
    FLowPassEvent  : integer;

    FmaxMidi : integer;
    FminMidi : integer;

    FInMidiValues : TStringList;{beliebige Reihe    {InputListe}

    {--- *** ---}

    NoteOFF: string;
    { 80 81 82 83 84 85 86 87 88 89 8A 8B 8C 8D 8E 8F}
    { 1  2  3  4  5  6  7  8  9  10 11 12 13 14 15 16}
    NoteON: string;
    { 90 91 92 93 94 95 96 97 98 99 9A 9B 9C 9D 9E 9F}
    { 1  2  3  4  5  6  7  8  9  10 11 12 13 14 15 16}
    MaxValue: double;//maxFrequenz (Grenze des Werte-Bereichs)
    ControlChange: string;
    {Kanal: B0 B1 B2 B3 B4 B5 B6 B7 B8 B9 BA BB BC BD BE BF}
    {       1  2  3  4  5  6  7  8  9  10 11 12 13 14 15 16}


    {--- Methoden für Konvertierungs-Klasse ---}

    procedure SetDefaultsEvents;
    function CalcDeltaTime(qword: Longint): string;
    function word_format(word: string): string;

    function GetInMidiValues: TStringList;
    procedure SetInMidiValues(PValues:TStringList);
    function GetMidiBereich:integer;
    procedure SetMidiBereich(PBereich:integer);
    function GetCtrlNr:string;
    procedure SetCtrlNr(PNr:string);
    function GetEventZeit:integer;
    procedure SetEventZeit(PEventZeit:integer);
    function GetMidiCh:integer;
    procedure SetMidiCh(PMidiCh:integer);

    function GetCtrlChange:boolean;
    procedure SetCtrlChange(PCtrlChange:boolean);
    function GetNote:boolean;
    procedure SetNote(PNote:boolean);
    function GetmaxMidi:integer;
    procedure SetmaxMidi(PMaxMidi:integer);
    function GetminMidi:integer;
    procedure SetminMidi(PMinMidi:integer);
    function GetLowPassEvent:integer;
    procedure SetLowPassEvent(PLowPEvent:integer);
    function GetHighPassEvent:integer;
    procedure SetHighPassEvent(PHighPEvent:integer);
    function GetFill:boolean;
    procedure SetFill(PFill:boolean);
    function GetPause:boolean;
    procedure SetPause(PPause:boolean);

    function GetTrackName:string;
    procedure SetTrackName(PTrackName:string);
  public

(* ************************************************************************** *)
(* ***************************  Nutzer-Interface **************************** *)
(* ************************************************************************** *)

    {OutputListe}
    OutMidiEvents: TStringList;{kontextbez. Inhalt}

  published

    {InputListe}
    property InMidiValues:TStringList read GetInMidiValues write SetInMidiValues;    {enthält alle EingabeWerte in Form einer Stringliste}

    property MidiCh:integer read GetMidiCh write SetMidiCh default 1;                {MidiKanal}
    property CtrlNr:string read GetCtrlNr write SetCtrlNr;                           {CtrlNr: 01 Modulation}

    {NoteOn/NoteOff;Controller}
    property CtrlChange:boolean read GetCtrlChange write SetCtrlChange default false;{true=das erzeugte Script beeinflußt ausschließlich Controller-Daten}
    property Note:boolean read GetNote write SetNote default true;                   {true=das erzeugte Script beeinflußt ausschließlich NoteOn/NoteOff-Daten}

    {beeinflußt den Wertebereich der MidiEvents}
    property MidiBereich:integer read GetMidiBereich write SetMidiBereich;           {genutzter Midi-Event-Bereich}
    property maxMidi:integer read GetmaxMidi write SetmaxMidi default 127;           {genutzter Midi-Event-Bereich: von(minMidi) -> bis(maxMidi) }
    property minMidi:integer read GetminMidi write SetminMidi default 0;             { }

    {beeinflußt den Rhythmus}
    property EventZeit:integer read GetEventZeit write SetEventZeit default 48;      {1/32=48;1/4=384}
    property LowPassEvent:integer read GetLowPassEvent write SetLowPassEvent;        {Schwellwert für MidiLowPass-Filter}
    property HighPassEvent:integer read GetHighPassEvent write SetHighPassEvent;     {Schwellwert für MidiHighPass-Filter}
    property fill:boolean read GetFill write SetFill;                                {true=entstehende Pausen werdend NICHT genutzt (z.B. durch entspr. FilterEinstellungen)}
    property pause:boolean read GetPause write SetPause;                             {true=entstehende Pausen werdend genutzt}

    {allgemein}
    property TrackName:string read GetTrackName write SetTrackName;                  {Name des Midi-Tracks innerhalb des StandardMidi-Files}

    function CreateMidiEvents: TStringList;                                          {erzeugt MidiEvents und liefert das Ergebnis in einer StringListe}
    function CreateMidiDatei: TStringList;                                           {erzeugt MidiEventDatei und liefert das Ergebnis in einer StringListe}
    function SaveMidiFile: boolean;                                                  {speichert eine StandarMidiDatei(*.mid) inkl. einer ParameterDatei(*.par)}

    constructor Create(Sender: TObject);
  end;

implementation


(* ******************* Property-Methoden für UserInterface ****************** *)


function TZMidi.GetInMidiValues: TStringList;
begin
  if FInMidiValues <> nil then
    result := FInMidiValues;
end;

procedure TZMidi.SetInMidiValues(PValues:TStringList);
begin
  if FInMidiValues = nil then
    FInMidiValues:=TStringList.Create;
  FInMidiValues.AddStrings(PValues);
end;

function TZMidi.GetMidiBereich:integer;
begin
  result:=FMidiBereich;
end;

procedure TZMidi.SetMidiBereich(PBereich:integer);
begin
  FMidiBereich:=PBereich;
end;

function TZMidi.GetCtrlNr:string;
begin
  result:=FCtrlNr;
end;

procedure TZMidi.SetCtrlNr(PNr:string);
begin
  FCtrlNr:=PNr;
end;

function TZMidi.GetEventZeit:integer;
begin
  result:=FEventZeit;
end;

procedure TZMidi.SetEventZeit(PEventZeit:integer);
begin
  FEventZeit:=PEventZeit;
end;

function TZMidi.GetMidiCh:integer;
begin
  result:=FMidiCh;
end;

procedure TZMidi.SetMidiCh(PMidiCh:integer);
begin
  {für NoteEvent}
  NoteON := IntToHex(144 + PMidiCh, 2);
  NoteOFF := IntToHex(128 + PMidiCh, 2);
  {für ControlEvent}
  ControlChange := IntToHex(176 + PMidiCh, 2);
end;


function TZMidi.GetTrackName:string;
begin
  result:=TrackNameStr;
end;

procedure TZMidi.SetTrackName(PTrackName:string);
begin
  TrackNameStr    := PTrackName+'.mid';
  TrackNameLaenge := length(PTrackName);
  TrackNameHex    := StrToHex(PTrackName,' ',1);
end;

function TZMidi.GetCtrlChange:boolean;
begin
  result:=FCtrlChange;
end;

procedure TZMidi.SetCtrlChange(PCtrlChange:boolean);
begin
  FCtrlChange:=PCtrlChange;
end;

function TZMidi.GetNote:boolean;
begin
  result:=FNote;
end;

procedure TZMidi.SetNote(PNote:boolean);
begin
  FNote:=PNote;
end;

function TZMidi.GetmaxMidi:integer;
begin
  result:=FMaxMidi;
end;

procedure TZMidi.SetmaxMidi(PMaxMidi:integer);
begin
  FMaxMidi:=PMaxMidi;
end;

function TZMidi.GetminMidi:integer;
begin
  result:=FMinMidi;
end;

procedure TZMidi.SetminMidi(PMinMidi:integer);
begin
  FMinMidi:=PMinMidi;
end;

function TZMidi.GetLowPassEvent:integer;
begin
  result:=FLowPassEvent;
end;

procedure TZMidi.SetLowPassEvent(PLowPEvent:integer);
begin
  FLowPassEvent:=PLowPEvent;
end;

function TZMidi.GetHighPassEvent:integer;
begin
  result:=FHighPassEvent;
end;

procedure TZMidi.SetHighPassEvent(PHighPEvent:integer);
begin
  FHighPassEvent:=PHighPEvent;
end;

function TZMidi.GetFill:boolean;
begin
  result:=FFill;
end;

procedure TZMidi.SetFill(PFill:boolean);
begin
  FFill:=PFill;
end;

function TZMidi.GetPause:boolean;
begin
  result:=FPause;
end;

procedure TZMidi.SetPause(PPause:boolean);
begin
  FPause:=PPause;
end;


(* ***************************  TZMidi allgemein **************************** *)


constructor TZMidi.Create(Sender: TObject);
begin
  InMidiValues := TStringList.Create;
  SetDefaultsEvents;
end;

procedure TZMidi.SetDefaultsEvents;
begin

  {defaults für MidiEvents}
  EventDelta    := 0;    //EventZeit relativ zum VorgängerEvent
  Anschlag      := '00';
  Hoehe         := '00';
  CtrlNr        := '01'; //1->Modulation

  {DateiOverhead}
  tab4       := '      ';
  tab2       := '  ';
  CopyRight1 := '00  FF  02  10'; //optional
  CopyRight2 := 'A9  20  62  79  20  61  71  75  61  70  6C  61  6E  69  6E  67';
  HKopf      := '4D  54  68  64  00  00  00  06  00  00  00  01  01  80';
  DKopf      := '4D  54  72  6B';
  DKopf21    := '00  FF  03';//+TrackName
  DKopf22    := '00  FF  58  04  04  02  18  08  00  FF  51  03  07  A1  20';
  Schluss    := 'FF  2F  00';
end;

(**)

{erzeugt anhand eingestellter Parameter eine Midi-Event-Liste}
//neu aufzunehmende Parameter:
//       WerteListe
function TZMidi.CreateMidiEvents: TStringList;
var
  i: integer;
  dummy: double;
  bOk: boolean;
  noteMidi: integer;
  DeltaTime, Befehl, MidiBefehl: string;
  {anzahl, fak: integer;  }
  Takt: integer;

begin

  {Init}
  extra       := 0;
  Takt        := 0;
  MidiBefehl  := '';
  anzahl      := 0;
  bOk         := true;
  MaxValue    := GetMaxValFromStrList(InMidiValues);{Bestimmt Maximum der Liste}

  {MidiKanal}
  {}
  {Liste zur Aufnahem der erzeugten MidiEvents}
  if OutMidiEvents = nil then
    OutMidiEvents := TStringList.Create;
  OutMidiEvents.Clear;

  //-----------------------------EventsErzeugen-----------------------------//

  {alles}
  for i := 0 to InMidiValues.Count-1 do
  begin

    //Daten aus dem generierten Array holen
    dummy := StrToFloat(InMidiValues.Strings[i]);

    //EditEingabenAuswerten------------------------------------>

    //umwandeln der berechneten Frequenz in eine MidiNoteWert des gewählten Bereichs(0-127)
    { Berechnung erfolgt relativ zum Maximum in InMidiValues }
    noteMidi := round( ((dummy * MidiBereich) / MaxValue) + minMidi);

    //LowPassEventFilter
    if (noteMidi > LowPassEvent) then
    begin
     bOk := false;
     //Pause
     if pause then
       EventDelta := EventDelta + EventZeit;
    end;

    //HighPassEventFilter
    if (noteMidi < HighPassEvent) then
    begin
     bOk := false;
     //Pause
     if pause then
       EventDelta := EventDelta + EventZeit;
    end;


    //<-------------------------------------------------------

    if bOk then
    begin

      //NotenErzeugen
      if Note then
      begin
        fak := 2;
        //für TrackLaengenBerechnung
        anzahl := anzahl + 1;
        //für TaktLänge
        Takt := Takt + (EventZeit + EventDelta);
        //NoteON
        {deltaTime}
        if fill then
          DeltaTime := CalcDeltaTime(EventZeit)
        else
          DeltaTime := CalcDeltaTime(EventDelta);
        {Befehl}
        Befehl := NoteON;
        {Parameter}
        Hoehe:= IntToHex(noteMidi, 2);
        Anschlag:= '7F';
        {MidiBefehl zusammenbauen}
        MidiBefehl := DeltaTime + '  ' + Befehl + '  ' + Hoehe + '  ' + Anschlag;
        {in temporäre Liste kopieren}
        OutMidiEvents.Add(MidiBefehl);
        //NoteOFF
        {deltaTime}
        if fill then
          DeltaTime := CalcDeltaTime(EventDelta)
        else
          DeltaTime := CalcDeltaTime(EventZeit);
        {Befehl}
        Befehl := NoteOFF;
        {Parameter}
        Hoehe:= IntToHex(noteMidi, 2);
        Anschlag:= '40';
        {MidiBefehl zusammenbauen}
        MidiBefehl := DeltaTime + '  ' + Befehl + '  ' + Hoehe + '  ' + Anschlag;
        {in temporäre Liste kopieren}
        OutMidiEvents.Add(MidiBefehl);
        {zum Rücksetzen der DeltaTime}
        EventDelta := 0;
      end;//NotenErzeugen

      //ControlChangeErzeugen
      if CtrlChange then
      begin
        fak := 1;
        //für TrackLaengenBerechnung
        anzahl := anzahl + 1;
        //für TaktLänge
        Takt := Takt + (EventZeit + EventDelta);
        //CtrlChange
        {deltaTime}
        DeltaTime := CalcDeltaTime(EventDelta);
        {Befehl}
        Befehl := ControlChange;
        {Parameter}
        Controller := CtrlNr;
        Param := IntToHex(noteMidi, 2);
        {MidiBefehl zusammenbauen}
        MidiBefehl := DeltaTime + '  ' + Befehl + '  ' + CtrlNr + '  ' + Param;
        {in temporäre Liste kopieren}
        OutMidiEvents.Add(MidiBefehl);
      end;//ControlChangeErzeugen
    end;//if bOk
    bOk := true;
  end;//forAnzahl
  result := OutMidiEvents;
end;


(* ************************  Spez. Hilfs-Methoden *************************** *)


{berechnet den entsprechenden DeltaTimeWert aus einem Integer}
function TZMidi.CalcDeltaTime(qword: Longint): string;
var
  bit1_4, bit1_3, bit1_2: Int64;
  byteKap1, byteKap2, byteKap3, byteKap4: Longint;
  byteAnz, bitstart, i, j: integer;
  Basis, Dummy: integer;
  stellen, zahl, tmp1: Longint;
  byte1, byte2, byte3, byte4: Longint;
begin

  {Init}
  Basis := 2;
  zahl  := 0;
  byte1 := 0;
  byte2 := 0;
  byte3 := 0;
  byte4 := 0;
  //Werte der möglichen FlagBits
  bit1_4 := 2147483648;
  bit1_3 := 8388608;
  bit1_2 := 32768;
  //DarstellungsKapazitäten der einzelnen Bytes
  byteKap4 := 266338304;
  byteKap3 := 2080768;
  byteKap2 := 16256;
  byteKap1 := 127;
  byteAnz  := 1;//immer nötig
  bitstart := 6;

  if qword > 127 then
  begin
    Inc(byteAnz);
    bitstart := 13;
  end;
  if qword > 16256 then
  begin
    Inc(byteAnz);
    bitstart := 20;
  end;
  if qword > 2080768 then
  begin
    Inc(byteAnz);
    bitstart := 27;
  end;

  extra := extra + (byteAnz - 1);

  {ausrechnen der einzelnen DezimalWerte pro Byte}

  //abgehen der einzelnen Bytes (von High nach Low)
  for i := byteAnz downto 1 do
  begin
    tmp1 := bitstart - 6;
    //setzen des FlagBits
    case i of
    2: byte2 := byte2 + bit1_2;
    3: begin
         byte3 := byte4 + bit1_3;
         byte2 := byte2 + bit1_2;
       end;
    4: begin
         byte4 := byte4 + bit1_4;
         byte3 := byte4 + bit1_3;
         byte2 := byte2 + bit1_2;
       end;
    end;

    for j := bitstart downto tmp1 do
    begin
      Dummy := trunc(Power(2, j));
      //ist der errechnete Wert(bit) kleiner des Gesamtwertes
      if Dummy <= qword then
      begin
        //qword wird um den Wert(bit) verringert
        qword := qword mod Dummy;
        //zu welchem Byte gehört das Bit
        if (i = 1) then
          byte1 := byte1 + Dummy
        else if (i = 2) then
          byte2 := byte2 + (Dummy shl 1)
        else if (i = 3) then
           byte3 := byte3 + (Dummy shl 1)
        else if (i = 4) then
           byte4 := byte4 + (Dummy shl 1);
      end;//ifDummy
    end;//BitSchleife
    bitstart :=  bitstart - 7;
  end;//ByteSchleife
  stellen := byteAnz*2;
  result := word_format(IntToHex(byte1+byte2+byte3+byte4, stellen));
end;

//für formatiert DoubleWordDarstellung (00000000 -> 00 00 00 00)
function TZMidi.word_format(word: string): string;
var
  count, i, bis: integer;
  erg_str, tab, tmp_word: string;
begin

  {Init}
  count    := 1;
  erg_str  := '';
  tmp_word := word;
  tab      := '  ';
  bis      := length(tmp_word);

  for i := 1 to bis do
  begin
    if ( ((i = 3) or (i = 5) or (i = 7)) and (i <> length(tmp_word)) ) then
      erg_str := erg_str + tab;
    erg_str := erg_str + tmp_word[i];
  end;
  result := erg_str;
end;

function TZMidi.CreateMidiDatei: TStringList;
var
  hex: string;
  i: integer;
  TmpStrList: TStringList;
begin

  {Init}
  TmpStrList := TStringList.Create;
  TmpStrList.Clear;

  //----------------      Script bauen      ---------------//

  //Länge berechnen
  {Länge = ((Kopf+CopyR)+TrackNameLänge + (( Events * 4 mind.Bytes)*faktor für spez. Event + extra(wegen DeltaTime) + Schluss)}

  {CopyRight+HKopf+DKopf = 38}
  TrackLaenge := (38 + TrackNameLaenge + 1 + ((anzahl * 4) * fak) + extra + 4);


  hex := word_format(IntToHex(TrackLaenge, 8));
  //Länge dranmachen
  DKopf := DKopf + '  ' + hex;

{
  1. HKopf

  2. DKopf
     -Gesamt-Länge ab dieser Position (für den ganzen Rest)

  3. DKopf21
     -TrackNameBefehl + Länge d. TrackName + TrackName

  4. DKopf22

  5. CopyRight1
  6. CopyRight2

}

  {Kopf}
  TmpStrList.Add(HKopf);
  TmpStrList.Add(DKopf);
  TmpStrList.Add(DKopf21+tab2+IntTohex(TrackNameLaenge,2)+tab2+TrackNameHex);
  TmpStrList.Add(DKopf22);
  TmpStrList.Add(CopyRight1);
  TmpStrList.Add(CopyRight2);

  {MidiEvents}
  for i := 0 to OutMidiEvents.Count - 1 do
  begin
    TmpStrList.Add(OutMidiEvents.strings[i]);
  end;

  {Schluß}
  Schluss := IntToHex(0, 2) + '  ' + Schluss;
  TmpStrList.Add(Schluss);

  OutMidiEvents.Clear;
  OutMidiEvents.AddStrings(TmpStrList);

  result := OutMidiEvents;

end;

function TZMidi.SaveMidiFile: boolean;
var
  SaveDataFile: TFileStream;
  ok: boolean;
  i, j, pos, zeilen, fehler: integer;
  Char_buffer: Longint;
  string_buffer, zeile, tmp_str: string;
  TmpStrList:TStringList;
  NameParamFile:string;
begin

  {Init}
  zeilen               := OutMidiEvents.Count;
  zeile                := '';
  pos                  := 0;
  ok                   := true;
  SaveDialog1          := TSaveDialog.Create(self);
  SaveDialog1.FileName := TrackNameStr;
  TmpStrList           := TStringList.Create;

  {Parameter-File erzeugen}
  {speichter alle Property-Einstellungen}
  TmpStrList.Add('*****************************');
  TmpStrList.Add('* Parameter-File '+ DateTimeToStr(Date)+ ' *');
  TmpStrList.Add('*****************************');
  TmpStrList.Add('');
  TmpStrList.Add('MidiBereich: '+IntToStr(MidiBereich));
  TmpStrList.Add('');
  TmpStrList.Add('CtrlNr: '+CtrlNr);
  TmpStrList.Add('');
  TmpStrList.Add('EventZeit: '+IntToStr(EventZeit));
  TmpStrList.Add('');
  TmpStrList.Add('MidiCh: '+IntToStr(MidiCh));
  TmpStrList.Add('');
  if CtrlChange then
    TmpStrList.Add('CtrlChange: True')
  else
    TmpStrList.Add('CtrlChange: False');
  TmpStrList.Add('');
  if Note then
    TmpStrList.Add('Note: True')
  else
    TmpStrList.Add('Note: False');
  TmpStrList.Add('');
  TmpStrList.Add('maxMidi: '+IntToStr(maxMidi));
  TmpStrList.Add('');
  TmpStrList.Add('minMidi: '+IntToStr(minMidi));
  TmpStrList.Add('');
  TmpStrList.Add('LowPassEvent: '+IntToStr(LowPassEvent));
  TmpStrList.Add('');
  TmpStrList.Add('HighPassEvent: '+IntToStr(HighPassEvent));
  TmpStrList.Add('');
  if fill then
    TmpStrList.Add('fill: True')
  else
    TmpStrList.Add('fill: False');
  TmpStrList.Add('');
  if pause then
    TmpStrList.Add('pause: True')
  else
    TmpStrList.Add('pause: False');
  TmpStrList.Add('');
  TmpStrList.Add('TrackName: '+TrackNameStr);
  TmpStrList.Add('');
  TmpStrList.Add('InMidiValues:');
  TmpStrList.AddStrings(InMidiValues);
  if SaveDialog1.Execute then
  begin
    try
      SaveDataFile := TFileStream.Create(SaveDialog1.FileName, fmCreate);
      NameParamFile:=StringReplace(SaveDialog1.FileName,'.','_',[rfReplaceAll, rfIgnoreCase]);
      TmpStrList.SaveToFile(NameParamFile+'.par');
     except
      ok := false;
//      Error(2);
    end;

    if ok then
    begin
      SaveDataFile.Position := pos;
      //SpeicherSchleife
      for i:=0 to zeilen-1 do
      begin
        zeile := OutMidiEvents.Strings[i];
        for j := 1 to Length(zeile) do
        begin
          //LeerZeichen zählen
          if (Length(string_Buffer) < 2) then
          begin
            tmp_str := zeile[j];
            if (tmp_str <> ' ') then
              string_Buffer := string_Buffer + tmp_str;
          end;
          //schreiben
          if (Length(string_Buffer) = 2) then
          begin
            val('$' + string_Buffer, Char_Buffer, fehler);
            SaveDataFile.Write(Char_buffer, 1);
            Inc(pos);
            string_Buffer := '';
            tmp_str := '';
            SaveDataFile.Position := pos;
          end;
        end;//forSchleife(j)
      end;//forSchleife(i)
      if (SaveDataFile <> nil) then
      begin
        SaveDataFile.Destroy;
        SaveDataFile := nil;
        SaveDataFile.Free;
      end;
    end;//ifOk
  end;//SaveDialog
end;

end.