ugui.pas 42 KB

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