1 {
2 *****************************************************************************
3 This file is part of the EducationLaz package
4
5 See the file COPYING.modifiedLGPL.txt, included in this distribution,
6 for details about the license.
7 *****************************************************************************
8
9 Author: Mattias Gaertner
10
11 Abstract:
12 Options.
13 }
14 unit EduOptions;
15
16 {$mode objfpc}{$H+}
17
18 interface
19
20 uses
21 Classes, SysUtils, LCLProc, LazConfigStorage, Controls, Forms, BaseIDEIntf,
22 LazFileUtils, LazIDEIntf, IDEOptionsIntf, ProjectIntf;
23
24 resourcestring
25 EduRSEducation = 'Education';
26 ersShowAll = 'Show all';
27 ersHideAll = 'Hide all';
28 ersShowExtended = 'Show Extended';
29 ersShowMinimal = 'Show Minimal';
30 ersVisibleComponents = 'Visible components';
31 ersShowAllChilds = 'Show all children';
32 ersIDEMenuItems = 'IDE menu items';
33 ersNewSingleFileProgram = 'New single file program';
34 ersNewSingleFileEducationProgram = 'New single file education program';
35 ersNewProgram = 'New program';
36 ersAddIcon = 'Add icon';
37 ersAddASpeedButtonToTheIDEToolbarToCreateANewProgram = 'Add a speed button '
38 +'to the IDE toolbar to create a new program';
39 ersAddMenuItem = 'Add menu item';
40 ersAddAnIDEMenuItemToCreateANewProgram = 'Add an IDE menu item to create a new program';
41 ersAddToNewDialog = 'Add to %sNew ...%s dialog';
42 ersAddAnEntryToTheNewDialogToCreateANewProgram = 'Add an entry to the %'
43 +'sNew ...%s dialog to create a new program';
44 ersSource = 'Source';
45 ersSingleFileProgram = 'Single file program';
46 ersASimpleProgramOnlyOneFileIsCreatedAndAddedToTheCur = 'A simple program. '
47 +'Only one file is created and added to the current project.';
48 ersLoadDefaultCode = 'Load default code?';
49 ersReplaceCurrentWithDefaultSourceCode = 'Replace current with default '
50 +'source code?';
51 ersReplaceCurrentSourceWithDefaultSourceCode = 'Replace current source with '
52 +'default source code';
53 ersLoadSourceFromFile = 'Load source from file';
54
55 ersGrpBoxPropsMin = 'Properties: Minimal Configuration';
56 ersGrpBoxPropsExt = 'Properties: Extended Configuration';
57 ersGrpBoxPropsFull = 'Properties: Full Configuration';
58
59 ersGrpBoxEventsMin = 'Events: Minimal Configuration';
60 ersGrpBoxEventsExt = 'Events: Extended Configuration';
61 ersGrpBoxEventsFull = 'Events: Full Configuration';
62
63 ersStTextPropsMin = 'Name, Caption, Visible, Text, Checked, Items, Font, Color, Enabled, Height, Width, MaxLength, Picture, Columns';
64 ersStTextPropsExt ='Align, Left, Top, Hint, ShowHint, ParentFont, TabOrder, ParentShowHint, WordWrap, FixedCols, FixedRows, DefaultColWidth, DefaultRowHeight, ColCount, RowCount, Borderstyle, Glyph, State, Interval, DataSource, DataField + DB-Properties';
65 ersStTextPropsFull = 'All Properties available';
66
67 ersStTextEventsMin = 'OnClick, OnChange, OnMouseMove';
68 ersStTextEventsExt = 'OnClick, OnChange, OnMouseMove, OnDblClick, OnCreate, OnKeyPress, OnFormCreate';
69 ersStTextEventsFull = 'All Events available';
70
71 ersRdGrpPropsCaption = 'Properties';
72 ersRdGrpEventsCaption = 'Events';
73
74 ersEduEnvOptsFrameTitle = 'General';
75 ersEduPropsEventsTitle = 'Properties and Events';
76 ersEduCompPaletteTitle = 'Component palette';
77 ersEduNewProgramTitle = 'New program';
78 ersEduMenuTitle = 'Menus';
79 ersEduOIPages = 'Object Inspector';
80
81 ersRdBtnFull = 'Show All';
82 ersEnableEduCheckBoxCaption = 'Enable education settings';
83 ersShowOIPages = 'Show Object Inspector Pages';
84
85 ersEduSBTitle = 'Speed Buttons';
86 ersShowSelection = 'Show Selection';
87 ersVisibleSpeedButtons = 'Visible SpeedButtons';
88
89
90
91
92 const
93 DefaultEduOptionsFilename = 'education.xml';
94 var
95 EduOptionID: integer = 2000;
96 EduOptionGeneralID: integer = 100;
97 EduOptionCompPaletteID: integer = 200;
98 EduOptionMenuID: integer = 300;
99 EduOptionNewPrgID: integer = 400;
100 EduPropsEventsOptionsID: integer = 500;
101 EduOIPagesOptionsID: integer = 600;
102 EduSpeedButtonsOptionsID: integer = 700;
103
104 type
105
106 { TEduOptionsNode }
107
108 TEduOptionsNode = class(TPersistent)
109 private
110 FChilds: TFPList; // list of TEduOptionsNode
111 FName: string;
112 FNextSibling: TEduOptionsNode;
113 FParent: TEduOptionsNode;
114 FPrevSibling: TEduOptionsNode;
GetChildCountnull115 function GetChildCount: integer;
GetChildsnull116 function GetChilds(Index: integer): TEduOptionsNode;
117 procedure SetName(const AValue: string);
118 public
119 constructor Create; virtual;
120 destructor Destroy; override;
121 procedure Clear; virtual;
122 procedure Delete(Index: integer); virtual;
123 procedure Remove(Index: integer); virtual;
124 procedure Add(Node: TEduOptionsNode);
125 procedure Insert(Index: integer; Node: TEduOptionsNode);
126 procedure Unbind;
Loadnull127 function Load(Config: TConfigStorage): TModalResult; virtual;
Savenull128 function Save(Config: TConfigStorage): TModalResult; virtual;
129 procedure Changed; virtual;
130 procedure Apply(Enable: boolean); virtual;
131 public
132 property Name: string read FName write SetName;
133 property Parent: TEduOptionsNode read FParent;
134 property NextSibling: TEduOptionsNode read FNextSibling;
135 property PrevSibling: TEduOptionsNode read FPrevSibling;
136 property ChildCount: integer read GetChildCount;
137 property Children[Index: integer]: TEduOptionsNode read GetChilds; default;
138 end;
139
140 { TEduOptsRootNode }
141
142 TEduOptsRootNode = class(TEduOptionsNode)
143 private
144 FChangeStep: integer;
145 procedure SetChangeStep(const AValue: integer);
146 public
147 procedure Changed; override;
148 procedure IncreaseChangeStep;
149 property ChangeStep: integer read FChangeStep write SetChangeStep;
150 end;
151
152 TEduOptions = class(TAbstractIDEEnvironmentOptions)
153 private
154 FEnabled: boolean;
155 FFilename: string;
156 FNeedLoad: boolean;
157 FRoot: TEduOptionsNode;
158 FLastSavedChangeStep: integer;
159 procedure SetEnabled(const AValue: boolean);
160 procedure SetFilename(const AValue: string);
161 public
162 constructor Create;
163 destructor Destroy; override;
GetGroupCaptionnull164 class function GetGroupCaption: string; override;
GetInstancenull165 class function GetInstance: TAbstractIDEOptions; override;
166 property Root: TEduOptionsNode read FRoot;
Loadnull167 function Load(Config: TConfigStorage): TModalResult; virtual;
Savenull168 function Save(Config: TConfigStorage): TModalResult; virtual;
LoadFromFilenull169 function LoadFromFile(Filename: string): TModalResult; virtual;
SaveToFilenull170 function SaveToFile(Filename: string): TModalResult; virtual;
Loadnull171 function Load: TModalResult; virtual;
Savenull172 function Save: TModalResult; virtual;
173 procedure DoAfterWrite(Restore: boolean); override;
174 procedure Apply; virtual;
GetFullFilenamenull175 function GetFullFilename: string;
OnProjectOpenednull176 function OnProjectOpened(Sender: TObject; {%H-}AProject: TLazProject): TModalResult;
177 property Filename: string read FFilename write SetFilename;
178 property Enabled: boolean read FEnabled write SetEnabled;
179 property NeedLoad: boolean read FNeedLoad write FNeedLoad;
180 end;
181
182 type
183 EducationIDEOptionsClass = TAbstractIDEEnvironmentOptions;
184
185 var
186 EducationOptions: TEduOptions = nil;
187
188 implementation
189
190 { TEduOptionsNode }
191
192 procedure TEduOptionsNode.SetName(const AValue: string);
193 begin
194 if FName=AValue then exit;
195 FName:=AValue;
196 end;
197
TEduOptionsNode.GetChildsnull198 function TEduOptionsNode.GetChilds(Index: integer): TEduOptionsNode;
199 begin
200 Result:=TEduOptionsNode(fChilds[Index]);
201 end;
202
GetChildCountnull203 function TEduOptionsNode.GetChildCount: integer;
204 begin
205 Result:=fChilds.Count;
206 end;
207
208 constructor TEduOptionsNode.Create;
209 begin
210 fChilds:=TFPList.Create;
211 end;
212
213 destructor TEduOptionsNode.Destroy;
214 begin
215 Clear;
216 FreeAndNil(fChilds);
217 inherited Destroy;
218 end;
219
220 procedure TEduOptionsNode.Clear;
221 begin
222 while ChildCount>0 do Delete(ChildCount-1);
223 end;
224
225 procedure TEduOptionsNode.Delete(Index: integer);
226 var
227 Child: TEduOptionsNode;
228 begin
229 Child:=Children[Index];
230 Remove(Index);
231 Child.Free;
232 end;
233
234 procedure TEduOptionsNode.Remove(Index: integer);
235 var
236 Child: TEduOptionsNode;
237 begin
238 Child:=Children[Index];
239 fChilds.Delete(Index);
240 Child.FParent:=nil;
241 Child.Unbind;
242 end;
243
244 procedure TEduOptionsNode.Add(Node: TEduOptionsNode);
245 begin
246 Insert(ChildCount,Node);
247 end;
248
249 procedure TEduOptionsNode.Insert(Index: integer; Node: TEduOptionsNode);
250 begin
251 Node.Unbind;
252 FChilds.Insert(Index,Node);
253 Node.FParent:=Self;
254 if Index>0 then begin
255 Node.FPrevSibling:=Children[Index-1];
256 Node.FPrevSibling.FNextSibling:=Node;
257 end;
258 if Index+1<ChildCount then begin
259 Node.FNextSibling:=Children[Index+1];
260 Node.FNextSibling.FPrevSibling:=Node;
261 end;
262 end;
263
264 procedure TEduOptionsNode.Unbind;
265 begin
266 if FParent<>nil then
267 FParent.fChilds.Remove(Self);
268 FParent:=nil;
269 if FPrevSibling<>nil then
270 FPrevSibling.FNextSibling:=FNextSibling;
271 if FNextSibling<>nil then
272 FNextSibling.FPrevSibling:=FPrevSibling;
273 FPrevSibling:=nil;
274 FNextSibling:=nil;
275 end;
276
Loadnull277 function TEduOptionsNode.Load(Config: TConfigStorage): TModalResult;
278 var
279 i: Integer;
280 Child: TEduOptionsNode;
281 begin
282 for i:=0 to ChildCount-1 do begin
283 Child:=Children[i];
284 if not IsValidIdent(Child.Name) then continue;
285 Config.AppendBasePath(Child.Name);
286 try
287 Result:=Child.Load(Config);
288 if Result<>mrOK then exit;
289 finally
290 Config.UndoAppendBasePath;
291 end;
292 end;
293 Result:=mrOk;
294 end;
295
Savenull296 function TEduOptionsNode.Save(Config: TConfigStorage): TModalResult;
297 var
298 i: Integer;
299 Child: TEduOptionsNode;
300 begin
301 for i:=0 to ChildCount-1 do begin
302 Child:=Children[i];
303 if not IsValidIdent(Child.Name) then continue;
304 Config.AppendBasePath(Child.Name);
305 try
306 Result:=Child.Save(Config);
307 if Result<>mrOK then exit;
308 finally
309 Config.UndoAppendBasePath;
310 end;
311 end;
312 Result:=mrOk;
313 end;
314
315 procedure TEduOptionsNode.Changed;
316 begin
317 if FParent<>nil then FParent.Changed;
318 end;
319
320 procedure TEduOptionsNode.Apply(Enable: boolean);
321 var
322 i: Integer;
323 begin
324 for i:=0 to ChildCount-1 do
325 Children[i].Apply(Enable);
326 end;
327
328 { TEduOptions }
329
330 procedure TEduOptions.SetFilename(const AValue: string);
331 begin
332 if FFilename=AValue then exit;
333 FFilename:=AValue;
334 end;
335
336 procedure TEduOptions.SetEnabled(const AValue: boolean);
337 begin
338 if FEnabled=AValue then exit;
339 FEnabled:=AValue;
340 Root.Changed;
341 Apply;
342 end;
343
344 constructor TEduOptions.Create;
345 begin
346 FRoot:=TEduOptsRootNode.Create;
347 FFilename:=DefaultEduOptionsFilename;
348 FNeedLoad:=true;
349 end;
350
351 destructor TEduOptions.Destroy;
352 begin
353 FreeAndNil(FRoot);
354 inherited Destroy;
355 end;
356
TEduOptions.GetGroupCaptionnull357 class function TEduOptions.GetGroupCaption: string;
358 begin
359 Result:=EduRSEducation;
360 end;
361
TEduOptions.GetInstancenull362 class function TEduOptions.GetInstance: TAbstractIDEOptions;
363 begin
364 Result:=EducationOptions;
365 end;
366
Loadnull367 function TEduOptions.Load(Config: TConfigStorage): TModalResult;
368 begin
369 FEnabled:=Config.GetValue('Enabled',false);
370 Result:=FRoot.Load(Config);
371 end;
372
TEduOptions.Savenull373 function TEduOptions.Save(Config: TConfigStorage): TModalResult;
374 begin
375 Config.SetDeleteValue('Enabled',Enabled,false);
376 Result:=FRoot.Save(Config);
377 end;
378
LoadFromFilenull379 function TEduOptions.LoadFromFile(Filename: string): TModalResult;
380 var
381 Config: TConfigStorage;
382 begin
383 Config:=GetIDEConfigStorage(Filename,true);
384 try
385 Result:=Load(Config);
386 finally
387 Config.Free;
388 end;
389 end;
390
SaveToFilenull391 function TEduOptions.SaveToFile(Filename: string): TModalResult;
392 var
393 Config: TConfigStorage;
394 begin
395 //DebugLn(['TEduOptions.SaveToFile ',Filename]);
396 Config:=GetIDEConfigStorage(Filename,false);
397 try
398 Result:=Save(Config);
399 finally
400 Config.Free;
401 end;
402 end;
403
Loadnull404 function TEduOptions.Load: TModalResult;
405 begin
406 Result:=LoadFromFile(Filename);
407 FLastSavedChangeStep:=TEduOptsRootNode(Root).ChangeStep;
408 end;
409
TEduOptions.Savenull410 function TEduOptions.Save: TModalResult;
411 var
412 FullFilename: String;
413 begin
414 FullFilename:=GetFullFilename;
415 if FileExistsUTF8(FullFilename)
416 and (FLastSavedChangeStep=TEduOptsRootNode(Root).ChangeStep) then
417 Result:=mrOK;
418 Result:=SaveToFile(Filename);
419 FLastSavedChangeStep:=TEduOptsRootNode(Root).ChangeStep;
420 end;
421
422 procedure TEduOptions.DoAfterWrite(Restore: boolean);
423 begin
424 inherited DoAfterWrite(Restore);
425 if not Restore then begin
426 if EducationOptions.Save<>mrOk then
427 DebugLn(['TEduOptions.DoAfterWrite Failed']);
428 Apply;
429 end;
430 end;
431
432 procedure TEduOptions.Apply;
433 begin
434 //DebugLn(['TEduOptions.Apply ']);
435 Root.Apply(Enabled);
436 end;
437
GetFullFilenamenull438 function TEduOptions.GetFullFilename: string;
439 begin
440 Result:=Filename;
441 if FilenameIsAbsolute(Result) then exit;
442 Result:=AppendPathDelim(LazarusIDE.GetPrimaryConfigPath)+Result;
443 end;
444
OnProjectOpenednull445 function TEduOptions.OnProjectOpened(Sender: TObject; AProject: TLazProject
446 ): TModalResult;
447 begin
448 Result:=mrOk;
449 if NeedLoad then
450 Load;
451 Apply;
452 end;
453
454 { TEduOptsRootNode }
455
456 procedure TEduOptsRootNode.SetChangeStep(const AValue: integer);
457 begin
458 if FChangeStep=AValue then exit;
459 FChangeStep:=AValue;
460 end;
461
462 procedure TEduOptsRootNode.Changed;
463 begin
464 inherited Changed;
465 IncreaseChangeStep;
466 end;
467
468 procedure TEduOptsRootNode.IncreaseChangeStep;
469 begin
470 if FChangeStep=High(FChangeStep) then
471 FChangeStep:=low(FChangeStep)
472 else
473 inc(FChangeStep);
474 end;
475
476 initialization
477 EducationOptions:=TEduOptions.Create;
478
479 finalization
480 FreeAndNil(EducationOptions);
481
482 end.
483