1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005 |
- 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;
- acSaveAs: TAction;
- acUpload: TAction;
- ActionList1: TActionList;
- acFileOpen: TFileOpen;
- btnTone: TBitBtn;
- cbIgnDly: TCheckBox;
- cbTPSVersion: TComboBox;
- cbAdrActual: TCheckBox;
- EditDelay: TLabeledEdit;
- EditJump: TLabeledEdit;
- EditPage: TLabeledEdit;
- EditRAdr: TLabeledEdit;
- acPresetLoad: TFileOpen;
- acPresetSave: TFileSaveAs;
- GBControl: TGroupBox;
- ImageList2: TImageList;
- ImageList3: 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;
- 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;
- SaveBinFile: 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;
- ToolButton21: 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 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 acSaveAsExecute(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 cbIgnDlyChange(Sender: TObject);
- procedure cbTPSVersionChange(Sender: TObject);
- procedure FormActivate(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 tbPrgChange(Sender: TObject);
- procedure tbResetClick(Sender: TObject);
- procedure tbSelChange(Sender: TObject);
- procedure Timer1Timer(Sender: TObject);
- procedure XMLPropStorage1RestoringProperties(Sender: TObject);
- procedure XMLPropStorage1SavingProperties(Sender: TObject);
- private
- { private declarations }
- sps: TSPS;
- stopit: boolean;
- activeFile: string;
- dirty: boolean;
- lastNote: byte;
- Examples: TStringList;
- procedure doStopExecute();
- procedure initMidi;
- procedure playNote(note: byte);
- procedure loadFromList(Lines: TStringList; filename: string);
- 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(singleStep: boolean);
- procedure renumberGrid;
- procedure saveFile(filename: string);
- procedure selectAddress(addr: word);
- procedure inputSps;
- procedure outputSps;
- procedure uploadFile;
- function serialUpload: string;
- procedure setDirty(Value: boolean);
- function checkDirty: boolean;
- procedure checkPresets;
- procedure makeBinFile(fileName: string);
- procedure makeHexFile(fileName: string);
- procedure setCaption;
- procedure addHeaderText;
- procedure loadPreset(filename: string);
- procedure savePreset(filename: string);
- procedure activateSps(enable: boolean);
- procedure enableMicrobit(enable: boolean);
- procedure outputMicrobit();
- procedure inputMicrobit();
- public
- { public declarations }
- end;
- var
- Form1: TForm1;
- implementation
- uses MCSAbout, uTextUi, uSelectCom, MCSTools, MCSStrings, synaser,
- MCSIO, mcsintelhex, MCSLSU, MCSIniFiles, MCSWinHttp, luijsonutils,
- uiMicrobit, uMicrobit;
- {$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/willie/pages/mcs/microcontroller/tps-sps-emulator.php';
- sps := TSPS.Create();
- sps.setDelayCallback(@delayCallback);
- addHeaderText;
- renumberGrid();
- cbTPSVersion.ItemIndex := 0;
- cbTPSVersionChange(Sender);
- acStop.Enabled := False;
- ToolButton18.Align := alRight;
- MCSLabel.Align := alRight;
- cbAdrActual.Enabled := False;
- cbIgnDly.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.loadFromList(Lines: TStringList; filename: string);
- var
- i, x: integer;
- line: string;
- list: TStringList;
- begin
- acNew.Execute;
- list := TStringList.Create;
- i := 1;
- for x := 0 to Lines.Count - 1 do
- begin
- if (i + 1 > StringGrid1.RowCount) then
- begin
- StringGrid1.RowCount := StringGrid1.RowCount + 1;
- end;
- line := Lines[x];
- 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;
- Inc(i);
- end;
- end;
- list.Free;
- activeFile := filename;
- renumberGrid();
- addHeaderText;
- setCaption();
- setDirty(False);
- 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;
- fileName, Data: string;
- Lines: TStringList;
- begin
- if (Sender is TMenuItem) then
- begin
- if (checkDirty()) then
- begin
- i := TMenuItem(Sender).Tag;
- 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;
- procedure TForm1.mnSaveClick(Sender: TObject);
- begin
- Statusbar1.SimpleText := Sender.ClassName;
- end;
- procedure TForm1.pmExamplesPopup(Sender: TObject);
- var
- x, i, j, pos, index: integer;
- myName: string;
- myMenu, my2Menu: TMenuItem;
- jsonString: string;
- JsonObject: TJsonObject;
- Data, JArray: TJSONData;
- JItem: TJSONData;
- subMenuName: string;
- subMenu: TMenuItem;
- begin
- for i := pmExamples.Items.Count - 1 downto 0 do
- begin
- 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;
- end;
- pmExamples.Items.Clear;
- Examples.Clear;
- try
- jsonString := DownloadFile('http://wkla.no-ip.biz/down/tps_examples/examples.json');
- Data := StringToJSONData(jsonString);
- JsonObject := TJSONObject(Data);
- i := JsonObject.Count;
- for x := 0 to JsonObject.Count - 1 do
- begin
- subMenuName := JsonObject.Names[x];
- JArray := GetJSONProp(TJSONObject(Data), subMenuName);
- if (JArray <> nil) then
- begin
- subMenu := TMenuItem.Create(pmExamples);
- subMenu.Caption := subMenuName;
- pmExamples.Items.Add(subMenu);
- 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('%.2d - %s', [index, myName]);
- end;
- myMenu := TMenuItem.Create(subMenu);
- myMenu.Caption := myName;
- myMenu.Tag := pos;
- if (index > -1) then
- begin
- myMenu.OnClick := @MenuItem1Click;
- end;
- subMenu.Add(myMenu);
- end;
- end;
- 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.acSaveAsExecute(Sender: TObject);
- var
- filename: string;
- begin
- if SaveDialog1.Execute() then
- begin
- filename := SaveDialog1.FileName;
- saveFile(filename);
- end;
- 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 := 57;
- cbAdrActual.Enabled := True;
- cbIgnDly.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(False);
- if not sps.isActive() then
- begin
- stopit := True;
- doStopExecute(); // error in sps
- end;
- if (cbAdrActual.Checked) then
- selectAddress(sps.getAddress());
- Application.ProcessMessages;
- end;
- if sps.getLastError() <> '' then
- MyMsgBox(sps.getLastError(), 'Error', MB_OK + MB_ICONERROR)
- else
- 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;
- i := StringGrid1.RowCount-1;
- if (i >= (sps.getE2E())) then
- begin
- LSUAutoMsgBox('Messages', 'ID_PRG_TO_LONG', MB_OK + MB_ICONERROR);
- exit;
- end;
- 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;
- i : integer;
- begin
- i := StringGrid1.RowCount-1;
- if (i >= (sps.getE2E())) then
- begin
- LSUAutoMsgBox('Messages', 'ID_PRG_TO_LONG', MB_OK + MB_ICONERROR);
- exit;
- end;
- 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);
- sps.setIgnoreDelay(cbIgnDly.Checked);
- end;
- procedure TForm1.acNextStepExecute(Sender: TObject);
- begin
- nextStep(True);
- 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(singleStep: boolean);
- 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 := True;
- inputMicrobit();
- inputSps();
- sps.nextStep();
- outputSps();
- outputMicrobit();
- acNextStep.Enabled := singleStep;
- 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();
- doStopExecute();
- end;
- end;
- procedure TForm1.doStopExecute();
- begin
- acDebug.ImageIndex := 40;
- // repeat
- // Application.ProcessMessages;
- // until (not sps.isDelayActive());
- sps.doReset();
- acStop.Enabled := False;
- acDebug.Enabled := True;
- outputSps();
- selectAddress(0);
- activateSps(False);
- 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);
- ImageList2.GetBitmap(22, btnTone.Glyph);
- 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;
- filename: string;
- retries: integer;
- begin
- error := False;
- if cbTPSVersion.ItemIndex = 4 then
- begin
- // microbit code
- SaveBinFile.FileName := 'mycobit';
- if (SaveBinFile.Execute) then
- begin
- filename := SaveBinFile.FileName;
- makeBinFile(filename);
- end;
- end
- else
- begin
- 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.BaudRate := br__9600;
- if cbTPSVersion.ItemIndex = 5 then
- begin
- // Micro:bit V2 auto programm
- SdpoSerial1.BaudRate := br115200;
- end;
- SdpoSerial1.Device := comService;
- SdpoSerial1.Active := True;
- error := true;
- while retries < 10 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);
- 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
- LSUAutoMsgBox('Messages', 'ID_NOT_READY', MB_OK + MB_ICONERROR);
- end
- else
- begin
- LSUAutoMsgBox('Messages', 'ID_UPLOAD_OK', MB_OK + MB_ICONINFORMATION);
- end;
- SdpoSerial1.Active := False;
- DeleteFile(hexFile);
- end;
- 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.makeBinFile(fileName: string);
- var
- i, x: integer;
- tmp: string;
- hexFormat: TIntelHexFormat;
- com, Data: byte;
- f: file of byte;
- begin
- i := StringGrid1.RowCount;
- AssignFile(f, fileName);
- Rewrite(f, 1);
- 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;
- Write(f, Data);
- end;
- CloseFile(f);
- 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.cbIgnDlyChange(Sender: TObject);
- begin
- sps.SetIgnoreDelay(cbIgnDly.Checked);
- 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;
- ADC1.Value := 0;
- ADC1.MaxValue := 15;
- ADC2.Value := 0;
- ADC2.MaxValue := 15;
- enableMicrobit(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;
- ADC1.Value := 0;
- ADC1.MaxValue := 15;
- ADC2.Value := 0;
- ADC2.MaxValue := 15;
- enableMicrobit(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;
- ADC1.Value := 0;
- ADC1.MaxValue := 255;
- ADC2.Value := 0;
- ADC2.MaxValue := 255;
- enableMicrobit(False);
- end;
- if (cbTPSVersion.ItemIndex = 4) then
- begin
- // micro:bit
- sps.setTPSVersion(microbit);
- 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 := True;
- Label5.Visible := False;
- btnTone.Visible := False;
- ADC1.Value := 0;
- ADC1.MaxValue := 15;
- ADC2.Value := 0;
- ADC2.MaxValue := 15;
- enableMicrobit(False);
- end;
- if (cbTPSVersion.ItemIndex = 5) then
- begin
- // micro:bit v2
- sps.setTPSVersion(MicroBitV2);
- 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;
- acUpload.Enabled := True;
- Label5.Visible := True;
- btnTone.Visible := True;
- ADC1.Value := 0;
- ADC1.MaxValue := 15;
- ADC2.Value := 0;
- ADC2.MaxValue := 15;
- enableMicrobit(True);
- end;
- cbCommand.Items.Clear;
- sps.getCommands(cbCommand.Items);
- end;
- procedure TForm1.FormActivate(Sender: TObject);
- begin
- enableMicrobit(cbTPSVersion.ItemIndex = 5);
- end;
- procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
- begin
- canClose := checkDirty();
- if canClose then
- begin
- if (sps.isActive()) then
- begin
- acStopExecute(Sender);
- end;
- end;
- 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
- if StringGrid1.RowCount <= sps.getE2E() then begin
- setDirty(True);
- StringGrid1.RowCount := StringGrid1.RowCount + 1;
- renumberGrid();
- end;
- 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.enableMicrobit(enable: boolean);
- begin
- if fMicrobit <> nil then
- begin
- if enable and not fMicrobit.Visible then
- begin
- fMicrobit.Show();
- fMicrobit.Left := Left + Width + 8;
- fMicrobit.Top := Top;
- end;
- if not enable and fMicrobit.Visible then
- fMicrobit.Hide();
- end;
- end;
- procedure TForm1.inputMicrobit();
- begin
- if (fMicrobit <> nil) and fMicrobit.Visible then
- begin
- sps.setACC(fMicrobit.accx.Value, fMicrobit.accz.Value, fMicrobit.accz.Value);
- sps.setComp(fMicrobit.compass.Value);
- sps.setLight(fMicrobit.light.Value);
- sps.setSnd(fMicrobit.snd.Value);
- sps.setGesture(fMicrobit.cbGesture.ItemIndex);
- sps.setLogo(fMicrobit.tbLogo.Checked);
- end;
- end;
- procedure TForm1.outputMicrobit();
- var
- image: TMBImage;
- begin
- if (fMicrobit <> nil) and fMicrobit.Visible then
- begin
- image := sps.getDisplay();
- fMicrobit.setImage(image);
- end;
- 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);
- WriteIniBool(key, 'logo', XMLPropStorage1.ReadBoolean(key + '.logo', False), filename);
- WriteIniInteger(key, 'accx', XMLPropStorage1.ReadInteger(key + '.accx', 0), filename);
- WriteIniInteger(key, 'accy', XMLPropStorage1.ReadInteger(key + '.accy', 0), filename);
- WriteIniInteger(key, 'accz', XMLPropStorage1.ReadInteger(key + '.accz', 0), filename);
- WriteIniInteger(key, 'sound', XMLPropStorage1.ReadInteger(key + '.sound', 0),
- filename);
- WriteIniInteger(key, 'light', XMLPropStorage1.ReadInteger(key + '.light', 0),
- filename);
- WriteIniInteger(key, 'comp', XMLPropStorage1.ReadInteger(key + '.comp', 0), filename);
- WriteIniInteger(key, 'gesture', XMLPropStorage1.ReadInteger(key +
- '.gesture', 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));
- XMLPropStorage1.WriteBoolean(key + '.logo', ReadIniBool(key, 'logo', False, filename));
- XMLPropStorage1.WriteInteger(key + '.accx', ReadIniInteger(key, 'accx', 0, filename));
- XMLPropStorage1.WriteInteger(key + '.accy', ReadIniInteger(key, 'accy', 0, filename));
- XMLPropStorage1.WriteInteger(key + '.accz', ReadIniInteger(key, 'accz', 0, filename));
- XMLPropStorage1.WriteInteger(key + '.sound', ReadIniInteger(key,
- 'sound', 0, filename));
- XMLPropStorage1.WriteInteger(key + '.light', ReadIniInteger(key,
- 'light', 0, filename));
- XMLPropStorage1.WriteInteger(key + '.comp', ReadIniInteger(key, 'comp', 0, filename));
- XMLPropStorage1.WriteInteger(key + '.gesture', ReadIniInteger(key,
- 'gesture', 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);
- fMicrobit.tbLogo.Checked := XMLPropStorage1.ReadBoolean(key + '.logo',
- fMicrobit.tbLogo.Checked);
- fMicrobit.accx.Value := XMLPropStorage1.ReadInteger(key + '.accx',
- fMicrobit.accx.Value);
- fMicrobit.accy.Value := XMLPropStorage1.ReadInteger(key + '.accy',
- fMicrobit.accy.Value);
- fMicrobit.accz.Value := XMLPropStorage1.ReadInteger(key + '.accz',
- fMicrobit.accz.Value);
- fMicrobit.snd.Value := XMLPropStorage1.ReadInteger(key + '.sound',
- fMicrobit.snd.Value);
- fMicrobit.light.Value := XMLPropStorage1.ReadInteger(key + '.light',
- fMicrobit.light.Value);
- fMicrobit.compass.Value := XMLPropStorage1.ReadInteger(key + '.comp',
- fMicrobit.compass.Value);
- fMicrobit.cbGesture.ItemIndex :=
- XMLPropStorage1.ReadInteger(key + '.gesture', fMicrobit.cbGesture.ItemIndex);
- 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);
- XMLPropStorage1.WriteBoolean(key + '.logo', fMicrobit.tbLogo.Checked);
- XMLPropStorage1.WriteInteger(key + '.accx', fMicrobit.accx.Value);
- XMLPropStorage1.WriteInteger(key + '.accy', fMicrobit.accy.Value);
- XMLPropStorage1.WriteInteger(key + '.accz', fMicrobit.accz.Value);
- XMLPropStorage1.WriteInteger(key + '.sound', fMicrobit.snd.Value);
- XMLPropStorage1.WriteInteger(key + '.light', fMicrobit.light.Value);
- XMLPropStorage1.WriteInteger(key + '.comp', fMicrobit.compass.Value);
- XMLPropStorage1.WriteInteger(key + '.gesture', fMicrobit.cbGesture.ItemIndex);
- checkPresets();
- end;
- procedure TForm1.tbPrgChange(Sender: TObject);
- begin
- if tbPrg.Checked then
- begin
- tbPrg.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_PRG_SEL', lsuCode);
- end
- else
- begin
- tbPrg.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_PRG_NON', lsuCode);
- end;
- end;
- procedure TForm1.tbResetClick(Sender: TObject);
- begin
- tbPrg.Checked := False;
- tbPrg.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_PRG_NON', lsuCode);
- tbSel.Checked := False;
- tbSel.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_SEL_NON', lsuCode);
- 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.tbSelChange(Sender: TObject);
- begin
- if tbSel.Checked then
- begin
- tbSel.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_SEL_SEL', lsuCode);
- end
- else
- begin
- tbSel.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_SEL_NON', lsuCode);
- end;
- 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.XMLPropStorage1RestoringProperties(Sender: TObject);
- var
- Uid: TGuid;
- Result: HResult;
- uuid: string;
- begin
- uuid := XMLPropStorage1.ReadString('AppUUID', '');
- if uuid = '' then
- begin
- Result := CreateGuid(Uid);
- if Result = S_OK then
- begin
- uuid := GuidToString(Uid);
- XMLPropStorage1.WriteString('AppUUID', uuid);
- end;
- end;
- Infobox.AppUUID := uuid;
- end;
- procedure TForm1.XMLPropStorage1SavingProperties(Sender: TObject);
- begin
- 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: word);
- 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 := True;
- 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.
|