2
0

Main.pas 5.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216
  1. unit Main;
  2. interface
  3. uses
  4. Winapi.Windows,
  5. Winapi.Messages,
  6. System.SysUtils,
  7. System.Variants,
  8. System.Classes,
  9. Vcl.Graphics,
  10. Vcl.Controls,
  11. Vcl.Forms,
  12. Vcl.Dialogs,
  13. Vcl.StdCtrls,
  14. System.Generics.Collections,
  15. Quick.Config.Json;
  16. type
  17. TMyPriority = (msLow, msMed, msHigh);
  18. TWinPos = record
  19. public
  20. PosX : Integer;
  21. PosY : Integer;
  22. end;
  23. TProcessType = record
  24. Id : Integer;
  25. Priority : TMyPriority;
  26. Redundant : Boolean;
  27. end;
  28. TWorker = class
  29. private
  30. fName : string;
  31. fActive : Boolean;
  32. published
  33. property Name : string read fName write fName;
  34. property Active : Boolean read fActive write fActive;
  35. end;
  36. TMyConfig = class(TAppConfigJson)
  37. private
  38. fTitle : string;
  39. fHidden : Boolean;
  40. fSessionName: string;
  41. fSizes : TArray<Integer>;
  42. fLastFilename : string;
  43. fWindowPos : TWinPos;
  44. fHistory : TArray<TProcessType>;
  45. fComplex : TProcessType;
  46. fModifyDate : TDateTime;
  47. fWorkList : TObjectList<TWorker>;
  48. published
  49. property Sizes : TArray<Integer> read fSizes write fSizes;
  50. property LastFilename : string read fLastFilename write fLastFilename;
  51. property WindowPos : TWinPos read fWindowPos write fWindowPos;
  52. property History : TArray<TProcessType> read fHistory write fHistory;
  53. property Complex : TProcessType read fComplex write fComplex;
  54. property ModifyDate : TDateTime read fModifyDate write fModifyDate;
  55. property Title : string read fTitle write fTitle;
  56. property SessionName : string read fSessionName write fSessionName;
  57. property WorkList : TObjectList<TWorker> read fWorkList write fWorkList;
  58. public
  59. destructor Destroy; override;
  60. procedure Init; override;
  61. procedure DefaultValues; override;
  62. end;
  63. TMainForm = class(TForm)
  64. meInfo: TMemo;
  65. btnLoadFile: TButton;
  66. btnSaveFile: TButton;
  67. procedure FormCreate(Sender: TObject);
  68. procedure btnSaveFileClick(Sender: TObject);
  69. procedure btnLoadFileClick(Sender: TObject);
  70. procedure SetConfig(cConfig: TMyConfig);
  71. function TestConfig(cConfig1, cConfig2 : TMyConfig) : Boolean;
  72. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  73. procedure OnFileModified;
  74. end;
  75. var
  76. MainForm: TMainForm;
  77. ConfigTest : TMyConfig;
  78. ConfigJson : TMyConfig;
  79. implementation
  80. {$R *.dfm}
  81. procedure TMainForm.btnLoadFileClick(Sender: TObject);
  82. begin
  83. meInfo.Lines.Add('Load ConfigReg');
  84. ConfigJson.Load;
  85. meInfo.Lines.Add(ConfigJson.ToJSON);
  86. if TestConfig(configtest,ConfigJson) then meInfo.Lines.Add('Test passed successfully!');
  87. end;
  88. procedure TMainForm.btnSaveFileClick(Sender: TObject);
  89. begin
  90. SetConfig(ConfigJson);
  91. ConfigJson.Save;
  92. meInfo.Lines.Add('Saved Config in Registry at ' + DateTimeToStr(ConfigJson.LastSaved));
  93. end;
  94. procedure TMainForm.SetConfig(cConfig : TMyConfig);
  95. var
  96. winpos : TWinpos;
  97. protype : TProcessType;
  98. i : Integer;
  99. worker : TWorker;
  100. begin
  101. cConfig.LastFilename := 'library.txt';
  102. cConfig.Sizes := [23,11,554,12,34,29,77,30,48,59,773,221,98,3,22,983,122,231,433,12,31,987];
  103. winpos.PosX := 640;
  104. winpos.PosX := 480;
  105. cConfig.WindowPos := winpos;
  106. protype.Priority := msHigh;
  107. protype.Redundant := False;
  108. cConfig.Complex := protype;
  109. cConfig.Title := 'a fresh title';
  110. cConfig.SessionName := 'First Session';
  111. for I := 0 to 22 do
  112. begin
  113. worker := TWorker.Create;
  114. worker.Name := 'Process ' + i.ToString;
  115. worker.Active := Boolean(Random(1));
  116. cConfig.WorkList.Add(worker);
  117. end;
  118. for i := 0 to 15 do
  119. begin
  120. protype.Id := i;
  121. protype.Priority := msLow;
  122. protype.Redundant := True;
  123. cConfig.History := cConfig.History + [protype];
  124. end;
  125. cConfig.ModifyDate := Now();
  126. end;
  127. function TMainForm.TestConfig(cConfig1, cConfig2 : TMyConfig) : Boolean;
  128. var
  129. i : Integer;
  130. begin
  131. Result := False;
  132. try
  133. Assert(cConfig1.LastFilename = cConfig2.LastFilename);
  134. for i := Low(cConfig1.Sizes) to High(cConfig1.Sizes) do
  135. Assert(cConfig1.Sizes[i] = cConfig2.Sizes[i]);
  136. Assert(cConfig1.WindowPos.PosX = cConfig2.WindowPos.PosX);
  137. Assert(cConfig1.WindowPos.PosX = cConfig2.WindowPos.PosX);
  138. Assert(cConfig1.Complex.Priority = cConfig2.Complex.Priority);
  139. Assert(cConfig1.Complex.Redundant = cConfig2.Complex.Redundant);
  140. Assert(cConfig1.Title = cConfig2.Title);
  141. for i := 0 to cConfig1.WorkList.Count - 1 do
  142. begin
  143. Assert(cConfig1.WorkList[i].Name = cConfig2.WorkList[i].Name);
  144. Assert(cConfig1.WorkList[i].Active = cConfig2.WorkList[i].Active);
  145. end;
  146. for i := 0 to High(cConfig1.History) do
  147. begin
  148. Assert(cConfig1.History[i].Priority = cConfig2.History[i].Priority);
  149. Assert(cConfig1.History[i].Redundant = cConfig2.History[i].Redundant);
  150. end;
  151. Result := True;
  152. except
  153. ShowMessage('Configuration not has been saved previously or has a corruption problem');
  154. end;
  155. end;
  156. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  157. begin
  158. if Assigned(ConfigJson) then ConfigJson.Free;
  159. if Assigned(ConfigTest) then ConfigTest.Free;
  160. end;
  161. procedure TMainForm.FormCreate(Sender: TObject);
  162. begin
  163. ReportMemoryLeaksOnShutdown := True;
  164. ConfigJson := TMyConfig.Create('.\config.json');
  165. ConfigJson.Provider.OnFileModified := OnFileModified;
  166. ConfigJson.Provider.ReloadIfFileChanged := True;
  167. //create config test to compare later
  168. ConfigTest := TMyConfig.Create('');
  169. SetConfig(ConfigTest);
  170. end;
  171. procedure TMainForm.OnFileModified;
  172. begin
  173. meInfo.Lines.Add('Config file modified. Config will be reload');
  174. end;
  175. { TMyConfig }
  176. procedure TMyConfig.Init;
  177. begin
  178. inherited;
  179. WorkList := TObjectList<TWorker>.Create(True);
  180. DefaultValues;
  181. end;
  182. procedure TMyConfig.DefaultValues;
  183. begin
  184. inherited;
  185. fTitle := 'Default value';
  186. end;
  187. destructor TMyConfig.Destroy;
  188. begin
  189. if Assigned(WorkList) then WorkList.Free;
  190. inherited;
  191. end;
  192. end.