ugui.pas 45 KB

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