ugui.pas 47 KB

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