ugui.pas 42 KB

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