ugui.pas 43 KB

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