SPS_Emulator/ugui.pas

unit uGUI;

{$mode objfpc}{$H+}

{$define DebugLCLComponents}

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, Midi;

type

  { TForm1 }

  TForm1 = class(TForm)
    acExit: TAction;
    acDebug: TAction;
    acNextStep: TAction;
    acStop: TAction;
    acThisStep: TAction;
    acShowHexFile: TAction;
    acNew: TAction;
    acNewRow: TAction;
    acDeleteRow: TAction;
    acFileSave: TAction;
    acHelpAbout: TAction;
    acHexFile: TAction;
    acNextInsert: TAction;
    acUpload: TAction;
    ActionList1: TActionList;
    acFileOpen: TFileOpen;
    acFileSaveAs: TFileSaveAs;
    btnTone: TBitBtn;
    cbTPSVersion: TComboBox;
    cbAdrActual: TCheckBox;
    EditDelay: TLabeledEdit;
    EditJump: TLabeledEdit;
    EditPage: TLabeledEdit;
    EditRAdr: TLabeledEdit;
    acPresetLoad: TFileOpen;
    acPresetSave: TFileSaveAs;
    GBControl: TGroupBox;
    ImageList2: TImageList;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    lbStack: TListBox;
    MCSLabel: TLabel;
    MenuItem1: TMenuItem;
    pmExamples: TPopupMenu;
    RC1: TSpinEdit;
    RC2: TSpinEdit;
    cbCommand: TComboBox;
    cbData: TComboBox;
    Din1: TCheckBox;
    Din2: TCheckBox;
    Din3: TCheckBox;
    Din4: TCheckBox;
    GBOutput: TGroupBox;
    GBInput: TGroupBox;
    GBInternal: TGroupBox;
    ImageList1: TImageList;
    Label1: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label2: TLabel;
    Panel2: TPanel;
    Panel3: TPanel;
    PWM1: TLabeledEdit;
    PWM2: TLabeledEdit;
    Panel1: TPanel;
    ADC1: TSpinEdit;
    ADC2: TSpinEdit;
    SaveDialog1: TSaveDialog;
    SaveHexFile: TSaveDialog;
    SdpoSerial1: TSdpoSerial;
    Servo1: TLabeledEdit;
    Servo2: TLabeledEdit;
    EditA: TLabeledEdit;
    EditC: TLabeledEdit;
    EditE: TLabeledEdit;
    EditB: TLabeledEdit;
    EditD: TLabeledEdit;
    EditF: TLabeledEdit;
    EditAddr: TLabeledEdit;
    Shape1: TShape;
    Shape2: TShape;
    ShapeOut1: TShape;
    ShapeOut2: TShape;
    ShapeOut3: TShape;
    ShapeOut4: TShape;
    SpeedButton1: TSpeedButton;
    StatusBar1: TStatusBar;
    StringGrid1: TStringGrid;
    tbPrg: TToggleBox;
    tbPreLoad: TToolButton;
    tbPreSave: TToolButton;
    tbSel: TToggleBox;
    Timer1: TTimer;
    ToolBar1: TToolBar;
    ToolBar2: TToolBar;
    ToolButton1: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    tbPreset1: TToolButton;
    tbReset: TToolButton;
    ToolButton19: TToolButton;
    ToolButton2: TToolButton;
    tbPreset2: TToolButton;
    tbPreset3: TToolButton;
    tbPreset4: TToolButton;
    tbPreset5: TToolButton;
    tbPreset6: TToolButton;
    tbPreset7: TToolButton;
    tbPreset8: TToolButton;
    ToolButton20: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    TOpenDialogPreset: TOpenDialog;
    TSaveDialogPreset: TSaveDialog;
    XMLPropStorage1: TXMLPropStorage;
    procedure acDeleteRowExecute(Sender: TObject);
    procedure acExitExecute(Sender: TObject);
    procedure acFileOpenAccept(Sender: TObject);
    procedure acFileSaveAsAccept(Sender: TObject);
    procedure acDebugExecute(Sender: TObject);
    procedure acHelpAboutExecute(Sender: TObject);
    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);
    procedure acShowHexFileExecute(Sender: TObject);
    procedure acStopExecute(Sender: TObject);
    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);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDropFiles(Sender: TObject; const FileNames: array of string);
    procedure MCSLabelClick(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
    procedure mnSaveClick(Sender: TObject);
    procedure pmExamplesPopup(Sender: TObject);
    procedure Shape1Paint(Sender: TObject);
    procedure Shape2Paint(Sender: TObject);
    procedure StringGrid1EditingDone(Sender: TObject);
    procedure StringGrid1Selection(Sender: TObject; aCol, aRow: integer);
    procedure tbPreset1Click(Sender: TObject);
    procedure tbPreset1ContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: boolean);
    procedure tbResetClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
    sps: TSPS;
    stopit: boolean;
    activeFile: string;
    dirty: boolean;
    lastNote: byte;
    Examples : TStringList;
    procedure initMidi;
    procedure playNote(note: byte);
    function readString(var line: string): boolean;
    procedure saveSection(filename: string; key: string);
    procedure loadSection(filename: string; key: string);

    procedure loadFile(filename: string);
    procedure programSps;
    procedure nextStep;
    procedure renumberGrid;
    procedure saveFile(filename: string);
    procedure selectAddress(addr: byte);
    procedure inputSps;
    procedure outputSps;
    procedure uploadFile;
    function serialUpload: string;
    procedure setDirty(Value: boolean);
    function checkDirty: boolean;
    procedure checkPresets;
    procedure makeHexFile(fileName: string);
    procedure setCaption;
    procedure addHeaderText;
    procedure loadPreset(filename: string);
    procedure savePreset(filename: string);
    procedure activateSps(enable: boolean);
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

uses MCSAbout, uTextUi, uSelectCom, MCSTools, MCSStrings, synaser,
  MCSIO, mcsintelhex, MCSLSU, MCSIniFiles, MCSWinHttp, luijsonutils;

{$R *.lfm}

procedure delayCallback(Value: integer);
begin
  Form1.EditDelay.Text := IntToStr(Value);
  Application.ProcessMessages;
end;

{ TForm1 }

var
  lsuCode: integer;

procedure TForm1.FormCreate(Sender: TObject);
var
  line: string;
begin
  Infobox.AppTitel := MCSLSU.GetLSUText('infobox', 'ID_APPTITLE', lsuCode);
  Infobox.CopyRight := MCSLSU.GetLSUText('infobox', 'ID_COPYRIGHT', lsuCode);
  Infobox.Build := MCSGetVersion(Application.ExeName);
  Infobox.AppID := 31;
  Infobox.AppURL :=
    'http://www.wk-music.de/pages/mcs/microcontroller/tps-sps-emulator.php';
  sps := TSPS.Create();
  sps.setDelayCallback(@delayCallback);
  addHeaderText;
  renumberGrid();
  cbTPSVersionChange(Sender);
  acStop.Enabled := False;
  ToolButton18.Align := alRight;
  MCSLabel.Align := alRight;
  cbAdrActual.Enabled := False;
  checkPresets();
  tbResetClick(nil);
  if Application.ParamCount >= 1 then
  begin
    line := Application.Params[1];
    loadFile(line);
  end;
  activateSps(False);
  Timer1.Enabled := True;
  MCSLSU.MakeForm('form1', 'ID_', form1);
  initMidi;
  Examples := TStringList.Create;
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);
var
  line: string;
begin
  if (SizeOF(FileNames) > 0) then
  begin
    line := FileNames[0];
    loadFile(line);
  end;
end;

procedure TForm1.MCSLabelClick(Sender: TObject);
begin
  ShExec2(self.Handle, InfoBox.AppURL);
end;

procedure TForm1.MenuItem1Click(Sender: TObject);
var i : integer;
begin
  // todo
  if (Sender is TMenuItem) then begin
    i := TMenuItem(Sender).Tag;
  end;
end;

procedure TForm1.mnSaveClick(Sender: TObject);
begin
  Statusbar1.SimpleText := Sender.ClassName;
end;

procedure TForm1.pmExamplesPopup(Sender: TObject);
var
  i: integer;
  myName: string;
  myMenu: TMenuItem;
  jsonString: string;
  Data, JArray: TJSONData;
  JItem: TJSONData;
begin
  for i := pmExamples.Items.Count - 1 downto 0 do
  begin
    myMenu := pmExamples.Items[i];
    myMenu.Free;
  end;
  pmExamples.Items.Clear;
  Examples.Clear;

  try
    jsonString := DownloadFile('http://wkla.no-ip.biz/down/examples.json');
    Data := StringToJSONData(jsonString);
    JArray := GetJSONProp(TJSONObject(Data), 'examples');
    for i := 1 to TJSONArray(JArray).Count do
    begin
      JItem := TJSONArray(JArray).Items[i-1];
      myName := GetJsonProp(TJSONObject(JItem), 'name', '');
      myName := format('%.2d - %s', [i, myName]);
      myMenu := TMenuItem.Create(pmExamples);
      myMenu.Caption := myName;
      myMenu.Tag := i;
      myMenu.OnClick := @MenuItem1Click;
      pmExamples.Items.Add(myMenu);
      Examples.Add(GetJsonProp(TJSONObject(JItem), 'file', ''));
    end;
  except
  end;
end;

procedure TForm1.Shape1Paint(Sender: TObject);
var
  radius: integer;
  x, y: integer;
begin
  radius := round(Shape1.Width / 2);
  Shape1.Canvas.Brush.Color := clBlack;
  Shape1.canvas.MoveTo(radius, radius);
  x := radius - round(radius * cos(degtorad(sps.getServo1())));
  y := radius - round(radius * sin(degtorad(sps.getServo1())));
  Shape1.Canvas.LineTo(x, y);
end;

procedure TForm1.Shape2Paint(Sender: TObject);
var
  radius: integer;
  x, y: integer;
begin
  radius := round(Shape1.Width / 2);
  Shape2.Canvas.Brush.Color := clBlack;
  Shape2.canvas.MoveTo(radius, radius);
  x := radius - round(radius * cos(degtorad(sps.getServo2())));
  y := radius - round(radius * sin(degtorad(sps.getServo2())));
  Shape2.Canvas.LineTo(x, y);
end;

procedure TForm1.acExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TForm1.acDeleteRowExecute(Sender: TObject);
var
  i: integer;
begin
  i := StringGrid1.Row;
  StringGrid1.DeleteRow(i);
  renumberGrid();
end;

procedure TForm1.acFileOpenAccept(Sender: TObject);
var
  filename: string;
begin
  filename := (Sender as TFileOpen).Dialog.FileName;
  loadFile(filename);
end;

procedure TForm1.loadFile(filename: string);
var
  i: integer;
  f: Text;
  line: string;
  list: TStringList;
begin
  if (checkDirty()) then
  begin
    if (FileExists(filename)) then
    begin
      acNew.Execute;
      list := TStringList.Create;
      i := 1;
      AssignFile(f, filename);
      Reset(f);
      while (not EOF(f)) do
      begin
        if (i + 1 > StringGrid1.RowCount) then
        begin
          StringGrid1.RowCount := StringGrid1.RowCount + 1;
        end;
        readln(f, line);
        if (Pos('#', line) = 1) then
        begin
          line := RightstrPos(line, 2);
          if (Pos('TPS:', line) = 1) then
          begin
            line := RightstrPos(line, 5);
            cbTPSVersion.Text := line;
            cbTPSVersionChange(nil);
          end;
        end
        else
        begin
          MCSStrings.DelimSepTextToStringlist(line, '"', ',', list);
          if list.Count > 0 then
            Stringgrid1.Cells[0, i] := list[0];
          if list.Count > 1 then
            Stringgrid1.Cells[1, i] := list[1];
          if list.Count > 2 then
            Stringgrid1.Cells[2, i] := list[2];
          if list.Count > 3 then
            Stringgrid1.Cells[4, i] := list[3];
          list.Clear;
          i := i + 1;
        end;
      end;
      CloseFile(f);
      list.Free;
      activeFile := filename;
      renumberGrid();
      addHeaderText;
      setCaption();
      setDirty(False);

    end;
  end;
end;

procedure TForm1.acFileSaveAsAccept(Sender: TObject);
var
  filename: string;
begin
  filename := (Sender as TFileSaveAs).Dialog.FileName;
  saveFile(filename);
end;

procedure TForm1.saveFile(filename: string);
var
  x, i: integer;
  f: Text;
  line: string;
begin
  if (filename = '') then
  begin
    if SaveDialog1.Execute() then
    begin
      filename := SaveDialog1.FileName;
    end;
  end;
  if (filename <> '') then
  begin
    AssignFile(f, filename);
    Rewrite(f);
    line := '#TPS:' + cbTPSVersion.Text;
    Writeln(f, line);
    i := StringGrid1.RowCount;
    for x := 1 to i - 1 do
    begin
      if (StringGrid1.Cells[1, x] <> '') then
      begin
        line := StringGrid1.Cells[0, x] + ',' + StringGrid1.Cells[1, x] +
          ',' + StringGrid1.Cells[2, x] + ',"' + StringGrid1.Cells[4, x] + '"';
        Writeln(f, line);
      end;
    end;
    CloseFile(f);
    setDirty(False);
    activeFile := filename;
    setCaption();
  end;
end;

procedure TForm1.acDebugExecute(Sender: TObject);
begin
  if (sps.isActive()) then
  begin
    acStopExecute(Sender);
  end
  else
  begin
    activateSps(True);
    acDebug.Enabled := True;
    acDebug.ImageIndex := 10;
    cbAdrActual.Enabled := True;
    acNextStep.Enabled := False;
    // sps programmieren
    programSps();
    // programm starten
    Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_START', lsuCode);
    sps.start();

    stopit := False;

    Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_RUNNING', lsuCode);
    while (not stopit) do
    begin
      nextStep();
      if (cbAdrActual.Checked) then
        selectAddress(sps.getAddress());
      Application.ProcessMessages;
    end;
    Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_STOPPED', lsuCode);
    cbAdrActual.Enabled := False;
    acNextStep.Enabled := True;
    sps.doReset();
  end;
end;

procedure TForm1.acHelpAboutExecute(Sender: TObject);
begin
  Infobox.Show;
end;

procedure TForm1.acHexFileExecute(Sender: TObject);
var
  filename: string;
begin
  filename := MCSIO.MCSExtractFileNameExlExt(activeFile) + '.hex';
  SaveHexFile.FileName := filename;
  if (SaveHexFile.Execute) then
  begin
    filename := SaveHexFile.FileName;
    makeHexFile(filename);
  end;
end;

procedure TForm1.acNewExecute(Sender: TObject);
begin
  if (checkDirty()) then
  begin
    StringGrid1.RowCount := 2;
    StringGrid1.Clean;
    addHeaderText();
    renumberGrid();
    activeFile := '';
    setCaption();
    setDirty(False);
  end;
end;

procedure TForm1.acNewRowExecute(Sender: TObject);
var
  myPos: integer;
  i, x: integer;
  eot: boolean;
begin
  eot := False;
  myPos := StringGrid1.Row;
  if (myPos = StringGrid1.RowCount - 1) then
    eot := True;
  StringGrid1.RowCount := StringGrid1.RowCount + 1;
  if (not eot) then
  begin
    for i := StringGrid1.RowCount - 2 downto myPos do
    begin
      for x := 1 to StringGrid1.ColCount - 1 do
      begin
        StringGrid1.Cells[x, i + 1] := StringGrid1.Cells[x, i];
      end;
    end;
    for x := 1 to StringGrid1.ColCount - 1 do
    begin
      StringGrid1.Cells[x, myPos] := '';
    end;
  end;
  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;
  com, Data: byte;
  tmp: string;
begin
  Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_PROGRAMMING', lsuCode);
  i := StringGrid1.RowCount;
  for x := 1 to i - 1 do
  begin
    com := 0;
    Data := 0;
    tmp := StringGrid1.Cells[1, x];
    if (tmp <> '') then
    begin
      com := HexToInt(tmp);
      tmp := StringGrid1.Cells[2, x];
      if (tmp <> '') then
        Data := HexToInt(tmp);
      Data := com * 16 + Data;
    end;
    sps.writeEEProm(x - 1, Data);
  end;
  // endekennzeichnung schreiben
  sps.writeEEProm(i, $ff);
end;

procedure TForm1.acNextStepExecute(Sender: TObject);
begin
  nextStep();
  selectAddress(sps.getAddress());
end;

procedure TForm1.acPresetLoadAccept(Sender: TObject);
var
  filename: string;
begin
  filename := (Sender as TFileOpen).Dialog.FileName;
  loadPreset(filename);
end;

procedure TForm1.acPresetSaveAccept(Sender: TObject);
var
  filename: string;
begin
  filename := (Sender as TFileSaveAs).Dialog.FileName;
  savePreset(filename);
end;

procedure TForm1.nextStep;
begin
  if (not sps.isActive()) then
  begin
    activateSps(True);
    programSps;
    sps.start();
    acStop.Enabled := True;
    acDebug.Enabled := False;
  end
  else
  begin
    acNextStep.Enabled := False;
    acStop.Enabled := False;
    inputSps();
    sps.nextStep();
    outputSps();
    acNextStep.Enabled := True;
    acStop.Enabled := True;
  end;
end;

procedure TForm1.acShowHexFileExecute(Sender: TObject);
var
  list: TStringList;
  i, x: integer;
  line, tmp: string;

  Value: byte;
begin
  Form2 := TForm2.Create(self);
  list := TStringList.Create();

  line := MCSLSU.GetLSUText('hexfile', 'ID_START_LINE', lsuCode);
  list.add(line);

  i := StringGrid1.RowCount;
  for x := 1 to i - 1 do
  begin
    if (StringGrid1.Cells[1, x] <> '') then
    begin
      tmp := '';
      if (StringGrid1.Cells[1, x] = '') then
      begin
        tmp := ' ';
      end
      else
      begin
        tmp := StringGrid1.Cells[1, x];
      end;
      if (StringGrid1.Cells[2, x] = '') then
      begin
        tmp := tmp + ' ';
      end
      else
      begin
        tmp := tmp + StringGrid1.Cells[2, x];
      end;

      line := StringGrid1.Cells[0, x] + ':  ' + tmp + '   ';

      Value := HexToInt(StringGrid1.Cells[1, x]);
      tmp := '';
      if (Value and 8) > 0 then
        tmp := tmp + 'X'
      else
        tmp := tmp + '0';
      if (Value and 4) > 0 then
        tmp := tmp + 'X'
      else
        tmp := tmp + '0';
      if (Value and 2) > 0 then
        tmp := tmp + 'X'
      else
        tmp := tmp + '0';
      if (Value and 1) > 0 then
        tmp := tmp + 'X'
      else
        tmp := tmp + '0';
      line := line + tmp + '     ';

      Value := HexToInt(StringGrid1.Cells[2, x]);
      tmp := '';
      if (Value and 8) > 0 then
        tmp := tmp + 'X'
      else
        tmp := tmp + '0';
      if (Value and 4) > 0 then
        tmp := tmp + 'X'
      else
        tmp := tmp + '0';
      if (Value and 2) > 0 then
        tmp := tmp + 'X'
      else
        tmp := tmp + '0';
      if (Value and 1) > 0 then
        tmp := tmp + 'X'
      else
        tmp := tmp + '0';
      line := line + tmp;

      line := line + '      ' + StringGrid1.Cells[3, x] + '   ,"' +
        StringGrid1.Cells[4, x] + '"';
      list.add(line);
    end;
  end;
  Form2.addHexFile(list);
  Form2.ShowModal;
  list.Free;
end;

procedure TForm1.acStopExecute(Sender: TObject);
begin

  if (sps.isActive()) then
  begin
    stopit := True;
    sps.break();
    acDebug.ImageIndex := 18;
    //   repeat
    //     Application.ProcessMessages;
    //   until (not sps.isDelayActive());
    sps.doReset();
    acStop.Enabled := False;
    acDebug.Enabled := True;
    outputSps();
    selectAddress(0);
    activateSps(False);
  end;
end;

procedure TForm1.acThisStepExecute(Sender: TObject);
var
  Data, com: byte;
  tmp: string;
begin
  inputSps();
  try
    tmp := StringGrid1.Cells[1, StringGrid1.Row];
    if (tmp <> '') then
    begin
      com := HexToInt(tmp);
      tmp := StringGrid1.Cells[2, StringGrid1.Row];
      if (tmp <> '') then
        Data := HexToInt(tmp);
      Data := com * 16 + Data;
    end;
    sps.doSingleCommand(Data);
  except
  end;
  outputSps();
end;

procedure TForm1.acFileSaveExecute(Sender: TObject);
begin
  saveFile(activeFile);
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;
  comServices: TStringList;
  comService: string;
  return: integer;
  hexFile: string;
  hexFormat: TIntelHexFormat;
  prgMem: array of byte;
  i, x: integer;
  com, Data: byte;
  tmp: string;
  arduinoPath: string;
  cmd, config, mcu: string;
  KeyName, StringValue: string;
  Res: WideString;
  Lines: TStringList;
  TimeOut: integer;
  error: boolean;

begin
  error := False;
  line := GetSerialPortNames;
  //  if (line <> '') then
  begin
    comServices := TStringList.Create;
    MCSStrings.DelimTextToStringlist(line, ',', comServices);
    return := mrOk;
    line := XMLPropStorage1.ReadString('ComPort', comServices[0]);
    frmSelectCom := TfrmSelectCom.Create(self);
    frmSelectCom.cbServices.Items.AddStrings(comServices);
    frmSelectCom.cbServices.Text := line;

    return := frmSelectCom.ShowModal;

    comService := frmSelectCom.cbServices.Text;
    XMLPropStorage1.WriteString('ComPort', comService);
    comServices.Free;

    if (return = mrOk) then
    begin
      hexFile := serialUpload;

      SdpoSerial1.Device := comService;
      SdpoSerial1.Active := True;

      if (not readString(line)) then
      begin
        error := True;
      end;
      if (not error) then
      begin
        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;

      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;
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
    Dec(TimeOut);
    Sleep(1000);
  end;
  if (Timeout > 0) then
  begin
    line := SdpoSerial1.ReadData;
    Result := True;
  end;
end;

procedure TForm1.setDirty(Value: boolean);
begin
  if (dirty <> Value) then
  begin
    dirty := Value;
    if (dirty) then
    begin
      if (Pos('*', Caption) = 0) then
      begin
        Caption := Caption + '*';
      end;
    end
    else
    begin
      if (Pos('*', Caption) > 0) then
      begin
        Caption := Leftstr(Caption, Pos('*', Caption) - 1);
      end;
    end;
  end;
end;

function TForm1.checkDirty: boolean;
var
  i: integer;
begin
  if (dirty) then
  begin
    i := MCSLSU.LSUAutoMsgBox('Messages', 'SAVE_CHANGES', MB_ICONQUESTION or
      MB_YESNOCANCEL);
    if (i = mrYes) then
    begin
      saveFile(activeFile);
      Result := True;
    end
    else if (i = mrNo) then
    begin
      setDirty(False);
      Result := True;
    end
    else
    begin
      Result := False;
    end;
  end
  else
  begin
    Result := True;
  end;
end;

procedure TForm1.checkPresets;
begin
  if XMLPropStorage1.ReadBoolean('preset_1.set', False) then
    tbPreset1.Caption := '1*'
  else
    tbPreset1.Caption := '1';
  if XMLPropStorage1.ReadBoolean('preset_2.set', False) then
    tbPreset2.Caption := '2*'
  else
    tbPreset2.Caption := '2';
  if XMLPropStorage1.ReadBoolean('preset_3.set', False) then
    tbPreset3.Caption := '3*'
  else
    tbPreset3.Caption := '3';
  if XMLPropStorage1.ReadBoolean('preset_4.set', False) then
    tbPreset4.Caption := '4*'
  else
    tbPreset4.Caption := '4';
  if XMLPropStorage1.ReadBoolean('preset_5.set', False) then
    tbPreset5.Caption := '5*'
  else
    tbPreset5.Caption := '5';
  if XMLPropStorage1.ReadBoolean('preset_6.set', False) then
    tbPreset6.Caption := '6*'
  else
    tbPreset6.Caption := '6';
  if XMLPropStorage1.ReadBoolean('preset_7.set', False) then
    tbPreset7.Caption := '7*'
  else
    tbPreset7.Caption := '7';
  if XMLPropStorage1.ReadBoolean('preset_8.set', False) then
    tbPreset7.Caption := '8*'
  else
    tbPreset7.Caption := '8';
end;

procedure TForm1.makeHexFile(fileName: string);
var
  i, x: integer;
  tmp: string;
  hexFormat: TIntelHexFormat;
  prgMem: array of byte;
  com, Data: byte;

begin
  i := StringGrid1.RowCount;
  SetLength(prgMem, i);

  for x := 1 to i - 1 do
  begin
    com := 0;
    Data := 0;
    tmp := StringGrid1.Cells[1, x];
    if (tmp <> '') then
    begin
      com := HexToInt(tmp);
      tmp := StringGrid1.Cells[2, x];
      if (tmp <> '') then
        Data := HexToInt(tmp);
      Data := com * 16 + Data;
    end;
    prgMem[x - 1] := Data;
  end;
  hexFormat := TIntelHexFormat.Create(prgMem, 8);
  tmp := hexFormat.Text;
  MCSIO.StrToFile(fileName, tmp);
  hexFormat.Free;
  SetLength(prgMem, 0);
end;

procedure TForm1.setCaption;
begin
  if (activeFile = '') then
  begin
    Caption := MCSLSU.GetLSUText('form1Captions', 'ID_CAPTION', lsuCode);
  end
  else
  begin
    Caption := MCSLSU.GetLSUText('form1Captions', 'ID_CAPTION', lsuCode) +
      ':' + ExtractFileName(activeFile);
  end;

end;

procedure TForm1.addHeaderText;
var
  i: integer;
begin
  for i := 0 to StringGrid1.Columns.Count - 1 do
  begin
    ;
    StringGrid1.Columns[i].Title.Caption :=
      MCSLSU.GetLSUText('form1Captions', StringGrid1.Columns[i].Title.Caption, lsuCode);
  end;
  StringGrid1.Cells[0, 0] := MCSLSU.GetLSUText('form1Captions',
    'ID_GRID_STORAGE', lsuCode);
  StringGrid1.Repaint;
end;

procedure TForm1.cbCommandChange(Sender: TObject);
var
  x: integer;
begin
  cbData.Items.Clear;
  x := cbCommand.ItemIndex;
  sps.getDatas(x, cbData.Items);
  if StringGrid1.Row > 0 then
  begin
    StringGrid1.Cells[1, StringGrid1.Row] := IntToHex(x, 1);
  end;
end;

procedure TForm1.cbDataChange(Sender: TObject);
var
  x: integer;
begin
  x := cbData.ItemIndex;
  if StringGrid1.Row > 0 then
  begin
    StringGrid1.Cells[2, StringGrid1.Row] := IntToHex(x, 1);
    StringGrid1.Cells[3, StringGrid1.Row] := sps.getCommandText(cbCommand.ItemIndex, x);
  end;
end;

procedure TForm1.cbTPSVersionChange(Sender: TObject);
begin
  if (cbTPSVersion.ItemIndex = 0) then
  begin
    // HOLTEC
    sps.setTPSVersion(Holtek);

    Label2.Visible := True;
    ADC2.Visible := True;
    PWM2.Visible := False;
    Label16.Visible := False;
    RC1.Visible := False;
    Label17.Visible := False;
    RC2.Visible := False;
    Servo1.Visible := False;
    Servo2.Visible := False;
    Shape1.Visible := False;
    Shape2.Visible := False;
    EditE.Visible := False;
    EditF.Visible := False;
    acUpload.Enabled := False;
    Label5.Visible := False;
    btnTone.Visible := False;
  end;
  if (cbTPSVersion.ItemIndex = 1) then
  begin
    // ATMega8
    sps.setTPSVersion(ATMega8);

    Label2.Visible := True;
    ADC2.Visible := True;
    PWM2.Visible := True;
    Label16.Visible := False;
    RC1.Visible := False;
    Label17.Visible := False;
    RC2.Visible := False;
    Servo1.Visible := False;
    Servo2.Visible := False;
    Shape1.Visible := False;
    Shape2.Visible := False;
    EditE.Visible := False;
    EditF.Visible := False;
    acUpload.Enabled := False;
    Label5.Visible := False;
    btnTone.Visible := False;
  end;
  if ((cbTPSVersion.ItemIndex = 2) or (cbTPSVersion.ItemIndex = 3)) then
  begin
    if (cbTPSVersion.ItemIndex = 2) then
    begin
      // ATMega84
      sps.setTPSVersion(ATTiny84);
      acUpload.Enabled := False;
      Label5.Visible := False;
      btnTone.Visible := False;
    end
    else
    begin
      // Arduino 328
      sps.setTPSVersion(Arduino);
      acUpload.Enabled := True;
      Label5.Visible := True;
      btnTone.Visible := True;
    end;

    Label2.Visible := True;
    ADC2.Visible := True;
    PWM2.Visible := True;
    Label16.Visible := True;
    RC1.Visible := True;
    Label17.Visible := True;
    RC2.Visible := True;
    Servo1.Visible := True;
    Servo2.Visible := True;
    Shape1.Visible := True;
    Shape2.Visible := True;

    EditE.Visible := True;
    EditF.Visible := True;
  end;
  cbCommand.Items.Clear;
  sps.getCommands(cbCommand.Items);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
  canClose := checkDirty();
end;

procedure TForm1.StringGrid1EditingDone(Sender: TObject);
var
  Value: string;
  x: integer;
begin
  // die aktuelle Zeile ist auch die letzte
  if ((StringGrid1.Row + 1) = StringGrid1.RowCount) then
  begin
    // es wurde auch was eingegeben
    Value := StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row];
    Value := trim(Value);
    if (Value <> '') then
    begin
      setDirty(True);
      StringGrid1.RowCount := StringGrid1.RowCount + 1;
      renumberGrid();
    end;
  end
  else
  begin
    x := StringGrid1.Row;
    StringGrid1.Cells[3, x] :=
      sps.getCommandText(HexToInt(StringGrid1.Cells[1, x]),
      HexToInt(StringGrid1.Cells[2, x]));
    setDirty(True);
  end;
end;

procedure TForm1.StringGrid1Selection(Sender: TObject; aCol, aRow: integer);
begin
  try
    cbCommand.ItemIndex := HexToInt(StringGrid1.Cells[1, aRow]);
    cbCommandChange(Sender);
    cbData.ItemIndex := HexToInt(StringGrid1.Cells[2, aRow]);
  except
  end;
end;

procedure TForm1.loadPreset(filename: string);
var
  x: integer;
  key: string;
begin
  for x := 1 to 8 do
  begin
    key := 'preset_' + IntToStr(x);
    loadSection(filename, key);
  end;
  checkPresets;
end;

procedure TForm1.savePreset(filename: string);
var
  x: integer;
  key: string;
begin
  for x := 1 to 8 do
  begin
    key := 'preset_' + IntToStr(x);
    saveSection(filename, key);
  end;
end;

procedure TForm1.activateSps(enable: boolean);
begin
  GBControl.Enabled := enable;
  GBInternal.Enabled := enable;
  GBOutput.Enabled := enable;
  ;
end;

procedure TForm1.saveSection(filename: string; key: string);
begin
  WriteIniBool(key, 'set', XMLPropStorage1.ReadBoolean(key + '.set', False), filename);
  WriteIniBool(key, 'prg', XMLPropStorage1.ReadBoolean(key + '.prg', False), filename);
  WriteIniBool(key, 'sel', XMLPropStorage1.ReadBoolean(key + '.sel', False), filename);
  WriteIniBool(key, 'input1', XMLPropStorage1.ReadBoolean(key + '.input1', False),
    filename);
  WriteIniBool(key, 'input2', XMLPropStorage1.ReadBoolean(key + '.input2', False),
    filename);
  WriteIniBool(key, 'input3', XMLPropStorage1.ReadBoolean(key + '.input3', False),
    filename);
  WriteIniBool(key, 'input4', XMLPropStorage1.ReadBoolean(key + '.input4', False),
    filename);
  WriteIniInteger(key, 'adc1', XMLPropStorage1.ReadInteger(key + '.adc1', 0), filename);
  WriteIniInteger(key, 'adc2', XMLPropStorage1.ReadInteger(key + '.adc2', 0), filename);
  WriteIniInteger(key, 'rc1', XMLPropStorage1.ReadInteger(key + '.rc1', 0), filename);
  WriteIniInteger(key, 'rc2', XMLPropStorage1.ReadInteger(key + '.rc2', 0), filename);
end;

procedure TForm1.loadSection(filename: string; key: string);
begin
  XMLPropStorage1.WriteBoolean(key + '.set', ReadIniBool(key, 'set', False, filename));
  XMLPropStorage1.WriteBoolean(key + '.prg', ReadIniBool(key, 'prg', False, filename));
  XMLPropStorage1.WriteBoolean(key + '.sel', ReadIniBool(key, 'sel', False, filename));
  XMLPropStorage1.WriteBoolean(key + '.input1', ReadIniBool(key,
    'input1', False, filename));
  XMLPropStorage1.WriteBoolean(key + '.input2', ReadIniBool(key,
    'input2', False, filename));
  XMLPropStorage1.WriteBoolean(key + '.input3', ReadIniBool(key,
    'input3', False, filename));
  XMLPropStorage1.WriteBoolean(key + '.input4', ReadIniBool(key,
    'input4', False, filename));
  XMLPropStorage1.WriteInteger(key + '.adc1', ReadIniInteger(key, 'adc1', 0, filename));
  XMLPropStorage1.WriteInteger(key + '.adc2', ReadIniInteger(key, 'adc2', 0, filename));
  XMLPropStorage1.WriteInteger(key + '.rc1', ReadIniInteger(key, 'rc1', 0, filename));
  XMLPropStorage1.WriteInteger(key + '.rc2', ReadIniInteger(key, 'rc2', 0, filename));
end;

procedure TForm1.tbPreset1Click(Sender: TObject);
var
  key: string;
begin
  if Sender = tbPreset1 then
    key := 'preset_1'
  else
  if Sender = tbPreset2 then
    key := 'preset_2'
  else
  if Sender = tbPreset3 then
    key := 'preset_3'
  else
  if Sender = tbPreset4 then
    key := 'preset_4'
  else
  if Sender = tbPreset5 then
    key := 'preset_5'
  else
  if Sender = tbPreset6 then
    key := 'preset_6'
  else
  if Sender = tbPreset7 then
    key := 'preset_7'
  else
  if Sender = tbPreset8 then
    key := 'preset_8';

  tbSel.Checked := XMLPropStorage1.ReadBoolean(key + '.prg', tbSel.Checked);
  tbPrg.Checked := XMLPropStorage1.ReadBoolean(key + '.sel', tbPrg.Checked);
  Din1.Checked := XMLPropStorage1.ReadBoolean(key + '.input1', Din1.Checked);
  Din2.Checked := XMLPropStorage1.ReadBoolean(key + '.input2', Din2.Checked);
  Din3.Checked := XMLPropStorage1.ReadBoolean(key + '.input3', Din3.Checked);
  Din4.Checked := XMLPropStorage1.ReadBoolean(key + '.input4', Din4.Checked);
  ADC1.Value := XMLPropStorage1.ReadInteger(key + '.adc1', ADC1.Value);
  ADC2.Value := XMLPropStorage1.ReadInteger(key + '.adc2', ADC2.Value);
  RC1.Value := XMLPropStorage1.ReadInteger(key + '.rc1', RC1.Value);
  RC2.Value := XMLPropStorage1.ReadInteger(key + '.rc2', RC2.Value);
end;

procedure TForm1.tbPreset1ContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: boolean);
var
  key: string;
begin
  if Sender = tbPreset1 then
    key := 'preset_1'
  else
  if Sender = tbPreset2 then
    key := 'preset_2'
  else
  if Sender = tbPreset3 then
    key := 'preset_3'
  else
  if Sender = tbPreset4 then
    key := 'preset_4'
  else
  if Sender = tbPreset5 then
    key := 'preset_5'
  else
  if Sender = tbPreset6 then
    key := 'preset_6'
  else
  if Sender = tbPreset7 then
    key := 'preset_7'
  else
  if Sender = tbPreset8 then
    key := 'preset_8';

  XMLPropStorage1.WriteBoolean(key + '.set', True);
  XMLPropStorage1.WriteBoolean(key + '.prg', tbPrg.Checked);
  XMLPropStorage1.WriteBoolean(key + '.sel', tbSel.Checked);
  XMLPropStorage1.WriteBoolean(key + '.input1', Din1.Checked);
  XMLPropStorage1.WriteBoolean(key + '.input2', Din2.Checked);
  XMLPropStorage1.WriteBoolean(key + '.input3', Din3.Checked);
  XMLPropStorage1.WriteBoolean(key + '.input4', Din4.Checked);
  XMLPropStorage1.WriteInteger(key + '.adc1', ADC1.Value);
  XMLPropStorage1.WriteInteger(key + '.adc2', ADC2.Value);
  XMLPropStorage1.WriteInteger(key + '.rc1', RC1.Value);
  XMLPropStorage1.WriteInteger(key + '.rc2', RC2.Value);
  checkPresets();
end;

procedure TForm1.tbResetClick(Sender: TObject);
begin
  tbPrg.Checked := False;
  tbSel.Checked := False;
  Din1.Checked := False;
  Din2.Checked := False;
  Din3.Checked := False;
  Din4.Checked := False;
  ADC1.Value := 0;
  ADC2.Value := 0;
  RC1.Value := 8;
  RC2.Value := 8;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  jsonString: string;
  Data: TJSONData;
  iNetVersion, version: string;
  thisVersion, iVersion: TVersionRecord;

begin
  MCSLabel.AutoSize := True;
  Timer1.Enabled := False;
  MCSLabel.Hint := InfoBox.versionHint;
  if (InfoBox.newVersion) then
  begin
    MCSLabel.Font.Color := clred;
    MCSLabel.Hint := InfoBox.versionHint + chr($0a) + chr($0d) +
      MCSLSU.GetLSUText('form1Captions', 'ID_CLICK_HERE', lsuCode);
  end;
  MCSLabel.Caption := InfoBox.versionText;
end;

procedure TForm1.renumberGrid;
var
  x, i: integer;
begin
  i := StringGrid1.RowCount;
  for x := 1 to i - 1 do
  begin
    StringGrid1.Cells[0, x] := '0x' + inttohex(x - 1, 2);
    if (StringGrid1.Cells[1, x] = '') then
      StringGrid1.Cells[1, x] := '0';
    if (StringGrid1.Cells[2, x] = '') then
      StringGrid1.Cells[2, x] := '0';
    StringGrid1.Cells[3, x] :=
      sps.getCommandText(HexToInt(StringGrid1.Cells[1, x]),
      HexToInt(StringGrid1.Cells[2, x]));
  end;
end;

procedure TForm1.selectAddress(addr: byte);
begin
  StringGrid1.Row := addr + 1;
  Application.ProcessMessages;
end;

procedure TForm1.inputSps;
begin
  sps.setDin1(Din1.Checked);
  sps.setDin2(Din2.Checked);
  sps.setDin3(Din3.Checked);
  sps.setDin4(Din4.Checked);
  sps.setADC1(ADC1.Value);
  sps.setADC2(ADC2.Value);
  sps.setRC1(RC1.Value);
  sps.setRC2(RC2.Value);
  sps.setSPrg(tbPrg.Checked);
  sps.setSSel(tbSel.Checked);
end;

procedure TForm1.outputSps;
var
  List: TStrings;
  i: integer;
begin
  if sps.isDout1() then
    ShapeOut1.Brush.Color := clRed
  else
    ShapeOut1.Brush.Color := clWhite;
  if sps.isDout2() then
    ShapeOut2.Brush.Color := clRed
  else
    ShapeOut2.Brush.Color := clWhite;
  if sps.isDout3() then
    ShapeOut3.Brush.Color := clRed
  else
    ShapeOut3.Brush.Color := clWhite;
  if sps.isDout4() then
    ShapeOut4.Brush.Color := clRed
  else
    ShapeOut4.Brush.Color := clWhite;

  PWM1.Text := IntToStr(sps.getPWM1());
  PWM2.Text := IntToStr(sps.getPWM2());
  Servo1.Text := IntToStr(sps.getServo1());
  Shape1.Repaint;
  Servo2.Text := IntToStr(sps.getServo2());
  Shape2.Repaint;
  EditA.Text := IntToStr(sps.getARegister());
  EditB.Text := IntToStr(sps.getBRegister());
  EditC.Text := IntToStr(sps.getCRegister());
  EditD.Text := IntToStr(sps.getDRegister());
  EditE.Text := IntToStr(sps.getERegister());
  EditF.Text := IntToStr(sps.getFRegister());
  EditAddr.Text := '0x' + IntToHex(sps.getAddress(), 2);
  EditRAdr.Text := '0x' + IntToHex(sps.getRAdr(), 2);
  EditPage.Text := '0x' + IntToHex(sps.getPage(), 2);
  if (sps.getJump() > 0) then
    EditJump.Text := '0x' + IntToHex(sps.getJump(), 2)
  else
    EditJump.Text := '';
  if (sps.getTone() > 0) then
  begin
    ImageList2.GetBitmap(23, btnTone.Glyph);
    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
    sps.getStack(List);
    lbStack.Clear;
    for i := 0 to List.Count - 1 do
    begin
      lbStack.Items.Add(IntToStr(i) + ':' + List[i]);
    end;
  finally
    List.Free;
  end;

end;

end.