ugui.pas 52 KB

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