ugui.pas 45 KB

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