Main.pas 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209
  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.Base,
  16. Quick.Config.Registry;
  17. type
  18. TMyPriority = (msLow, msMed, msHigh);
  19. TWinPos = record
  20. public
  21. PosX : Integer;
  22. PosY : Integer;
  23. end;
  24. TProcessType = record
  25. Id : Integer;
  26. Priority : TMyPriority;
  27. Redundant : Boolean;
  28. end;
  29. TWorker = class
  30. private
  31. fName : string;
  32. fActive : Boolean;
  33. published
  34. property Name : string read fName write fName;
  35. property Active : Boolean read fActive write fActive;
  36. end;
  37. TMyConfig = class(TAppConfigRegistry)
  38. private
  39. fTitle : string;
  40. fHidden : Boolean;
  41. fSessionName: string;
  42. fSizes : TArray<Integer>;
  43. fLastFilename : string;
  44. fWindowPos : TWinPos;
  45. fHistory : TArray<TProcessType>;
  46. fComplex : TProcessType;
  47. fModifyDate : TDateTime;
  48. fWorkList : TObjectList<TWorker>;
  49. published
  50. property Sizes : TArray<Integer> read fSizes write fSizes;
  51. property LastFilename : string read fLastFilename write fLastFilename;
  52. property WindowPos : TWinPos read fWindowPos write fWindowPos;
  53. property History : TArray<TProcessType> read fHistory write fHistory;
  54. property Complex : TProcessType read fComplex write fComplex;
  55. property ModifyDate : TDateTime read fModifyDate write fModifyDate;
  56. property Title : string read fTitle write fTitle;
  57. property SessionName : string read fSessionName write fSessionName;
  58. property WorkList : TObjectList<TWorker> read fWorkList write fWorkList;
  59. public
  60. constructor Create; override;
  61. destructor Destroy; override;
  62. procedure DefaultValues; override;
  63. end;
  64. TMainForm = class(TForm)
  65. meInfo: TMemo;
  66. btnLoadRegistry: TButton;
  67. SaveRegistry: TButton;
  68. procedure FormCreate(Sender: TObject);
  69. procedure SaveRegistryClick(Sender: TObject);
  70. procedure btnLoadRegistryClick(Sender: TObject);
  71. procedure SetConfig(cConfig: TMyConfig);
  72. function TestConfig(cConfig1, cConfig2 : TMyConfig) : Boolean;
  73. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  74. end;
  75. var
  76. MainForm: TMainForm;
  77. ConfigTest : TMyConfig;
  78. ConfigReg : TMyConfig;
  79. implementation
  80. {$R *.dfm}
  81. procedure TMainForm.btnLoadRegistryClick(Sender: TObject);
  82. begin
  83. meInfo.Lines.Add('Load ConfigReg');
  84. ConfigReg.Load;
  85. meInfo.Lines.Add(ConfigReg.ToJSON);
  86. if TestConfig(configtest,ConfigReg) then meInfo.Lines.Add('Test passed successfully!');
  87. end;
  88. procedure TMainForm.SaveRegistryClick(Sender: TObject);
  89. begin
  90. SetConfig(ConfigReg);
  91. ConfigReg.Save;
  92. meInfo.Lines.Add('Saved Config in Registry at ' + DateTimeToStr(ConfigReg.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(ConfigReg) then ConfigReg.Free;
  159. end;
  160. procedure TMainForm.FormCreate(Sender: TObject);
  161. begin
  162. ConfigReg := TMyConfig.Create;
  163. ConfigReg.Provider.HRoot := HKEY_CURRENT_USER;
  164. ConfigReg.Provider.MainKey := '_AppConfig';
  165. //create config test to compare later
  166. ConfigTest := TMyConfig.Create;
  167. SetConfig(ConfigTest);
  168. end;
  169. { TMyConfig }
  170. constructor TMyConfig.Create;
  171. begin
  172. inherited;
  173. WorkList := TObjectList<TWorker>.Create(True);
  174. DefaultValues;
  175. end;
  176. procedure TMyConfig.DefaultValues;
  177. begin
  178. inherited;
  179. fTitle := 'Default value';
  180. end;
  181. destructor TMyConfig.Destroy;
  182. begin
  183. if Assigned(WorkList) then WorkList.Free;
  184. inherited;
  185. end;
  186. end.