ugui.pas 46 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812
  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. if (not readString(line)) then
  955. begin
  956. error := True;
  957. end;
  958. if (not error) then
  959. begin
  960. SdpoSerial1.WriteData('w');
  961. if (readString(line)) then
  962. begin
  963. if (pos('ready', line) > 0) then
  964. begin
  965. Lines := TStringList.Create;
  966. Lines.LoadFromFile(hexFile);
  967. for x := 0 to Lines.Count - 1 do
  968. begin
  969. SdpoSerial1.WriteData(Lines.Strings[x]);
  970. SdpoSerial1.WriteData(CRLF);
  971. Sleep(250);
  972. end;
  973. SdpoSerial1.WriteData('e');
  974. end
  975. else
  976. begin
  977. error := True;
  978. end;
  979. end;
  980. end;
  981. if (error) then
  982. begin
  983. LSUAutoMsgBox('Messages', 'ID_NOT_READY', MB_OK + MB_ICONERROR);
  984. end
  985. else
  986. begin
  987. LSUAutoMsgBox('Messages', 'ID_UPLOAD_OK', MB_OK + MB_ICONINFORMATION);
  988. end;
  989. SdpoSerial1.Active := False;
  990. DeleteFile(hexFile);
  991. end;
  992. end;
  993. end;
  994. end;
  995. function TForm1.readString(var line: string): boolean;
  996. var
  997. TimeOut: integer;
  998. begin
  999. Result := False;
  1000. TimeOut := 10;
  1001. while ((not SdpoSerial1.DataAvailable) and (TimeOut > 0)) do
  1002. begin
  1003. Dec(TimeOut);
  1004. Sleep(1000);
  1005. end;
  1006. if (Timeout > 0) then
  1007. begin
  1008. line := SdpoSerial1.ReadData;
  1009. Result := True;
  1010. end;
  1011. end;
  1012. procedure TForm1.setDirty(Value: boolean);
  1013. begin
  1014. if (dirty <> Value) then
  1015. begin
  1016. dirty := Value;
  1017. if (dirty) then
  1018. begin
  1019. if (Pos('*', Caption) = 0) then
  1020. begin
  1021. Caption := Caption + '*';
  1022. end;
  1023. end
  1024. else
  1025. begin
  1026. if (Pos('*', Caption) > 0) then
  1027. begin
  1028. Caption := Leftstr(Caption, Pos('*', Caption) - 1);
  1029. end;
  1030. end;
  1031. end;
  1032. end;
  1033. function TForm1.checkDirty: boolean;
  1034. var
  1035. i: integer;
  1036. begin
  1037. if (dirty) then
  1038. begin
  1039. i := MCSLSU.LSUAutoMsgBox('Messages', 'SAVE_CHANGES', MB_ICONQUESTION or
  1040. MB_YESNOCANCEL);
  1041. if (i = mrYes) then
  1042. begin
  1043. saveFile(activeFile);
  1044. Result := True;
  1045. end
  1046. else if (i = mrNo) then
  1047. begin
  1048. setDirty(False);
  1049. Result := True;
  1050. end
  1051. else
  1052. begin
  1053. Result := False;
  1054. end;
  1055. end
  1056. else
  1057. begin
  1058. Result := True;
  1059. end;
  1060. end;
  1061. procedure TForm1.checkPresets;
  1062. begin
  1063. if XMLPropStorage1.ReadBoolean('preset_1.set', False) then
  1064. tbPreset1.Caption := '1*'
  1065. else
  1066. tbPreset1.Caption := '1';
  1067. if XMLPropStorage1.ReadBoolean('preset_2.set', False) then
  1068. tbPreset2.Caption := '2*'
  1069. else
  1070. tbPreset2.Caption := '2';
  1071. if XMLPropStorage1.ReadBoolean('preset_3.set', False) then
  1072. tbPreset3.Caption := '3*'
  1073. else
  1074. tbPreset3.Caption := '3';
  1075. if XMLPropStorage1.ReadBoolean('preset_4.set', False) then
  1076. tbPreset4.Caption := '4*'
  1077. else
  1078. tbPreset4.Caption := '4';
  1079. if XMLPropStorage1.ReadBoolean('preset_5.set', False) then
  1080. tbPreset5.Caption := '5*'
  1081. else
  1082. tbPreset5.Caption := '5';
  1083. if XMLPropStorage1.ReadBoolean('preset_6.set', False) then
  1084. tbPreset6.Caption := '6*'
  1085. else
  1086. tbPreset6.Caption := '6';
  1087. if XMLPropStorage1.ReadBoolean('preset_7.set', False) then
  1088. tbPreset7.Caption := '7*'
  1089. else
  1090. tbPreset7.Caption := '7';
  1091. if XMLPropStorage1.ReadBoolean('preset_8.set', False) then
  1092. tbPreset7.Caption := '8*'
  1093. else
  1094. tbPreset7.Caption := '8';
  1095. end;
  1096. procedure TForm1.makeHexFile(fileName: string);
  1097. var
  1098. i, x: integer;
  1099. tmp: string;
  1100. hexFormat: TIntelHexFormat;
  1101. prgMem: array of byte;
  1102. com, Data: byte;
  1103. begin
  1104. i := StringGrid1.RowCount;
  1105. SetLength(prgMem, i);
  1106. for x := 1 to i - 1 do
  1107. begin
  1108. com := 0;
  1109. Data := 0;
  1110. tmp := StringGrid1.Cells[1, x];
  1111. if (tmp <> '') then
  1112. begin
  1113. com := HexToInt(tmp);
  1114. tmp := StringGrid1.Cells[2, x];
  1115. if (tmp <> '') then
  1116. Data := HexToInt(tmp);
  1117. Data := com * 16 + Data;
  1118. end;
  1119. prgMem[x - 1] := Data;
  1120. end;
  1121. hexFormat := TIntelHexFormat.Create(prgMem, 8);
  1122. tmp := hexFormat.Text;
  1123. MCSIO.StrToFile(fileName, tmp);
  1124. hexFormat.Free;
  1125. SetLength(prgMem, 0);
  1126. end;
  1127. procedure TForm1.makeBinFile(fileName: string);
  1128. var
  1129. i, x: integer;
  1130. tmp: string;
  1131. hexFormat: TIntelHexFormat;
  1132. com, Data: byte;
  1133. f: file of byte;
  1134. begin
  1135. i := StringGrid1.RowCount;
  1136. AssignFile(f, fileName);
  1137. Rewrite(f, 1);
  1138. for x := 1 to i - 1 do
  1139. begin
  1140. com := 0;
  1141. Data := 0;
  1142. tmp := StringGrid1.Cells[1, x];
  1143. if (tmp <> '') then
  1144. begin
  1145. com := HexToInt(tmp);
  1146. tmp := StringGrid1.Cells[2, x];
  1147. if (tmp <> '') then
  1148. Data := HexToInt(tmp);
  1149. Data := com * 16 + Data;
  1150. end;
  1151. Write(f, Data);
  1152. end;
  1153. CloseFile(f);
  1154. end;
  1155. procedure TForm1.setCaption;
  1156. begin
  1157. if (activeFile = '') then
  1158. begin
  1159. Caption := MCSLSU.GetLSUText('form1Captions', 'ID_CAPTION', lsuCode);
  1160. end
  1161. else
  1162. begin
  1163. Caption := MCSLSU.GetLSUText('form1Captions', 'ID_CAPTION', lsuCode) +
  1164. ':' + ExtractFileName(activeFile);
  1165. end;
  1166. end;
  1167. procedure TForm1.addHeaderText;
  1168. var
  1169. i: integer;
  1170. begin
  1171. for i := 0 to StringGrid1.Columns.Count - 1 do
  1172. begin
  1173. ;
  1174. StringGrid1.Columns[i].Title.Caption :=
  1175. MCSLSU.GetLSUText('form1Captions', StringGrid1.Columns[i].Title.Caption, lsuCode);
  1176. end;
  1177. StringGrid1.Cells[0, 0] := MCSLSU.GetLSUText('form1Captions',
  1178. 'ID_GRID_STORAGE', lsuCode);
  1179. StringGrid1.Repaint;
  1180. end;
  1181. procedure TForm1.cbCommandChange(Sender: TObject);
  1182. var
  1183. x: integer;
  1184. begin
  1185. cbData.Items.Clear;
  1186. x := cbCommand.ItemIndex;
  1187. sps.getDatas(x, cbData.Items);
  1188. if StringGrid1.Row > 0 then
  1189. begin
  1190. StringGrid1.Cells[1, StringGrid1.Row] := IntToHex(x, 1);
  1191. end;
  1192. end;
  1193. procedure TForm1.cbDataChange(Sender: TObject);
  1194. var
  1195. x: integer;
  1196. begin
  1197. x := cbData.ItemIndex;
  1198. if StringGrid1.Row > 0 then
  1199. begin
  1200. StringGrid1.Cells[2, StringGrid1.Row] := IntToHex(x, 1);
  1201. StringGrid1.Cells[3, StringGrid1.Row] := sps.getCommandText(cbCommand.ItemIndex, x);
  1202. end;
  1203. end;
  1204. procedure TForm1.cbTPSVersionChange(Sender: TObject);
  1205. begin
  1206. if (cbTPSVersion.ItemIndex = 0) then
  1207. begin
  1208. // HOLTEC
  1209. sps.setTPSVersion(Holtek);
  1210. Label2.Visible := True;
  1211. ADC2.Visible := True;
  1212. PWM2.Visible := False;
  1213. Label16.Visible := False;
  1214. RC1.Visible := False;
  1215. Label17.Visible := False;
  1216. RC2.Visible := False;
  1217. Servo1.Visible := False;
  1218. Servo2.Visible := False;
  1219. Shape1.Visible := False;
  1220. Shape2.Visible := False;
  1221. EditE.Visible := False;
  1222. EditF.Visible := False;
  1223. acUpload.Enabled := False;
  1224. Label5.Visible := False;
  1225. btnTone.Visible := False;
  1226. ADC1.Value := 0;
  1227. ADC1.MaxValue := 15;
  1228. ADC2.Value := 0;
  1229. ADC2.MaxValue := 15;
  1230. end;
  1231. if (cbTPSVersion.ItemIndex = 1) then
  1232. begin
  1233. // ATMega8
  1234. sps.setTPSVersion(ATMega8);
  1235. Label2.Visible := True;
  1236. ADC2.Visible := True;
  1237. PWM2.Visible := True;
  1238. Label16.Visible := False;
  1239. RC1.Visible := False;
  1240. Label17.Visible := False;
  1241. RC2.Visible := False;
  1242. Servo1.Visible := False;
  1243. Servo2.Visible := False;
  1244. Shape1.Visible := False;
  1245. Shape2.Visible := False;
  1246. EditE.Visible := False;
  1247. EditF.Visible := False;
  1248. acUpload.Enabled := False;
  1249. Label5.Visible := False;
  1250. btnTone.Visible := False;
  1251. ADC1.Value := 0;
  1252. ADC1.MaxValue := 15;
  1253. ADC2.Value := 0;
  1254. ADC2.MaxValue := 15;
  1255. end;
  1256. if ((cbTPSVersion.ItemIndex = 2) or (cbTPSVersion.ItemIndex = 3)) then
  1257. begin
  1258. if (cbTPSVersion.ItemIndex = 2) then
  1259. begin
  1260. // ATMega84
  1261. sps.setTPSVersion(ATTiny84);
  1262. acUpload.Enabled := False;
  1263. Label5.Visible := False;
  1264. btnTone.Visible := False;
  1265. end
  1266. else
  1267. begin
  1268. // Arduino 328
  1269. sps.setTPSVersion(Arduino);
  1270. acUpload.Enabled := True;
  1271. Label5.Visible := True;
  1272. btnTone.Visible := True;
  1273. end;
  1274. Label2.Visible := True;
  1275. ADC2.Visible := True;
  1276. PWM2.Visible := True;
  1277. Label16.Visible := True;
  1278. RC1.Visible := True;
  1279. Label17.Visible := True;
  1280. RC2.Visible := True;
  1281. Servo1.Visible := True;
  1282. Servo2.Visible := True;
  1283. Shape1.Visible := True;
  1284. Shape2.Visible := True;
  1285. EditE.Visible := True;
  1286. EditF.Visible := True;
  1287. ADC1.Value := 0;
  1288. ADC1.MaxValue := 255;
  1289. ADC2.Value := 0;
  1290. ADC2.MaxValue := 255;
  1291. end;
  1292. if (cbTPSVersion.ItemIndex = 4) then
  1293. begin
  1294. // micro:bit
  1295. sps.setTPSVersion(microbit);
  1296. Label2.Visible := True;
  1297. ADC2.Visible := True;
  1298. PWM2.Visible := False;
  1299. Label16.Visible := False;
  1300. RC1.Visible := False;
  1301. Label17.Visible := False;
  1302. RC2.Visible := False;
  1303. Servo1.Visible := False;
  1304. Servo2.Visible := False;
  1305. Shape1.Visible := False;
  1306. Shape2.Visible := False;
  1307. EditE.Visible := False;
  1308. EditF.Visible := False;
  1309. acUpload.Enabled := True;
  1310. Label5.Visible := False;
  1311. btnTone.Visible := False;
  1312. ADC1.Value := 0;
  1313. ADC1.MaxValue := 15;
  1314. ADC2.Value := 0;
  1315. ADC2.MaxValue := 15;
  1316. end;
  1317. cbCommand.Items.Clear;
  1318. sps.getCommands(cbCommand.Items);
  1319. end;
  1320. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
  1321. begin
  1322. canClose := checkDirty();
  1323. end;
  1324. procedure TForm1.StringGrid1EditingDone(Sender: TObject);
  1325. var
  1326. Value: string;
  1327. x: integer;
  1328. begin
  1329. // die aktuelle Zeile ist auch die letzte
  1330. if ((StringGrid1.Row + 1) = StringGrid1.RowCount) then
  1331. begin
  1332. // es wurde auch was eingegeben
  1333. Value := StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row];
  1334. Value := trim(Value);
  1335. if (Value <> '') then
  1336. begin
  1337. setDirty(True);
  1338. StringGrid1.RowCount := StringGrid1.RowCount + 1;
  1339. renumberGrid();
  1340. end;
  1341. end
  1342. else
  1343. begin
  1344. x := StringGrid1.Row;
  1345. StringGrid1.Cells[3, x] :=
  1346. sps.getCommandText(HexToInt(StringGrid1.Cells[1, x]),
  1347. HexToInt(StringGrid1.Cells[2, x]));
  1348. setDirty(True);
  1349. end;
  1350. end;
  1351. procedure TForm1.StringGrid1Selection(Sender: TObject; aCol, aRow: integer);
  1352. begin
  1353. try
  1354. cbCommand.ItemIndex := HexToInt(StringGrid1.Cells[1, aRow]);
  1355. cbCommandChange(Sender);
  1356. cbData.ItemIndex := HexToInt(StringGrid1.Cells[2, aRow]);
  1357. except
  1358. end;
  1359. end;
  1360. procedure TForm1.loadPreset(filename: string);
  1361. var
  1362. x: integer;
  1363. key: string;
  1364. begin
  1365. for x := 1 to 8 do
  1366. begin
  1367. key := 'preset_' + IntToStr(x);
  1368. loadSection(filename, key);
  1369. end;
  1370. checkPresets;
  1371. end;
  1372. procedure TForm1.savePreset(filename: string);
  1373. var
  1374. x: integer;
  1375. key: string;
  1376. begin
  1377. for x := 1 to 8 do
  1378. begin
  1379. key := 'preset_' + IntToStr(x);
  1380. saveSection(filename, key);
  1381. end;
  1382. end;
  1383. procedure TForm1.activateSps(enable: boolean);
  1384. begin
  1385. GBControl.Enabled := enable;
  1386. GBInternal.Enabled := enable;
  1387. GBOutput.Enabled := enable;
  1388. ;
  1389. end;
  1390. procedure TForm1.saveSection(filename: string; key: string);
  1391. begin
  1392. WriteIniBool(key, 'set', XMLPropStorage1.ReadBoolean(key + '.set', False), filename);
  1393. WriteIniBool(key, 'prg', XMLPropStorage1.ReadBoolean(key + '.prg', False), filename);
  1394. WriteIniBool(key, 'sel', XMLPropStorage1.ReadBoolean(key + '.sel', False), filename);
  1395. WriteIniBool(key, 'input1', XMLPropStorage1.ReadBoolean(key + '.input1', False),
  1396. filename);
  1397. WriteIniBool(key, 'input2', XMLPropStorage1.ReadBoolean(key + '.input2', False),
  1398. filename);
  1399. WriteIniBool(key, 'input3', XMLPropStorage1.ReadBoolean(key + '.input3', False),
  1400. filename);
  1401. WriteIniBool(key, 'input4', XMLPropStorage1.ReadBoolean(key + '.input4', False),
  1402. filename);
  1403. WriteIniInteger(key, 'adc1', XMLPropStorage1.ReadInteger(key + '.adc1', 0), filename);
  1404. WriteIniInteger(key, 'adc2', XMLPropStorage1.ReadInteger(key + '.adc2', 0), filename);
  1405. WriteIniInteger(key, 'rc1', XMLPropStorage1.ReadInteger(key + '.rc1', 0), filename);
  1406. WriteIniInteger(key, 'rc2', XMLPropStorage1.ReadInteger(key + '.rc2', 0), filename);
  1407. end;
  1408. procedure TForm1.loadSection(filename: string; key: string);
  1409. begin
  1410. XMLPropStorage1.WriteBoolean(key + '.set', ReadIniBool(key, 'set', False, filename));
  1411. XMLPropStorage1.WriteBoolean(key + '.prg', ReadIniBool(key, 'prg', False, filename));
  1412. XMLPropStorage1.WriteBoolean(key + '.sel', ReadIniBool(key, 'sel', False, filename));
  1413. XMLPropStorage1.WriteBoolean(key + '.input1', ReadIniBool(key,
  1414. 'input1', False, filename));
  1415. XMLPropStorage1.WriteBoolean(key + '.input2', ReadIniBool(key,
  1416. 'input2', False, filename));
  1417. XMLPropStorage1.WriteBoolean(key + '.input3', ReadIniBool(key,
  1418. 'input3', False, filename));
  1419. XMLPropStorage1.WriteBoolean(key + '.input4', ReadIniBool(key,
  1420. 'input4', False, filename));
  1421. XMLPropStorage1.WriteInteger(key + '.adc1', ReadIniInteger(key, 'adc1', 0, filename));
  1422. XMLPropStorage1.WriteInteger(key + '.adc2', ReadIniInteger(key, 'adc2', 0, filename));
  1423. XMLPropStorage1.WriteInteger(key + '.rc1', ReadIniInteger(key, 'rc1', 0, filename));
  1424. XMLPropStorage1.WriteInteger(key + '.rc2', ReadIniInteger(key, 'rc2', 0, filename));
  1425. end;
  1426. procedure TForm1.tbPreset1Click(Sender: TObject);
  1427. var
  1428. key: string;
  1429. begin
  1430. if Sender = tbPreset1 then
  1431. key := 'preset_1'
  1432. else
  1433. if Sender = tbPreset2 then
  1434. key := 'preset_2'
  1435. else
  1436. if Sender = tbPreset3 then
  1437. key := 'preset_3'
  1438. else
  1439. if Sender = tbPreset4 then
  1440. key := 'preset_4'
  1441. else
  1442. if Sender = tbPreset5 then
  1443. key := 'preset_5'
  1444. else
  1445. if Sender = tbPreset6 then
  1446. key := 'preset_6'
  1447. else
  1448. if Sender = tbPreset7 then
  1449. key := 'preset_7'
  1450. else
  1451. if Sender = tbPreset8 then
  1452. key := 'preset_8';
  1453. tbSel.Checked := XMLPropStorage1.ReadBoolean(key + '.prg', tbSel.Checked);
  1454. tbPrg.Checked := XMLPropStorage1.ReadBoolean(key + '.sel', tbPrg.Checked);
  1455. Din1.Checked := XMLPropStorage1.ReadBoolean(key + '.input1', Din1.Checked);
  1456. Din2.Checked := XMLPropStorage1.ReadBoolean(key + '.input2', Din2.Checked);
  1457. Din3.Checked := XMLPropStorage1.ReadBoolean(key + '.input3', Din3.Checked);
  1458. Din4.Checked := XMLPropStorage1.ReadBoolean(key + '.input4', Din4.Checked);
  1459. ADC1.Value := XMLPropStorage1.ReadInteger(key + '.adc1', ADC1.Value);
  1460. ADC2.Value := XMLPropStorage1.ReadInteger(key + '.adc2', ADC2.Value);
  1461. RC1.Value := XMLPropStorage1.ReadInteger(key + '.rc1', RC1.Value);
  1462. RC2.Value := XMLPropStorage1.ReadInteger(key + '.rc2', RC2.Value);
  1463. end;
  1464. procedure TForm1.tbPreset1ContextPopup(Sender: TObject; MousePos: TPoint;
  1465. var Handled: boolean);
  1466. var
  1467. key: string;
  1468. begin
  1469. if Sender = tbPreset1 then
  1470. key := 'preset_1'
  1471. else
  1472. if Sender = tbPreset2 then
  1473. key := 'preset_2'
  1474. else
  1475. if Sender = tbPreset3 then
  1476. key := 'preset_3'
  1477. else
  1478. if Sender = tbPreset4 then
  1479. key := 'preset_4'
  1480. else
  1481. if Sender = tbPreset5 then
  1482. key := 'preset_5'
  1483. else
  1484. if Sender = tbPreset6 then
  1485. key := 'preset_6'
  1486. else
  1487. if Sender = tbPreset7 then
  1488. key := 'preset_7'
  1489. else
  1490. if Sender = tbPreset8 then
  1491. key := 'preset_8';
  1492. XMLPropStorage1.WriteBoolean(key + '.set', True);
  1493. XMLPropStorage1.WriteBoolean(key + '.prg', tbPrg.Checked);
  1494. XMLPropStorage1.WriteBoolean(key + '.sel', tbSel.Checked);
  1495. XMLPropStorage1.WriteBoolean(key + '.input1', Din1.Checked);
  1496. XMLPropStorage1.WriteBoolean(key + '.input2', Din2.Checked);
  1497. XMLPropStorage1.WriteBoolean(key + '.input3', Din3.Checked);
  1498. XMLPropStorage1.WriteBoolean(key + '.input4', Din4.Checked);
  1499. XMLPropStorage1.WriteInteger(key + '.adc1', ADC1.Value);
  1500. XMLPropStorage1.WriteInteger(key + '.adc2', ADC2.Value);
  1501. XMLPropStorage1.WriteInteger(key + '.rc1', RC1.Value);
  1502. XMLPropStorage1.WriteInteger(key + '.rc2', RC2.Value);
  1503. checkPresets();
  1504. end;
  1505. procedure TForm1.tbPrgChange(Sender: TObject);
  1506. begin
  1507. if tbPrg.Checked then
  1508. begin
  1509. tbPrg.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_PRG_SEL', lsuCode);
  1510. end
  1511. else
  1512. begin
  1513. tbPrg.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_PRG_NON', lsuCode);
  1514. end;
  1515. end;
  1516. procedure TForm1.tbResetClick(Sender: TObject);
  1517. begin
  1518. tbPrg.Checked := False;
  1519. tbPrg.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_PRG_NON', lsuCode);
  1520. tbSel.Checked := False;
  1521. tbSel.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_SEL_NON', lsuCode);
  1522. Din1.Checked := False;
  1523. Din2.Checked := False;
  1524. Din3.Checked := False;
  1525. Din4.Checked := False;
  1526. ADC1.Value := 0;
  1527. ADC2.Value := 0;
  1528. RC1.Value := 8;
  1529. RC2.Value := 8;
  1530. end;
  1531. procedure TForm1.tbSelChange(Sender: TObject);
  1532. begin
  1533. if tbSel.Checked then
  1534. begin
  1535. tbSel.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_SEL_SEL', lsuCode);
  1536. end
  1537. else
  1538. begin
  1539. tbSel.Hint := MCSLSU.GetLSUText('form1Hints', 'ID_BTN_SEL_NON', lsuCode);
  1540. end;
  1541. end;
  1542. procedure TForm1.Timer1Timer(Sender: TObject);
  1543. var
  1544. jsonString: string;
  1545. Data: TJSONData;
  1546. iNetVersion, version: string;
  1547. thisVersion, iVersion: TVersionRecord;
  1548. begin
  1549. MCSLabel.AutoSize := True;
  1550. Timer1.Enabled := False;
  1551. MCSLabel.Hint := InfoBox.versionHint;
  1552. if (InfoBox.newVersion) then
  1553. begin
  1554. MCSLabel.Font.Color := clred;
  1555. MCSLabel.Hint := InfoBox.versionHint + chr($0a) + chr($0d) +
  1556. MCSLSU.GetLSUText('form1Captions', 'ID_CLICK_HERE', lsuCode);
  1557. end;
  1558. MCSLabel.Caption := InfoBox.versionText;
  1559. end;
  1560. procedure TForm1.XMLPropStorage1RestoringProperties(Sender: TObject);
  1561. var
  1562. Uid: TGuid;
  1563. Result: HResult;
  1564. uuid: string;
  1565. begin
  1566. uuid := XMLPropStorage1.ReadString('AppUUID', '');
  1567. if uuid = '' then
  1568. begin
  1569. Result := CreateGuid(Uid);
  1570. if Result = S_OK then
  1571. begin
  1572. uuid := GuidToString(Uid);
  1573. XMLPropStorage1.WriteString('AppUUID', uuid);
  1574. end;
  1575. end;
  1576. Infobox.AppUUID := uuid;
  1577. end;
  1578. procedure TForm1.XMLPropStorage1SavingProperties(Sender: TObject);
  1579. begin
  1580. end;
  1581. procedure TForm1.renumberGrid;
  1582. var
  1583. x, i: integer;
  1584. begin
  1585. i := StringGrid1.RowCount;
  1586. for x := 1 to i - 1 do
  1587. begin
  1588. StringGrid1.Cells[0, x] := '0x' + inttohex(x - 1, 2);
  1589. if (StringGrid1.Cells[1, x] = '') then
  1590. StringGrid1.Cells[1, x] := '0';
  1591. if (StringGrid1.Cells[2, x] = '') then
  1592. StringGrid1.Cells[2, x] := '0';
  1593. StringGrid1.Cells[3, x] :=
  1594. sps.getCommandText(HexToInt(StringGrid1.Cells[1, x]),
  1595. HexToInt(StringGrid1.Cells[2, x]));
  1596. end;
  1597. end;
  1598. procedure TForm1.selectAddress(addr: byte);
  1599. begin
  1600. StringGrid1.Row := addr + 1;
  1601. Application.ProcessMessages;
  1602. end;
  1603. procedure TForm1.inputSps;
  1604. begin
  1605. sps.setDin1(Din1.Checked);
  1606. sps.setDin2(Din2.Checked);
  1607. sps.setDin3(Din3.Checked);
  1608. sps.setDin4(Din4.Checked);
  1609. sps.setADC1(ADC1.Value);
  1610. sps.setADC2(ADC2.Value);
  1611. sps.setRC1(RC1.Value);
  1612. sps.setRC2(RC2.Value);
  1613. sps.setSPrg(tbPrg.Checked);
  1614. sps.setSSel(tbSel.Checked);
  1615. end;
  1616. procedure TForm1.outputSps;
  1617. var
  1618. List: TStrings;
  1619. i: integer;
  1620. begin
  1621. if sps.isDout1() then
  1622. ShapeOut1.Brush.Color := clRed
  1623. else
  1624. ShapeOut1.Brush.Color := clWhite;
  1625. if sps.isDout2() then
  1626. ShapeOut2.Brush.Color := clRed
  1627. else
  1628. ShapeOut2.Brush.Color := clWhite;
  1629. if sps.isDout3() then
  1630. ShapeOut3.Brush.Color := clRed
  1631. else
  1632. ShapeOut3.Brush.Color := clWhite;
  1633. if sps.isDout4() then
  1634. ShapeOut4.Brush.Color := clRed
  1635. else
  1636. ShapeOut4.Brush.Color := clWhite;
  1637. PWM1.Text := IntToStr(sps.getPWM1());
  1638. PWM2.Text := IntToStr(sps.getPWM2());
  1639. Servo1.Text := IntToStr(sps.getServo1());
  1640. Shape1.Repaint;
  1641. Servo2.Text := IntToStr(sps.getServo2());
  1642. Shape2.Repaint;
  1643. EditA.Text := IntToStr(sps.getARegister());
  1644. EditB.Text := IntToStr(sps.getBRegister());
  1645. EditC.Text := IntToStr(sps.getCRegister());
  1646. EditD.Text := IntToStr(sps.getDRegister());
  1647. EditE.Text := IntToStr(sps.getERegister());
  1648. EditF.Text := IntToStr(sps.getFRegister());
  1649. EditAddr.Text := '0x' + IntToHex(sps.getAddress(), 2);
  1650. EditRAdr.Text := '0x' + IntToHex(sps.getRAdr(), 2);
  1651. EditPage.Text := '0x' + IntToHex(sps.getPage(), 2);
  1652. if (sps.getJump() > 0) then
  1653. EditJump.Text := '0x' + IntToHex(sps.getJump(), 2)
  1654. else
  1655. EditJump.Text := '';
  1656. if (sps.getTone() > 0) then
  1657. begin
  1658. ImageList2.GetBitmap(23, btnTone.Glyph);
  1659. i := round(440 * power(2.0, ((sps.getTone() - 69) / 12)));
  1660. btnTone.Caption := IntToStr(i);
  1661. if (lastNote <> sps.getTone()) then
  1662. begin
  1663. playNote(sps.getTone());
  1664. end;
  1665. btntone.Enabled := True;
  1666. end
  1667. else
  1668. begin
  1669. ImageList2.GetBitmap(22, btnTone.Glyph);
  1670. btnTone.Caption := '';
  1671. if (lastNote <> sps.getTone()) then
  1672. begin
  1673. playNote(0);
  1674. end;
  1675. btntone.Enabled := True;
  1676. end;
  1677. List := TStringList.Create;
  1678. try
  1679. sps.getStack(List);
  1680. lbStack.Clear;
  1681. for i := 0 to List.Count - 1 do
  1682. begin
  1683. lbStack.Items.Add(IntToStr(i) + ':' + List[i]);
  1684. end;
  1685. finally
  1686. List.Free;
  1687. end;
  1688. end;
  1689. end.