ugui.pas 47 KB

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