ugui.pas 44 KB

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