12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970 |
- 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;
- 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 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: byte);
- 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;
- 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;
- 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;
- 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(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;
- 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;
- SdpoSerial1.WriteData('p');
- 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
- 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.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
- 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.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: 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);
- 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.
|