123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995 |
- 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: 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;
- 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;
- 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);
- 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.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.
|