ugui.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275
  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. type
  10. { TForm1 }
  11. TForm1 = class(TForm)
  12. acExit: TAction;
  13. acDebug: TAction;
  14. acNextStep: TAction;
  15. acStop: TAction;
  16. acThisStep: TAction;
  17. acShowHexFile: TAction;
  18. acNew: TAction;
  19. acNewRow: TAction;
  20. acDeleteRow: TAction;
  21. acFileSave: TAction;
  22. acHelpAbout: TAction;
  23. acHexFile: TAction;
  24. acUpload: TAction;
  25. ActionList1: TActionList;
  26. acFileOpen: TFileOpen;
  27. acFileSaveAs: TFileSaveAs;
  28. btnTone: TBitBtn;
  29. cbTPSVersion: TComboBox;
  30. cbAdrActual: TCheckBox;
  31. EditDelay: TLabeledEdit;
  32. EditPage: TLabeledEdit;
  33. EditRAdr: TLabeledEdit;
  34. GroupBox4: TGroupBox;
  35. ImageList2: TImageList;
  36. Label3: TLabel;
  37. Label4: TLabel;
  38. Label5: TLabel;
  39. lbStack: TListBox;
  40. MCSLabel: TLabel;
  41. RC1: TSpinEdit;
  42. RC2: TSpinEdit;
  43. cbCommand: TComboBox;
  44. cbData: TComboBox;
  45. Din1: TCheckBox;
  46. Din2: TCheckBox;
  47. Din3: TCheckBox;
  48. Din4: TCheckBox;
  49. GroupBox1: TGroupBox;
  50. GroupBox2: TGroupBox;
  51. GroupBox3: TGroupBox;
  52. ImageList1: TImageList;
  53. Label1: TLabel;
  54. Label10: TLabel;
  55. Label11: TLabel;
  56. Label12: TLabel;
  57. Label13: TLabel;
  58. Label14: TLabel;
  59. Label15: TLabel;
  60. Label16: TLabel;
  61. Label17: TLabel;
  62. Label2: TLabel;
  63. Panel2: TPanel;
  64. Panel3: TPanel;
  65. PWM1: TLabeledEdit;
  66. PWM2: TLabeledEdit;
  67. Panel1: TPanel;
  68. ADC1: TSpinEdit;
  69. ADC2: TSpinEdit;
  70. SaveDialog1: TSaveDialog;
  71. SaveHexFile: TSaveDialog;
  72. Servo1: TLabeledEdit;
  73. Servo2: TLabeledEdit;
  74. EditA: TLabeledEdit;
  75. EditC: TLabeledEdit;
  76. EditE: TLabeledEdit;
  77. EditB: TLabeledEdit;
  78. EditD: TLabeledEdit;
  79. EditF: TLabeledEdit;
  80. EditAddr: TLabeledEdit;
  81. Shape1: TShape;
  82. Shape2: TShape;
  83. ShapeOut1: TShape;
  84. ShapeOut2: TShape;
  85. ShapeOut3: TShape;
  86. ShapeOut4: TShape;
  87. StatusBar1: TStatusBar;
  88. StringGrid1: TStringGrid;
  89. tbPrg: TToggleBox;
  90. tbSel: TToggleBox;
  91. Timer1: TTimer;
  92. ToolBar1: TToolBar;
  93. ToolBar2: TToolBar;
  94. ToolButton1: TToolButton;
  95. ToolButton10: TToolButton;
  96. ToolButton11: TToolButton;
  97. ToolButton12: TToolButton;
  98. ToolButton13: TToolButton;
  99. ToolButton14: TToolButton;
  100. ToolButton15: TToolButton;
  101. ToolButton16: TToolButton;
  102. ToolButton17: TToolButton;
  103. ToolButton18: TToolButton;
  104. tbPreset1: TToolButton;
  105. tbReset: TToolButton;
  106. ToolButton19: TToolButton;
  107. ToolButton2: TToolButton;
  108. tbPreset2: TToolButton;
  109. tbPreset3: TToolButton;
  110. tbPreset4: TToolButton;
  111. tbPreset5: TToolButton;
  112. tbPreset6: TToolButton;
  113. tbPreset7: TToolButton;
  114. tbPreset8: TToolButton;
  115. ToolButton3: TToolButton;
  116. ToolButton4: TToolButton;
  117. ToolButton5: TToolButton;
  118. ToolButton6: TToolButton;
  119. ToolButton7: TToolButton;
  120. ToolButton8: TToolButton;
  121. ToolButton9: TToolButton;
  122. XMLPropStorage1: TXMLPropStorage;
  123. procedure acDeleteRowExecute(Sender: TObject);
  124. procedure acExitExecute(Sender: TObject);
  125. procedure acFileOpenAccept(Sender: TObject);
  126. procedure acFileSaveAsAccept(Sender: TObject);
  127. procedure acDebugExecute(Sender: TObject);
  128. procedure acHelpAboutExecute(Sender: TObject);
  129. procedure acHexFileExecute(Sender: TObject);
  130. procedure acNewExecute(Sender: TObject);
  131. procedure acNewRowExecute(Sender: TObject);
  132. procedure acNextStepExecute(Sender: TObject);
  133. procedure acShowHexFileExecute(Sender: TObject);
  134. procedure acStopExecute(Sender: TObject);
  135. procedure acThisStepExecute(Sender: TObject);
  136. procedure acFileSaveExecute(Sender: TObject);
  137. procedure acUploadExecute(Sender: TObject);
  138. procedure cbCommandChange(Sender: TObject);
  139. procedure cbDataChange(Sender: TObject);
  140. procedure cbTPSVersionChange(Sender: TObject);
  141. procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
  142. procedure FormCreate(Sender: TObject);
  143. procedure FormDropFiles(Sender: TObject; const FileNames: array of string);
  144. procedure MCSLabelClick(Sender: TObject);
  145. procedure mnSaveClick(Sender: TObject);
  146. procedure Shape1Paint(Sender: TObject);
  147. procedure Shape2Paint(Sender: TObject);
  148. procedure StringGrid1EditingDone(Sender: TObject);
  149. procedure StringGrid1Selection(Sender: TObject; aCol, aRow: integer);
  150. procedure tbPreset1Click(Sender: TObject);
  151. procedure tbPreset1ContextPopup(Sender: TObject; MousePos: TPoint;
  152. var Handled: boolean);
  153. procedure tbResetClick(Sender: TObject);
  154. procedure Timer1Timer(Sender: TObject);
  155. private
  156. { private declarations }
  157. sps: TSPS;
  158. stopit: boolean;
  159. activeFile: string;
  160. dirty: boolean;
  161. procedure loadFile(filename: string);
  162. procedure programSps;
  163. procedure nextStep;
  164. procedure renumberGrid;
  165. procedure saveFile(filename: string);
  166. procedure selectAddress(addr: byte);
  167. procedure inputSps;
  168. procedure outputSps;
  169. procedure uploadFile;
  170. procedure setDirty(Value: boolean);
  171. function checkDirty: boolean;
  172. procedure checkPresets;
  173. procedure makeHexFile(fileName: string);
  174. procedure setCaption;
  175. procedure addHeaderText;
  176. public
  177. { public declarations }
  178. end;
  179. var
  180. Form1: TForm1;
  181. implementation
  182. uses MCSAbout, uTextUi, uSelectCom, MCSTools, MCSStrings, synaser,
  183. MCSIO, mcsintelhex, fpjson, MCSLSU;
  184. {$R *.lfm}
  185. procedure delayCallback(Value: integer);
  186. begin
  187. Form1.EditDelay.Text := IntToStr(Value);
  188. Application.ProcessMessages;
  189. end;
  190. { TForm1 }
  191. var
  192. lsuCode: integer;
  193. procedure TForm1.FormCreate(Sender: TObject);
  194. var
  195. line: string;
  196. begin
  197. Infobox.AppTitel := MCSLSU.GetLSUText('infobox', 'ID_APPTITLE', lsuCode);
  198. Infobox.CopyRight := MCSLSU.GetLSUText('infobox', 'ID_COPYRIGHT', lsuCode);
  199. Infobox.Build := MCSGetVersion(Application.ExeName);
  200. Infobox.AppID := 31;
  201. Infobox.AppURL :=
  202. 'http://www.wk-music.de/pages/mcs/microcontroller/tps-sps-emulator.php';
  203. sps := TSPS.Create();
  204. sps.setDelayCallback(@delayCallback);
  205. addHeaderText;
  206. renumberGrid();
  207. cbTPSVersionChange(Sender);
  208. acStop.Enabled := False;
  209. ToolButton18.Align := alRight;
  210. MCSLabel.Align := alRight;
  211. cbAdrActual.Enabled := False;
  212. checkPresets();
  213. tbResetClick(nil);
  214. if Application.ParamCount >= 1 then
  215. begin
  216. line := Application.Params[1];
  217. loadFile(line);
  218. end;
  219. Timer1.Enabled := True;
  220. MCSLSU.MakeForm('form1', 'ID_', form1);
  221. end;
  222. procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of string);
  223. var
  224. line: string;
  225. begin
  226. if (SizeOF(FileNames) > 0) then
  227. begin
  228. line := FileNames[0];
  229. loadFile(line);
  230. end;
  231. end;
  232. procedure TForm1.MCSLabelClick(Sender: TObject);
  233. begin
  234. ShExec2(self.Handle, InfoBox.AppURL);
  235. end;
  236. procedure TForm1.mnSaveClick(Sender: TObject);
  237. begin
  238. Statusbar1.SimpleText := Sender.ClassName;
  239. end;
  240. procedure TForm1.Shape1Paint(Sender: TObject);
  241. var
  242. radius: integer;
  243. x, y: integer;
  244. begin
  245. radius := round(Shape1.Width / 2);
  246. Shape1.Canvas.Brush.Color := clBlack;
  247. Shape1.canvas.MoveTo(radius, radius);
  248. x := radius - round(radius * cos(degtorad(sps.getServo1())));
  249. y := radius - round(radius * sin(degtorad(sps.getServo1())));
  250. Shape1.Canvas.LineTo(x, y);
  251. end;
  252. procedure TForm1.Shape2Paint(Sender: TObject);
  253. var
  254. radius: integer;
  255. x, y: integer;
  256. begin
  257. radius := round(Shape1.Width / 2);
  258. Shape2.Canvas.Brush.Color := clBlack;
  259. Shape2.canvas.MoveTo(radius, radius);
  260. x := radius - round(radius * cos(degtorad(sps.getServo2())));
  261. y := radius - round(radius * sin(degtorad(sps.getServo2())));
  262. Shape2.Canvas.LineTo(x, y);
  263. end;
  264. procedure TForm1.acExitExecute(Sender: TObject);
  265. begin
  266. Close;
  267. end;
  268. procedure TForm1.acDeleteRowExecute(Sender: TObject);
  269. var
  270. i: integer;
  271. begin
  272. i := StringGrid1.Row;
  273. StringGrid1.DeleteRow(i);
  274. renumberGrid();
  275. end;
  276. procedure TForm1.acFileOpenAccept(Sender: TObject);
  277. var
  278. filename: string;
  279. begin
  280. filename := (Sender as TFileOpen).Dialog.FileName;
  281. loadFile(filename);
  282. end;
  283. procedure TForm1.loadFile(filename: string);
  284. var
  285. i: integer;
  286. f: Text;
  287. line: string;
  288. list: TStringList;
  289. begin
  290. if (checkDirty()) then
  291. begin
  292. if (FileExists(filename)) then
  293. begin
  294. acNew.Execute;
  295. list := TStringList.Create;
  296. i := 1;
  297. AssignFile(f, filename);
  298. Reset(f);
  299. while (not EOF(f)) do
  300. begin
  301. if (i + 1 > StringGrid1.RowCount) then
  302. begin
  303. StringGrid1.RowCount := StringGrid1.RowCount + 1;
  304. end;
  305. readln(f, line);
  306. if (Pos('#', line) = 1) then
  307. begin
  308. line := RightstrPos(line, 2);
  309. if (Pos('TPS:', line) = 1) then
  310. begin
  311. line := RightstrPos(line, 5);
  312. cbTPSVersion.Text := line;
  313. cbTPSVersionChange(nil);
  314. end;
  315. end
  316. else
  317. begin
  318. MCSStrings.DelimSepTextToStringlist(line, '"', ',', list);
  319. if list.Count > 0 then
  320. Stringgrid1.Cells[0, i] := list[0];
  321. if list.Count > 1 then
  322. Stringgrid1.Cells[1, i] := list[1];
  323. if list.Count > 2 then
  324. Stringgrid1.Cells[2, i] := list[2];
  325. if list.Count > 3 then
  326. Stringgrid1.Cells[4, i] := list[3];
  327. list.Clear;
  328. i := i + 1;
  329. end;
  330. end;
  331. CloseFile(f);
  332. list.Free;
  333. activeFile := filename;
  334. renumberGrid();
  335. addHeaderText;
  336. setCaption();
  337. setDirty(False);
  338. end;
  339. end;
  340. end;
  341. procedure TForm1.acFileSaveAsAccept(Sender: TObject);
  342. var
  343. filename: string;
  344. begin
  345. filename := (Sender as TFileSaveAs).Dialog.FileName;
  346. saveFile(filename);
  347. end;
  348. procedure TForm1.saveFile(filename: string);
  349. var
  350. x, i: integer;
  351. f: Text;
  352. line: string;
  353. begin
  354. if (filename = '') then
  355. begin
  356. if SaveDialog1.Execute() then
  357. begin
  358. filename := SaveDialog1.FileName;
  359. end;
  360. end;
  361. if (filename <> '') then
  362. begin
  363. AssignFile(f, filename);
  364. Rewrite(f);
  365. line := '#TPS:' + cbTPSVersion.Text;
  366. Writeln(f, line);
  367. i := StringGrid1.RowCount;
  368. for x := 1 to i - 1 do
  369. begin
  370. if (StringGrid1.Cells[1, x] <> '') then
  371. begin
  372. line := StringGrid1.Cells[0, x] + ',' + StringGrid1.Cells[1, x] +
  373. ',' + StringGrid1.Cells[2, x] + ',"' + StringGrid1.Cells[4, x] + '"';
  374. Writeln(f, line);
  375. end;
  376. end;
  377. CloseFile(f);
  378. setDirty(False);
  379. activeFile := filename;
  380. setCaption();
  381. end;
  382. end;
  383. procedure TForm1.acDebugExecute(Sender: TObject);
  384. begin
  385. if (sps.isActive()) then
  386. begin
  387. stopit := True;
  388. acDebug.ImageIndex := 18;
  389. sps.break();
  390. end
  391. else
  392. begin
  393. acDebug.Enabled := True;
  394. acDebug.ImageIndex := 10;
  395. cbAdrActual.Enabled := True;
  396. acNextStep.Enabled := False;
  397. // sps programmieren
  398. programSps();
  399. // programm starten
  400. Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_START', lsuCode);
  401. sps.start();
  402. stopit := False;
  403. Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_RUNNING', lsuCode);
  404. while (not stopit) do
  405. begin
  406. nextStep();
  407. if (cbAdrActual.Checked) then
  408. selectAddress(sps.getAddress());
  409. Application.ProcessMessages;
  410. end;
  411. Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_STOPPED', lsuCode);
  412. cbAdrActual.Enabled := False;
  413. acNextStep.Enabled := True;
  414. sps.doReset();
  415. end;
  416. end;
  417. procedure TForm1.acHelpAboutExecute(Sender: TObject);
  418. begin
  419. Infobox.Show;
  420. end;
  421. procedure TForm1.acHexFileExecute(Sender: TObject);
  422. var
  423. filename: string;
  424. begin
  425. filename := MCSIO.MCSExtractFileNameExlExt(activeFile) + '.hex';
  426. SaveHexFile.FileName := filename;
  427. if (SaveHexFile.Execute) then
  428. begin
  429. filename := SaveHexFile.FileName;
  430. makeHexFile(filename);
  431. end;
  432. end;
  433. procedure TForm1.acNewExecute(Sender: TObject);
  434. begin
  435. StringGrid1.RowCount := 2;
  436. StringGrid1.Clean;
  437. addHeaderText();
  438. renumberGrid();
  439. activeFile := '';
  440. setCaption();
  441. setDirty(False);
  442. end;
  443. procedure TForm1.acNewRowExecute(Sender: TObject);
  444. var
  445. myPos: integer;
  446. i, x: integer;
  447. begin
  448. myPos := StringGrid1.Row;
  449. StringGrid1.RowCount := StringGrid1.RowCount + 1;
  450. for i := StringGrid1.RowCount - 2 downto myPos do
  451. begin
  452. for x := 1 to StringGrid1.ColCount - 1 do
  453. begin
  454. StringGrid1.Cells[x, i + 1] := StringGrid1.Cells[x, i];
  455. end;
  456. end;
  457. for x := 1 to StringGrid1.ColCount - 1 do
  458. begin
  459. StringGrid1.Cells[x, myPos] := '';
  460. end;
  461. renumberGrid();
  462. end;
  463. procedure TForm1.programSps;
  464. var
  465. x, i: integer;
  466. com, Data: byte;
  467. tmp: string;
  468. begin
  469. Statusbar1.SimpleText := MCSLSU.GetLSUText('statusbar', 'ID_SPS_PROGRAMMING', lsuCode);
  470. i := StringGrid1.RowCount;
  471. for x := 1 to i - 1 do
  472. begin
  473. com := 0;
  474. Data := 0;
  475. tmp := StringGrid1.Cells[1, x];
  476. if (tmp <> '') then
  477. begin
  478. com := HexToInt(tmp);
  479. tmp := StringGrid1.Cells[2, x];
  480. if (tmp <> '') then
  481. Data := HexToInt(tmp);
  482. Data := com * 16 + Data;
  483. end;
  484. sps.writeEEProm(x - 1, Data);
  485. end;
  486. // endekennzeichnung schreiben
  487. sps.writeEEProm(i, $ff);
  488. end;
  489. procedure TForm1.acNextStepExecute(Sender: TObject);
  490. begin
  491. nextStep();
  492. selectAddress(sps.getAddress());
  493. end;
  494. procedure TForm1.nextStep;
  495. begin
  496. if (not sps.isActive()) then
  497. begin
  498. programSps;
  499. sps.start();
  500. acStop.Enabled := True;
  501. acDebug.Enabled := False;
  502. end
  503. else
  504. begin
  505. acNextStep.Enabled := False;
  506. acStop.Enabled := False;
  507. inputSps();
  508. sps.nextStep();
  509. outputSps();
  510. acNextStep.Enabled := True;
  511. acStop.Enabled := True;
  512. end;
  513. end;
  514. procedure TForm1.acShowHexFileExecute(Sender: TObject);
  515. var
  516. list: TStringList;
  517. i, x: integer;
  518. line, tmp: string;
  519. Value: byte;
  520. begin
  521. Form2 := TForm2.Create(self);
  522. list := TStringList.Create();
  523. line := MCSLSU.GetLSUText('hexfile', 'ID_START_LINE', lsuCode);
  524. list.add(line);
  525. i := StringGrid1.RowCount;
  526. for x := 1 to i - 1 do
  527. begin
  528. if (StringGrid1.Cells[1, x] <> '') then
  529. begin
  530. tmp := '';
  531. if (StringGrid1.Cells[1, x] = '') then
  532. begin
  533. tmp := ' ';
  534. end
  535. else
  536. begin
  537. tmp := StringGrid1.Cells[1, x];
  538. end;
  539. if (StringGrid1.Cells[2, x] = '') then
  540. begin
  541. tmp := tmp + ' ';
  542. end
  543. else
  544. begin
  545. tmp := tmp + StringGrid1.Cells[2, x];
  546. end;
  547. line := StringGrid1.Cells[0, x] + ': ' + tmp + ' ';
  548. Value := HexToInt(StringGrid1.Cells[1, x]);
  549. tmp := '';
  550. if (Value and 8) > 0 then
  551. tmp := tmp + 'X'
  552. else
  553. tmp := tmp + '0';
  554. if (Value and 4) > 0 then
  555. tmp := tmp + 'X'
  556. else
  557. tmp := tmp + '0';
  558. if (Value and 2) > 0 then
  559. tmp := tmp + 'X'
  560. else
  561. tmp := tmp + '0';
  562. if (Value and 1) > 0 then
  563. tmp := tmp + 'X'
  564. else
  565. tmp := tmp + '0';
  566. line := line + tmp + ' ';
  567. Value := HexToInt(StringGrid1.Cells[2, x]);
  568. tmp := '';
  569. if (Value and 8) > 0 then
  570. tmp := tmp + 'X'
  571. else
  572. tmp := tmp + '0';
  573. if (Value and 4) > 0 then
  574. tmp := tmp + 'X'
  575. else
  576. tmp := tmp + '0';
  577. if (Value and 2) > 0 then
  578. tmp := tmp + 'X'
  579. else
  580. tmp := tmp + '0';
  581. if (Value and 1) > 0 then
  582. tmp := tmp + 'X'
  583. else
  584. tmp := tmp + '0';
  585. line := line + tmp;
  586. line := line + ' ' + StringGrid1.Cells[3, x] + ' ,"' +
  587. StringGrid1.Cells[4, x] + '"';
  588. list.add(line);
  589. end;
  590. end;
  591. Form2.addHexFile(list);
  592. Form2.ShowModal;
  593. list.Free;
  594. end;
  595. procedure TForm1.acStopExecute(Sender: TObject);
  596. begin
  597. if (sps.isActive()) then
  598. begin
  599. stopit := True;
  600. sps.break();
  601. repeat
  602. Application.ProcessMessages;
  603. until (not sps.isDelayActive());
  604. sps.doReset();
  605. acStop.Enabled := False;
  606. acDebug.Enabled := True;
  607. outputSps();
  608. selectAddress(0);
  609. end;
  610. end;
  611. procedure TForm1.acThisStepExecute(Sender: TObject);
  612. var
  613. Data, com: byte;
  614. tmp: string;
  615. begin
  616. inputSps();
  617. try
  618. tmp := StringGrid1.Cells[1, StringGrid1.Row];
  619. if (tmp <> '') then
  620. begin
  621. com := HexToInt(tmp);
  622. tmp := StringGrid1.Cells[2, StringGrid1.Row];
  623. if (tmp <> '') then
  624. Data := HexToInt(tmp);
  625. Data := com * 16 + Data;
  626. end;
  627. sps.doSingleCommand(Data);
  628. except
  629. end;
  630. outputSps();
  631. end;
  632. procedure TForm1.acFileSaveExecute(Sender: TObject);
  633. begin
  634. saveFile(activeFile);
  635. end;
  636. procedure TForm1.acUploadExecute(Sender: TObject);
  637. begin
  638. uploadFile();
  639. end;
  640. procedure TForm1.uploadFile;
  641. var
  642. line: string;
  643. comServices: TStringList;
  644. comService: string;
  645. return: integer;
  646. hexFile: string;
  647. hexFormat: TIntelHexFormat;
  648. prgMem: array of byte;
  649. i, x: integer;
  650. com, Data: byte;
  651. tmp: string;
  652. arduinoPath: string;
  653. cmd, config, mcu: string;
  654. KeyName, StringValue: string;
  655. Res: WideString;
  656. begin
  657. line := GetSerialPortNames;
  658. // if (line <> '') then
  659. begin
  660. comServices := TStringList.Create;
  661. MCSStrings.DelimTextToStringlist(line, ',', comServices);
  662. return := mrOk;
  663. line := XMLPropStorage1.ReadString('ComPort', comServices[0]);
  664. frmSelectCom := TfrmSelectCom.Create(self);
  665. frmSelectCom.cbServices.Items.AddStrings(comServices);
  666. frmSelectCom.cbServices.Text := line;
  667. line := XMLPropStorage1.ReadString('ArduinoBin', '');
  668. if (line = '') then
  669. begin
  670. KeyName := 'SOFTWARE\WOW6432Node\Arduino';
  671. StringValue := 'Install_Dir';
  672. Res := RegistryReadString(HKEY_LOCAL_MACHINE, WideString(KeyName),
  673. WideString(StringValue));
  674. if Res <> '' then
  675. begin
  676. line := string(Res);
  677. end;
  678. end;
  679. frmSelectCom.deArduino.Text := line;
  680. return := frmSelectCom.ShowModal;
  681. comService := frmSelectCom.cbServices.Text;
  682. XMLPropStorage1.WriteString('ComPort', comService);
  683. line := frmSelectCom.deArduino.Text;
  684. arduinoPath := MCSIO.GetNormPath(line);
  685. XMLPropStorage1.WriteString('ArduinoBin', line);
  686. comServices.Free;
  687. if (return = mrOk) then
  688. begin
  689. hexFile := MCSIO.CreateUniqueFile(MCSIO.GetTempDir, 'TPS', '.hex');
  690. makeHexFile(hexFile);
  691. cmd := arduinoPath + 'hardware\tools\avr\bin\avrdude';
  692. XMLPropStorage1.WriteString('avrdude', cmd);
  693. config := arduinoPath + 'hardware\tools\avr\etc\avrdude.conf';
  694. XMLPropStorage1.WriteString('avrdudeconf', config);
  695. if (cbTPSVersion.ItemIndex = 3) then
  696. begin
  697. mcu := 'atmega328p';
  698. end
  699. else if (cbTPSVersion.ItemIndex = 2) then
  700. begin
  701. mcu := 'attiny84';
  702. end;
  703. XMLPropStorage1.WriteString('arduinomcu', mcu);
  704. line :=
  705. '-C%AVRCONF% -v -v -v -p%MCU% -carduino -P\\.\%COM% -b57600 -D -Ueeprom:w:%FILE%:i';
  706. line := Replace2('%AVRCONF%', config, line);
  707. line := Replace2('%MCU%', mcu, line);
  708. line := Replace2('%COM%', comService, line);
  709. line := Replace2('%FILE%', hexFile, line);
  710. ExecuteProcess(cmd, line);
  711. DeleteFile(hexFile);
  712. end;
  713. end;
  714. { else
  715. begin
  716. Application.MessageBox('Kein Comport vorhanden. EVt. Arduino nicht angeschlossen?',
  717. 'Kein Comport',
  718. MB_OK + MB_ICONEXCLAMATION);
  719. end;
  720. }
  721. end;
  722. procedure TForm1.setDirty(Value: boolean);
  723. begin
  724. if (dirty <> Value) then
  725. begin
  726. dirty := Value;
  727. if (dirty) then
  728. begin
  729. if (Pos('*', Caption) = 0) then
  730. begin
  731. Caption := Caption + '*';
  732. end;
  733. end
  734. else
  735. begin
  736. if (Pos('*', Caption) > 0) then
  737. begin
  738. Caption := Leftstr(Caption, Pos('*', Caption) - 1);
  739. end;
  740. end;
  741. end;
  742. end;
  743. function TForm1.checkDirty: boolean;
  744. var
  745. i: integer;
  746. begin
  747. if (dirty) then
  748. begin
  749. i := MCSLSU.LSUAutoMsgBox('Messages', 'SAVE_CHANGES', MB_ICONQUESTION or
  750. MB_YESNOCANCEL);
  751. if (i = mrYes) then
  752. begin
  753. saveFile(activeFile);
  754. Result := True;
  755. end
  756. else if (i = mrNo) then
  757. begin
  758. setDirty(False);
  759. Result := True;
  760. end
  761. else
  762. begin
  763. Result := False;
  764. end;
  765. end
  766. else
  767. begin
  768. Result := True;
  769. end;
  770. end;
  771. procedure TForm1.checkPresets;
  772. begin
  773. if XMLPropStorage1.ReadBoolean('preset_1.set', False) then
  774. tbPreset1.Caption := '1*';
  775. if XMLPropStorage1.ReadBoolean('preset_2.set', False) then
  776. tbPreset2.Caption := '2*';
  777. if XMLPropStorage1.ReadBoolean('preset_3.set', False) then
  778. tbPreset3.Caption := '3*';
  779. if XMLPropStorage1.ReadBoolean('preset_4.set', False) then
  780. tbPreset4.Caption := '4*';
  781. if XMLPropStorage1.ReadBoolean('preset_5.set', False) then
  782. tbPreset5.Caption := '5*';
  783. if XMLPropStorage1.ReadBoolean('preset_6.set', False) then
  784. tbPreset6.Caption := '6*';
  785. if XMLPropStorage1.ReadBoolean('preset_7.set', False) then
  786. tbPreset7.Caption := '7*';
  787. if XMLPropStorage1.ReadBoolean('preset_8.set', False) then
  788. tbPreset8.Caption := '8*';
  789. end;
  790. procedure TForm1.makeHexFile(fileName: string);
  791. var
  792. i, x: integer;
  793. tmp: string;
  794. hexFormat: TIntelHexFormat;
  795. prgMem: array of byte;
  796. com, Data: byte;
  797. begin
  798. i := StringGrid1.RowCount;
  799. SetLength(prgMem, i);
  800. for x := 1 to i - 1 do
  801. begin
  802. com := 0;
  803. Data := 0;
  804. tmp := StringGrid1.Cells[1, x];
  805. if (tmp <> '') then
  806. begin
  807. com := HexToInt(tmp);
  808. tmp := StringGrid1.Cells[2, x];
  809. if (tmp <> '') then
  810. Data := HexToInt(tmp);
  811. Data := com * 16 + Data;
  812. end;
  813. prgMem[x - 1] := Data;
  814. end;
  815. hexFormat := TIntelHexFormat.Create(prgMem, 8);
  816. tmp := hexFormat.Text;
  817. MCSIO.StrToFile(fileName, tmp);
  818. hexFormat.Free;
  819. SetLength(prgMem, 0);
  820. end;
  821. procedure TForm1.setCaption;
  822. begin
  823. if (activeFile = '') then
  824. begin
  825. Caption := MCSLSU.GetLSUText('form1Captions', 'ID_CAPTION', lsuCode);
  826. end
  827. else
  828. begin
  829. Caption := MCSLSU.GetLSUText('form1Captions', 'ID_CAPTION', lsuCode) +
  830. ':' + ExtractFileName(activeFile);
  831. end;
  832. end;
  833. procedure TForm1.addHeaderText;
  834. var
  835. i: integer;
  836. begin
  837. for i := 0 to StringGrid1.Columns.Count - 1 do
  838. begin
  839. ;
  840. StringGrid1.Columns[i].Title.Caption :=
  841. MCSLSU.GetLSUText('form1Captions', StringGrid1.Columns[i].Title.Caption, lsuCode);
  842. end;
  843. StringGrid1.Cells[0, 0] := MCSLSU.GetLSUText('form1Captions',
  844. 'ID_GRID_STORAGE', lsuCode);
  845. StringGrid1.Repaint;
  846. end;
  847. procedure TForm1.cbCommandChange(Sender: TObject);
  848. var
  849. x: integer;
  850. begin
  851. cbData.Items.Clear;
  852. x := cbCommand.ItemIndex;
  853. sps.getDatas(x, cbData.Items);
  854. if StringGrid1.Row > 0 then
  855. begin
  856. StringGrid1.Cells[1, StringGrid1.Row] := IntToHex(x, 1);
  857. end;
  858. end;
  859. procedure TForm1.cbDataChange(Sender: TObject);
  860. var
  861. x: integer;
  862. begin
  863. x := cbData.ItemIndex;
  864. if StringGrid1.Row > 0 then
  865. begin
  866. StringGrid1.Cells[2, StringGrid1.Row] := IntToHex(x, 1);
  867. StringGrid1.Cells[3, StringGrid1.Row] := sps.getCommandText(cbCommand.ItemIndex, x);
  868. end;
  869. end;
  870. procedure TForm1.cbTPSVersionChange(Sender: TObject);
  871. begin
  872. if (cbTPSVersion.ItemIndex = 0) then
  873. begin
  874. // HOLTEC
  875. sps.setTPSVersion(Holtec);
  876. Label2.Visible := True;
  877. ADC2.Visible := True;
  878. PWM2.Visible := False;
  879. Label16.Visible := False;
  880. RC1.Visible := False;
  881. Label17.Visible := False;
  882. RC2.Visible := False;
  883. Servo1.Visible := False;
  884. Servo2.Visible := False;
  885. Shape1.Visible := False;
  886. Shape2.Visible := False;
  887. EditE.Visible := False;
  888. EditF.Visible := False;
  889. acUpload.Enabled := False;
  890. Label5.Visible := False;
  891. btnTone.Visible := False;
  892. end;
  893. if (cbTPSVersion.ItemIndex = 1) then
  894. begin
  895. // ATMega8
  896. sps.setTPSVersion(ATMega8);
  897. Label2.Visible := True;
  898. ADC2.Visible := True;
  899. PWM2.Visible := True;
  900. Label16.Visible := False;
  901. RC1.Visible := False;
  902. Label17.Visible := False;
  903. RC2.Visible := False;
  904. Servo1.Visible := False;
  905. Servo2.Visible := False;
  906. Shape1.Visible := False;
  907. Shape2.Visible := False;
  908. EditE.Visible := False;
  909. EditF.Visible := False;
  910. acUpload.Enabled := False;
  911. Label5.Visible := False;
  912. btnTone.Visible := False;
  913. end;
  914. if ((cbTPSVersion.ItemIndex = 2) or (cbTPSVersion.ItemIndex = 3)) then
  915. begin
  916. if (cbTPSVersion.ItemIndex = 2) then
  917. begin
  918. // ATMega84
  919. sps.setTPSVersion(ATTiny84);
  920. acUpload.Enabled := False;
  921. Label5.Visible := False;
  922. btnTone.Visible := False;
  923. end
  924. else
  925. begin
  926. // Arduino 328
  927. sps.setTPSVersion(Arduino);
  928. acUpload.Enabled := True;
  929. Label5.Visible := True;
  930. btnTone.Visible := True;
  931. end;
  932. Label2.Visible := True;
  933. ADC2.Visible := True;
  934. PWM2.Visible := True;
  935. Label16.Visible := True;
  936. RC1.Visible := True;
  937. Label17.Visible := True;
  938. RC2.Visible := True;
  939. Servo1.Visible := True;
  940. Servo2.Visible := True;
  941. Shape1.Visible := True;
  942. Shape2.Visible := True;
  943. EditE.Visible := True;
  944. EditF.Visible := True;
  945. end;
  946. cbCommand.Items.Clear;
  947. sps.getCommands(cbCommand.Items);
  948. end;
  949. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
  950. begin
  951. canClose := checkDirty();
  952. end;
  953. procedure TForm1.StringGrid1EditingDone(Sender: TObject);
  954. var
  955. Value: string;
  956. x: integer;
  957. begin
  958. // die aktuelle Zeile ist auch die letzte
  959. if ((StringGrid1.Row + 1) = StringGrid1.RowCount) then
  960. begin
  961. // es wurde auch was eingegeben
  962. Value := StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row];
  963. Value := trim(Value);
  964. if (Value <> '') then
  965. begin
  966. setDirty(True);
  967. StringGrid1.RowCount := StringGrid1.RowCount + 1;
  968. renumberGrid();
  969. end;
  970. end
  971. else
  972. begin
  973. x := StringGrid1.Row;
  974. StringGrid1.Cells[3, x] :=
  975. sps.getCommandText(HexToInt(StringGrid1.Cells[1, x]),
  976. HexToInt(StringGrid1.Cells[2, x]));
  977. setDirty(True);
  978. end;
  979. end;
  980. procedure TForm1.StringGrid1Selection(Sender: TObject; aCol, aRow: integer);
  981. begin
  982. try
  983. cbCommand.ItemIndex := HexToInt(StringGrid1.Cells[1, aRow]);
  984. cbCommandChange(Sender);
  985. cbData.ItemIndex := HexToInt(StringGrid1.Cells[2, aRow]);
  986. except
  987. end;
  988. end;
  989. procedure TForm1.tbPreset1Click(Sender: TObject);
  990. var
  991. key: string;
  992. begin
  993. if Sender = tbPreset1 then
  994. key := 'preset_1'
  995. else
  996. if Sender = tbPreset2 then
  997. key := 'preset_2'
  998. else
  999. if Sender = tbPreset3 then
  1000. key := 'preset_3'
  1001. else
  1002. if Sender = tbPreset4 then
  1003. key := 'preset_4'
  1004. else
  1005. if Sender = tbPreset5 then
  1006. key := 'preset_5'
  1007. else
  1008. if Sender = tbPreset6 then
  1009. key := 'preset_6'
  1010. else
  1011. if Sender = tbPreset7 then
  1012. key := 'preset_7'
  1013. else
  1014. if Sender = tbPreset8 then
  1015. key := 'preset_8';
  1016. Din1.Checked := XMLPropStorage1.ReadBoolean(key + '.input1', Din1.Checked);
  1017. Din2.Checked := XMLPropStorage1.ReadBoolean(key + '.input2', Din2.Checked);
  1018. Din3.Checked := XMLPropStorage1.ReadBoolean(key + '.input3', Din3.Checked);
  1019. Din4.Checked := XMLPropStorage1.ReadBoolean(key + '.input4', Din4.Checked);
  1020. ADC1.Value := XMLPropStorage1.ReadInteger(key + '.adc1', ADC1.Value);
  1021. ADC2.Value := XMLPropStorage1.ReadInteger(key + '.adc2', ADC2.Value);
  1022. RC1.Value := XMLPropStorage1.ReadInteger(key + '.rc1', RC1.Value);
  1023. RC2.Value := XMLPropStorage1.ReadInteger(key + '.rc2', RC2.Value);
  1024. end;
  1025. procedure TForm1.tbPreset1ContextPopup(Sender: TObject; MousePos: TPoint;
  1026. var Handled: boolean);
  1027. var
  1028. key: string;
  1029. begin
  1030. if Sender = tbPreset1 then
  1031. key := 'preset_1'
  1032. else
  1033. if Sender = tbPreset2 then
  1034. key := 'preset_2'
  1035. else
  1036. if Sender = tbPreset3 then
  1037. key := 'preset_3'
  1038. else
  1039. if Sender = tbPreset4 then
  1040. key := 'preset_4'
  1041. else
  1042. if Sender = tbPreset5 then
  1043. key := 'preset_5'
  1044. else
  1045. if Sender = tbPreset6 then
  1046. key := 'preset_6'
  1047. else
  1048. if Sender = tbPreset7 then
  1049. key := 'preset_7'
  1050. else
  1051. if Sender = tbPreset8 then
  1052. key := 'preset_8';
  1053. XMLPropStorage1.WriteBoolean(key + '.set', True);
  1054. XMLPropStorage1.WriteBoolean(key + '.input1', Din1.Checked);
  1055. XMLPropStorage1.WriteBoolean(key + '.input2', Din2.Checked);
  1056. XMLPropStorage1.WriteBoolean(key + '.input3', Din3.Checked);
  1057. XMLPropStorage1.WriteBoolean(key + '.input4', Din4.Checked);
  1058. XMLPropStorage1.WriteInteger(key + '.adc1', ADC1.Value);
  1059. XMLPropStorage1.WriteInteger(key + '.adc2', ADC2.Value);
  1060. XMLPropStorage1.WriteInteger(key + '.rc1', RC1.Value);
  1061. XMLPropStorage1.WriteInteger(key + '.rc2', RC2.Value);
  1062. checkPresets();
  1063. end;
  1064. procedure TForm1.tbResetClick(Sender: TObject);
  1065. begin
  1066. Din1.Checked := False;
  1067. Din2.Checked := False;
  1068. Din3.Checked := False;
  1069. Din4.Checked := False;
  1070. ADC1.Value := 0;
  1071. ADC2.Value := 0;
  1072. RC1.Value := 8;
  1073. RC2.Value := 8;
  1074. end;
  1075. procedure TForm1.Timer1Timer(Sender: TObject);
  1076. var
  1077. jsonString: string;
  1078. Data: TJSONData;
  1079. iNetVersion, version: string;
  1080. thisVersion, iVersion: TVersionRecord;
  1081. begin
  1082. MCSLabel.AutoSize := True;
  1083. Timer1.Enabled := False;
  1084. MCSLabel.Hint := InfoBox.versionHint;
  1085. if (InfoBox.newVersion) then
  1086. begin
  1087. MCSLabel.Font.Color := clred;
  1088. MCSLabel.Hint := InfoBox.versionHint + chr($0a) + chr($0d) +
  1089. MCSLSU.GetLSUText('form1Captions', 'ID_CLICK_HERE', lsuCode);
  1090. end;
  1091. MCSLabel.Caption := InfoBox.versionText;
  1092. end;
  1093. procedure TForm1.renumberGrid;
  1094. var
  1095. x, i: integer;
  1096. begin
  1097. i := StringGrid1.RowCount;
  1098. for x := 1 to i - 1 do
  1099. begin
  1100. StringGrid1.Cells[0, x] := '0x' + inttohex(x - 1, 2);
  1101. StringGrid1.Cells[3, x] :=
  1102. sps.getCommandText(HexToInt(StringGrid1.Cells[1, x]),
  1103. HexToInt(StringGrid1.Cells[2, x]));
  1104. end;
  1105. end;
  1106. procedure TForm1.selectAddress(addr: byte);
  1107. begin
  1108. StringGrid1.Row := addr + 1;
  1109. Application.ProcessMessages;
  1110. end;
  1111. procedure TForm1.inputSps;
  1112. begin
  1113. sps.setDin1(Din1.Checked);
  1114. sps.setDin2(Din2.Checked);
  1115. sps.setDin3(Din3.Checked);
  1116. sps.setDin4(Din4.Checked);
  1117. sps.setADC1(ADC1.Value);
  1118. sps.setADC2(ADC2.Value);
  1119. sps.setRC1(RC1.Value);
  1120. sps.setRC2(RC2.Value);
  1121. sps.setSPrg(tbPrg.Checked);
  1122. sps.setSSel(tbSel.Checked);
  1123. end;
  1124. procedure TForm1.outputSps;
  1125. var
  1126. List: TStrings;
  1127. i: integer;
  1128. begin
  1129. if sps.isDout1() then
  1130. ShapeOut1.Brush.Color := clRed
  1131. else
  1132. ShapeOut1.Brush.Color := clWhite;
  1133. if sps.isDout2() then
  1134. ShapeOut2.Brush.Color := clRed
  1135. else
  1136. ShapeOut2.Brush.Color := clWhite;
  1137. if sps.isDout3() then
  1138. ShapeOut3.Brush.Color := clRed
  1139. else
  1140. ShapeOut3.Brush.Color := clWhite;
  1141. if sps.isDout4() then
  1142. ShapeOut4.Brush.Color := clRed
  1143. else
  1144. ShapeOut4.Brush.Color := clWhite;
  1145. PWM1.Text := IntToStr(sps.getPWM1());
  1146. PWM2.Text := IntToStr(sps.getPWM2());
  1147. Servo1.Text := IntToStr(sps.getServo1());
  1148. Shape1.Repaint;
  1149. Servo2.Text := IntToStr(sps.getServo2());
  1150. Shape2.Repaint;
  1151. EditA.Text := IntToStr(sps.getARegister());
  1152. EditB.Text := IntToStr(sps.getBRegister());
  1153. EditC.Text := IntToStr(sps.getCRegister());
  1154. EditD.Text := IntToStr(sps.getDRegister());
  1155. EditE.Text := IntToStr(sps.getERegister());
  1156. EditF.Text := IntToStr(sps.getFRegister());
  1157. EditAddr.Text := '0x' + IntToHex(sps.getAddress(), 2);
  1158. EditRAdr.Text := '0x' + IntToHex(sps.getRAdr(), 2);
  1159. EditPage.Text := '0x' + IntToHex(sps.getPage(), 2);
  1160. if (sps.getTone() > 0) then
  1161. begin
  1162. ImageList2.GetBitmap(23, btnTone.Glyph);
  1163. btnTone.Caption := IntToStr(sps.getTone());
  1164. end
  1165. else
  1166. begin
  1167. ImageList2.GetBitmap(22, btnTone.Glyph);
  1168. btnTone.Caption := '';
  1169. end;
  1170. List := TStringList.Create;
  1171. try
  1172. sps.getStack(List);
  1173. lbStack.Clear;
  1174. for i := 0 to List.Count - 1 do
  1175. begin
  1176. lbStack.Items.Add(IntToStr(i) + ':' + List[i]);
  1177. end;
  1178. finally
  1179. List.Free;
  1180. end;
  1181. end;
  1182. end.