ugui.pas 43 KB

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