1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444 |
- 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;
- 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;
- 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;
- 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 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 mnSaveClick(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;
- 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;
- {$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);
- 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.mnSaveClick(Sender: TObject);
- begin
- Statusbar1.SimpleText := Sender.ClassName;
- 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;
- 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);
- btnTone.Caption := IntToStr(sps.getTone());
- end
- else
- begin
- ImageList2.GetBitmap(22, btnTone.Glyph);
- btnTone.Caption := '';
- 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.
|