ugui.pas 42 KB

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