Browse Source

Bug: sometimes it's dificult to upload a new TPS file.

Wilfried Klaas 2 years ago
parent
commit
2b1a859f51
7 changed files with 112 additions and 61 deletions
  1. 2 2
      SPS_EMU.000
  2. 1 1
      SPS_Emu.lpi
  3. BIN
      SPS_Emu.lsu
  4. 2 2
      ugui.lfm
  5. 66 28
      ugui.pas
  6. 35 28
      uselectcom.lfm
  7. 6 0
      uselectcom.pas

+ 2 - 2
SPS_EMU.000

@@ -2,8 +2,8 @@
 LSUTextFile=1
 Copyrigth=MCS Media Computer Software
 [LSUInfo]
-CompileDate=12.06.2021
-CompileTime=09:51:47
+CompileDate=23.07.2021
+CompileTime=16:42:05
 Name=Wilfried Klaas
 LSUBinFile=.\SPS_EMU.lsu
 LSUTextFile=.\SPS_EMU.

+ 1 - 1
SPS_Emu.lpi

@@ -23,7 +23,7 @@
       <AutoIncrementBuild Value="True"/>
       <MinorVersionNr Value="2"/>
       <RevisionNr Value="1"/>
-      <BuildNr Value="101"/>
+      <BuildNr Value="102"/>
       <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>

BIN
SPS_Emu.lsu


+ 2 - 2
ugui.lfm

@@ -1,7 +1,7 @@
 object Form1: TForm1
-  Left = 243
+  Left = 288
   Height = 730
-  Top = 113
+  Top = 142
   Width = 1199
   AllowDropFiles = True
   Caption = 'SPS Emulator'

+ 66 - 28
ugui.pas

@@ -200,7 +200,7 @@ type
     procedure initMidi;
     procedure playNote(note: byte);
     procedure loadFromList(Lines: TStringList; filename: string);
-    function readString(var line: string): boolean;
+    function readString(var line: string; wait: boolean): boolean;
     procedure saveSection(filename: string; key: string);
     procedure loadSection(filename: string; key: string);
 
@@ -648,7 +648,7 @@ begin
     acDebug.Enabled := True;
     acDebug.ImageIndex := 57;
     cbAdrActual.Enabled := True;
-    cbIgnDly.Enabled:= True;
+    cbIgnDly.Enabled := True;
     acNextStep.Enabled := False;
     // sps programmieren
     programSps();
@@ -720,7 +720,7 @@ var
   eot: boolean;
 begin
   eot := False;
-  i := StringGrid1.RowCount-1;
+  i := StringGrid1.RowCount - 1;
   if (i >= (sps.getE2E())) then
   begin
     LSUAutoMsgBox('Messages', 'ID_PRG_TO_LONG', MB_OK + MB_ICONERROR);
@@ -750,9 +750,9 @@ end;
 procedure TForm1.acNextInsertExecute(Sender: TObject);
 var
   myPos: integer;
-  i : integer;
+  i: integer;
 begin
-  i := StringGrid1.RowCount-1;
+  i := StringGrid1.RowCount - 1;
   if (i >= (sps.getE2E())) then
   begin
     LSUAutoMsgBox('Messages', 'ID_PRG_TO_LONG', MB_OK + MB_ICONERROR);
@@ -925,6 +925,7 @@ begin
   end;
   Form2.addHexFile(list);
   Form2.ShowModal;
+  Form2.Destroy;
   list.Free;
 end;
 
@@ -1056,6 +1057,10 @@ begin
 
       if (return = mrOk) then
       begin
+        Form2 := TForm2.Create(self);
+        Form2.Memo1.Clear;
+        Form2.Show;
+
         hexFile := serialUpload;
         SdpoSerial1.BaudRate := br__9600;
 
@@ -1067,38 +1072,66 @@ begin
 
         SdpoSerial1.Device := comService;
         SdpoSerial1.Active := True;
-
-        error := true;
-        while retries < 10 do
+        retries := 10;
+        error := True;
+        while retries > 0 do
         begin
-             SdpoSerial1.WriteData('p');
-             if (readString(line)) then
-             begin
-               if (pos('command', line) > 0) then
-               begin
-                 retries := 10;
-                 error := false;
-               end;
-             end;
-             SdpoSerial1.WriteData('h');
-             inc(retries);
+          Form2.Memo1.Append('>p');
+          SdpoSerial1.WriteData('p');
+          if (readString(line, True)) then
+          begin
+            Form2.Memo1.Append(line);
+            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 (not error) then
         begin
+          Form2.Memo1.Append('>w');
           SdpoSerial1.WriteData('w');
-          if (readString(line)) then
+          if (readString(line, True)) then
           begin
+            Form2.Memo1.Append(line);
             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);
+                Form2.Memo1.Append('>' + Lines.Strings[x]);
+                SdpoSerial1.WriteData(Lines.Strings[x] + CRLF);
                 Sleep(250);
+                if (readString(line, False)) then
+                begin
+                  if line <> '' then
+                  begin
+                    line := StringReplace(line, '\r', '', []);
+                    line := StringReplace(line, '\n', '', []);
+                    Form2.Memo1.Append(line);
+                  end;
+                end;
               end;
+              Form2.Memo1.Append('>e');
               SdpoSerial1.WriteData('e');
+              Sleep(250);
+              if (readString(line, True)) then
+              begin
+                if line <> '' then
+                begin
+                  line := StringReplace(line, '\r', '', []);
+                  line := StringReplace(line, '\n', '', []);
+                  Form2.Memo1.Append(line);
+                end;
+              end;
             end
             else
             begin
@@ -1106,7 +1139,6 @@ begin
             end;
           end;
         end;
-
         if (error) then
         begin
           LSUAutoMsgBox('Messages', 'ID_NOT_READY', MB_OK + MB_ICONERROR);
@@ -1115,6 +1147,8 @@ begin
         begin
           LSUAutoMsgBox('Messages', 'ID_UPLOAD_OK', MB_OK + MB_ICONINFORMATION);
         end;
+        Form2.Close();
+        Form2.Destroy();
         SdpoSerial1.Active := False;
         DeleteFile(hexFile);
       end;
@@ -1122,16 +1156,19 @@ begin
   end;
 end;
 
-function TForm1.readString(var line: string): boolean;
+function TForm1.readString(var line: string; wait: boolean): boolean;
 var
   TimeOut: integer;
 begin
   Result := False;
   TimeOut := 10;
-  while ((not SdpoSerial1.DataAvailable) and (TimeOut > 0)) do
+  if (wait) then
   begin
-    Dec(TimeOut);
-    Sleep(1000);
+    while ((not SdpoSerial1.DataAvailable) and (TimeOut > 0)) do
+    begin
+      Dec(TimeOut);
+      Sleep(1000);
+    end;
   end;
   if (Timeout > 0) then
   begin
@@ -1536,7 +1573,8 @@ begin
     Value := trim(Value);
     if (Value <> '') then
     begin
-      if StringGrid1.RowCount <= sps.getE2E() then begin
+      if StringGrid1.RowCount <= sps.getE2E() then
+      begin
         setDirty(True);
         StringGrid1.RowCount := StringGrid1.RowCount + 1;
         renumberGrid();

+ 35 - 28
uselectcom.lfm

@@ -1,20 +1,22 @@
 object frmSelectCom: TfrmSelectCom
   Left = 375
-  Height = 172
+  Height = 215
   Top = 161
-  Width = 401
+  Width = 501
   Caption = 'Schnittstelle auswählen'
-  ClientHeight = 172
-  ClientWidth = 401
+  ClientHeight = 215
+  ClientWidth = 501
+  DesignTimePPI = 120
   OnCreate = FormCreate
   OnShow = FormShow
   Position = poMainFormCenter
-  LCLVersion = '2.0.10.0'
+  LCLVersion = '2.0.12.0'
   object ButtonPanel1: TButtonPanel
-    Left = 6
-    Height = 34
-    Top = 132
-    Width = 389
+    Left = 8
+    Height = 38
+    Top = 169
+    Width = 485
+    BorderSpacing.Around = 8
     OKButton.Name = 'OKButton'
     OKButton.DefaultCaption = True
     HelpButton.Name = 'HelpButton'
@@ -24,51 +26,56 @@ object frmSelectCom: TfrmSelectCom
     CancelButton.Name = 'CancelButton'
     CancelButton.DefaultCaption = True
     TabOrder = 0
+    OnClick = ButtonPanel1Click
     ShowButtons = [pbOK, pbCancel]
   end
   object Label1: TLabel
     AnchorSideTop.Control = cbServices
     AnchorSideTop.Side = asrCenter
     AnchorSideRight.Side = asrBottom
-    Left = 79
-    Height = 15
-    Top = 52
-    Width = 72
+    Left = 100
+    Height = 20
+    Top = 64
+    Width = 89
     Anchors = [akTop, akRight]
     Caption = 'ID_COMPORT'
     ParentColor = False
+    ParentFont = False
   end
   object cbServices: TComboBox
-    Left = 160
-    Height = 23
-    Top = 48
-    Width = 100
-    ItemHeight = 15
+    Left = 200
+    Height = 28
+    Top = 60
+    Width = 125
+    ItemHeight = 20
+    ParentFont = False
     Style = csDropDownList
     TabOrder = 1
   end
   object Label2: TLabel
     AnchorSideRight.Side = asrBottom
-    Left = 4
-    Height = 15
-    Top = 4
-    Width = 393
+    Left = 5
+    Height = 20
+    Top = 5
+    Width = 491
     Align = alTop
-    BorderSpacing.Around = 4
+    BorderSpacing.Around = 5
     Caption = 'ID_COMMENT'
     ParentColor = False
+    ParentFont = False
     WordWrap = True
   end
   object Label3: TLabel
-    Left = 4
-    Height = 39
-    Top = 87
-    Width = 393
+    Left = 5
+    Height = 49
+    Top = 112
+    Width = 491
     Align = alBottom
     AutoSize = False
-    BorderSpacing.Around = 4
+    BorderSpacing.Around = 5
     Caption = 'ID_COMMAND_HINT'
     ParentColor = False
+    ParentFont = False
     WordWrap = True
   end
 end

+ 6 - 0
uselectcom.pas

@@ -18,6 +18,7 @@ type
     Label1: TLabel;
     Label2: TLabel;
     Label3: TLabel;
+    procedure ButtonPanel1Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormShow(Sender: TObject);
   private
@@ -41,6 +42,11 @@ begin
   MCSLSU.MakeForm('frmSelectCom', 'ID_', frmSelectCom );
 end;
 
+procedure TfrmSelectCom.ButtonPanel1Click(Sender: TObject);
+begin
+
+end;
+
 procedure TfrmSelectCom.FormShow(Sender: TObject);
 begin
   MCSLSU.MakeForm('frmSelectCom', 'ID_', frmSelectCom );