ugui.pas 56 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129
  1. unit uGUI;
  2. {$mode objfpc}{$H+}
  3. {$define DebugLCLComponents}
  4. interface
  5. uses
  6. Windows, Classes, SysUtils, FileUtil, SdpoSerial, Forms, Controls, Graphics, Dialogs,
  7. Grids, ExtCtrls, Menus, ComCtrls, ActnList, StdActns, LCLProc, StdCtrls, Spin,
  8. XMLPropStorage, uSPS, LCLType, Buttons, types, MCSWINAPI, Math,
  9. fpjson, jsonparser, Midi;
  10. type
  11. { TForm1 }
  12. TForm1 = class(TForm)
  13. acExit: TAction;
  14. acDebug: TAction;
  15. acNextStep: TAction;
  16. acStop: TAction;
  17. acThisStep: TAction;
  18. acShowHexFile: TAction;
  19. acNew: TAction;
  20. acNewRow: TAction;
  21. acDeleteRow: TAction;
  22. acFileSave: TAction;
  23. acHelpAbout: TAction;
  24. acHexFile: TAction;
  25. acNextInsert: TAction;
  26. acSaveAs: TAction;
  27. acUpload: TAction;
  28. ActionList1: TActionList;
  29. acFileOpen: TFileOpen;
  30. btnTone: TBitBtn;
  31. cbIgnDly: TCheckBox;
  32. cbTPSVersion: TComboBox;
  33. cbAdrActual: TCheckBox;
  34. cbHardwareEmu: TCheckBox;
  35. cbSerialNames: TComboBox;
  36. EditDelay: TLabeledEdit;
  37. EditJump: TLabeledEdit;
  38. EditPage: TLabeledEdit;
  39. EditRAdr: TLabeledEdit;
  40. acPresetLoad: TFileOpen;
  41. acPresetSave: TFileSaveAs;
  42. GBControl: TGroupBox;
  43. ImageList2: TImageList;
  44. ImageList3: TImageList;
  45. Label3: TLabel;
  46. Label4: TLabel;
  47. Label5: TLabel;
  48. lbStack: TListBox;
  49. MCSLabel: TLabel;
  50. mmLogMessages: TMemo;
  51. MenuItem1: TMenuItem;
  52. pmExamples: TPopupMenu;
  53. RC1: TSpinEdit;
  54. RC2: TSpinEdit;
  55. cbCommand: TComboBox;
  56. cbData: TComboBox;
  57. Din1: TCheckBox;
  58. Din2: TCheckBox;
  59. Din3: TCheckBox;
  60. Din4: TCheckBox;
  61. GBOutput: TGroupBox;
  62. GBInput: TGroupBox;
  63. GBInternal: TGroupBox;
  64. Label1: TLabel;
  65. Label10: TLabel;
  66. Label11: TLabel;
  67. Label12: TLabel;
  68. Label13: TLabel;
  69. Label14: TLabel;
  70. Label15: TLabel;
  71. Label16: TLabel;
  72. Label17: TLabel;
  73. Label2: TLabel;
  74. Panel2: TPanel;
  75. Panel3: TPanel;
  76. PWM1: TLabeledEdit;
  77. PWM2: TLabeledEdit;
  78. Panel1: TPanel;
  79. ADC1: TSpinEdit;
  80. ADC2: TSpinEdit;
  81. SaveDialog1: TSaveDialog;
  82. SaveHexFile: TSaveDialog;
  83. SaveBinFile: TSaveDialog;
  84. SdpoSerial1: TSdpoSerial;
  85. Servo1: TLabeledEdit;
  86. Servo2: TLabeledEdit;
  87. EditA: TLabeledEdit;
  88. EditC: TLabeledEdit;
  89. EditE: TLabeledEdit;
  90. EditB: TLabeledEdit;
  91. EditD: TLabeledEdit;
  92. EditF: TLabeledEdit;
  93. EditAddr: TLabeledEdit;
  94. Shape1: TShape;
  95. Shape2: TShape;
  96. ShapeOut1: TShape;
  97. ShapeOut2: TShape;
  98. ShapeOut3: TShape;
  99. ShapeOut4: TShape;
  100. SpeedButton1: TSpeedButton;
  101. StatusBar1: TStatusBar;
  102. StringGrid1: TStringGrid;
  103. tbPrg: TToggleBox;
  104. tbPreLoad: TToolButton;
  105. tbPreSave: TToolButton;
  106. tbSel: TToggleBox;
  107. Timer1: TTimer;
  108. ToolBar1: TToolBar;
  109. ToolBar2: TToolBar;
  110. ToolButton1: TToolButton;
  111. ToolButton10: TToolButton;
  112. ToolButton11: TToolButton;
  113. ToolButton12: TToolButton;
  114. ToolButton13: TToolButton;
  115. ToolButton14: TToolButton;
  116. ToolButton15: TToolButton;
  117. ToolButton16: TToolButton;
  118. ToolButton17: TToolButton;
  119. ToolButton18: TToolButton;
  120. tbPreset1: TToolButton;
  121. tbReset: TToolButton;
  122. ToolButton19: TToolButton;
  123. ToolButton2: TToolButton;
  124. tbPreset2: TToolButton;
  125. tbPreset3: TToolButton;
  126. tbPreset4: TToolButton;
  127. tbPreset5: TToolButton;
  128. tbPreset6: TToolButton;
  129. tbPreset7: TToolButton;
  130. tbPreset8: TToolButton;
  131. ToolButton20: TToolButton;
  132. ToolButton21: TToolButton;
  133. ToolButton3: TToolButton;
  134. ToolButton4: TToolButton;
  135. ToolButton5: TToolButton;
  136. ToolButton6: TToolButton;
  137. ToolButton7: TToolButton;
  138. ToolButton8: TToolButton;
  139. ToolButton9: TToolButton;
  140. TOpenDialogPreset: TOpenDialog;
  141. TSaveDialogPreset: TSaveDialog;
  142. XMLPropStorage1: TXMLPropStorage;
  143. procedure acDeleteRowExecute(Sender: TObject);
  144. procedure acExitExecute(Sender: TObject);
  145. procedure acFileOpenAccept(Sender: TObject);
  146. procedure acDebugExecute(Sender: TObject);
  147. procedure acHelpAboutExecute(Sender: TObject);
  148. procedure acHexFileExecute(Sender: TObject);
  149. procedure acNewExecute(Sender: TObject);
  150. procedure acNewRowExecute(Sender: TObject);
  151. procedure acNextInsertExecute(Sender: TObject);
  152. procedure acNextStepExecute(Sender: TObject);
  153. procedure acPresetLoadAccept(Sender: TObject);
  154. procedure acPresetSaveAccept(Sender: TObject);
  155. procedure acSaveAsExecute(Sender: TObject);
  156. procedure acShowHexFileExecute(Sender: TObject);
  157. procedure acStopExecute(Sender: TObject);
  158. procedure acThisStepExecute(Sender: TObject);
  159. procedure acFileSaveExecute(Sender: TObject);
  160. procedure acUploadExecute(Sender: TObject);
  161. procedure btnToneClick(Sender: TObject);
  162. procedure cbCommandChange(Sender: TObject);
  163. procedure cbDataChange(Sender: TObject);
  164. procedure cbHardwareEmuChange(Sender: TObject);
  165. procedure cbIgnDlyChange(Sender: TObject);
  166. procedure cbSerialNamesChange(Sender: TObject);
  167. procedure cbTPSVersionChange(Sender: TObject);
  168. procedure FormActivate(Sender: TObject);
  169. procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
  170. procedure FormCreate(Sender: TObject);
  171. procedure FormDropFiles(Sender: TObject; const FileNames: array of string);
  172. procedure MCSLabelClick(Sender: TObject);
  173. procedure MenuItem1Click(Sender: TObject);
  174. procedure mnSaveClick(Sender: TObject);
  175. procedure pmExamplesPopup(Sender: TObject);
  176. procedure Shape1Paint(Sender: TObject);
  177. procedure Shape2Paint(Sender: TObject);
  178. procedure StringGrid1EditingDone(Sender: TObject);
  179. procedure StringGrid1Selection(Sender: TObject; aCol, aRow: integer);
  180. procedure tbPreset1Click(Sender: TObject);
  181. procedure tbPreset1ContextPopup(Sender: TObject; MousePos: TPoint;
  182. var Handled: boolean);
  183. procedure tbPrgChange(Sender: TObject);
  184. procedure tbResetClick(Sender: TObject);
  185. procedure tbSelChange(Sender: TObject);
  186. procedure Timer1Timer(Sender: TObject);
  187. procedure XMLPropStorage1RestoringProperties(Sender: TObject);
  188. procedure XMLPropStorage1SavingProperties(Sender: TObject);
  189. private
  190. { private declarations }
  191. sps: TSPS;
  192. stopit: boolean;
  193. activeFile: string;
  194. dirty: boolean;
  195. lastNote: byte;
  196. Examples: TStringList;
  197. procedure doStopExecute();
  198. procedure initMidi;
  199. procedure playNote(note: byte);
  200. procedure loadFromList(Lines: TStringList; filename: string);
  201. function readString(var line: string; wait: boolean): boolean;
  202. procedure saveSection(filename: string; key: string);
  203. procedure loadSection(filename: string; key: string);
  204. procedure loadFile(filename: string);
  205. procedure programSps;
  206. procedure nextStep(singleStep: boolean);
  207. procedure renumberGrid;
  208. procedure saveFile(filename: string);
  209. procedure selectAddress(addr: word);
  210. procedure inputSps;
  211. procedure outputSps;
  212. procedure uploadFile;
  213. function serialUpload: string;
  214. procedure setDirty(Value: boolean);
  215. function checkDirty: boolean;
  216. procedure checkPresets;
  217. procedure makeBinFile(fileName: string);
  218. procedure makeHexFile(fileName: string);
  219. procedure setCaption;
  220. procedure addHeaderText;
  221. procedure loadPreset(filename: string);
  222. procedure savePreset(filename: string);
  223. procedure activateSps(enable: boolean);
  224. procedure enableMicrobit(enable: boolean);
  225. procedure outputMicrobit();
  226. procedure inputMicrobit();
  227. public
  228. { public declarations }
  229. end;
  230. var
  231. Form1: TForm1;
  232. implementation
  233. uses MCSAbout, uTextUi, uSelectCom, MCSTools, MCSStrings, synaser,
  234. MCSIO, mcsintelhex, MCSLSU, MCSIniFiles, MCSWinHttp, luijsonutils,
  235. uiMicrobit, uMicrobit;
  236. {$R *.lfm}
  237. procedure delayCallback(Value: integer);
  238. begin
  239. Form1.EditDelay.Text := IntToStr(Value);
  240. Application.ProcessMessages;
  241. end;
  242. { TForm1 }
  243. var
  244. lsuCode: integer;
  245. procedure TForm1.FormCreate(Sender: TObject);
  246. var
  247. line: string;
  248. begin
  249. Infobox.AppTitel := MCSLSU.GetLSUText('infobox', 'ID_APPTITLE', lsuCode);
  250. Infobox.CopyRight := MCSLSU.GetLSUText('infobox', 'ID_COPYRIGHT', lsuCode);
  251. Infobox.Build := MCSGetVersion(Application.ExeName);
  252. Infobox.AppID := 31;
  253. Infobox.AppURL :=
  254. 'http://www.wk-music.de/willie/pages/mcs/microcontroller/tps-sps-emulator.php';
  255. sps := TSPS.Create();
  256. sps.setDelayCallback(@delayCallback);
  257. addHeaderText;
  258. renumberGrid();
  259. cbTPSVersion.ItemIndex := 0;
  260. cbTPSVersionChange(Sender);
  261. acStop.Enabled := False;
  262. ToolButton18.Align := alRight;
  263. MCSLabel.Align := alRight;
  264. cbAdrActual.Enabled := False;
  265. cbIgnDly.Enabled := False;
  266. checkPresets();
  267. tbResetClick(nil);
  268. if Application.ParamCount >= 1 then
  269. begin
  270. line := Application.Params[1];
  271. loadFile(line);
  272. end;
  273. activateSps(False);
  274. Timer1.Enabled := True;
  275. MCSLSU.MakeForm('form1', 'ID_', form1);
  276. initMidi;
  277. Examples := TStringList.Create;
  278. end;
  279. procedure TForm1.initMidi;
  280. var
  281. Value: integer;
  282. begin
  283. lastNote := 0;
  284. MidiOutput.Open(0);
  285. Value := XMLPropStorage1.ReadInteger('MidiProgram', 30);
  286. MidiOutput.Send(0, 192, Value, 0);
  287. end;
  288. procedure TForm1.playNote(note: byte);
  289. var
  290. command, velocity: byte;
  291. begin
  292. if (lastNote > 0) then
  293. begin
  294. command := $80;
  295. velocity := $7F;
  296. MidiOutput.Send(0, command, lastnote, velocity);
  297. end;
  298. if (note > 0) then
  299. begin
  300. command := $90;
  301. velocity := $7F;
  302. MidiOutput.Send(0, command, note, velocity);
  303. end;
  304. lastNote := note;
  305. end;
  306. procedure TForm1.loadFromList(Lines: TStringList; filename: string);
  307. var
  308. i, x: integer;
  309. line: string;
  310. list: TStringList;
  311. begin
  312. acNew.Execute;
  313. list := TStringList.Create;
  314. i := 1;
  315. for x := 0 to Lines.Count - 1 do
  316. begin
  317. if (i + 1 > StringGrid1.RowCount) then
  318. begin
  319. StringGrid1.RowCount := StringGrid1.RowCount + 1;
  320. end;
  321. line := Lines[x];
  322. if (Pos('#', line) = 1) then
  323. begin
  324. line := RightstrPos(line, 2);
  325. if (Pos('TPS:', line) = 1) then
  326. begin
  327. line := RightstrPos(line, 5);
  328. cbTPSVersion.Text := line;
  329. cbTPSVersionChange(nil);
  330. end;
  331. end
  332. else
  333. begin
  334. MCSStrings.DelimSepTextToStringlist(line, '"', ',', list);
  335. if list.Count > 0 then
  336. Stringgrid1.Cells[0, i] := list[0];
  337. if list.Count > 1 then
  338. Stringgrid1.Cells[1, i] := list[1];
  339. if list.Count > 2 then
  340. Stringgrid1.Cells[2, i] := list[2];
  341. if list.Count > 3 then
  342. Stringgrid1.Cells[4, i] := list[3];
  343. list.Clear;
  344. Inc(i);
  345. end;
  346. end;
  347. list.Free;
  348. activeFile := filename;
  349. renumberGrid();
  350. addHeaderText;
  351. setCaption();
  352. setDirty(False);
  353. end;
  354. procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of string);
  355. var
  356. line: string;
  357. begin
  358. if (SizeOF(FileNames) > 0) then
  359. begin
  360. line := FileNames[0];
  361. loadFile(line);
  362. end;
  363. end;
  364. procedure TForm1.MCSLabelClick(Sender: TObject);
  365. begin
  366. ShExec2(self.Handle, InfoBox.AppURL);
  367. end;
  368. procedure TForm1.MenuItem1Click(Sender: TObject);
  369. var
  370. i: integer;
  371. fileName, Data: string;
  372. Lines: TStringList;
  373. begin
  374. if (Sender is TMenuItem) then
  375. begin
  376. if (checkDirty()) then
  377. begin
  378. i := TMenuItem(Sender).Tag;
  379. if (i >= 0) then
  380. begin
  381. filename := examples[i];
  382. Data := DownloadFile('http://wkla.no-ip.biz/down/tps_examples/' + filename);
  383. Lines := TStringList.Create;
  384. Lines.Text := Data;
  385. loadFromList(Lines, filename);
  386. Lines.Free;
  387. end;
  388. end;
  389. end;
  390. end;
  391. procedure TForm1.mnSaveClick(Sender: TObject);
  392. begin
  393. Statusbar1.SimpleText := Sender.ClassName;
  394. end;
  395. procedure TForm1.pmExamplesPopup(Sender: TObject);
  396. var
  397. x, i, j, pos, index: integer;
  398. myName: string;
  399. myMenu, my2Menu: TMenuItem;
  400. jsonString: string;
  401. JsonObject: TJsonObject;
  402. Data, JArray: TJSONData;
  403. JItem: TJSONData;
  404. subMenuName: string;
  405. subMenu: TMenuItem;
  406. begin
  407. for i := pmExamples.Items.Count - 1 downto 0 do
  408. begin
  409. myMenu := pmExamples.Items[i];
  410. if (myMenu.Count > 0) then
  411. begin
  412. for j := myMenu.Count - 1 downto 0 do
  413. begin
  414. my2Menu := myMenu.Items[j];
  415. my2Menu.Free;
  416. end;
  417. myMenu.Clear;
  418. end;
  419. myMenu.Free;
  420. end;
  421. pmExamples.Items.Clear;
  422. Examples.Clear;
  423. try
  424. jsonString := DownloadFile('http://wkla.no-ip.biz/down/tps_examples/examples.json');
  425. Data := StringToJSONData(jsonString);
  426. JsonObject := TJSONObject(Data);
  427. i := JsonObject.Count;
  428. for x := 0 to JsonObject.Count - 1 do
  429. begin
  430. subMenuName := JsonObject.Names[x];
  431. JArray := GetJSONProp(TJSONObject(Data), subMenuName);
  432. if (JArray <> nil) then
  433. begin
  434. subMenu := TMenuItem.Create(pmExamples);
  435. subMenu.Caption := subMenuName;
  436. pmExamples.Items.Add(subMenu);
  437. for i := 1 to TJSONArray(JArray).Count do
  438. begin
  439. JItem := TJSONArray(JArray).Items[i - 1];
  440. myName := GetJsonProp(TJSONObject(JItem), 'name', '');
  441. pos := -1;
  442. index := GetJsonProp(TJSONObject(JItem), 'index', -1);
  443. if (index > -1) then
  444. begin
  445. pos := Examples.Add(GetJsonProp(TJSONObject(JItem), 'file', ''));
  446. myName := format('%.2d - %s', [index, myName]);
  447. end;
  448. myMenu := TMenuItem.Create(subMenu);
  449. myMenu.Caption := myName;
  450. myMenu.Tag := pos;
  451. if (index > -1) then
  452. begin
  453. myMenu.OnClick := @MenuItem1Click;
  454. end;
  455. subMenu.Add(myMenu);
  456. end;
  457. end;
  458. end;
  459. except
  460. end;
  461. end;
  462. procedure TForm1.Shape1Paint(Sender: TObject);
  463. var
  464. radius: integer;
  465. x, y: integer;
  466. begin
  467. radius := round(Shape1.Width / 2);
  468. Shape1.Canvas.Brush.Color := clBlack;
  469. Shape1.canvas.MoveTo(radius, radius);
  470. x := radius - round(radius * cos(degtorad(sps.getServo1())));
  471. y := radius - round(radius * sin(degtorad(sps.getServo1())));
  472. Shape1.Canvas.LineTo(x, y);
  473. end;
  474. procedure TForm1.Shape2Paint(Sender: TObject);
  475. var
  476. radius: integer;
  477. x, y: integer;
  478. begin
  479. radius := round(Shape1.Width / 2);
  480. Shape2.Canvas.Brush.Color := clBlack;
  481. Shape2.canvas.MoveTo(radius, radius);
  482. x := radius - round(radius * cos(degtorad(sps.getServo2())));
  483. y := radius - round(radius * sin(degtorad(sps.getServo2())));
  484. Shape2.Canvas.LineTo(x, y);
  485. end;
  486. procedure TForm1.acExitExecute(Sender: TObject);
  487. begin
  488. Close;
  489. end;
  490. procedure TForm1.acDeleteRowExecute(Sender: TObject);
  491. var
  492. i: integer;
  493. begin
  494. i := StringGrid1.Row;
  495. StringGrid1.DeleteRow(i);
  496. renumberGrid();
  497. end;
  498. procedure TForm1.acFileOpenAccept(Sender: TObject);
  499. var
  500. filename: string;
  501. begin
  502. filename := (Sender as TFileOpen).Dialog.FileName;
  503. loadFile(filename);
  504. end;
  505. procedure TForm1.loadFile(filename: string);
  506. var
  507. i: integer;
  508. f: Text;
  509. line: string;
  510. list: TStringList;
  511. begin
  512. if (checkDirty()) then
  513. begin
  514. if (FileExists(filename)) then
  515. begin
  516. acNew.Execute;
  517. list := TStringList.Create;
  518. i := 1;
  519. AssignFile(f, filename);
  520. Reset(f);
  521. while (not EOF(f)) do
  522. begin
  523. if (i + 1 > StringGrid1.RowCount) then
  524. begin
  525. StringGrid1.RowCount := StringGrid1.RowCount + 1;
  526. end;
  527. readln(f, line);
  528. if (Pos('#', line) = 1) then
  529. begin
  530. line := RightstrPos(line, 2);
  531. if (Pos('TPS:', line) = 1) then
  532. begin
  533. line := RightstrPos(line, 5);
  534. cbTPSVersion.Text := line;
  535. cbTPSVersionChange(nil);
  536. end;
  537. end
  538. else
  539. begin
  540. MCSStrings.DelimSepTextToStringlist(line, '"', ',', list);
  541. if list.Count > 0 then
  542. Stringgrid1.Cells[0, i] := list[0];
  543. if list.Count > 1 then
  544. Stringgrid1.Cells[1, i] := list[1];
  545. if list.Count > 2 then
  546. Stringgrid1.Cells[2, i] := list[2];
  547. if list.Count > 3 then
  548. Stringgrid1.Cells[4, i] := list[3];
  549. list.Clear;
  550. i := i + 1;
  551. end;
  552. end;
  553. CloseFile(f);
  554. list.Free;
  555. activeFile := filename;
  556. renumberGrid();
  557. addHeaderText;
  558. setCaption();
  559. setDirty(False);
  560. end;
  561. end;
  562. end;
  563. procedure TForm1.acSaveAsExecute(Sender: TObject);
  564. var
  565. filename: string;
  566. begin
  567. if SaveDialog1.Execute() then
  568. begin
  569. filename := SaveDialog1.FileName;
  570. saveFile(filename);
  571. end;
  572. end;
  573. procedure TForm1.saveFile(filename: string);
  574. var
  575. x, i: integer;
  576. f: Text;
  577. line: string;
  578. begin
  579. if (filename = '') then
  580. begin
  581. if SaveDialog1.Execute() then
  582. begin
  583. filename := SaveDialog1.FileName;
  584. end;
  585. end;
  586. if (filename <> '') then
  587. begin
  588. AssignFile(f, filename);
  589. Rewrite(f);
  590. line := '#TPS:' + cbTPSVersion.Text;
  591. Writeln(f, line);
  592. i := StringGrid1.RowCount;
  593. for x := 1 to i - 1 do
  594. begin
  595. if (StringGrid1.Cells[1, x] <> '') then
  596. begin
  597. line := StringGrid1.Cells[0, x] + ',' + StringGrid1.Cells[1, x] +
  598. ',' + StringGrid1.Cells[2, x] + ',"' + StringGrid1.Cells[4, x] + '"';
  599. Writeln(f, line);
  600. end;
  601. end;
  602. CloseFile(f);
  603. setDirty(False);
  604. activeFile := filename;
  605. setCaption();
  606. end;
  607. end;
  608. procedure TForm1.acDebugExecute(Sender: TObject);
  609. begin
  610. if (sps.isActive()) then
  611. begin
  612. acStopExecute(Sender);
  613. end
  614. else
  615. begin
  616. activateSps(True);
  617. acDebug.Enabled := True;
  618. acDebug.ImageIndex := 57;
  619. cbAdrActual.Enabled := True;
  620. cbIgnDly.Enabled := True;
  621. acNextStep.Enabled := False;
  622. // sps programmieren
  623. programSps();
  624. // programm starten
  625. Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_START', lsuCode);
  626. sps.start();
  627. stopit := False;
  628. Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_RUNNING', lsuCode);
  629. while (not stopit) do
  630. begin
  631. nextStep(False);
  632. if not sps.isActive() then
  633. begin
  634. stopit := True;
  635. doStopExecute(); // error in sps
  636. end;
  637. if (cbAdrActual.Checked) then
  638. selectAddress(sps.getAddress());
  639. Application.ProcessMessages;
  640. end;
  641. if sps.getLastError() <> '' then
  642. MyMsgBox(sps.getLastError(), 'Error', MB_OK + MB_ICONERROR)
  643. else
  644. Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_STOPPED', lsuCode);
  645. cbAdrActual.Enabled := False;
  646. acNextStep.Enabled := True;
  647. sps.doReset();
  648. end;
  649. end;
  650. procedure TForm1.acHelpAboutExecute(Sender: TObject);
  651. begin
  652. Infobox.Show;
  653. end;
  654. procedure TForm1.acHexFileExecute(Sender: TObject);
  655. var
  656. filename: string;
  657. begin
  658. filename := MCSIO.MCSExtractFileNameExlExt(activeFile) + '.hex';
  659. SaveHexFile.FileName := filename;
  660. if (SaveHexFile.Execute) then
  661. begin
  662. filename := SaveHexFile.FileName;
  663. makeHexFile(filename);
  664. end;
  665. end;
  666. procedure TForm1.acNewExecute(Sender: TObject);
  667. begin
  668. if (checkDirty()) then
  669. begin
  670. StringGrid1.RowCount := 2;
  671. StringGrid1.Clean;
  672. addHeaderText();
  673. renumberGrid();
  674. activeFile := '';
  675. setCaption();
  676. setDirty(False);
  677. end;
  678. end;
  679. procedure TForm1.acNewRowExecute(Sender: TObject);
  680. var
  681. myPos: integer;
  682. i, x: integer;
  683. eot: boolean;
  684. begin
  685. eot := False;
  686. i := StringGrid1.RowCount - 1;
  687. if (i >= (sps.getE2E())) then
  688. begin
  689. LSUAutoMsgBox('Messages', 'ID_PRG_TO_LONG', MB_OK + MB_ICONERROR);
  690. exit;
  691. end;
  692. myPos := StringGrid1.Row;
  693. if (myPos = StringGrid1.RowCount - 1) then
  694. eot := True;
  695. StringGrid1.RowCount := StringGrid1.RowCount + 1;
  696. if (not eot) then
  697. begin
  698. for i := StringGrid1.RowCount - 2 downto myPos do
  699. begin
  700. for x := 1 to StringGrid1.ColCount - 1 do
  701. begin
  702. StringGrid1.Cells[x, i + 1] := StringGrid1.Cells[x, i];
  703. end;
  704. end;
  705. for x := 1 to StringGrid1.ColCount - 1 do
  706. begin
  707. StringGrid1.Cells[x, myPos] := '';
  708. end;
  709. end;
  710. renumberGrid();
  711. end;
  712. procedure TForm1.acNextInsertExecute(Sender: TObject);
  713. var
  714. myPos: integer;
  715. i: integer;
  716. begin
  717. i := StringGrid1.RowCount - 1;
  718. if (i >= (sps.getE2E())) then
  719. begin
  720. LSUAutoMsgBox('Messages', 'ID_PRG_TO_LONG', MB_OK + MB_ICONERROR);
  721. exit;
  722. end;
  723. myPos := StringGrid1.Row;
  724. if (myPos = StringGrid1.RowCount - 1) then
  725. acNewRow.Execute;
  726. StringGrid1.Row := myPos + 1;
  727. renumberGrid();
  728. end;
  729. procedure TForm1.programSps;
  730. var
  731. x, i: integer;
  732. com, Data: byte;
  733. tmp: string;
  734. begin
  735. Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_PROGRAMMING', lsuCode);
  736. i := StringGrid1.RowCount;
  737. for x := 1 to i - 1 do
  738. begin
  739. com := 0;
  740. Data := 0;
  741. tmp := StringGrid1.Cells[1, x];
  742. if (tmp <> '') then
  743. begin
  744. com := HexToInt(tmp);
  745. tmp := StringGrid1.Cells[2, x];
  746. if (tmp <> '') then
  747. Data := HexToInt(tmp);
  748. Data := com * 16 + Data;
  749. end;
  750. sps.writeEEProm(x - 1, Data);
  751. end;
  752. // endekennzeichnung schreiben
  753. sps.writeEEProm(i, $ff);
  754. sps.setIgnoreDelay(cbIgnDly.Checked);
  755. end;
  756. procedure TForm1.acNextStepExecute(Sender: TObject);
  757. begin
  758. nextStep(True);
  759. selectAddress(sps.getAddress());
  760. end;
  761. procedure TForm1.acPresetLoadAccept(Sender: TObject);
  762. var
  763. filename: string;
  764. begin
  765. filename := (Sender as TFileOpen).Dialog.FileName;
  766. loadPreset(filename);
  767. end;
  768. procedure TForm1.acPresetSaveAccept(Sender: TObject);
  769. var
  770. filename: string;
  771. begin
  772. filename := (Sender as TFileSaveAs).Dialog.FileName;
  773. savePreset(filename);
  774. end;
  775. procedure TForm1.nextStep(singleStep: boolean);
  776. begin
  777. if (not sps.isActive()) then
  778. begin
  779. activateSps(True);
  780. programSps;
  781. sps.start();
  782. acStop.Enabled := True;
  783. acDebug.Enabled := False;
  784. end
  785. else
  786. begin
  787. acNextStep.Enabled := False;
  788. acStop.Enabled := True;
  789. inputMicrobit();
  790. inputSps();
  791. sps.nextStep();
  792. outputSps();
  793. outputMicrobit();
  794. acNextStep.Enabled := singleStep;
  795. acStop.Enabled := True;
  796. end;
  797. end;
  798. procedure TForm1.acShowHexFileExecute(Sender: TObject);
  799. var
  800. list: TStringList;
  801. i, x: integer;
  802. line, tmp: string;
  803. Value: byte;
  804. begin
  805. Form2 := TForm2.Create(self);
  806. list := TStringList.Create();
  807. line := MCSLSU.GetLSUText('hexfile', 'ID_START_LINE', lsuCode);
  808. list.add(line);
  809. i := StringGrid1.RowCount;
  810. for x := 1 to i - 1 do
  811. begin
  812. if (StringGrid1.Cells[1, x] <> '') then
  813. begin
  814. tmp := '';
  815. if (StringGrid1.Cells[1, x] = '') then
  816. begin
  817. tmp := ' ';
  818. end
  819. else
  820. begin
  821. tmp := StringGrid1.Cells[1, x];
  822. end;
  823. if (StringGrid1.Cells[2, x] = '') then
  824. begin
  825. tmp := tmp + ' ';
  826. end
  827. else
  828. begin
  829. tmp := tmp + StringGrid1.Cells[2, x];
  830. end;
  831. line := StringGrid1.Cells[0, x] + ': ' + tmp + ' ';
  832. Value := HexToInt(StringGrid1.Cells[1, x]);
  833. tmp := '';
  834. if (Value and 8) > 0 then
  835. tmp := tmp + 'X'
  836. else
  837. tmp := tmp + '0';
  838. if (Value and 4) > 0 then
  839. tmp := tmp + 'X'
  840. else
  841. tmp := tmp + '0';
  842. if (Value and 2) > 0 then
  843. tmp := tmp + 'X'
  844. else
  845. tmp := tmp + '0';
  846. if (Value and 1) > 0 then
  847. tmp := tmp + 'X'
  848. else
  849. tmp := tmp + '0';
  850. line := line + tmp + ' ';
  851. Value := HexToInt(StringGrid1.Cells[2, x]);
  852. tmp := '';
  853. if (Value and 8) > 0 then
  854. tmp := tmp + 'X'
  855. else
  856. tmp := tmp + '0';
  857. if (Value and 4) > 0 then
  858. tmp := tmp + 'X'
  859. else
  860. tmp := tmp + '0';
  861. if (Value and 2) > 0 then
  862. tmp := tmp + 'X'
  863. else
  864. tmp := tmp + '0';
  865. if (Value and 1) > 0 then
  866. tmp := tmp + 'X'
  867. else
  868. tmp := tmp + '0';
  869. line := line + tmp;
  870. line := line + ' ' + StringGrid1.Cells[3, x] + ' ,"' +
  871. StringGrid1.Cells[4, x] + '"';
  872. list.add(line);
  873. end;
  874. end;
  875. Form2.addHexFile(list);
  876. Form2.ShowModal;
  877. Form2.Destroy;
  878. list.Free;
  879. end;
  880. procedure TForm1.acStopExecute(Sender: TObject);
  881. begin
  882. if (sps.isActive()) then
  883. begin
  884. stopit := True;
  885. sps.break();
  886. doStopExecute();
  887. end;
  888. end;
  889. procedure TForm1.doStopExecute();
  890. begin
  891. acDebug.ImageIndex := 40;
  892. // repeat
  893. // Application.ProcessMessages;
  894. // until (not sps.isDelayActive());
  895. sps.doReset();
  896. acStop.Enabled := False;
  897. acDebug.Enabled := True;
  898. outputSps();
  899. selectAddress(0);
  900. activateSps(False);
  901. if SdpoSerial1.Active then begin
  902. SdpoSerial1.Close;
  903. end;
  904. end;
  905. procedure TForm1.acThisStepExecute(Sender: TObject);
  906. var
  907. Data, com: byte;
  908. tmp: string;
  909. begin
  910. inputSps();
  911. try
  912. tmp := StringGrid1.Cells[1, StringGrid1.Row];
  913. if (tmp <> '') then
  914. begin
  915. com := HexToInt(tmp);
  916. tmp := StringGrid1.Cells[2, StringGrid1.Row];
  917. if (tmp <> '') then
  918. Data := HexToInt(tmp);
  919. Data := com * 16 + Data;
  920. end;
  921. sps.doSingleCommand(Data);
  922. except
  923. end;
  924. outputSps();
  925. end;
  926. procedure TForm1.acFileSaveExecute(Sender: TObject);
  927. begin
  928. saveFile(activeFile);
  929. end;
  930. procedure TForm1.acUploadExecute(Sender: TObject);
  931. begin
  932. uploadFile();
  933. //serialUpload;
  934. end;
  935. procedure TForm1.btnToneClick(Sender: TObject);
  936. begin
  937. MidiOutput.SendAllSoundOff(0, 0);
  938. ImageList2.GetBitmap(22, btnTone.Glyph);
  939. end;
  940. function TForm1.serialUpload: string;
  941. var
  942. hexFile: string;
  943. begin
  944. hexFile := MCSIO.CreateUniqueFile(MCSIO.GetTempDir, 'TPS', '.hex');
  945. makeHexFile(hexFile);
  946. Result := hexFile;
  947. end;
  948. procedure TForm1.uploadFile;
  949. var
  950. line: string;
  951. comServices: TStringList;
  952. comService: string;
  953. return: integer;
  954. hexFile: string;
  955. hexFormat: TIntelHexFormat;
  956. prgMem: array of byte;
  957. i, x: integer;
  958. com, Data: byte;
  959. tmp: string;
  960. arduinoPath: string;
  961. cmd, config, mcu: string;
  962. KeyName, StringValue: string;
  963. Res: WideString;
  964. Lines: TStringList;
  965. TimeOut: integer;
  966. error: boolean;
  967. filename: string;
  968. retries: integer;
  969. begin
  970. error := False;
  971. if cbTPSVersion.ItemIndex = 4 then
  972. begin
  973. // microbit code
  974. SaveBinFile.FileName := 'mycobit';
  975. if (SaveBinFile.Execute) then
  976. begin
  977. filename := SaveBinFile.FileName;
  978. makeBinFile(filename);
  979. end;
  980. end
  981. else
  982. begin
  983. line := GetSerialPortNames;
  984. // if (line <> '') then
  985. begin
  986. comServices := TStringList.Create;
  987. MCSStrings.DelimTextToStringlist(line, ',', comServices);
  988. return := mrOk;
  989. line := XMLPropStorage1.ReadString('ComPort', comServices[0]);
  990. frmSelectCom := TfrmSelectCom.Create(self);
  991. frmSelectCom.cbServices.Items.AddStrings(comServices);
  992. frmSelectCom.cbServices.Text := line;
  993. return := frmSelectCom.ShowModal;
  994. comService := frmSelectCom.cbServices.Text;
  995. XMLPropStorage1.WriteString('ComPort', comService);
  996. comServices.Free;
  997. if (return = mrOk) then
  998. begin
  999. Form2 := TForm2.Create(self);
  1000. Form2.Memo1.Clear;
  1001. Form2.Show;
  1002. hexFile := serialUpload;
  1003. SdpoSerial1.BaudRate := br__9600;
  1004. if cbTPSVersion.ItemIndex = 5 then
  1005. begin
  1006. // Micro:bit V2 auto programm
  1007. SdpoSerial1.BaudRate := br115200;
  1008. end;
  1009. SdpoSerial1.Device := comService;
  1010. SdpoSerial1.Active := True;
  1011. retries := 10;
  1012. error := True;
  1013. while retries > 0 do
  1014. begin
  1015. Form2.Memo1.Append('>p');
  1016. SdpoSerial1.WriteData('p');
  1017. if (readString(line, True)) then
  1018. begin
  1019. Form2.Memo1.Append(line);
  1020. if (pos('command', line) > 0) then
  1021. begin
  1022. retries := 0;
  1023. error := False;
  1024. end;
  1025. end;
  1026. if error then
  1027. begin
  1028. Form2.Memo1.Append('>h');
  1029. SdpoSerial1.WriteData('h');
  1030. end;
  1031. Dec(retries);
  1032. end;
  1033. if (not error) then
  1034. begin
  1035. Form2.Memo1.Append('>w');
  1036. SdpoSerial1.WriteData('w');
  1037. if (readString(line, True)) then
  1038. begin
  1039. Form2.Memo1.Append(line);
  1040. if (pos('ready', line) > 0) then
  1041. begin
  1042. Lines := TStringList.Create;
  1043. Lines.LoadFromFile(hexFile);
  1044. for x := 0 to Lines.Count - 1 do
  1045. begin
  1046. Form2.Memo1.Append('>' + Lines.Strings[x]);
  1047. SdpoSerial1.WriteData(Lines.Strings[x] + CRLF);
  1048. Sleep(250);
  1049. if (readString(line, False)) then
  1050. begin
  1051. if line <> '' then
  1052. begin
  1053. line := StringReplace(line, '\r', '', []);
  1054. line := StringReplace(line, '\n', '', []);
  1055. Form2.Memo1.Append(line);
  1056. end;
  1057. end;
  1058. end;
  1059. Form2.Memo1.Append('>e');
  1060. SdpoSerial1.WriteData('e');
  1061. Sleep(250);
  1062. if (readString(line, True)) then
  1063. begin
  1064. if line <> '' then
  1065. begin
  1066. line := StringReplace(line, '\r', '', []);
  1067. line := StringReplace(line, '\n', '', []);
  1068. Form2.Memo1.Append(line);
  1069. end;
  1070. end;
  1071. end
  1072. else
  1073. begin
  1074. error := True;
  1075. end;
  1076. end;
  1077. end;
  1078. if (error) then
  1079. begin
  1080. LSUAutoMsgBox('Messages', 'ID_NOT_READY', MB_OK + MB_ICONERROR);
  1081. end
  1082. else
  1083. begin
  1084. LSUAutoMsgBox('Messages', 'ID_UPLOAD_OK', MB_OK + MB_ICONINFORMATION);
  1085. end;
  1086. Form2.Close();
  1087. Form2.Destroy();
  1088. SdpoSerial1.Active := False;
  1089. DeleteFile(hexFile);
  1090. end;
  1091. end;
  1092. end;
  1093. end;
  1094. function TForm1.readString(var line: string; wait: boolean): boolean;
  1095. var
  1096. TimeOut: integer;
  1097. begin
  1098. Result := False;
  1099. TimeOut := 10;
  1100. if (wait) then
  1101. begin
  1102. while ((not SdpoSerial1.DataAvailable) and (TimeOut > 0)) do
  1103. begin
  1104. Dec(TimeOut);
  1105. Sleep(1000);
  1106. end;
  1107. end;
  1108. if (Timeout > 0) then
  1109. begin
  1110. line := SdpoSerial1.ReadData;
  1111. Result := True;
  1112. end;
  1113. end;
  1114. procedure TForm1.setDirty(Value: boolean);
  1115. begin
  1116. if (dirty <> Value) then
  1117. begin
  1118. dirty := Value;
  1119. if (dirty) then
  1120. begin
  1121. if (Pos('*', Caption) = 0) then
  1122. begin
  1123. Caption := Caption + '*';
  1124. end;
  1125. end
  1126. else
  1127. begin
  1128. if (Pos('*', Caption) > 0) then
  1129. begin
  1130. Caption := Leftstr(Caption, Pos('*', Caption) - 1);
  1131. end;
  1132. end;
  1133. end;
  1134. end;
  1135. function TForm1.checkDirty: boolean;
  1136. var
  1137. i: integer;
  1138. begin
  1139. if (dirty) then
  1140. begin
  1141. i := MCSLSU.LSUAutoMsgBox('Messages', 'SAVE_CHANGES', MB_ICONQUESTION or
  1142. MB_YESNOCANCEL);
  1143. if (i = mrYes) then
  1144. begin
  1145. saveFile(activeFile);
  1146. Result := True;
  1147. end
  1148. else if (i = mrNo) then
  1149. begin
  1150. setDirty(False);
  1151. Result := True;
  1152. end
  1153. else
  1154. begin
  1155. Result := False;
  1156. end;
  1157. end
  1158. else
  1159. begin
  1160. Result := True;
  1161. end;
  1162. end;
  1163. procedure TForm1.checkPresets;
  1164. begin
  1165. if XMLPropStorage1.ReadBoolean('preset_1.set', False) then
  1166. tbPreset1.Caption := '1*'
  1167. else
  1168. tbPreset1.Caption := '1';
  1169. if XMLPropStorage1.ReadBoolean('preset_2.set', False) then
  1170. tbPreset2.Caption := '2*'
  1171. else
  1172. tbPreset2.Caption := '2';
  1173. if XMLPropStorage1.ReadBoolean('preset_3.set', False) then
  1174. tbPreset3.Caption := '3*'
  1175. else
  1176. tbPreset3.Caption := '3';
  1177. if XMLPropStorage1.ReadBoolean('preset_4.set', False) then
  1178. tbPreset4.Caption := '4*'
  1179. else
  1180. tbPreset4.Caption := '4';
  1181. if XMLPropStorage1.ReadBoolean('preset_5.set', False) then
  1182. tbPreset5.Caption := '5*'
  1183. else
  1184. tbPreset5.Caption := '5';
  1185. if XMLPropStorage1.ReadBoolean('preset_6.set', False) then
  1186. tbPreset6.Caption := '6*'
  1187. else
  1188. tbPreset6.Caption := '6';
  1189. if XMLPropStorage1.ReadBoolean('preset_7.set', False) then
  1190. tbPreset7.Caption := '7*'
  1191. else
  1192. tbPreset7.Caption := '7';
  1193. if XMLPropStorage1.ReadBoolean('preset_8.set', False) then
  1194. tbPreset7.Caption := '8*'
  1195. else
  1196. tbPreset7.Caption := '8';
  1197. end;
  1198. procedure TForm1.makeHexFile(fileName: string);
  1199. var
  1200. i, x: integer;
  1201. tmp: string;
  1202. hexFormat: TIntelHexFormat;
  1203. prgMem: array of byte;
  1204. com, Data: byte;
  1205. begin
  1206. i := StringGrid1.RowCount;
  1207. SetLength(prgMem, i);
  1208. for x := 1 to i - 1 do
  1209. begin
  1210. com := 0;
  1211. Data := 0;
  1212. tmp := StringGrid1.Cells[1, x];
  1213. if (tmp <> '') then
  1214. begin
  1215. com := HexToInt(tmp);
  1216. tmp := StringGrid1.Cells[2, x];
  1217. if (tmp <> '') then
  1218. Data := HexToInt(tmp);
  1219. Data := com * 16 + Data;
  1220. end;
  1221. prgMem[x - 1] := Data;
  1222. end;
  1223. hexFormat := TIntelHexFormat.Create(prgMem, 8);
  1224. tmp := hexFormat.Text;
  1225. MCSIO.StrToFile(fileName, tmp);
  1226. hexFormat.Free;
  1227. SetLength(prgMem, 0);
  1228. end;
  1229. procedure TForm1.makeBinFile(fileName: string);
  1230. var
  1231. i, x: integer;
  1232. tmp: string;
  1233. hexFormat: TIntelHexFormat;
  1234. com, Data: byte;
  1235. f: file of byte;
  1236. begin
  1237. i := StringGrid1.RowCount;
  1238. AssignFile(f, fileName);
  1239. Rewrite(f, 1);
  1240. for x := 1 to i - 1 do
  1241. begin
  1242. com := 0;
  1243. Data := 0;
  1244. tmp := StringGrid1.Cells[1, x];
  1245. if (tmp <> '') then
  1246. begin
  1247. com := HexToInt(tmp);
  1248. tmp := StringGrid1.Cells[2, x];
  1249. if (tmp <> '') then
  1250. Data := HexToInt(tmp);
  1251. Data := com * 16 + Data;
  1252. end;
  1253. Write(f, Data);
  1254. end;
  1255. CloseFile(f);
  1256. end;
  1257. procedure TForm1.setCaption;
  1258. begin
  1259. if (activeFile = '') then
  1260. begin
  1261. Caption := MCSLSU.GetLSUText('form1Captions', 'ID_CAPTION', lsuCode);
  1262. end
  1263. else
  1264. begin
  1265. Caption := MCSLSU.GetLSUText('form1Captions', 'ID_CAPTION', lsuCode) +
  1266. ':' + ExtractFileName(activeFile);
  1267. end;
  1268. end;
  1269. procedure TForm1.addHeaderText;
  1270. var
  1271. i: integer;
  1272. begin
  1273. for i := 0 to StringGrid1.Columns.Count - 1 do
  1274. begin
  1275. ;
  1276. StringGrid1.Columns[i].Title.Caption :=
  1277. MCSLSU.GetLSUText('form1Captions', StringGrid1.Columns[i].Title.Caption, lsuCode);
  1278. end;
  1279. StringGrid1.Cells[0, 0] := MCSLSU.GetLSUText('form1Captions',
  1280. 'ID_GRID_STORAGE', lsuCode);
  1281. StringGrid1.Repaint;
  1282. end;
  1283. procedure TForm1.cbCommandChange(Sender: TObject);
  1284. var
  1285. x: integer;
  1286. begin
  1287. cbData.Items.Clear;
  1288. x := cbCommand.ItemIndex;
  1289. sps.getDatas(x, cbData.Items);
  1290. if StringGrid1.Row > 0 then
  1291. begin
  1292. StringGrid1.Cells[1, StringGrid1.Row] := IntToHex(x, 1);
  1293. end;
  1294. end;
  1295. procedure TForm1.cbDataChange(Sender: TObject);
  1296. var
  1297. x: integer;
  1298. begin
  1299. x := cbData.ItemIndex;
  1300. if StringGrid1.Row > 0 then
  1301. begin
  1302. StringGrid1.Cells[2, StringGrid1.Row] := IntToHex(x, 1);
  1303. StringGrid1.Cells[3, StringGrid1.Row] := sps.getCommandText(cbCommand.ItemIndex, x);
  1304. end;
  1305. end;
  1306. procedure TForm1.cbHardwareEmuChange(Sender: TObject);
  1307. var line : String;
  1308. comServices : TStringList;
  1309. begin
  1310. if cbHardwareEmu.Checked then
  1311. begin
  1312. cbSerialNames.Enabled:=true;
  1313. line := GetSerialPortNames;
  1314. comServices := TStringList.Create;
  1315. MCSStrings.DelimTextToStringlist(line, ',', comServices);
  1316. line := XMLPropStorage1.ReadString('ComPort', comServices[0]);
  1317. cbSerialNames.Items.AddStrings(comServices);
  1318. cbSerialNames.Text := line;
  1319. comServices.Free;
  1320. cbSerialNamesChange(sender);
  1321. end;
  1322. end;
  1323. procedure TForm1.cbIgnDlyChange(Sender: TObject);
  1324. begin
  1325. sps.SetIgnoreDelay(cbIgnDly.Checked);
  1326. end;
  1327. procedure TForm1.cbSerialNamesChange(Sender: TObject);
  1328. var retries : integer;
  1329. error : boolean;
  1330. line : string;
  1331. begin
  1332. SdpoSerial1.Active := False;
  1333. SdpoSerial1.BaudRate := br__9600;
  1334. if cbTPSVersion.ItemIndex = 5 then
  1335. begin
  1336. // Micro:bit V2 auto programm
  1337. SdpoSerial1.BaudRate := br115200;
  1338. end;
  1339. SdpoSerial1.Device := cbSerialNames.Text;
  1340. SdpoSerial1.Active := True;
  1341. retries := 10;
  1342. error := True;
  1343. while retries > 0 do
  1344. begin
  1345. SdpoSerial1.WriteData('p');
  1346. if (readString(line, True)) then
  1347. begin
  1348. if (pos('command', line) > 0) then
  1349. begin
  1350. retries := 0;
  1351. error := False;
  1352. end;
  1353. end;
  1354. if error then
  1355. begin
  1356. Form2.Memo1.Append('>h');
  1357. SdpoSerial1.WriteData('h');
  1358. end;
  1359. Dec(retries);
  1360. end;
  1361. if (error) then
  1362. begin
  1363. LSUAutoMsgBox('Messages', 'ID_NOT_READY', MB_OK + MB_ICONERROR);
  1364. end;
  1365. end;
  1366. procedure TForm1.cbTPSVersionChange(Sender: TObject);
  1367. begin
  1368. if (cbTPSVersion.ItemIndex = 0) then
  1369. begin
  1370. // HOLTEC
  1371. sps.setTPSVersion(Holtek);
  1372. Label2.Visible := True;
  1373. ADC2.Visible := True;
  1374. PWM2.Visible := False;
  1375. Label16.Visible := False;
  1376. RC1.Visible := False;
  1377. Label17.Visible := False;
  1378. RC2.Visible := False;
  1379. Servo1.Visible := False;
  1380. Servo2.Visible := False;
  1381. Shape1.Visible := False;
  1382. Shape2.Visible := False;
  1383. EditE.Visible := False;
  1384. EditF.Visible := False;
  1385. acUpload.Enabled := False;
  1386. Label5.Visible := False;
  1387. btnTone.Visible := False;
  1388. ADC1.Value := 0;
  1389. ADC1.MaxValue := 15;
  1390. ADC2.Value := 0;
  1391. ADC2.MaxValue := 15;
  1392. enableMicrobit(False);
  1393. end;
  1394. if (cbTPSVersion.ItemIndex = 1) then
  1395. begin
  1396. // ATMega8
  1397. sps.setTPSVersion(ATMega8);
  1398. Label2.Visible := True;
  1399. ADC2.Visible := True;
  1400. PWM2.Visible := True;
  1401. Label16.Visible := False;
  1402. RC1.Visible := False;
  1403. Label17.Visible := False;
  1404. RC2.Visible := False;
  1405. Servo1.Visible := False;
  1406. Servo2.Visible := False;
  1407. Shape1.Visible := False;
  1408. Shape2.Visible := False;
  1409. EditE.Visible := False;
  1410. EditF.Visible := False;
  1411. acUpload.Enabled := False;
  1412. Label5.Visible := False;
  1413. btnTone.Visible := False;
  1414. ADC1.Value := 0;
  1415. ADC1.MaxValue := 15;
  1416. ADC2.Value := 0;
  1417. ADC2.MaxValue := 15;
  1418. enableMicrobit(False);
  1419. end;
  1420. if ((cbTPSVersion.ItemIndex = 2) or (cbTPSVersion.ItemIndex = 3)) then
  1421. begin
  1422. if (cbTPSVersion.ItemIndex = 2) then
  1423. begin
  1424. // ATMega84
  1425. sps.setTPSVersion(ATTiny84);
  1426. acUpload.Enabled := False;
  1427. Label5.Visible := False;
  1428. btnTone.Visible := False;
  1429. end
  1430. else
  1431. begin
  1432. // Arduino 328
  1433. sps.setTPSVersion(Arduino);
  1434. acUpload.Enabled := True;
  1435. Label5.Visible := True;
  1436. btnTone.Visible := True;
  1437. end;
  1438. Label2.Visible := True;
  1439. ADC2.Visible := True;
  1440. PWM2.Visible := True;
  1441. Label16.Visible := True;
  1442. RC1.Visible := True;
  1443. Label17.Visible := True;
  1444. RC2.Visible := True;
  1445. Servo1.Visible := True;
  1446. Servo2.Visible := True;
  1447. Shape1.Visible := True;
  1448. Shape2.Visible := True;
  1449. EditE.Visible := True;
  1450. EditF.Visible := True;
  1451. ADC1.Value := 0;
  1452. ADC1.MaxValue := 255;
  1453. ADC2.Value := 0;
  1454. ADC2.MaxValue := 255;
  1455. enableMicrobit(False);
  1456. end;
  1457. if (cbTPSVersion.ItemIndex = 4) then
  1458. begin
  1459. // micro:bit
  1460. sps.setTPSVersion(microbit);
  1461. Label2.Visible := True;
  1462. ADC2.Visible := True;
  1463. PWM2.Visible := False;
  1464. Label16.Visible := False;
  1465. RC1.Visible := False;
  1466. Label17.Visible := False;
  1467. RC2.Visible := False;
  1468. Servo1.Visible := False;
  1469. Servo2.Visible := False;
  1470. Shape1.Visible := False;
  1471. Shape2.Visible := False;
  1472. EditE.Visible := False;
  1473. EditF.Visible := False;
  1474. acUpload.Enabled := True;
  1475. Label5.Visible := False;
  1476. btnTone.Visible := False;
  1477. ADC1.Value := 0;
  1478. ADC1.MaxValue := 15;
  1479. ADC2.Value := 0;
  1480. ADC2.MaxValue := 15;
  1481. enableMicrobit(False);
  1482. end;
  1483. if (cbTPSVersion.ItemIndex = 5) then
  1484. begin
  1485. // micro:bit v2
  1486. sps.setTPSVersion(MicroBitV2);
  1487. Label2.Visible := True;
  1488. ADC2.Visible := True;
  1489. PWM2.Visible := True;
  1490. Label16.Visible := True;
  1491. RC1.Visible := True;
  1492. Label17.Visible := True;
  1493. RC2.Visible := True;
  1494. Servo1.Visible := True;
  1495. Servo2.Visible := True;
  1496. Shape1.Visible := True;
  1497. Shape2.Visible := True;
  1498. EditE.Visible := True;
  1499. EditF.Visible := True;
  1500. acUpload.Enabled := True;
  1501. Label5.Visible := True;
  1502. btnTone.Visible := True;
  1503. ADC1.Value := 0;
  1504. ADC1.MaxValue := 15;
  1505. ADC2.Value := 0;
  1506. ADC2.MaxValue := 15;
  1507. enableMicrobit(True);
  1508. end;
  1509. cbCommand.Items.Clear;
  1510. sps.getCommands(cbCommand.Items);
  1511. end;
  1512. procedure TForm1.FormActivate(Sender: TObject);
  1513. begin
  1514. enableMicrobit(cbTPSVersion.ItemIndex = 5);
  1515. end;
  1516. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
  1517. begin
  1518. canClose := checkDirty();
  1519. if canClose then
  1520. begin
  1521. if (sps.isActive()) then
  1522. begin
  1523. acStopExecute(Sender);
  1524. end;
  1525. end;
  1526. end;
  1527. procedure TForm1.StringGrid1EditingDone(Sender: TObject);
  1528. var
  1529. Value: string;
  1530. x: integer;
  1531. begin
  1532. // die aktuelle Zeile ist auch die letzte
  1533. if ((StringGrid1.Row + 1) = StringGrid1.RowCount) then
  1534. begin
  1535. // es wurde auch was eingegeben
  1536. Value := StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row];
  1537. Value := trim(Value);
  1538. if (Value <> '') then
  1539. begin
  1540. if StringGrid1.RowCount <= sps.getE2E() then
  1541. begin
  1542. setDirty(True);
  1543. StringGrid1.RowCount := StringGrid1.RowCount + 1;
  1544. renumberGrid();
  1545. end;
  1546. end;
  1547. end
  1548. else
  1549. begin
  1550. x := StringGrid1.Row;
  1551. StringGrid1.Cells[3, x] :=
  1552. sps.getCommandText(HexToInt(StringGrid1.Cells[1, x]),
  1553. HexToInt(StringGrid1.Cells[2, x]));
  1554. setDirty(True);
  1555. end;
  1556. end;
  1557. procedure TForm1.StringGrid1Selection(Sender: TObject; aCol, aRow: integer);
  1558. begin
  1559. try
  1560. cbCommand.ItemIndex := HexToInt(StringGrid1.Cells[1, aRow]);
  1561. cbCommandChange(Sender);
  1562. cbData.ItemIndex := HexToInt(StringGrid1.Cells[2, aRow]);
  1563. except
  1564. end;
  1565. end;
  1566. procedure TForm1.loadPreset(filename: string);
  1567. var
  1568. x: integer;
  1569. key: string;
  1570. begin
  1571. for x := 1 to 8 do
  1572. begin
  1573. key := 'preset_' + IntToStr(x);
  1574. loadSection(filename, key);
  1575. end;
  1576. checkPresets;
  1577. end;
  1578. procedure TForm1.savePreset(filename: string);
  1579. var
  1580. x: integer;
  1581. key: string;
  1582. begin
  1583. for x := 1 to 8 do
  1584. begin
  1585. key := 'preset_' + IntToStr(x);
  1586. saveSection(filename, key);
  1587. end;
  1588. end;
  1589. procedure TForm1.activateSps(enable: boolean);
  1590. begin
  1591. GBControl.Enabled := enable;
  1592. GBInternal.Enabled := enable;
  1593. GBOutput.Enabled := enable;
  1594. end;
  1595. procedure TForm1.enableMicrobit(enable: boolean);
  1596. begin
  1597. if fMicrobit <> nil then
  1598. begin
  1599. if enable and not fMicrobit.Visible then
  1600. begin
  1601. fMicrobit.Show();
  1602. fMicrobit.Left := Left + Width + 8;
  1603. fMicrobit.Top := Top;
  1604. end;
  1605. if not enable and fMicrobit.Visible then
  1606. fMicrobit.Hide();
  1607. end;
  1608. end;
  1609. procedure TForm1.inputMicrobit();
  1610. begin
  1611. if (fMicrobit <> nil) and fMicrobit.Visible then
  1612. begin
  1613. sps.setACC(fMicrobit.accx.Value, fMicrobit.accz.Value, fMicrobit.accz.Value);
  1614. sps.setComp(fMicrobit.compass.Value);
  1615. sps.setLight(fMicrobit.light.Value);
  1616. sps.setSnd(fMicrobit.snd.Value);
  1617. sps.setGesture(fMicrobit.cbGesture.ItemIndex);
  1618. sps.setLogo(fMicrobit.tbLogo.Checked);
  1619. end;
  1620. end;
  1621. procedure TForm1.outputMicrobit();
  1622. var
  1623. image: TMBImage;
  1624. begin
  1625. if (fMicrobit <> nil) and fMicrobit.Visible then
  1626. begin
  1627. image := sps.getDisplay();
  1628. fMicrobit.setImage(image);
  1629. end;
  1630. end;
  1631. procedure TForm1.saveSection(filename: string; key: string);
  1632. begin
  1633. WriteIniBool(key, 'set', XMLPropStorage1.ReadBoolean(key + '.set', False), filename);
  1634. WriteIniBool(key, 'prg', XMLPropStorage1.ReadBoolean(key + '.prg', False), filename);
  1635. WriteIniBool(key, 'sel', XMLPropStorage1.ReadBoolean(key + '.sel', False), filename);
  1636. WriteIniBool(key, 'input1', XMLPropStorage1.ReadBoolean(key + '.input1', False),
  1637. filename);
  1638. WriteIniBool(key, 'input2', XMLPropStorage1.ReadBoolean(key + '.input2', False),
  1639. filename);
  1640. WriteIniBool(key, 'input3', XMLPropStorage1.ReadBoolean(key + '.input3', False),
  1641. filename);
  1642. WriteIniBool(key, 'input4', XMLPropStorage1.ReadBoolean(key + '.input4', False),
  1643. filename);
  1644. WriteIniInteger(key, 'adc1', XMLPropStorage1.ReadInteger(key + '.adc1', 0), filename);
  1645. WriteIniInteger(key, 'adc2', XMLPropStorage1.ReadInteger(key + '.adc2', 0), filename);
  1646. WriteIniInteger(key, 'rc1', XMLPropStorage1.ReadInteger(key + '.rc1', 0), filename);
  1647. WriteIniInteger(key, 'rc2', XMLPropStorage1.ReadInteger(key + '.rc2', 0), filename);
  1648. WriteIniBool(key, 'logo', XMLPropStorage1.ReadBoolean(key + '.logo', False), filename);
  1649. WriteIniInteger(key, 'accx', XMLPropStorage1.ReadInteger(key + '.accx', 0), filename);
  1650. WriteIniInteger(key, 'accy', XMLPropStorage1.ReadInteger(key + '.accy', 0), filename);
  1651. WriteIniInteger(key, 'accz', XMLPropStorage1.ReadInteger(key + '.accz', 0), filename);
  1652. WriteIniInteger(key, 'sound', XMLPropStorage1.ReadInteger(key + '.sound', 0),
  1653. filename);
  1654. WriteIniInteger(key, 'light', XMLPropStorage1.ReadInteger(key + '.light', 0),
  1655. filename);
  1656. WriteIniInteger(key, 'comp', XMLPropStorage1.ReadInteger(key + '.comp', 0), filename);
  1657. WriteIniInteger(key, 'gesture', XMLPropStorage1.ReadInteger(key +
  1658. '.gesture', 0), filename);
  1659. end;
  1660. procedure TForm1.loadSection(filename: string; key: string);
  1661. begin
  1662. XMLPropStorage1.WriteBoolean(key + '.set', ReadIniBool(key, 'set', False, filename));
  1663. XMLPropStorage1.WriteBoolean(key + '.prg', ReadIniBool(key, 'prg', False, filename));
  1664. XMLPropStorage1.WriteBoolean(key + '.sel', ReadIniBool(key, 'sel', False, filename));
  1665. XMLPropStorage1.WriteBoolean(key + '.input1', ReadIniBool(key,
  1666. 'input1', False, filename));
  1667. XMLPropStorage1.WriteBoolean(key + '.input2', ReadIniBool(key,
  1668. 'input2', False, filename));
  1669. XMLPropStorage1.WriteBoolean(key + '.input3', ReadIniBool(key,
  1670. 'input3', False, filename));
  1671. XMLPropStorage1.WriteBoolean(key + '.input4', ReadIniBool(key,
  1672. 'input4', False, filename));
  1673. XMLPropStorage1.WriteInteger(key + '.adc1', ReadIniInteger(key, 'adc1', 0, filename));
  1674. XMLPropStorage1.WriteInteger(key + '.adc2', ReadIniInteger(key, 'adc2', 0, filename));
  1675. XMLPropStorage1.WriteInteger(key + '.rc1', ReadIniInteger(key, 'rc1', 0, filename));
  1676. XMLPropStorage1.WriteInteger(key + '.rc2', ReadIniInteger(key, 'rc2', 0, filename));
  1677. XMLPropStorage1.WriteBoolean(key + '.logo', ReadIniBool(key, 'logo', False, filename));
  1678. XMLPropStorage1.WriteInteger(key + '.accx', ReadIniInteger(key, 'accx', 0, filename));
  1679. XMLPropStorage1.WriteInteger(key + '.accy', ReadIniInteger(key, 'accy', 0, filename));
  1680. XMLPropStorage1.WriteInteger(key + '.accz', ReadIniInteger(key, 'accz', 0, filename));
  1681. XMLPropStorage1.WriteInteger(key + '.sound', ReadIniInteger(key,
  1682. 'sound', 0, filename));
  1683. XMLPropStorage1.WriteInteger(key + '.light', ReadIniInteger(key,
  1684. 'light', 0, filename));
  1685. XMLPropStorage1.WriteInteger(key + '.comp', ReadIniInteger(key, 'comp', 0, filename));
  1686. XMLPropStorage1.WriteInteger(key + '.gesture', ReadIniInteger(key,
  1687. 'gesture', 0, filename));
  1688. end;
  1689. procedure TForm1.tbPreset1Click(Sender: TObject);
  1690. var
  1691. key: string;
  1692. begin
  1693. if Sender = tbPreset1 then
  1694. key := 'preset_1'
  1695. else
  1696. if Sender = tbPreset2 then
  1697. key := 'preset_2'
  1698. else
  1699. if Sender = tbPreset3 then
  1700. key := 'preset_3'
  1701. else
  1702. if Sender = tbPreset4 then
  1703. key := 'preset_4'
  1704. else
  1705. if Sender = tbPreset5 then
  1706. key := 'preset_5'
  1707. else
  1708. if Sender = tbPreset6 then
  1709. key := 'preset_6'
  1710. else
  1711. if Sender = tbPreset7 then
  1712. key := 'preset_7'
  1713. else
  1714. if Sender = tbPreset8 then
  1715. key := 'preset_8';
  1716. tbSel.Checked := XMLPropStorage1.ReadBoolean(key + '.prg', tbSel.Checked);
  1717. tbPrg.Checked := XMLPropStorage1.ReadBoolean(key + '.sel', tbPrg.Checked);
  1718. Din1.Checked := XMLPropStorage1.ReadBoolean(key + '.input1', Din1.Checked);
  1719. Din2.Checked := XMLPropStorage1.ReadBoolean(key + '.input2', Din2.Checked);
  1720. Din3.Checked := XMLPropStorage1.ReadBoolean(key + '.input3', Din3.Checked);
  1721. Din4.Checked := XMLPropStorage1.ReadBoolean(key + '.input4', Din4.Checked);
  1722. ADC1.Value := XMLPropStorage1.ReadInteger(key + '.adc1', ADC1.Value);
  1723. ADC2.Value := XMLPropStorage1.ReadInteger(key + '.adc2', ADC2.Value);
  1724. RC1.Value := XMLPropStorage1.ReadInteger(key + '.rc1', RC1.Value);
  1725. RC2.Value := XMLPropStorage1.ReadInteger(key + '.rc2', RC2.Value);
  1726. fMicrobit.tbLogo.Checked := XMLPropStorage1.ReadBoolean(key + '.logo',
  1727. fMicrobit.tbLogo.Checked);
  1728. fMicrobit.accx.Value := XMLPropStorage1.ReadInteger(key + '.accx',
  1729. fMicrobit.accx.Value);
  1730. fMicrobit.accy.Value := XMLPropStorage1.ReadInteger(key + '.accy',
  1731. fMicrobit.accy.Value);
  1732. fMicrobit.accz.Value := XMLPropStorage1.ReadInteger(key + '.accz',
  1733. fMicrobit.accz.Value);
  1734. fMicrobit.snd.Value := XMLPropStorage1.ReadInteger(key + '.sound',
  1735. fMicrobit.snd.Value);
  1736. fMicrobit.light.Value := XMLPropStorage1.ReadInteger(key + '.light',
  1737. fMicrobit.light.Value);
  1738. fMicrobit.compass.Value := XMLPropStorage1.ReadInteger(key + '.comp',
  1739. fMicrobit.compass.Value);
  1740. fMicrobit.cbGesture.ItemIndex :=
  1741. XMLPropStorage1.ReadInteger(key + '.gesture', fMicrobit.cbGesture.ItemIndex);
  1742. end;
  1743. procedure TForm1.tbPreset1ContextPopup(Sender: TObject; MousePos: TPoint;
  1744. var Handled: boolean);
  1745. var
  1746. key: string;
  1747. begin
  1748. if Sender = tbPreset1 then
  1749. key := 'preset_1'
  1750. else
  1751. if Sender = tbPreset2 then
  1752. key := 'preset_2'
  1753. else
  1754. if Sender = tbPreset3 then
  1755. key := 'preset_3'
  1756. else
  1757. if Sender = tbPreset4 then
  1758. key := 'preset_4'
  1759. else
  1760. if Sender = tbPreset5 then
  1761. key := 'preset_5'
  1762. else
  1763. if Sender = tbPreset6 then
  1764. key := 'preset_6'
  1765. else
  1766. if Sender = tbPreset7 then
  1767. key := 'preset_7'
  1768. else
  1769. if Sender = tbPreset8 then
  1770. key := 'preset_8';
  1771. XMLPropStorage1.WriteBoolean(key + '.set', True);
  1772. XMLPropStorage1.WriteBoolean(key + '.prg', tbPrg.Checked);
  1773. XMLPropStorage1.WriteBoolean(key + '.sel', tbSel.Checked);
  1774. XMLPropStorage1.WriteBoolean(key + '.input1', Din1.Checked);
  1775. XMLPropStorage1.WriteBoolean(key + '.input2', Din2.Checked);
  1776. XMLPropStorage1.WriteBoolean(key + '.input3', Din3.Checked);
  1777. XMLPropStorage1.WriteBoolean(key + '.input4', Din4.Checked);
  1778. XMLPropStorage1.WriteInteger(key + '.adc1', ADC1.Value);
  1779. XMLPropStorage1.WriteInteger(key + '.adc2', ADC2.Value);
  1780. XMLPropStorage1.WriteInteger(key + '.rc1', RC1.Value);
  1781. XMLPropStorage1.WriteInteger(key + '.rc2', RC2.Value);
  1782. XMLPropStorage1.WriteBoolean(key + '.logo', fMicrobit.tbLogo.Checked);
  1783. XMLPropStorage1.WriteInteger(key + '.accx', fMicrobit.accx.Value);
  1784. XMLPropStorage1.WriteInteger(key + '.accy', fMicrobit.accy.Value);
  1785. XMLPropStorage1.WriteInteger(key + '.accz', fMicrobit.accz.Value);
  1786. XMLPropStorage1.WriteInteger(key + '.sound', fMicrobit.snd.Value);
  1787. XMLPropStorage1.WriteInteger(key + '.light', fMicrobit.light.Value);
  1788. XMLPropStorage1.WriteInteger(key + '.comp', fMicrobit.compass.Value);
  1789. XMLPropStorage1.WriteInteger(key + '.gesture', fMicrobit.cbGesture.ItemIndex);
  1790. checkPresets();
  1791. end;
  1792. procedure TForm1.tbPrgChange(Sender: TObject);
  1793. begin
  1794. if tbPrg.Checked then
  1795. begin
  1796. tbPrg.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_PRG_SEL', lsuCode);
  1797. end
  1798. else
  1799. begin
  1800. tbPrg.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_PRG_NON', lsuCode);
  1801. end;
  1802. end;
  1803. procedure TForm1.tbResetClick(Sender: TObject);
  1804. begin
  1805. tbPrg.Checked := False;
  1806. tbPrg.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_PRG_NON', lsuCode);
  1807. tbSel.Checked := False;
  1808. tbSel.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_SEL_NON', lsuCode);
  1809. Din1.Checked := False;
  1810. Din2.Checked := False;
  1811. Din3.Checked := False;
  1812. Din4.Checked := False;
  1813. ADC1.Value := 0;
  1814. ADC2.Value := 0;
  1815. RC1.Value := 8;
  1816. RC2.Value := 8;
  1817. end;
  1818. procedure TForm1.tbSelChange(Sender: TObject);
  1819. begin
  1820. if tbSel.Checked then
  1821. begin
  1822. tbSel.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_SEL_SEL', lsuCode);
  1823. end
  1824. else
  1825. begin
  1826. tbSel.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_SEL_NON', lsuCode);
  1827. end;
  1828. end;
  1829. procedure TForm1.Timer1Timer(Sender: TObject);
  1830. var
  1831. jsonString: string;
  1832. Data: TJSONData;
  1833. iNetVersion, version: string;
  1834. thisVersion, iVersion: TVersionRecord;
  1835. begin
  1836. MCSLabel.AutoSize := True;
  1837. Timer1.Enabled := False;
  1838. MCSLabel.Hint := InfoBox.versionHint;
  1839. if (InfoBox.newVersion) then
  1840. begin
  1841. MCSLabel.Font.Color := clred;
  1842. MCSLabel.Hint := InfoBox.versionHint + chr($0a) + chr($0d) +
  1843. MCSLSU.GetLSUText('form1Captions', 'ID_CLICK_HERE', lsuCode);
  1844. end;
  1845. MCSLabel.Caption := InfoBox.versionText;
  1846. end;
  1847. procedure TForm1.XMLPropStorage1RestoringProperties(Sender: TObject);
  1848. var
  1849. Uid: TGuid;
  1850. Result: HResult;
  1851. uuid: string;
  1852. begin
  1853. uuid := XMLPropStorage1.ReadString('AppUUID', '');
  1854. if uuid = '' then
  1855. begin
  1856. Result := CreateGuid(Uid);
  1857. if Result = S_OK then
  1858. begin
  1859. uuid := GuidToString(Uid);
  1860. XMLPropStorage1.WriteString('AppUUID', uuid);
  1861. end;
  1862. end;
  1863. Infobox.AppUUID := uuid;
  1864. end;
  1865. procedure TForm1.XMLPropStorage1SavingProperties(Sender: TObject);
  1866. begin
  1867. end;
  1868. procedure TForm1.renumberGrid;
  1869. var
  1870. x, i: integer;
  1871. begin
  1872. i := StringGrid1.RowCount;
  1873. for x := 1 to i - 1 do
  1874. begin
  1875. StringGrid1.Cells[0, x] := '0x' + inttohex(x - 1, 2);
  1876. if (StringGrid1.Cells[1, x] = '') then
  1877. StringGrid1.Cells[1, x] := '0';
  1878. if (StringGrid1.Cells[2, x] = '') then
  1879. StringGrid1.Cells[2, x] := '0';
  1880. StringGrid1.Cells[3, x] :=
  1881. sps.getCommandText(HexToInt(StringGrid1.Cells[1, x]),
  1882. HexToInt(StringGrid1.Cells[2, x]));
  1883. end;
  1884. end;
  1885. procedure TForm1.selectAddress(addr: word);
  1886. begin
  1887. StringGrid1.Row := addr + 1;
  1888. Application.ProcessMessages;
  1889. end;
  1890. procedure TForm1.inputSps;
  1891. var line : string;
  1892. value : longint;
  1893. begin
  1894. if cbHardwareEmu.Checked then begin
  1895. while SdpoSerial1.DataAvailable do
  1896. begin
  1897. readString(line, false);
  1898. mmLogMessages.Lines.Insert(0, line);
  1899. end;
  1900. SdpoSerial1.WriteData('i');
  1901. readString(line, true);
  1902. line := RightstrPos(line, 3);
  1903. value := HexToInt(line);
  1904. mmLogMessages.Lines.Insert(0, line + ' ' + IntToHex(value, 2));
  1905. Din1.Checked:= (value and $01) > 0;
  1906. Din2.Checked:= (value and $02) > 0;
  1907. Din3.Checked:= (value and $04) > 0;
  1908. Din4.Checked:= (value and $08) > 0;
  1909. end;
  1910. sps.setDin1(Din1.Checked);
  1911. sps.setDin2(Din2.Checked);
  1912. sps.setDin3(Din3.Checked);
  1913. sps.setDin4(Din4.Checked);
  1914. sps.setADC1(ADC1.Value);
  1915. sps.setADC2(ADC2.Value);
  1916. sps.setRC1(RC1.Value);
  1917. sps.setRC2(RC2.Value);
  1918. sps.setSPrg(tbPrg.Checked);
  1919. sps.setSSel(tbSel.Checked);
  1920. end;
  1921. procedure TForm1.outputSps;
  1922. var
  1923. List: TStrings;
  1924. i: integer;
  1925. begin
  1926. if sps.isDout1() then
  1927. ShapeOut1.Brush.Color := clRed
  1928. else
  1929. ShapeOut1.Brush.Color := clWhite;
  1930. if sps.isDout2() then
  1931. ShapeOut2.Brush.Color := clRed
  1932. else
  1933. ShapeOut2.Brush.Color := clWhite;
  1934. if sps.isDout3() then
  1935. ShapeOut3.Brush.Color := clRed
  1936. else
  1937. ShapeOut3.Brush.Color := clWhite;
  1938. if sps.isDout4() then
  1939. ShapeOut4.Brush.Color := clRed
  1940. else
  1941. ShapeOut4.Brush.Color := clWhite;
  1942. PWM1.Text := IntToStr(sps.getPWM1());
  1943. PWM2.Text := IntToStr(sps.getPWM2());
  1944. Servo1.Text := IntToStr(sps.getServo1());
  1945. Shape1.Repaint;
  1946. Servo2.Text := IntToStr(sps.getServo2());
  1947. Shape2.Repaint;
  1948. EditA.Text := IntToStr(sps.getARegister());
  1949. EditB.Text := IntToStr(sps.getBRegister());
  1950. EditC.Text := IntToStr(sps.getCRegister());
  1951. EditD.Text := IntToStr(sps.getDRegister());
  1952. EditE.Text := IntToStr(sps.getERegister());
  1953. EditF.Text := IntToStr(sps.getFRegister());
  1954. EditAddr.Text := '0x' + IntToHex(sps.getAddress(), 2);
  1955. EditRAdr.Text := '0x' + IntToHex(sps.getRAdr(), 2);
  1956. EditPage.Text := '0x' + IntToHex(sps.getPage(), 2);
  1957. if (sps.getJump() > 0) then
  1958. EditJump.Text := '0x' + IntToHex(sps.getJump(), 2)
  1959. else
  1960. EditJump.Text := '';
  1961. if (sps.getTone() > 0) then
  1962. begin
  1963. ImageList2.GetBitmap(23, btnTone.Glyph);
  1964. i := round(440 * power(2.0, ((sps.getTone() - 69) / 12)));
  1965. btnTone.Caption := IntToStr(i);
  1966. if (lastNote <> sps.getTone()) then
  1967. begin
  1968. playNote(sps.getTone());
  1969. end;
  1970. btntone.Enabled := True;
  1971. end
  1972. else
  1973. begin
  1974. ImageList2.GetBitmap(22, btnTone.Glyph);
  1975. btnTone.Caption := '';
  1976. if (lastNote <> sps.getTone()) then
  1977. begin
  1978. playNote(0);
  1979. end;
  1980. btntone.Enabled := True;
  1981. end;
  1982. List := TStringList.Create;
  1983. try
  1984. sps.getStack(List);
  1985. lbStack.Clear;
  1986. for i := 0 to List.Count - 1 do
  1987. begin
  1988. lbStack.Items.Add(IntToStr(i) + ':' + List[i]);
  1989. end;
  1990. finally
  1991. List.Free;
  1992. end;
  1993. end;
  1994. end.