ugui.pas 59 KB

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