new version with hardware emulation part

SPS_EMU.000

@@ -2,9 +2,9 @@
 LSUTextFile=1
 Copyrigth=MCS Media Computer Software
 [LSUInfo]
-CompileDate=23.07.2021
-CompileTime=16:42:05
+CompileDate=28.09.2021
+CompileTime=15:12:44
 Name=Wilfried Klaas
-LSUBinFile=.\SPS_EMU.lsu
-LSUTextFile=.\SPS_EMU.
+LSUBinFile=E:\DATEN\Git-box\SPS_Emulator\SPS_Emu.lsu
+LSUTextFile=E:\DATEN\Git-box\SPS_Emulator\SPS_Emu.
 RegString=

SPS_EMU.001

@@ -63,6 +63,7 @@ ID_INPUT_3=Input &3
 ID_INPUT_2=Input &2
 ID_INPUT_1=Input &1
 ID_REFRESH_ADDR=Refresh address
+ID_HARDWARE_EMULATOR=Hardware Emu
 ID_IGNORE_DELAY=Ignore Delay
 ID_MNEMONIC=Instruction
 ID_MNE_DATA=Data

SPS_EMU.044

@@ -63,6 +63,7 @@ ID_INPUT_3=Input &3
 ID_INPUT_2=Input &2
 ID_INPUT_1=Input &1
 ID_REFRESH_ADDR=Refresh address
+ID_HARDWARE_EMULATOR=Hardware Emu
 ID_IGNORE_DELAY=Ignore Delay
 ID_MNEMONIC=Instruction
 ID_MNE_DATA=Data

SPS_EMU.049

@@ -63,6 +63,7 @@ ID_INPUT_3=Eingang &3
 ID_INPUT_2=Eingang &2
 ID_INPUT_1=Eingang &1
 ID_REFRESH_ADDR=Adresse aktualisieren
+ID_HARDWARE_EMULATOR=Hardware Emu
 ID_IGNORE_DELAY=Delay ignorieren
 ID_MNEMONIC=Befehle
 ID_MNE_DATA=Daten

ugui.lfm

@@ -1,7 +1,7 @@
 object Form1: TForm1
-  Left = 363
+  Left = 262
   Height = 712
-  Top = 121
+  Top = 112
   Width = 959
   AllowDropFiles = True
   Caption = 'SPS Emulator'
@@ -679,7 +679,6 @@ object Form1: TForm1
         Top = 24
         Width = 100
         ItemHeight = 15
-        OnChange = cbSerialNamesChange
         Style = csDropDownList
         TabOrder = 3
       end
@@ -688,6 +687,8 @@ object Form1: TForm1
         Height = 88
         Top = 56
         Width = 293
+        ReadOnly = True
+        ScrollBars = ssVertical
         TabOrder = 4
       end
     end
@@ -725,26 +726,26 @@ object Form1: TForm1
       Caption = 'ID_SAVE'
     end
     object ToolButton4: TToolButton
-      Left = 299
+      Left = 303
       Height = 26
       Top = 2
       Caption = 'ToolButton4'
       Style = tbsSeparator
     end
     object ToolButton6: TToolButton
-      Left = 337
+      Left = 345
       Top = 2
       Action = acNextStep
       Caption = 'ID_EXEC_NEXT'
     end
     object ToolButton7: TToolButton
-      Left = 363
+      Left = 371
       Top = 2
       Action = acStop
       Caption = 'ID_EXEC_STOP'
     end
     object ToolButton5: TToolButton
-      Left = 389
+      Left = 397
       Top = 2
       Action = acDebug
       Caption = 'ID_EXEC_DEBUG'
@@ -782,32 +783,32 @@ object Form1: TForm1
       ParentFont = False
     end
     object ToolButton8: TToolButton
-      Left = 331
+      Left = 337
       Height = 26
       Top = 2
       Caption = 'ToolButton8'
       Style = tbsSeparator
     end
     object ToolButton9: TToolButton
-      Left = 305
+      Left = 311
       Top = 2
       Action = acThisStep
     end
     object ToolButton10: TToolButton
-      Left = 221
+      Left = 225
       Top = 2
       Action = acShowHexFile
       Caption = 'ID_PRGFILE'
     end
     object ToolButton11: TToolButton
-      Left = 215
+      Left = 217
       Height = 26
       Top = 2
       Caption = 'ToolButton11'
       Style = tbsSeparator
     end
     object ToolButton12: TToolButton
-      Left = 247
+      Left = 251
       Top = 2
       Action = acUpload
       Caption = 'ID_PRGULOAD'
@@ -825,19 +826,19 @@ object Form1: TForm1
       Style = tbsSeparator
     end
     object ToolButton15: TToolButton
-      Left = 163
+      Left = 165
       Top = 2
       Action = acNewRow
       Caption = 'ID_NEWLINE'
     end
     object ToolButton16: TToolButton
-      Left = 189
+      Left = 191
       Top = 2
       Action = acDeleteRow
       Caption = 'ID_DELLINE'
     end
     object ToolButton17: TToolButton
-      Left = 415
+      Left = 653
       Height = 26
       Top = 2
       Caption = 'ToolButton17'
@@ -862,7 +863,7 @@ object Form1: TForm1
       OptimalFill = True
     end
     object ToolButton19: TToolButton
-      Left = 273
+      Left = 277
       Top = 2
       Action = acHexFile
       Caption = 'ID_HEXFILE'
@@ -920,14 +921,10 @@ object Form1: TForm1
           Width = 32
         end      
         item
-          MinSize = 10
-          MaxSize = 200
           ReadOnly = True
           Title.Caption = 'ID_GRID_DESCRIPTION'
         end      
         item
-          MinSize = 10
-          MaxSize = 200
           SizePriority = 2
           Title.Caption = 'ID_GRID_COMMENT'
           Width = 128
@@ -1049,8 +1046,8 @@ object Form1: TForm1
   end
   object ActionList1: TActionList
     Images = ImageList3
-    Left = 723
-    Top = 576
+    Left = 123
+    Top = 608
     object acExit: TAction
       Category = 'File'
       Caption = 'ID_EXIT'
@@ -1190,33 +1187,33 @@ object Form1: TForm1
       end>
     OnSavingProperties = XMLPropStorage1SavingProperties
     OnRestoringProperties = XMLPropStorage1RestoringProperties
-    Left = 688
-    Top = 576
+    Left = 88
+    Top = 608
   end
   object SaveDialog1: TSaveDialog
     Title = 'ID_SAVE_TPS'
     DefaultExt = '.tps'
-    Left = 819
-    Top = 576
+    Left = 219
+    Top = 608
   end
   object Timer1: TTimer
     Enabled = False
     Interval = 10000
     OnTimer = Timer1Timer
-    Left = 849
-    Top = 576
+    Left = 249
+    Top = 608
   end
   object SaveHexFile: TSaveDialog
     Title = 'ID_SAVE_HEX'
     DefaultExt = '.hex'
-    Left = 880
-    Top = 576
+    Left = 280
+    Top = 608
   end
   object ImageList2: TImageList
     Height = 32
     Width = 32
-    Left = 659
-    Top = 576
+    Left = 59
+    Top = 608
     Bitmap = {
       4C6969010000200000002000000080804000808040007C7C3EFF484824FF1A1A
       0DFF040402FF040402FF1A1A0DFF484824FF7C7C3EFF80804000808040008080
@@ -47438,13 +47435,13 @@ object Form1: TForm1
     FlowControl = fcNone
     StopBits = sbOne
     Device = 'COM1'
-    Left = 790
-    Top = 576
+    Left = 190
+    Top = 608
   end
   object pmExamples: TPopupMenu
     OnPopup = pmExamplesPopup
-    Left = 755
-    Top = 576
+    Left = 155
+    Top = 608
     object MenuItem1: TMenuItem
       Caption = '01-Blink'
       OnClick = MenuItem1Click
@@ -47453,8 +47450,8 @@ object Form1: TForm1
   object ImageList3: TImageList
     Height = 20
     Width = 20
-    Left = 624
-    Top = 576
+    Left = 24
+    Top = 608
     Bitmap = {
       4C69690100001400000014000000FFFFFF00BABABA3E333333C5020202FA1111
       11E96C6C6C8CF3F3F309FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
@@ -65514,7 +65511,7 @@ object Form1: TForm1
     FileName = 'mycobit'
     Filter = 'Default|*'
     Options = [ofNoTestFileCreate, ofEnableSizing, ofViewDetail]
-    Left = 912
-    Top = 576
+    Left = 312
+    Top = 608
   end
 end

ugui.pas

@@ -170,7 +170,6 @@ type
     procedure cbDataChange(Sender: TObject);
     procedure cbHardwareEmuChange(Sender: TObject);
     procedure cbIgnDlyChange(Sender: TObject);
-    procedure cbSerialNamesChange(Sender: TObject);
     procedure cbTPSVersionChange(Sender: TObject);
     procedure FormActivate(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
@@ -232,6 +231,8 @@ type
     procedure enableMicrobit(enable: boolean);
     procedure outputMicrobit();
     procedure inputMicrobit();
+    function checkSerialEmu(): boolean;
+    procedure log4SerialEmu(line : string);
   public
     { public declarations }
   end;
@@ -956,7 +957,8 @@ begin
   outputSps();
   selectAddress(0);
   activateSps(False);
-  if SdpoSerial1.Active then begin
+  if SdpoSerial1.Active then
+  begin
     SdpoSerial1.Close;
   end;
 end;
@@ -1175,7 +1177,7 @@ begin
     while ((not SdpoSerial1.DataAvailable) and (TimeOut > 0)) do
     begin
       Dec(TimeOut);
-      Sleep(1000);
+      Sleep(100);
     end;
   end;
   if (Timeout > 0) then
@@ -1391,12 +1393,13 @@ begin
 end;
 
 procedure TForm1.cbHardwareEmuChange(Sender: TObject);
-var line : String;
-    comServices : TStringList;
+var
+  line: string;
+  comServices: TStringList;
 begin
   if cbHardwareEmu.Checked then
   begin
-    cbSerialNames.Enabled:=true;
+    cbSerialNames.Enabled := True;
     line := GetSerialPortNames;
     comServices := TStringList.Create;
     MCSStrings.DelimTextToStringlist(line, ',', comServices);
@@ -1404,7 +1407,6 @@ begin
     cbSerialNames.Items.AddStrings(comServices);
     cbSerialNames.Text := line;
     comServices.Free;
-    cbSerialNamesChange(sender);
   end;
 end;
 
@@ -1413,47 +1415,6 @@ begin
   sps.SetIgnoreDelay(cbIgnDly.Checked);
 end;
 
-procedure TForm1.cbSerialNamesChange(Sender: TObject);
-var retries : integer;
-    error : boolean;
-    line : string;
-begin
-  SdpoSerial1.Active := False;
-  SdpoSerial1.BaudRate := br__9600;
-  if cbTPSVersion.ItemIndex = 5 then
-  begin
-    // Micro:bit V2 auto programm
-    SdpoSerial1.BaudRate := br115200;
-  end;
-
-  SdpoSerial1.Device := cbSerialNames.Text;
-  SdpoSerial1.Active := True;
-  retries := 10;
-  error := True;
-  while retries > 0 do
-  begin
-    SdpoSerial1.WriteData('p');
-    if (readString(line, True)) then
-    begin
-      if (pos('command', line) > 0) then
-      begin
-        retries := 0;
-        error := False;
-      end;
-    end;
-    if error then
-    begin
-      Form2.Memo1.Append('>h');
-      SdpoSerial1.WriteData('h');
-    end;
-    Dec(retries);
-  end;
-  if (error) then
-  begin
-    LSUAutoMsgBox('Messages', 'ID_NOT_READY', MB_OK + MB_ICONERROR);
-  end;
-end;
-
 procedure TForm1.cbTPSVersionChange(Sender: TObject);
 begin
   if (cbTPSVersion.ItemIndex = 0) then
@@ -1482,6 +1443,7 @@ begin
     ADC2.Value := 0;
     ADC2.MaxValue := 15;
     enableMicrobit(False);
+    cbHardwareEmu.Enabled:= false;
   end;
   if (cbTPSVersion.ItemIndex = 1) then
   begin
@@ -1509,6 +1471,7 @@ begin
     ADC2.Value := 0;
     ADC2.MaxValue := 15;
     enableMicrobit(False);
+    cbHardwareEmu.Enabled:= false;
   end;
   if ((cbTPSVersion.ItemIndex = 2) or (cbTPSVersion.ItemIndex = 3)) then
   begin
@@ -1519,6 +1482,7 @@ begin
       acUpload.Enabled := False;
       Label5.Visible := False;
       btnTone.Visible := False;
+      cbHardwareEmu.Enabled:= false;
     end
     else
     begin
@@ -1527,6 +1491,7 @@ begin
       acUpload.Enabled := True;
       Label5.Visible := True;
       btnTone.Visible := True;
+      cbHardwareEmu.Enabled:= true;
     end;
 
     Label2.Visible := True;
@@ -1576,6 +1541,7 @@ begin
     ADC2.Value := 0;
     ADC2.MaxValue := 15;
     enableMicrobit(False);
+    cbHardwareEmu.Enabled:= false;
   end;
 
   if (cbTPSVersion.ItemIndex = 5) then
@@ -1604,6 +1570,7 @@ begin
     ADC2.Value := 0;
     ADC2.MaxValue := 15;
     enableMicrobit(True);
+    cbHardwareEmu.Enabled:= false;
   end;
 
   cbCommand.Items.Clear;
@@ -1728,6 +1695,69 @@ begin
   end;
 end;
 
+function TForm1.checkSerialEmu(): boolean;
+var
+  retries: integer;
+  error: boolean;
+  line: string;
+begin
+  if cbHardwareEmu.Checked then
+  begin
+    if not SdpoSerial1.Active then
+    begin
+      mmLogMessages.Lines.Insert(0, 'start comunication');
+      SdpoSerial1.BaudRate := br__9600;
+      if cbTPSVersion.ItemIndex = 5 then
+      begin
+        // Micro:bit V2 auto programm
+        SdpoSerial1.BaudRate := br115200;
+      end;
+
+      SdpoSerial1.Device := cbSerialNames.Text;
+      SdpoSerial1.Active := True;
+      retries := 10;
+      error := True;
+      while retries > 0 do
+      begin
+        SdpoSerial1.WriteData('p' + CRLF);
+        if (readString(line, True)) then
+        begin
+          if (pos('command', line) > 0) then
+          begin
+            retries := 0;
+            error := False;
+          end;
+        end;
+        if error then
+        begin
+          SdpoSerial1.WriteData('h' + CRLF);
+        end;
+        Dec(retries);
+      end;
+      if (error) then
+      begin
+        LSUAutoMsgBox('Messages', 'ID_NOT_READY', MB_OK + MB_ICONERROR);
+      end;
+    end;
+    Result := True;
+  end
+  else
+  begin
+    if SdpoSerial1.Active then
+      SdpoSerial1.Close;
+    Result := False;
+  end;
+end;
+
+procedure TForm1.log4SerialEmu(line: string);
+begin
+  while mmLogMessages.Lines.Count > 100 do
+  begin
+    mmLogMessages.Lines.Delete(mmLogMessages.Lines.Count-1);
+  end;
+  mmLogMessages.Lines.Insert(0, line);
+end;
+
 procedure TForm1.outputMicrobit();
 var
   image: TMBImage;
@@ -2018,25 +2048,56 @@ begin
 end;
 
 procedure TForm1.inputSps;
-var line : string;
-    value : longint;
+var
+  line: string;
+  Value: longint;
 begin
-  if cbHardwareEmu.Checked then begin
+  if checkSerialEmu() then
+  begin
     while SdpoSerial1.DataAvailable do
     begin
-      readString(line, false);
-      mmLogMessages.Lines.Insert(0, line);
+      readString(line, False);
+      log4SerialEmu(line);
     end;
-    SdpoSerial1.WriteData('i');
-    readString(line, true);
+    SdpoSerial1.WriteData('i' + CR + LF);
+    readString(line, True);
+    line := StringReplace(line, CR + LF, '', [rfReplaceAll]);
+    log4SerialEmu(line + ' ' + IntToHex(Value, 2));
     line := RightstrPos(line, 3);
-    value := HexToInt(line);
-    mmLogMessages.Lines.Insert(0, line + ' ' + IntToHex(value, 2));
+    Value := HexToInt(line);
+
+    Din1.Checked := (Value and $01) > 0;
+    Din2.Checked := (Value and $02) > 0;
+    Din3.Checked := (Value and $04) > 0;
+    Din4.Checked := (Value and $08) > 0;
+
+    SdpoSerial1.WriteData('b' + CR + LF);
+    readString(line, True);
+    line := StringReplace(line, CR + LF, '', [rfReplaceAll]);
+    log4SerialEmu(line + ' ' + IntToHex(Value, 2));
+    line := RightstrPos(line, 3);
+    Value := HexToInt(line);
+
+    tbPrg.Checked := not ((Value and $01) > 0);
+    tbSel.Checked := not ((Value and $02) > 0);
 
-    Din1.Checked:= (value and $01) > 0;
-    Din2.Checked:= (value and $02) > 0;
-    Din3.Checked:= (value and $04) > 0;
-    Din4.Checked:= (value and $08) > 0;
+    SdpoSerial1.WriteData('a1' + CR + LF);
+    readString(line, True);
+    line := StringReplace(line, CR + LF, '', [rfReplaceAll]);
+    log4SerialEmu(line + ' ' + IntToHex(Value, 2));
+    line := RightstrPos(line, 4);
+    Value := HexToInt(line);
+
+    ADC1.Value := Value;
+
+    SdpoSerial1.WriteData('a2' + CR + LF);
+    readString(line, True);
+    line := StringReplace(line, CR + LF, '', [rfReplaceAll]);
+    log4SerialEmu(line + ' ' + IntToHex(Value, 2));
+    line := RightstrPos(line, 4);
+    Value := HexToInt(line);
+
+    ADC2.Value := Value;
   end;
   sps.setDin1(Din1.Checked);
   sps.setDin2(Din2.Checked);
@@ -2054,7 +2115,33 @@ procedure TForm1.outputSps;
 var
   List: TStrings;
   i: integer;
+  Value: integer;
+  line : string;
 begin
+  if checkSerialEmu() then
+  begin
+    Value := 0;
+    if sps.isDout1() then
+      Value := Value + 1;
+    if sps.isDout2() then
+      Value := Value + 2;
+    if sps.isDout3() then
+      Value := Value + 4;
+    if sps.isDout4() then
+      Value := Value + 8;
+    line := 'o' + IntToHex(Value, 1);
+    SdpoSerial1.WriteData(line);
+    log4SerialEmu(line);
+
+    line := 'd1:' + IntToHex(sps.getPWM1(), 2);
+    SdpoSerial1.WriteData(line);
+    log4SerialEmu(line);
+
+    line := 'd2:' + IntToHex(sps.getPWM2(), 2);
+    SdpoSerial1.WriteData(line);
+    log4SerialEmu(line);
+  end;
+
   if sps.isDout1() then
     ShapeOut1.Brush.Color := clRed
   else
@@ -2123,7 +2210,6 @@ begin
   finally
     List.Free;
   end;
-
 end;
 
 end.