Browse Source

adding new segment of examples...

Klaas, Wilfried 4 năm trước cách đây
mục cha
commit
b8755af930
5 tập tin đã thay đổi với 133 bổ sung75 xóa
  1. 4 4
      SPS_EMU.000
  2. 9 1
      SPS_Emu.lpi
  3. BIN
      SPS_Emu.lsu
  4. 31 31
      ugui.lfm
  5. 89 39
      ugui.pas

+ 4 - 4
SPS_EMU.000

@@ -2,9 +2,9 @@
 LSUTextFile=1
 LSUTextFile=1
 Copyrigth=MCS Media Computer Software
 Copyrigth=MCS Media Computer Software
 [LSUInfo]
 [LSUInfo]
-CompileDate=22.07.2020
-CompileTime=13:40:24
+CompileDate=26.10.2020
+CompileTime=13:40:45
 Name=Wilfried Klaas
 Name=Wilfried Klaas
-LSUBinFile=E:\daten\git-sourcen\SPS_Emulator\SPS_Emu.lsu
-LSUTextFile=E:\daten\git-sourcen\SPS_Emulator\SPS_Emu.
+LSUBinFile=H:\privat\git-sourcen\SPS_Emulator\SPS_Emu.lsu
+LSUTextFile=H:\privat\git-sourcen\SPS_Emulator\SPS_Emu.
 RegString=
 RegString=

+ 9 - 1
SPS_Emu.lpi

@@ -22,7 +22,7 @@
       <AutoIncrementBuild Value="True"/>
       <AutoIncrementBuild Value="True"/>
       <MinorVersionNr Value="2"/>
       <MinorVersionNr Value="2"/>
       <RevisionNr Value="1"/>
       <RevisionNr Value="1"/>
-      <BuildNr Value="64"/>
+      <BuildNr Value="65"/>
       <Language Value="0407"/>
       <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"/>
       <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>
     </VersionInfo>
@@ -34,6 +34,14 @@
       <DestinationDirectory Value="$(ProjPath)\published\"/>
       <DestinationDirectory Value="$(ProjPath)\published\"/>
     </PublishOptions>
     </PublishOptions>
     <RunParams>
     <RunParams>
+      <local>
+        <CommandLineParams Value="beispiele/tone.tps"/>
+      </local>
+      <environment>
+        <UserOverrides Count="1">
+          <Variable0 Name="lazarus_debuglog" Value="c:\temp\debug.txt"/>
+        </UserOverrides>
+      </environment>
       <FormatVersion Value="2"/>
       <FormatVersion Value="2"/>
       <Modes Count="1">
       <Modes Count="1">
         <Mode0 Name="default">
         <Mode0 Name="default">

BIN
SPS_Emu.lsu


+ 31 - 31
ugui.lfm

@@ -1,12 +1,12 @@
 object Form1: TForm1
 object Form1: TForm1
-  Left = 266
+  Left = 348
   Height = 584
   Height = 584
-  Top = 104
-  Width = 707
+  Top = 129
+  Width = 751
   AllowDropFiles = True
   AllowDropFiles = True
   Caption = 'SPS Emulator'
   Caption = 'SPS Emulator'
   ClientHeight = 584
   ClientHeight = 584
-  ClientWidth = 707
+  ClientWidth = 751
   Constraints.MinHeight = 582
   Constraints.MinHeight = 582
   Constraints.MinWidth = 684
   Constraints.MinWidth = 684
   OnCloseQuery = FormCloseQuery
   OnCloseQuery = FormCloseQuery
@@ -14,9 +14,9 @@ object Form1: TForm1
   OnDropFiles = FormDropFiles
   OnDropFiles = FormDropFiles
   SessionProperties = 'cbAdrActual.Checked;Height;Left;StringGrid1.Columns;Top;Width'
   SessionProperties = 'cbAdrActual.Checked;Height;Left;StringGrid1.Columns;Top;Width'
   ShowHint = True
   ShowHint = True
-  LCLVersion = '2.0.2.0'
+  LCLVersion = '2.0.10.0'
   object Panel1: TPanel
   object Panel1: TPanel
-    Left = 383
+    Left = 427
     Height = 535
     Height = 535
     Top = 26
     Top = 26
     Width = 324
     Width = 324
@@ -598,7 +598,7 @@ object Form1: TForm1
     Left = 0
     Left = 0
     Height = 26
     Height = 26
     Top = 0
     Top = 0
-    Width = 707
+    Width = 751
     ButtonHeight = 22
     ButtonHeight = 22
     ButtonWidth = 22
     ButtonWidth = 22
     Caption = 'ToolBar1'
     Caption = 'ToolBar1'
@@ -778,25 +778,25 @@ object Form1: TForm1
     Left = 0
     Left = 0
     Height = 23
     Height = 23
     Top = 561
     Top = 561
-    Width = 707
+    Width = 751
     Panels = <>
     Panels = <>
   end
   end
   object Panel2: TPanel
   object Panel2: TPanel
     Left = 0
     Left = 0
     Height = 535
     Height = 535
     Top = 26
     Top = 26
-    Width = 383
+    Width = 427
     Align = alClient
     Align = alClient
     BevelOuter = bvNone
     BevelOuter = bvNone
     Caption = 'Panel2'
     Caption = 'Panel2'
     ClientHeight = 535
     ClientHeight = 535
-    ClientWidth = 383
+    ClientWidth = 427
     TabOrder = 3
     TabOrder = 3
     object StringGrid1: TStringGrid
     object StringGrid1: TStringGrid
       Left = 0
       Left = 0
       Height = 501
       Height = 501
       Top = 0
       Top = 0
-      Width = 383
+      Width = 427
       Align = alClient
       Align = alClient
       Columns = <      
       Columns = <      
         item
         item
@@ -836,12 +836,12 @@ object Form1: TForm1
       Left = 0
       Left = 0
       Height = 34
       Height = 34
       Top = 501
       Top = 501
-      Width = 383
+      Width = 427
       Align = alBottom
       Align = alBottom
       BevelInner = bvLowered
       BevelInner = bvLowered
       BevelOuter = bvNone
       BevelOuter = bvNone
       ClientHeight = 34
       ClientHeight = 34
-      ClientWidth = 383
+      ClientWidth = 427
       TabOrder = 1
       TabOrder = 1
       object cbCommand: TComboBox
       object cbCommand: TComboBox
         Left = 64
         Left = 64
@@ -930,8 +930,8 @@ object Form1: TForm1
   end
   end
   object ActionList1: TActionList
   object ActionList1: TActionList
     Images = ImageList1
     Images = ImageList1
-    left = 472
-    top = 496
+    Left = 472
+    Top = 496
     object acExit: TAction
     object acExit: TAction
       Category = 'File'
       Category = 'File'
       Caption = 'ID_EXIT'
       Caption = 'ID_EXIT'
@@ -1065,8 +1065,8 @@ object Form1: TForm1
   object ImageList1: TImageList
   object ImageList1: TImageList
     Height = 20
     Height = 20
     Width = 20
     Width = 20
-    left = 432
-    top = 496
+    Left = 432
+    Top = 496
     Bitmap = {
     Bitmap = {
       4C695A0000001400000014000000C0C0C000C0C0C000C0C0C000C0C0C000C0C0
       4C695A0000001400000014000000C0C0C000C0C0C000C0C0C000C0C0C000C0C0
       C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0
       C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0
@@ -5578,33 +5578,33 @@ object Form1: TForm1
         Value = '30'
         Value = '30'
         KeyString = 'MidiProgram'
         KeyString = 'MidiProgram'
       end>
       end>
-    left = 496
-    top = 496
+    Left = 496
+    Top = 496
   end
   end
   object SaveDialog1: TSaveDialog
   object SaveDialog1: TSaveDialog
     Title = 'ID_SAVE_TPS'
     Title = 'ID_SAVE_TPS'
     DefaultExt = '.tps'
     DefaultExt = '.tps'
-    left = 528
-    top = 496
+    Left = 528
+    Top = 496
   end
   end
   object Timer1: TTimer
   object Timer1: TTimer
     Enabled = False
     Enabled = False
     Interval = 10000
     Interval = 10000
     OnTimer = Timer1Timer
     OnTimer = Timer1Timer
-    left = 558
-    top = 496
+    Left = 558
+    Top = 496
   end
   end
   object SaveHexFile: TSaveDialog
   object SaveHexFile: TSaveDialog
     Title = 'ID_SAVE_HEX'
     Title = 'ID_SAVE_HEX'
     DefaultExt = '.hex'
     DefaultExt = '.hex'
-    left = 584
-    top = 496
+    Left = 584
+    Top = 496
   end
   end
   object ImageList2: TImageList
   object ImageList2: TImageList
     Height = 32
     Height = 32
     Width = 32
     Width = 32
-    left = 616
-    top = 496
+    Left = 616
+    Top = 496
     Bitmap = {
     Bitmap = {
       4C6969010000200000002000000080804000808040007C7C3EFF484824FF1A1A
       4C6969010000200000002000000080804000808040007C7C3EFF484824FF1A1A
       0DFF040402FF040402FF1A1A0DFF484824FF7C7C3EFF80804000808040008080
       0DFF040402FF040402FF1A1A0DFF484824FF7C7C3EFF80804000808040008080
@@ -51825,13 +51825,13 @@ object Form1: TForm1
     FlowControl = fcNone
     FlowControl = fcNone
     StopBits = sbOne
     StopBits = sbOne
     Device = 'COM1'
     Device = 'COM1'
-    left = 656
-    top = 496
+    Left = 656
+    Top = 496
   end
   end
   object pmExamples: TPopupMenu
   object pmExamples: TPopupMenu
     OnPopup = pmExamplesPopup
     OnPopup = pmExamplesPopup
-    left = 432
-    top = 528
+    Left = 432
+    Top = 528
     object MenuItem1: TMenuItem
     object MenuItem1: TMenuItem
       Caption = '01-Blink'
       Caption = '01-Blink'
       OnClick = MenuItem1Click
       OnClick = MenuItem1Click

+ 89 - 39
ugui.pas

@@ -187,10 +187,10 @@ type
     activeFile: string;
     activeFile: string;
     dirty: boolean;
     dirty: boolean;
     lastNote: byte;
     lastNote: byte;
-    Examples : TStringList;
+    Examples: TStringList;
     procedure initMidi;
     procedure initMidi;
     procedure playNote(note: byte);
     procedure playNote(note: byte);
-    procedure loadFromList(lines : TStringlist; filename : String);
+    procedure loadFromList(Lines: TStringList; filename: string);
     function readString(var line: string): boolean;
     function readString(var line: string): boolean;
     procedure saveSection(filename: string; key: string);
     procedure saveSection(filename: string; key: string);
     procedure loadSection(filename: string; key: string);
     procedure loadSection(filename: string; key: string);
@@ -253,7 +253,7 @@ begin
   sps.setDelayCallback(@delayCallback);
   sps.setDelayCallback(@delayCallback);
   addHeaderText;
   addHeaderText;
   renumberGrid();
   renumberGrid();
-  cbTPSVersion.ItemIndex:=0;
+  cbTPSVersion.ItemIndex := 0;
   cbTPSVersionChange(Sender);
   cbTPSVersionChange(Sender);
   acStop.Enabled := False;
   acStop.Enabled := False;
   ToolButton18.Align := alRight;
   ToolButton18.Align := alRight;
@@ -302,21 +302,22 @@ begin
   lastNote := note;
   lastNote := note;
 end;
 end;
 
 
-procedure TForm1.loadFromList(lines: TStringlist; filename : String);
+procedure TForm1.loadFromList(Lines: TStringList; filename: string);
 var
 var
-  i,x: integer;
+  i, x: integer;
   line: string;
   line: string;
   list: TStringList;
   list: TStringList;
 begin
 begin
   acNew.Execute;
   acNew.Execute;
   list := TStringList.Create;
   list := TStringList.Create;
   i := 1;
   i := 1;
-  for x := 0 to lines.count-1 do begin
+  for x := 0 to Lines.Count - 1 do
+  begin
     if (i + 1 > StringGrid1.RowCount) then
     if (i + 1 > StringGrid1.RowCount) then
     begin
     begin
       StringGrid1.RowCount := StringGrid1.RowCount + 1;
       StringGrid1.RowCount := StringGrid1.RowCount + 1;
     end;
     end;
-    line :=  lines[x];
+    line := Lines[x];
     if (Pos('#', line) = 1) then
     if (Pos('#', line) = 1) then
     begin
     begin
       line := RightstrPos(line, 2);
       line := RightstrPos(line, 2);
@@ -326,7 +327,8 @@ begin
         cbTPSVersion.Text := line;
         cbTPSVersion.Text := line;
         cbTPSVersionChange(nil);
         cbTPSVersionChange(nil);
       end;
       end;
-    end else
+    end
+    else
     begin
     begin
       MCSStrings.DelimSepTextToStringlist(line, '"', ',', list);
       MCSStrings.DelimSepTextToStringlist(line, '"', ',', list);
       if list.Count > 0 then
       if list.Count > 0 then
@@ -338,7 +340,7 @@ begin
       if list.Count > 3 then
       if list.Count > 3 then
         Stringgrid1.Cells[4, i] := list[3];
         Stringgrid1.Cells[4, i] := list[3];
       list.Clear;
       list.Clear;
-      inc(i);
+      Inc(i);
     end;
     end;
   end;
   end;
   list.Free;
   list.Free;
@@ -366,19 +368,25 @@ begin
 end;
 end;
 
 
 procedure TForm1.MenuItem1Click(Sender: TObject);
 procedure TForm1.MenuItem1Click(Sender: TObject);
-var i : integer;
-    fileName, data : String;
-    lines : TStringList;
+var
+  i: integer;
+  fileName, Data: string;
+  Lines: TStringList;
 begin
 begin
-  if (Sender is TMenuItem) then begin
-    if (checkDirty()) then begin
+  if (Sender is TMenuItem) then
+  begin
+    if (checkDirty()) then
+    begin
       i := TMenuItem(Sender).Tag;
       i := TMenuItem(Sender).Tag;
-      filename :=  examples[i-1];
-      data := DownloadFile('http://wkla.no-ip.biz/down/tps_examples/' + filename);
-      lines := TStringList.Create;
-      lines.Text:= data;
-      loadFromList(lines, filename);
-      lines.Free;
+      if (i >= 0) then
+      begin
+        filename := examples[i];
+        Data := DownloadFile('http://wkla.no-ip.biz/down/tps_examples/' + filename);
+        Lines := TStringList.Create;
+        Lines.Text := Data;
+        loadFromList(Lines, filename);
+        Lines.Free;
+      end;
     end;
     end;
   end;
   end;
 end;
 end;
@@ -390,9 +398,9 @@ end;
 
 
 procedure TForm1.pmExamplesPopup(Sender: TObject);
 procedure TForm1.pmExamplesPopup(Sender: TObject);
 var
 var
-  i: integer;
+  i, j, pos, index: integer;
   myName: string;
   myName: string;
-  myMenu: TMenuItem;
+  myMenu, my2Menu: TMenuItem;
   jsonString: string;
   jsonString: string;
   Data, JArray: TJSONData;
   Data, JArray: TJSONData;
   JItem: TJSONData;
   JItem: TJSONData;
@@ -400,6 +408,15 @@ begin
   for i := pmExamples.Items.Count - 1 downto 0 do
   for i := pmExamples.Items.Count - 1 downto 0 do
   begin
   begin
     myMenu := pmExamples.Items[i];
     myMenu := pmExamples.Items[i];
+    if (myMenu.Count > 0) then
+    begin
+      for j := myMenu.Count - 1 downto 0 do
+      begin
+        my2Menu := myMenu.Items[j];
+        my2Menu.Free;
+      end;
+      myMenu.Clear;
+    end;
     myMenu.Free;
     myMenu.Free;
   end;
   end;
   pmExamples.Items.Clear;
   pmExamples.Items.Clear;
@@ -411,15 +428,48 @@ begin
     JArray := GetJSONProp(TJSONObject(Data), 'examples');
     JArray := GetJSONProp(TJSONObject(Data), 'examples');
     for i := 1 to TJSONArray(JArray).Count do
     for i := 1 to TJSONArray(JArray).Count do
     begin
     begin
-      JItem := TJSONArray(JArray).Items[i-1];
+      JItem := TJSONArray(JArray).Items[i - 1];
       myName := GetJsonProp(TJSONObject(JItem), 'name', '');
       myName := GetJsonProp(TJSONObject(JItem), 'name', '');
-      myName := format('%.2d - %s', [i, myName]);
+      pos := -1;
+      index := GetJsonProp(TJSONObject(JItem), 'index', -1);
+      if (index > -1) then
+      begin
+        pos := Examples.Add(GetJsonProp(TJSONObject(JItem), 'file', ''));
+        myName := format('%.2d - %s', [index, myName]);
+      end;
       myMenu := TMenuItem.Create(pmExamples);
       myMenu := TMenuItem.Create(pmExamples);
       myMenu.Caption := myName;
       myMenu.Caption := myName;
-      myMenu.Tag := i;
-      myMenu.OnClick := @MenuItem1Click;
+      myMenu.Tag := pos;
+      if (index > -1) then
+      begin
+        myMenu.OnClick := @MenuItem1Click;
+      end;
       pmExamples.Items.Add(myMenu);
       pmExamples.Items.Add(myMenu);
-      Examples.Add(GetJsonProp(TJSONObject(JItem), 'file', ''));
+    end;
+
+    JArray := GetJSONProp(TJSONObject(Data), 'demo');
+    if (JArray <> nil) then
+    begin
+      for i := 1 to TJSONArray(JArray).Count do
+      begin
+        JItem := TJSONArray(JArray).Items[i - 1];
+        myName := GetJsonProp(TJSONObject(JItem), 'name', '');
+        pos := -1;
+        index := GetJsonProp(TJSONObject(JItem), 'index', -1);
+        if (index > -1) then
+        begin
+          pos := Examples.Add(GetJsonProp(TJSONObject(JItem), 'file', ''));
+          myName := format('%s: %.2d - %s', ['demo', index, myName]);
+        end;
+        myMenu := TMenuItem.Create(pmExamples);
+        myMenu.Caption := myName;
+        myMenu.Tag := pos;
+        if (index > -1) then
+        begin
+          myMenu.OnClick := @MenuItem1Click;
+        end;
+        pmExamples.Items.Add(myMenu);
+      end;
     end;
     end;
   except
   except
   end;
   end;
@@ -1218,10 +1268,10 @@ begin
     acUpload.Enabled := False;
     acUpload.Enabled := False;
     Label5.Visible := False;
     Label5.Visible := False;
     btnTone.Visible := False;
     btnTone.Visible := False;
-    ADC1.Value:=0;
-    ADC1.MaxValue:=15;
-    ADC2.Value:=0;
-    ADC2.MaxValue:=15;
+    ADC1.Value := 0;
+    ADC1.MaxValue := 15;
+    ADC2.Value := 0;
+    ADC2.MaxValue := 15;
   end;
   end;
   if (cbTPSVersion.ItemIndex = 1) then
   if (cbTPSVersion.ItemIndex = 1) then
   begin
   begin
@@ -1244,10 +1294,10 @@ begin
     acUpload.Enabled := False;
     acUpload.Enabled := False;
     Label5.Visible := False;
     Label5.Visible := False;
     btnTone.Visible := False;
     btnTone.Visible := False;
-    ADC1.Value:=0;
-    ADC1.MaxValue:=15;
-    ADC2.Value:=0;
-    ADC2.MaxValue:=15;
+    ADC1.Value := 0;
+    ADC1.MaxValue := 15;
+    ADC2.Value := 0;
+    ADC2.MaxValue := 15;
   end;
   end;
   if ((cbTPSVersion.ItemIndex = 2) or (cbTPSVersion.ItemIndex = 3)) then
   if ((cbTPSVersion.ItemIndex = 2) or (cbTPSVersion.ItemIndex = 3)) then
   begin
   begin
@@ -1282,10 +1332,10 @@ begin
 
 
     EditE.Visible := True;
     EditE.Visible := True;
     EditF.Visible := True;
     EditF.Visible := True;
-    ADC1.Value:=0;
-    ADC1.MaxValue:=255;
-    ADC2.Value:=0;
-    ADC2.MaxValue:=255;
+    ADC1.Value := 0;
+    ADC1.MaxValue := 255;
+    ADC2.Value := 0;
+    ADC2.MaxValue := 255;
   end;
   end;
   cbCommand.Items.Clear;
   cbCommand.Items.Clear;
   sps.getCommands(cbCommand.Items);
   sps.getCommands(cbCommand.Items);