Merge branch 'develop'

.gitignore

@@ -30,3 +30,5 @@ lib/
 *.app/
 
 SPS_Emu\.zip
+
+SPS_Emu\.xml

Beispiele/SimpleServo.tps

@@ -1,12 +1,9 @@
 #TPS:Willies SPS Arduino
-0x00,4,4,""
-0x01,5,2,""
-0x02,4,F,""
-0x03,7,C,""
-0x04,F,8,""
-0x05,4,0,""
-0x06,F,8,""
-0x07,2,0,""
-0x08,A,2,""
-0x09,F,F,""
-0x0A,0,0,""
+0x00,1,F,""
+0x01,2,8,""
+0x02,1,0,""
+0x03,2,7,""
+0x04,3,4,""
+0x05,0,0,""
+0x06,0,0,""
+0x07,0,0,""

Beispiele/Tone.tps

@@ -0,0 +1,15 @@
+#TPS:Willies SPS Arduino
+0x00,4,3,""
+0x01,5,1,""
+0x02,4,0,""
+0x03,7,C,""
+0x04,F,8,""
+0x05,2,9,""
+0x06,4,0,""
+0x07,5,1,""
+0x08,4,0,""
+0x09,7,C,""
+0x0A,F,8,""
+0x0B,2,8,""
+0x0C,3,C,""
+0x0D,0,0,""

README.md

@@ -1,10 +1,19 @@
 # **SPS_Emulator Version History**
+**12.12.2018 Version 0.2.1.57**
+  
+  * FEATURE: Tone Mnemonic now gives a real tone output.
+
+**10.12.2018 Version 0.2.1.56**
+  
+  * FEATURE: serial upload to new SPS Targets with simple serial interface
 
 **18.11.2018 Version 0.2.1.52**
+  
   * FEATURE: deactivating right panel if not in emulator mode
   * FEATURE: new internal "Jump to" will show the absolute memory address, if a skip or jump command will be executed
 
 **17.11.2018 Version 0.2.1.51**
+  
   * BUG: clicking "new row" with active row at the end of the table, two rows will be added
   * BUG: The last empty row will only show command 0. Data is not be set. 
   * BUG: on Export the field names are no correctly padded

SPS_EMU.000

@@ -2,8 +2,8 @@
 LSUTextFile=1
 Copyrigth=MCS Media Computer Software
 [LSUInfo]
-CompileDate=18.11.2018
-CompileTime=10:31:39
+CompileDate=12.12.2018
+CompileTime=00:25:33
 Name=Wilfried Klaas
 LSUBinFile=E:\daten\git-sourcen\SPS_Emulator\SPS_Emu.lsu
 LSUTextFile=E:\daten\git-sourcen\SPS_Emulator\SPS_Emu.

SPS_EMU.001

@@ -19,6 +19,7 @@ ID_ABOUT=&About
 ID_RESETPRESETS=R
 ID_SAVEPRESETS=S
 ID_LOADPRESETS=L
+ID_NEXT_INSERT=
 
 [form1ButtonHints]
 ID_EXIT=Exit the program
@@ -38,6 +39,7 @@ ID_ABOUT=About this program
 ID_RESETPRESETS=reset all presets
 ID_SAVEPRESETS=save presets to file
 ID_LOADPRESETS=load presets from file
+ID_NEXT_INSERT=goto next row, add row if necessary
 
 [infobox]
 ID_APPTITLE=TPS/PLC Emulator
@@ -165,7 +167,7 @@ SAVE_CHANGESM=The program has been changed. Do you want to save the changes?
 [frmSelectComCaptions]
 ID_COMPORT=Port
 ID_ARDUINO_INST=Arduino installation
-ID_COMMENT=Please select the port of the arduino and the path to the arduino installtion.
+ID_COMMENT=Please select the port of the arduino.
 
 [frmSelectComHints]
 ID_COMPORT=Com Port

SPS_EMU.044

@@ -19,6 +19,7 @@ ID_ABOUT=&About
 ID_RESETPRESETS=R
 ID_SAVEPRESETS=S
 ID_LOADPRESETS=L
+ID_NEXT_INSERT=
 
 [form1ButtonHints]
 ID_EXIT=Exit the program
@@ -38,6 +39,7 @@ ID_ABOUT=About this program
 ID_RESETPRESETS=reset all presets
 ID_SAVEPRESETS=save presets to file
 ID_LOADPRESETS=load presets from file
+ID_NEXT_INSERT=goto next row, add row if necessary
 
 [infobox]
 ID_APPTITLE=TPS/PLC Emulator
@@ -165,7 +167,7 @@ SAVE_CHANGESM=The program has been changed. Do you want to save the changes?
 [frmSelectComCaptions]
 ID_COMPORT=Port
 ID_ARDUINO_INST=Arduino installation
-ID_COMMENT=Please select the port of the arduino and the path to the arduino installtion.
+ID_COMMENT=Please select the port of the arduino.
 
 [frmSelectComHints]
 ID_COMPORT=Com Port

SPS_EMU.049

@@ -19,6 +19,7 @@ ID_ABOUT=&Über
 ID_RESETPRESETS=R
 ID_SAVEPRESETS=S
 ID_LOADPRESETS=L
+ID_NEXT_INSERT=
 
 [form1ButtonHints]
 ID_EXIT=Beenden
@@ -38,6 +39,7 @@ ID_ABOUT=Über dieses Programm
 ID_RESETPRESETS=Einstellungen zurücksetzen
 ID_LOADPRESETS=Presets aus Datei laden
 ID_SAVEPRESETS=Presets in Datei speichern
+ID_NEXT_INSERT=nächste Zeile, wenn nötig, lege neue Zeile an
 
 [infobox]
 ID_APPTITLE=TPS/SPS Emulator
@@ -165,7 +167,7 @@ SAVE_CHANGESM=Die Datei wurde geändert. Wollen Sie die Änderungen speichern?
 [frmSelectComCaptions]
 ID_COMPORT=Schnittstelle
 ID_ARDUINO_INST=Arduinoinstallation
-ID_COMMENT=Bitte wählen Sie die Schnittstelle des Arduino und den Ort der Arduinodateien aus.
+ID_COMMENT=Bitte wählen Sie die Schnittstelle des Arduino.
 
 [frmSelectComHints]
 ID_COMPORT=

SPS_Emu.lpi

@@ -22,7 +22,7 @@
       <AutoIncrementBuild Value="True"/>
       <MinorVersionNr Value="2"/>
       <RevisionNr Value="1"/>
-      <BuildNr Value="55"/>
+      <BuildNr Value="57"/>
       <Language Value="0407"/>
       <StringTable CompanyName="MCS" FileDescription="TPS/SPS Emulator" InternalName="SPS_EMU" LegalCopyright="MCS (C) Wilfried Klaas" OriginalFilename="SPS_EMU.exe" ProductName="TPS/SPS Emulator" ProductVersion="0.2"/>
     </VersionInfo>
@@ -38,7 +38,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="beispiele/SimpleServo.tps"/>
+        <CommandLineParams Value="beispiele/tone.tps"/>
       </local>
       <environment>
         <UserOverrides Count="1">

midi.pas

@@ -0,0 +1,582 @@
+unit MIDI;
+
+{$ifdef fpc}
+  {$mode objfpc}{$H+}
+{$endif}
+
+
+{ ***   You can choose if You want MIDI.PAS to use exceptions    *** }
+{ ***   in case of Errors. If not, MIDI.PAS uses POSTMESSAGE()   *** }
+{ ***   and You have to handle these messages in Your MainForm   *** }
+
+//{$define MIDI_UseExceptions}
+
+//{$define DebugSysEx}
+
+
+{*******************************************************************************
+*                                                                              *
+*                                MIDI.PAS                                      *
+*                                                                              *
+*     This file is based on the MIDI device classes by Adrian Meyer            *
+*     This file was taken from the ZIP archive 'demo_MidiDevices_D6.zip'       *
+*     and partly changed by me, some changes take over from  'DAV_MidiIO.pas'  *
+*                                                                              *
+*                       latest changes 2015-04-13                              *
+********************************************************************************
+* V1.0  First release with simple MIDI Input/Output                            *
+* V1.1  SysEx Input Event added, refactured error handling                     *
+* V1.2  SysEx Output procedure added, changes sysex input for multiple ports   *
+* V1.3  Changes by BREAKOUTBOX 2009-07  (www.breakoutbox.de)                   *
+* V1.4  Changes adapted from DAV_MidiIO.pas - see http://www.ohloh.net/p/DAV   *
+* V1.5  removed an Exception on sending SysEx Data to a CLOSED Output          *
+* V1.6  added a Switch to choose between Exceptions and Other behaviore ...    *
+* V1.7  replaced  pChar => pAnsiChar  Char => AnsiChar  string => AnsiString   *
+*       to gain compatibility to DelphiXE and higher versions ..               *
+*       -                                                                      *
+*******************************************************************************}
+
+
+interface
+
+uses
+  {$ifdef FPC}
+  Interfaces,
+  JWAwindows,
+  {$else}
+  Windows,
+  {$endif}
+  Forms, Classes, Messages, SysUtils, Math, Contnrs, MMSystem, Dialogs;
+
+
+// -------------------------- WARNING --------------------------
+// If Your Application uses User-defined Messages YOU MUST CHECK
+// if these values collide with one of Your own messages !!!
+const
+  // define window messages for MainForm :
+  WM_MIDISYSTEM_MESSAGE = WM_USER +1;
+  WM_MIDIDATA_ARRIVED   = WM_USER +2;
+  WM_MIM_ERROR          = WM_USER +3;//1001;
+  WM_MIM_LONGERROR      = WM_USER +4;//1002;
+
+
+const
+  // define Your size of  System Exclusive buffer :
+  cMySysExBufferSize = 2048;
+
+
+
+type
+  TMIDIChannel      = 1..16;
+  TMIDIDataByte     = 0..$7F;           //  7 bits
+  TMIDIDataWord     = 0..$3FFF;         // 14 bits
+  TMIDIStatusByte   = $80..$FF;
+  TMIDIVelocity     = TMIDIDataByte;
+  TMIDIKey          = TMIDIDataByte;
+  TMIDINote         = TMIDIKey;
+
+type
+  // event if data is received
+  TOnMidiInData = procedure (const aDeviceIndex: integer; const aStatus, aData1, aData2: byte) of object;
+  // event if system exclusive data is received
+  TOnSysExData = procedure (const aDeviceIndex: integer; const aStream: TMemoryStream) of object;
+
+  EMidiDevices = Exception;
+
+  // base class for MIDI devices
+  TMidiDevices = class
+  private
+    fDevices    : TStringList;
+    fMidiResult : MMResult;
+    procedure SetMidiResult(const Value: MMResult);
+  protected
+    property MidiResult: MMResult read fMidiResult write SetMidiResult;
+    function GetHandle(const aDeviceIndex: integer): THandle;
+  public
+    // create the MIDI devices
+    constructor Create; virtual;
+    // whack the devices
+    destructor Destroy; override;
+    // open a specific device
+    procedure Open(const aDeviceIndex: integer); virtual; abstract;
+    // close a specific device
+    procedure Close(const aDeviceIndex: integer); virtual; abstract;
+    // close all devices
+    procedure CloseAll;
+    // THE devices
+    function IsOpen(ADeviceIndex: Integer): Boolean;                            // check if open
+    property Devices: TStringList read fDevices;
+  end;
+
+  // MIDI input devices
+  TMidiInput = class(TMidiDevices)
+  private
+    fOnMidiData  : TOnMidiInData;
+    fOnSysExData : TOnSysExData;
+    fSysExData   : TObjectList;
+  protected
+    procedure DoSysExData( const aDeviceIndex: integer);
+  public
+    // create an input device
+    constructor Create; override;
+    // what the input devices
+    destructor Destroy; override;
+    // open a specific input device
+    procedure Open( const aDeviceIndex: integer); override;
+    // close a specific device
+    procedure Close( const aDeviceIndex: integer); override;
+    // midi data event
+    property OnMidiData: TOnMidiInData read fOnMidiData write fOnMidiData;
+    // midi system exclusive is received
+    property OnSysExData: TOnSysExData read fOnSysExData write fOnSysExData;
+  end;
+
+  // MIDI output devices
+  TMidiOutput = class(TMidiDevices)
+    constructor Create; override;
+    // open a specific input device
+    procedure Open(const aDeviceIndex: integer); override;
+    // close a specific device
+    procedure Close(const aDeviceIndex: integer); override;
+    // send some midi data to the indexed device
+    procedure Send(const aDeviceIndex: integer; const aStatus, aData1, aData2: byte);
+    procedure SendSystemReset( const aDeviceIndex: integer);
+    procedure SendAllSoundOff( const aDeviceIndex: integer; const channel: byte);
+    // send system exclusive data to a device
+    procedure SendSysEx( const aDeviceIndex: integer; const aStream: TMemoryStream); overload;
+    procedure SendSysEx( const aDeviceIndex: integer; const aString: AnsiString); overload;
+  end;
+
+  // convert the stream into xx xx xx xx AnsiString
+  function SysExStreamToStr( const aStream: TMemoryStream): AnsiString;
+  // fill the AnsiString in a xx xx xx xx into the stream  
+  procedure StrToSysExStream( const aString: AnsiString; const aStream: TMemoryStream);
+
+  // MIDI input devices
+  function MidiInput: TMidiInput;
+  // MIDI output Devices
+  function MidiOutput: TMidiOutput;
+
+
+  type
+    TSysExBuffer = array[0..cMySysExBufferSize -1] of AnsiChar;
+
+    TSysExData = class
+    private
+      fSysExStream: TMemoryStream;
+    public
+      SysExHeader: {$ifdef FPC} _midihdr {$else} TMidiHdr {$endif};
+      SysExData: TSysExBuffer;
+      constructor Create;
+      destructor Destroy; override;
+      property   SysExStream: TMemoryStream read fSysExStream;
+    end;
+
+
+
+implementation
+
+
+{ ***** TMidiBase ************************************************************ }
+constructor TMidiDevices.Create;
+begin
+  FDevices:= TStringList.Create;
+end;
+
+destructor TMidiDevices.Destroy;
+begin
+  FreeAndNil( FDevices);
+  inherited;
+end;
+
+
+var
+  gMidiInput: TMidiInput;
+  gMidiOutput: TMidiOutput;
+
+
+function MidiInput: TMidiInput;
+begin
+  if not Assigned( gMidiInput)
+    then gMidiInput := TMidiInput.Create;
+  Result := gMidiInput;
+end;
+
+function MidiOutput: TMidiOutput;
+begin
+  if not Assigned( gMidiOutput)
+    then gMidiOutput := TMidiOutput.Create;
+  Result := gMidiOutput;
+end;
+
+
+{$IFDEF FPC}
+//type
+//  PHMIDIIN = ^HMIDIIN;
+//  TMidiOutCaps = TMidiOutCapsA;
+{$ENDIF}
+
+{ I don't know whatfor this RECORD is used in DAV_MidiIO.pas
+  but I think this maybe allows renumeration / resorting of MIDI devices
+  for use in Your application - I didn't use this until now
+  so I didn't take over the implementation in this MIDI.PAS ... !
+
+TMidiInputDeviceRecord = record
+    MidiInput    : TMidiInput;
+    DeviceNumber : Integer;
+  end;
+  PMidiInputDeviceRecord = ^TMidiInputDeviceRecord;
+}
+
+
+{ The Callback-Procedure receives MIDI data on interrupt : }
+procedure MidiInCallback( aMidiInHandle: PHMIDIIN; aMsg: Integer; aInstance,
+                          aMidiData, aTimeStamp: integer); stdcall;
+begin
+  case aMsg of
+    MIM_DATA:
+      begin
+        if Assigned(MidiInput.OnMidiData) then
+          begin
+            MidiInput.OnMidiData(   aInstance,
+                                    aMidiData and $000000FF,
+                                  ( aMidiData and $0000FF00) shr 8,
+                                  ( aMidiData and $00FF0000) shr 16);
+            PostMessage( Application.MainForm.Handle, WM_MIDIDATA_ARRIVED, aInstance, aMidiData);
+          end;
+      end;
+
+    MIM_LONGDATA:
+      MidiInput.DoSysExData( aInstance);
+
+    MIM_ERROR:  PostMessage( Application.MainForm.Handle, WM_MIM_ERROR, aInstance, aMidiData);
+
+    MIM_LONGERROR:
+      {$ifdef MIDI_UseExceptions}
+      raise Exception.Create( 'Midi In Error!');
+      {$else} // in a Callback Function you CANNOT use a MessageBox()  !!!
+      PostMessage( Application.MainForm.Handle, WM_MIM_LONGERROR, aInstance, aMidiData);
+      {$endif}
+  end;
+end;
+
+
+{ ***** TMidiInput *********************************************************** }
+constructor TMidiInput.Create;
+var
+  AvailableMIDIinputs : integer;
+  lInCaps             : TMidiInCaps;
+  i                   : integer;
+begin
+  inherited;
+  fSysExData := TObjectList.Create(true);
+  TRY   // TRY..EXCEPT was adapted from file "DAV_MidiIO.pas"
+    AvailableMIDIinputs:= MidiInGetNumDevs;
+  EXCEPT
+    AvailableMIDIinputs:= 0;
+  end;
+
+  if AvailableMIDIinputs > 0 then
+  for i:= 0 to AvailableMIDIinputs - 1 do
+  begin
+    MidiResult := midiInGetDevCaps(i, @lInCaps, SizeOf(TMidiInCaps));
+    if MidiResult = MMSYSERR_NOERROR then
+      begin
+        fDevices.Add(StrPas(lInCaps.szPname));
+        fSysExData.Add(TSysExData.Create);
+      end;
+  end;
+end;
+
+destructor TMidiInput.Destroy;
+begin
+  FreeAndNil( fSysExData);
+  inherited;
+end;
+
+procedure TMidiInput.Close( const aDeviceIndex: integer);
+begin
+  if GetHandle( aDeviceIndex) <> 0 then
+  begin
+    MidiResult := midiInStop(GetHandle(aDeviceIndex));
+    MidiResult := midiInReset(GetHandle(aDeviceIndex));
+    MidiResult := midiInUnprepareHeader(GetHandle(aDeviceIndex),
+                  @TSysExData(fSysExData[aDeviceIndex]).SysExHeader, SizeOf(TMidiHdr));
+    MidiResult := midiInClose(GetHandle(aDeviceIndex));
+    FDevices.Objects[aDeviceIndex] := nil;
+  end;
+end;
+                         
+procedure TMidiDevices.CloseAll;
+var
+  i : integer;
+begin
+  for i:= 0 to FDevices.Count - 1 do Close(i);
+end;
+
+procedure TMidiInput.Open( const aDeviceIndex: integer);
+var
+  lSysExData : TSysExData;
+  lHandle    : THandle;
+begin
+  if GetHandle(aDeviceIndex) <> 0 then Exit;
+
+  MidiResult := midiInOpen( @lHandle, aDeviceIndex, cardinal(@midiInCallback),
+                            aDeviceIndex, CALLBACK_FUNCTION);
+
+  fDevices.Objects[ aDeviceIndex ] := TObject(lHandle);
+  lSysExData := TSysExData(fSysExData[aDeviceIndex]);
+
+  lSysExData.SysExHeader.dwFlags := 0;
+
+  // DRAGONS:  why are the function returns not checked on errors here ?
+  MidiResult := midiInPrepareHeader(lHandle, @lSysExData.SysExHeader, SizeOf(TMidiHdr));
+  MidiResult := midiInAddBuffer( lHandle, @lSysExData.SysExHeader, SizeOf(TMidiHdr));
+  MidiResult := midiInStart( lHandle);
+end;
+
+
+{ ***** TMidiInput - SysEx *************************************************** }
+procedure TMidiInput.DoSysExData( const aDeviceIndex: integer);
+var
+  lSysExData : TSysExData;
+begin
+  lSysExData := TSysExData(fSysExData[aDeviceIndex]);
+  if lSysExData.SysExHeader.dwBytesRecorded = 0 then Exit;
+
+  lSysExData.SysExStream.Write( lSysExData.SysExData,
+                                lSysExData.SysExHeader.dwBytesRecorded);
+  if lSysExData.SysExHeader.dwFlags and MHDR_DONE = MHDR_DONE then
+  begin
+    lSysExData.SysExStream.Position := 0;
+    if assigned(fOnSysExData)
+      then fOnSysExData(aDeviceIndex, lSysExData.SysExStream);
+    lSysExData.SysExStream.Clear;
+  end;
+
+  lSysExData.SysExHeader.dwBytesRecorded := 0;
+
+  // DRAGONS:  why not check function returns on errors here ?
+  MidiResult := MidiInPrepareHeader( GetHandle(aDeviceIndex),
+                                     @lSysExData.SysExHeader, SizeOf(TMidiHdr));
+  MidiResult := MidiInAddBuffer( GetHandle(aDeviceIndex), @lSysExData.SysExHeader,
+                                 SizeOf( TMidiHdr));
+end;
+
+
+{ ***** TMidiOutput ********************************************************** }
+constructor TMidiOutput.Create;
+var
+  AvailableMIDIoutputs : integer;
+  lOutCaps             : TMidiOutCaps;
+  i                    : integer;
+begin
+  inherited;
+
+  TRY
+    AvailableMIDIoutputs := MidiOutGetNumDevs;
+  EXCEPT
+    AvailableMIDIoutputs := 0;
+  end;
+
+  //ShowMessage( 'DEBUG - AvailableMIDIoutputs = ' +IntToStr( AvailableMIDIoutputs));
+  for i:= 0 to AvailableMIDIoutputs - 1 do
+  begin
+    MidiResult := MidiOutGetDevCaps( i, @lOutCaps, SizeOf(TMidiOutCaps));
+    fDevices.Add( lOutCaps.szPname);
+  end;
+end;
+
+procedure TMidiOutput.Open( const aDeviceIndex: integer);
+var
+  lHandle: THandle;
+begin
+  {$ifndef FPC}
+  inherited;  // Lazarus doesn't like this, so for Delphi only ..
+  {$endif}
+  // device already open;
+  if GetHandle(aDeviceIndex) <> 0 then exit;
+
+  MidiResult := midiOutOpen( @lHandle, aDeviceIndex, 0, 0, CALLBACK_NULL);
+  fDevices.Objects[ aDeviceIndex ]:= TObject( lHandle);
+end;
+
+procedure TMidiOutput.Close( const aDeviceIndex: integer);
+begin
+  {$ifndef FPC}
+  inherited;  // Lazarus doesn't like this, so for Delphi only ..
+  {$endif}
+  if GetHandle(aDeviceIndex) <> 0 then // 'if .. then' added by BREAKOUTBOX 2009-07-15
+    begin
+      MidiResult := midiOutClose(GetHandle(aDeviceIndex));
+      fDevices.Objects[ aDeviceIndex ] := nil;
+    end;
+end;
+
+procedure TMidiOutput.Send( const aDeviceIndex: integer; const aStatus,
+                            aData1, aData2: byte);
+var
+  lMsg: cardinal;
+begin
+  // open if the device is not open      // NOW: do NOT open .. !
+  if not Assigned( fDevices.Objects[ aDeviceIndex ])
+    then exit;  // Open( aDeviceIndex);  // Breakoutbox changed 2008-07-01
+
+  //lMsg := aStatus + (aData1 * $100) + (aData2 * $10000);
+  lMsg:= aStatus or (aData1 shl 8) or (aData2 shl 16); // better ?
+  MidiResult := MidiOutShortMsg( GetHandle( aDeviceIndex), lMSG);
+end;
+
+{ --- common MIDI Out messages ----------------------------------------------- }
+{ System Reset = Status Byte FFh }
+procedure TMidiOutput.SendSystemReset( const aDeviceIndex: integer);
+begin
+  Self.Send( aDeviceIndex, $FF, $0, $0);
+end;
+
+{ All Sound Off = Status + Channel Byte Bnh, n = Channel number  }
+{                 Controller-ID = Byte 78h,  2nd Data-Byte = 00h }
+procedure TMidiOutput.SendAllSoundOff(const aDeviceIndex: integer; const channel: byte);
+begin
+  Self.Send( aDeviceIndex, $b0 +channel, $78, $0);
+end;
+
+// HINT:  in a Thread MidiInGetErrorText() makes no sense ..
+//        read out the error text in Your main thread / MainForm !
+procedure TMidiDevices.SetMidiResult( const Value: MMResult);
+var
+  lError: array[0..MAXERRORLENGTH] of AnsiChar;
+begin
+  fMidiResult := Value;
+  if fMidiResult <> MMSYSERR_NOERROR then
+    if MidiInGetErrorText( fMidiResult, @lError, MAXERRORLENGTH) = MMSYSERR_NOERROR
+      {$ifdef MIDI_UseExceptions}
+      then raise EMidiDevices.Create(StrPas(lError));
+      {$else}
+      // in a Thread or a Callback Function you CANNOT use a MessageBox()  !!!
+      //then ShowMessage( 'ERROR in  TMidiDevices.SetMidiResult()  Line 409' +#13#13
+      //                  +StrPas( lError) );
+      then PostMessage( Application.MainForm.Handle, WM_MIDISYSTEM_MESSAGE, fMidiResult, 0);
+      {$endif}
+end;
+
+function TMidiDevices.GetHandle( const aDeviceIndex: integer): THandle;
+begin
+  try
+    if not InRange(aDeviceIndex, 0, fDevices.Count - 1) then
+      raise EMidiDevices.CreateFmt( '%s: Device index out of bounds! (%d)',
+                                    [ClassName,aDeviceIndex]);
+
+    Result:= THandle(fDevices.Objects[ aDeviceIndex ]);
+  except
+    Result:= 0;
+  end;
+end;
+
+function TMidiDevices.IsOpen(ADeviceIndex: Integer): boolean;
+begin
+  Result := GetHandle(ADeviceIndex) <> 0;
+end;
+
+
+{ ***** TMidiOutput - SysEx ************************************************** }
+procedure TMidiOutput.SendSysEx( const aDeviceIndex: integer;
+                                 const aString: AnsiString);
+var
+  lStream: TMemoryStream;
+begin
+  lStream := TMemoryStream.Create;
+  try
+    StrToSysExStream( aString, lStream);
+    SendSysEx( aDeviceIndex, lStream);
+  finally
+    FreeAndNil( lStream);
+  end;
+end;
+
+procedure TMidiOutput.SendSysEx( const aDeviceIndex: integer;
+                                 const aStream: TMemoryStream);
+var
+  lSysExHeader: TMidiHdr;
+begin
+  // exit here if DeviceIndex is not open !
+  if not assigned(fDevices.Objects[ aDeviceIndex ])
+    then exit; // Breakoutbox added this 2013-06-15
+
+  aStream.Position := 0;
+  lSysExHeader.dwBufferLength := aStream.Size;
+  lSysExHeader.lpData := aStream.Memory;
+  lSysExHeader.dwFlags := 0;
+
+  //ShowMessage( 'HEX: ' +SysExStreamToStr( aStream));
+  {$ifdef DebugSysEx}  ShowMessage( '0 - ' +IntToStr(MidiResult));  {$endif}
+  MidiResult := midiOutPrepareHeader(GetHandle(aDeviceIndex), @lSysExHeader, SizeOf(TMidiHdr));
+  {$ifdef DebugSysEx}  ShowMessage( '1 - ' +IntToStr(MidiResult));  {$endif}
+  MidiResult := midiOutLongMsg( GetHandle(aDeviceIndex), @lSysExHeader, SizeOf(TMidiHdr));
+  {$ifdef DebugSysEx}  ShowMessage( '2 - ' +IntToStr(MidiResult));  {$endif}
+  MidiResult := midiOutUnprepareHeader(GetHandle(aDeviceIndex), @lSysExHeader, SizeOf(TMidiHdr));
+  {$ifdef DebugSysEx}  ShowMessage( '3 - ' +IntToStr(MidiResult));  {$endif}
+  {$ifdef DebugSysEx}  ShowMessage( '4 - ' +aStream.ReadAnsiString);  {$endif}
+end;
+
+
+{ ***** TSysExData *********************************************************** }
+constructor TSysExData.Create;
+begin
+  SysExHeader.dwBufferLength := cMySysExBufferSize;
+  SysExHeader.lpData := SysExData;
+  fSysExStream := TMemoryStream.Create;
+end;
+
+destructor TSysExData.Destroy;
+begin
+  FreeAndNil( fSysExStream);
+end;
+
+
+{ ***** Helper Funktions ***************************************************** }
+function SysExStreamToStr(const aStream: TMemoryStream): AnsiString;
+var
+  i : integer;
+begin
+  Result := '';
+  aStream.Position:= 0;
+  for i:= 0 to aStream.Size - 1
+    do Result := Result + Format( '%.2x ', [ byte(pAnsiChar(aStream.Memory)[i]) ]);
+end;
+
+procedure StrToSysExStream(const aString: AnsiString; const aStream: TMemoryStream);
+const
+  cHex : AnsiString = '123456789ABCDEF';
+var
+  lStr : AnsiString;
+  i    : integer;
+  L    : integer;
+begin
+  // check on errors  - added by BREAKOUTBOX 2009-07-30
+  L := length( aString);
+  if not (L mod 2 = 0) // as HEX every byte must be two AnsiChars long, for example '0F'
+    then raise EMidiDevices.Create( 'SysEx string corrupted')
+    else if l < 10  // shortest System Exclusive Message = 5 bytes = 10 hex AnsiChars
+           then raise EMidiDevices.Create( 'SysEx string too short');
+
+  lStr := StringReplace( AnsiUpperCase( aString), ' ', '', [rfReplaceAll]);
+  aStream.Size := Length( lStr) div 2; // ' - 1' removed by BREAKOUTBOX 2009-07-15
+  aStream.Position := 0;
+
+  for i:= 1 to aStream.Size do
+    pAnsiChar( aStream.Memory)[i-1] :=
+      AnsiChar( AnsiPos( lStr[ i*2 - 1], cHex) shl 4 + AnsiPos( lStr[i*2], cHex));
+end;
+
+
+initialization
+  gMidiInput  := nil;
+  gMidiOutput := nil;
+
+finalization
+  FreeAndNil( gMidiInput);
+  FreeAndNil( gMidiOutput);
+
+
+end.

ugui.lfm

@@ -1,12 +1,12 @@
 object Form1: TForm1
-  Left = 235
+  Left = 234
   Height = 582
-  Top = 107
-  Width = 691
+  Top = 104
+  Width = 717
   AllowDropFiles = True
   Caption = 'SPS Emulator'
   ClientHeight = 582
-  ClientWidth = 691
+  ClientWidth = 717
   Constraints.MinHeight = 582
   Constraints.MinWidth = 684
   OnCloseQuery = FormCloseQuery
@@ -16,7 +16,7 @@ object Form1: TForm1
   ShowHint = True
   LCLVersion = '1.8.4.0'
   object Panel1: TPanel
-    Left = 367
+    Left = 393
     Height = 533
     Top = 26
     Width = 324
@@ -205,6 +205,7 @@ object Form1: TForm1
         Top = 232
         Width = 60
         Enabled = False
+        OnClick = btnToneClick
         Spacing = 2
         TabOrder = 4
       end
@@ -702,7 +703,7 @@ object Form1: TForm1
     Left = 0
     Height = 26
     Top = 0
-    Width = 691
+    Width = 717
     ButtonHeight = 22
     ButtonWidth = 22
     Caption = 'ToolBar1'
@@ -870,25 +871,25 @@ object Form1: TForm1
     Left = 0
     Height = 23
     Top = 559
-    Width = 691
+    Width = 717
     Panels = <>
   end
   object Panel2: TPanel
     Left = 0
     Height = 533
     Top = 26
-    Width = 367
+    Width = 393
     Align = alClient
     BevelOuter = bvNone
     Caption = 'Panel2'
     ClientHeight = 533
-    ClientWidth = 367
+    ClientWidth = 393
     TabOrder = 3
     object StringGrid1: TStringGrid
       Left = 0
       Height = 499
       Top = 0
-      Width = 367
+      Width = 393
       Align = alClient
       Columns = <      
         item
@@ -928,12 +929,12 @@ object Form1: TForm1
       Left = 0
       Height = 34
       Top = 499
-      Width = 367
+      Width = 393
       Align = alBottom
       BevelInner = bvLowered
       BevelOuter = bvNone
       ClientHeight = 34
-      ClientWidth = 367
+      ClientWidth = 393
       TabOrder = 1
       object cbCommand: TComboBox
         Left = 64
@@ -1011,11 +1012,18 @@ object Form1: TForm1
         Caption = 'ID_MNE_DATA'
         ParentColor = False
       end
+      object SpeedButton1: TSpeedButton
+        Left = 344
+        Height = 22
+        Top = 4
+        Width = 23
+        Action = acNextInsert
+      end
     end
   end
   object ActionList1: TActionList
     Images = ImageList1
-    left = 464
+    left = 472
     top = 496
     object acExit: TAction
       Category = 'File'
@@ -1142,6 +1150,11 @@ object Form1: TForm1
       Dialog.Filter = 'ini files|*.ini|all files|*.*'
       OnAccept = acPresetSaveAccept
     end
+    object acNextInsert: TAction
+      Caption = 'ID_NEXT_INSERT'
+      ImageIndex = 5
+      OnExecute = acNextInsertExecute
+    end
   end
   object ImageList1: TImageList
     Height = 20
@@ -5653,7 +5666,12 @@ object Form1: TForm1
     }
   end
   object XMLPropStorage1: TXMLPropStorage
-    StoredValues = <>
+    StoredValues = <    
+      item
+        Name = 'MidiProgram'
+        Value = '30'
+        KeyString = 'MidiProgram'
+      end>
     left = 496
     top = 496
   end
@@ -51893,4 +51911,15 @@ object Form1: TForm1
       07FF111108FF434322FF7F7F40FF
     }
   end
+  object SdpoSerial1: TSdpoSerial
+    Active = False
+    BaudRate = br__9600
+    DataBits = db8bits
+    Parity = pNone
+    FlowControl = fcNone
+    StopBits = sbOne
+    Device = 'COM1'
+    left = 656
+    top = 496
+  end
 end

ugui.pas

@@ -9,7 +9,7 @@ interface
 uses
   Windows, Classes, SysUtils, FileUtil, SdpoSerial, Forms, Controls, Graphics, Dialogs,
   Grids, ExtCtrls, Menus, ComCtrls, ActnList, StdActns, LCLProc, StdCtrls, Spin,
-  XMLPropStorage, uSPS, LCLType, Buttons, types, MCSWINAPI, Math, fpjson, jsonparser;
+  XMLPropStorage, uSPS, LCLType, Buttons, types, MCSWINAPI, Math, fpjson, jsonparser, Midi;
 
 type
 
@@ -28,6 +28,7 @@ type
     acFileSave: TAction;
     acHelpAbout: TAction;
     acHexFile: TAction;
+    acNextInsert: TAction;
     acUpload: TAction;
     ActionList1: TActionList;
     acFileOpen: TFileOpen;
@@ -79,6 +80,7 @@ type
     ADC2: TSpinEdit;
     SaveDialog1: TSaveDialog;
     SaveHexFile: TSaveDialog;
+    SdpoSerial1: TSdpoSerial;
     Servo1: TLabeledEdit;
     Servo2: TLabeledEdit;
     EditA: TLabeledEdit;
@@ -94,6 +96,7 @@ type
     ShapeOut2: TShape;
     ShapeOut3: TShape;
     ShapeOut4: TShape;
+    SpeedButton1: TSpeedButton;
     StatusBar1: TStatusBar;
     StringGrid1: TStringGrid;
     tbPrg: TToggleBox;
@@ -143,6 +146,7 @@ type
     procedure acHexFileExecute(Sender: TObject);
     procedure acNewExecute(Sender: TObject);
     procedure acNewRowExecute(Sender: TObject);
+    procedure acNextInsertExecute(Sender: TObject);
     procedure acNextStepExecute(Sender: TObject);
     procedure acPresetLoadAccept(Sender: TObject);
     procedure acPresetSaveAccept(Sender: TObject);
@@ -151,6 +155,7 @@ type
     procedure acThisStepExecute(Sender: TObject);
     procedure acFileSaveExecute(Sender: TObject);
     procedure acUploadExecute(Sender: TObject);
+    procedure btnToneClick(Sender: TObject);
     procedure cbCommandChange(Sender: TObject);
     procedure cbDataChange(Sender: TObject);
     procedure cbTPSVersionChange(Sender: TObject);
@@ -173,6 +178,10 @@ type
     stopit: boolean;
     activeFile: string;
     dirty: boolean;
+    lastNote: byte;
+    procedure initMidi;
+    procedure playNote(note: byte);
+    function readString(var line: string): boolean;
     procedure saveSection(filename: string; key: string);
     procedure loadSection(filename: string; key: string);
 
@@ -185,6 +194,7 @@ type
     procedure inputSps;
     procedure outputSps;
     procedure uploadFile;
+    function serialUpload: string;
     procedure setDirty(Value: boolean);
     function checkDirty: boolean;
     procedure checkPresets;
@@ -248,6 +258,36 @@ begin
   activateSps(False);
   Timer1.Enabled := True;
   MCSLSU.MakeForm('form1', 'ID_', form1);
+  initMidi;
+end;
+
+procedure TForm1.initMidi;
+var
+  Value: integer;
+begin
+  lastNote := 0;
+  MidiOutput.Open(0);
+  Value := XMLPropStorage1.ReadInteger('MidiProgram', 30);
+  MidiOutput.Send(0, 192, Value, 0);
+end;
+
+procedure TForm1.playNote(note: byte);
+var
+  command, velocity: byte;
+begin
+  if (lastNote > 0) then
+  begin
+    command := $80;
+    velocity := $7F;
+    MidiOutput.Send(0, command, lastnote, velocity);
+  end;
+  if (note > 0) then
+  begin
+    command := $90;
+    velocity := $7F;
+    MidiOutput.Send(0, command, note, velocity);
+  end;
+  lastNote := note;
 end;
 
 procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of string);
@@ -519,6 +559,17 @@ begin
   renumberGrid();
 end;
 
+procedure TForm1.acNextInsertExecute(Sender: TObject);
+var
+  myPos: integer;
+begin
+  myPos := StringGrid1.Row;
+  if (myPos = StringGrid1.RowCount - 1) then
+    acNewRow.Execute;
+  StringGrid1.Row := myPos + 1;
+  renumberGrid();
+end;
+
 procedure TForm1.programSps;
 var
   x, i: integer;
@@ -686,9 +737,9 @@ begin
     stopit := True;
     sps.break();
     acDebug.ImageIndex := 18;
-    repeat
-      Application.ProcessMessages;
-    until (not sps.isDelayActive());
+    //   repeat
+    //     Application.ProcessMessages;
+    //   until (not sps.isDelayActive());
     sps.doReset();
     acStop.Enabled := False;
     acDebug.Enabled := True;
@@ -728,8 +779,24 @@ end;
 procedure TForm1.acUploadExecute(Sender: TObject);
 begin
   uploadFile();
+  //serialUpload;
 end;
 
+procedure TForm1.btnToneClick(Sender: TObject);
+begin
+  MidiOutput.SendAllSoundOff(0, 0);
+end;
+
+function TForm1.serialUpload: string;
+var
+  hexFile: string;
+begin
+  hexFile := MCSIO.CreateUniqueFile(MCSIO.GetTempDir, 'TPS', '.hex');
+  makeHexFile(hexFile);
+  Result := hexFile;
+end;
+
+
 procedure TForm1.uploadFile;
 var
   line: string;
@@ -746,8 +813,12 @@ var
   cmd, config, mcu: string;
   KeyName, StringValue: string;
   Res: WideString;
+  Lines: TStringList;
+  TimeOut: integer;
+  error: boolean;
 
 begin
+  error := False;
   line := GetSerialPortNames;
   //  if (line <> '') then
   begin
@@ -759,67 +830,75 @@ begin
     frmSelectCom.cbServices.Items.AddStrings(comServices);
     frmSelectCom.cbServices.Text := line;
 
-    line := XMLPropStorage1.ReadString('ArduinoBin', '');
-    if (line = '') then
-    begin
-      KeyName := 'SOFTWARE\WOW6432Node\Arduino';
-      StringValue := 'Install_Dir';
-      Res := RegistryReadString(HKEY_LOCAL_MACHINE, WideString(KeyName), WideString(StringValue));
-      if Res <> '' then
-      begin
-        line := string(Res);
-      end;
-    end;
-    frmSelectCom.deArduino.Text := line;
-
     return := frmSelectCom.ShowModal;
 
     comService := frmSelectCom.cbServices.Text;
     XMLPropStorage1.WriteString('ComPort', comService);
-    line := frmSelectCom.deArduino.Text;
-    arduinoPath := MCSIO.GetNormPath(line);
-    XMLPropStorage1.WriteString('ArduinoBin', line);
     comServices.Free;
+
     if (return = mrOk) then
     begin
-      hexFile := MCSIO.CreateUniqueFile(MCSIO.GetTempDir, 'TPS', '.hex');
-      makeHexFile(hexFile);
-      cmd := arduinoPath + 'hardware\tools\avr\bin\avrdude';
-      XMLPropStorage1.WriteString('avrdude', cmd);
+      hexFile := serialUpload;
 
-      config := arduinoPath + 'hardware\tools\avr\etc\avrdude.conf';
-      XMLPropStorage1.WriteString('avrdudeconf', config);
+      SdpoSerial1.Device := comService;
+      SdpoSerial1.Active := True;
 
-      if (cbTPSVersion.ItemIndex = 3) then
+      if (not readString(line)) then
       begin
-        mcu := 'atmega328p';
-      end
-      else if (cbTPSVersion.ItemIndex = 2) then
+        error := True;
+      end;
+      if (not error) then
       begin
-        mcu := 'attiny84';
+        SdpoSerial1.WriteData('w');
+        if (readString(line)) then
+        begin
+          if (pos('ready', line) > 0) then
+          begin
+            Lines := TStringList.Create;
+            Lines.LoadFromFile(hexFile);
+            for x := 0 to Lines.Count - 1 do
+            begin
+              SdpoSerial1.WriteData(Lines.Strings[x]);
+              SdpoSerial1.WriteData(CRLF);
+              Sleep(250);
+            end;
+            SdpoSerial1.WriteData('e');
+          end
+          else
+          begin
+            error := True;
+          end;
+        end;
       end;
 
-      XMLPropStorage1.WriteString('arduinomcu', mcu);
-
-      line :=
-        '-C%AVRCONF% -v -v -v -p%MCU% -carduino -P\\.\%COM% -b57600 -D -Ueeprom:w:%FILE%:i';
-
-      line := Replace2('%AVRCONF%', config, line);
-      line := Replace2('%MCU%', mcu, line);
-      line := Replace2('%COM%', comService, line);
-      line := Replace2('%FILE%', hexFile, line);
-
-      ExecuteProcess(cmd, line);
+      if (error) then
+      begin
+        Application.MessageBox('Arduino antwortet nicht. Evtl. Arduino nicht angeschlossen oder falsche Firmware?',
+          'Keine Antwort',
+          MB_OK + MB_ICONEXCLAMATION);
+      end;
+      SdpoSerial1.Active := False;
       DeleteFile(hexFile);
     end;
   end;
-{  else
+end;
+
+function TForm1.readString(var line: string): boolean;
+var
+  TimeOut: integer;
+begin
+  Result := False;
+  TimeOut := 10;
+  while ((not SdpoSerial1.DataAvailable) and (TimeOut > 0)) do
   begin
-    Application.MessageBox('Kein Comport vorhanden. EVt. Arduino nicht angeschlossen?',
-      'Kein Comport',
-      MB_OK + MB_ICONEXCLAMATION);
+    Dec(TimeOut);
+    Sleep(1000);
+  end;
+  if (Timeout > 0) then
+  begin
+    line := SdpoSerial1.ReadData;
+    Result := True;
   end;
-  }
 end;
 
 procedure TForm1.setDirty(Value: boolean);
@@ -1299,6 +1378,7 @@ begin
   MCSLabel.Caption := InfoBox.versionText;
 end;
 
+
 procedure TForm1.renumberGrid;
 var
   x, i: integer;
@@ -1380,12 +1460,23 @@ begin
   if (sps.getTone() > 0) then
   begin
     ImageList2.GetBitmap(23, btnTone.Glyph);
-    btnTone.Caption := IntToStr(sps.getTone());
+    i := round(440 * power(2.0, ((sps.getTone() - 69) / 12)));
+    btnTone.Caption := IntToStr(i);
+    if (lastNote <> sps.getTone()) then
+    begin
+      playNote(sps.getTone());
+    end;
+    btntone.Enabled := True;
   end
   else
   begin
     ImageList2.GetBitmap(22, btnTone.Glyph);
     btnTone.Caption := '';
+    if (lastNote <> sps.getTone()) then
+    begin
+      playNote(0);
+    end;
+    btntone.Enabled := False;
   end;
   List := TStringList.Create;
   try

uselectcom.lfm

@@ -1,7 +1,7 @@
 object frmSelectCom: TfrmSelectCom
-  Left = 344
+  Left = 375
   Height = 172
-  Top = 152
+  Top = 161
   Width = 401
   Caption = 'Schnittstelle auswählen'
   ClientHeight = 172
@@ -9,11 +9,11 @@ object frmSelectCom: TfrmSelectCom
   OnCreate = FormCreate
   OnShow = FormShow
   Position = poMainFormCenter
-  LCLVersion = '1.0.14.0'
+  LCLVersion = '1.8.4.0'
   object ButtonPanel1: TButtonPanel
     Left = 6
-    Height = 38
-    Top = 128
+    Height = 34
+    Top = 132
     Width = 389
     OKButton.Name = 'OKButton'
     OKButton.DefaultCaption = True
@@ -30,27 +30,27 @@ object frmSelectCom: TfrmSelectCom
     AnchorSideTop.Control = cbServices
     AnchorSideTop.Side = asrCenter
     AnchorSideRight.Side = asrBottom
-    Left = 60
-    Height = 21
+    Left = 78
+    Height = 15
     Top = 52
-    Width = 91
+    Width = 73
     Anchors = [akTop, akRight]
     Caption = 'ID_COMPORT'
     ParentColor = False
   end
   object cbServices: TComboBox
     Left = 160
-    Height = 28
+    Height = 23
     Top = 48
     Width = 100
-    ItemHeight = 20
+    ItemHeight = 15
     Style = csDropDownList
     TabOrder = 1
   end
   object Label2: TLabel
     AnchorSideRight.Side = asrBottom
     Left = 0
-    Height = 21
+    Height = 15
     Top = 0
     Width = 401
     Align = alTop
@@ -58,28 +58,4 @@ object frmSelectCom: TfrmSelectCom
     ParentColor = False
     WordWrap = True
   end
-  object deArduino: TDirectoryEdit
-    Left = 160
-    Height = 28
-    Top = 88
-    Width = 192
-    ShowHidden = False
-    ButtonWidth = 23
-    NumGlyphs = 0
-    MaxLength = 0
-    TabOrder = 2
-  end
-  object Label3: TLabel
-    AnchorSideTop.Control = deArduino
-    AnchorSideTop.Side = asrCenter
-    AnchorSideRight.Side = asrBottom
-    Left = 26
-    Height = 21
-    Top = 92
-    Width = 125
-    Anchors = [akTop, akRight]
-    Caption = 'ID_ARDUINO_INST'
-    ParentColor = False
-    WordWrap = True
-  end
 end

uselectcom.pas

@@ -15,10 +15,8 @@ type
   TfrmSelectCom = class(TForm)
     ButtonPanel1: TButtonPanel;
     cbServices: TComboBox;
-    deArduino: TDirectoryEdit;
     Label1: TLabel;
     Label2: TLabel;
-    Label3: TLabel;
     procedure FormCreate(Sender: TObject);
     procedure FormShow(Sender: TObject);
   private

usps.pas

@@ -130,7 +130,7 @@ const
     ('', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '');
   F_LIST_AT: array[0..15] of string = ('A=ADC.1', 'A=ADC.2', 'A=RCin.1', 'A=RCin.2',
     'PWM.1=A', 'PWM.2=A', 'Servo.1=A', 'Servo.2=A', 'Tone=A', '', '', '',
-    '', '', '', 'PrgEnd');
+    '', 'LED off', 'LED on', 'PrgEnd');
 
 type
   {TPSVersion}
@@ -1115,7 +1115,7 @@ end;
 procedure TSPS.doTone(Data: byte);
 begin
   if (a in [36..109]) then
-    tone := round(440 * power(2.0, ((a - 69) / 12)))
+    tone := a
   else
     tone := 0;
 end;