lazarus/components/education/eduoptions.pas

483 lines
13 KiB
ObjectPascal

{
*****************************************************************************
This file is part of the EducationLaz package
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Mattias Gaertner
Abstract:
Options.
}
unit EduOptions;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLProc, LazConfigStorage, Controls, Forms, BaseIDEIntf,
LazFileUtils, LazIDEIntf, IDEOptionsIntf, ProjectIntf;
resourcestring
EduRSEducation = 'Education';
ersShowAll = 'Show all';
ersHideAll = 'Hide all';
ersShowExtended = 'Show Extended';
ersShowMinimal = 'Show Minimal';
ersVisibleComponents = 'Visible components';
ersShowAllChilds = 'Show all children';
ersIDEMenuItems = 'IDE menu items';
ersNewSingleFileProgram = 'New single file program';
ersNewSingleFileEducationProgram = 'New single file education program';
ersNewProgram = 'New program';
ersAddIcon = 'Add icon';
ersAddASpeedButtonToTheIDEToolbarToCreateANewProgram = 'Add a speed button '
+'to the IDE toolbar to create a new program';
ersAddMenuItem = 'Add menu item';
ersAddAnIDEMenuItemToCreateANewProgram = 'Add an IDE menu item to create a new program';
ersAddToNewDialog = 'Add to %sNew ...%s dialog';
ersAddAnEntryToTheNewDialogToCreateANewProgram = 'Add an entry to the %'
+'sNew ...%s dialog to create a new program';
ersSource = 'Source';
ersSingleFileProgram = 'Single file program';
ersASimpleProgramOnlyOneFileIsCreatedAndAddedToTheCur = 'A simple program. '
+'Only one file is created and added to the current project.';
ersLoadDefaultCode = 'Load default code?';
ersReplaceCurrentWithDefaultSourceCode = 'Replace current with default '
+'source code?';
ersReplaceCurrentSourceWithDefaultSourceCode = 'Replace current source with '
+'default source code';
ersLoadSourceFromFile = 'Load source from file';
ersGrpBoxPropsMin = 'Properties: Minimal Configuration';
ersGrpBoxPropsExt = 'Properties: Extended Configuration';
ersGrpBoxPropsFull = 'Properties: Full Configuration';
ersGrpBoxEventsMin = 'Events: Minimal Configuration';
ersGrpBoxEventsExt = 'Events: Extended Configuration';
ersGrpBoxEventsFull = 'Events: Full Configuration';
ersStTextPropsMin = 'Name, Caption, Visible, Text, Checked, Items, Font, Color, Enabled, Height, Width, MaxLength, Picture, Columns';
ersStTextPropsExt ='Align, Left, Top, Hint, ShowHint, ParentFont, TabOrder, ParentShowHint, WordWrap, FixedCols, FixedRows, DefaultColWidth, DefaultRowHeight, ColCount, RowCount, Borderstyle, Glyph, State, Interval, DataSource, DataField + DB-Properties';
ersStTextPropsFull = 'All Properties available';
ersStTextEventsMin = 'OnClick, OnChange, OnMouseMove';
ersStTextEventsExt = 'OnClick, OnChange, OnMouseMove, OnDblClick, OnCreate, OnKeyPress, OnFormCreate';
ersStTextEventsFull = 'All Events available';
ersRdGrpPropsCaption = 'Properties';
ersRdGrpEventsCaption = 'Events';
ersEduEnvOptsFrameTitle = 'General';
ersEduPropsEventsTitle = 'Properties and Events';
ersEduCompPaletteTitle = 'Component palette';
ersEduNewProgramTitle = 'New program';
ersEduMenuTitle = 'Menus';
ersEduOIPages = 'Object Inspector';
ersRdBtnFull = 'Show All';
ersEnableEduCheckBoxCaption = 'Enable education settings';
ersShowOIPages = 'Show Object Inspector Pages';
ersEduSBTitle = 'Speed Buttons';
ersShowSelection = 'Show Selection';
ersVisibleSpeedButtons = 'Visible SpeedButtons';
const
DefaultEduOptionsFilename = 'education.xml';
var
EduOptionID: integer = 2000;
EduOptionGeneralID: integer = 100;
EduOptionCompPaletteID: integer = 200;
EduOptionMenuID: integer = 300;
EduOptionNewPrgID: integer = 400;
EduPropsEventsOptionsID: integer = 500;
EduOIPagesOptionsID: integer = 600;
EduSpeedButtonsOptionsID: integer = 700;
type
{ TEduOptionsNode }
TEduOptionsNode = class(TPersistent)
private
FChilds: TFPList; // list of TEduOptionsNode
FName: string;
FNextSibling: TEduOptionsNode;
FParent: TEduOptionsNode;
FPrevSibling: TEduOptionsNode;
function GetChildCount: integer;
function GetChilds(Index: integer): TEduOptionsNode;
procedure SetName(const AValue: string);
public
constructor Create; virtual;
destructor Destroy; override;
procedure Clear; virtual;
procedure Delete(Index: integer); virtual;
procedure Remove(Index: integer); virtual;
procedure Add(Node: TEduOptionsNode);
procedure Insert(Index: integer; Node: TEduOptionsNode);
procedure Unbind;
function Load(Config: TConfigStorage): TModalResult; virtual;
function Save(Config: TConfigStorage): TModalResult; virtual;
procedure Changed; virtual;
procedure Apply(Enable: boolean); virtual;
public
property Name: string read FName write SetName;
property Parent: TEduOptionsNode read FParent;
property NextSibling: TEduOptionsNode read FNextSibling;
property PrevSibling: TEduOptionsNode read FPrevSibling;
property ChildCount: integer read GetChildCount;
property Children[Index: integer]: TEduOptionsNode read GetChilds; default;
end;
{ TEduOptsRootNode }
TEduOptsRootNode = class(TEduOptionsNode)
private
FChangeStep: integer;
procedure SetChangeStep(const AValue: integer);
public
procedure Changed; override;
procedure IncreaseChangeStep;
property ChangeStep: integer read FChangeStep write SetChangeStep;
end;
TEduOptions = class(TAbstractIDEEnvironmentOptions)
private
FEnabled: boolean;
FFilename: string;
FNeedLoad: boolean;
FRoot: TEduOptionsNode;
FLastSavedChangeStep: integer;
procedure SetEnabled(const AValue: boolean);
procedure SetFilename(const AValue: string);
public
constructor Create;
destructor Destroy; override;
class function GetGroupCaption: string; override;
class function GetInstance: TAbstractIDEOptions; override;
property Root: TEduOptionsNode read FRoot;
function Load(Config: TConfigStorage): TModalResult; virtual;
function Save(Config: TConfigStorage): TModalResult; virtual;
function LoadFromFile(Filename: string): TModalResult; virtual;
function SaveToFile(Filename: string): TModalResult; virtual;
function Load: TModalResult; virtual;
function Save: TModalResult; virtual;
procedure DoAfterWrite(Restore: boolean); override;
procedure Apply; virtual;
function GetFullFilename: string;
function OnProjectOpened(Sender: TObject; {%H-}AProject: TLazProject): TModalResult;
property Filename: string read FFilename write SetFilename;
property Enabled: boolean read FEnabled write SetEnabled;
property NeedLoad: boolean read FNeedLoad write FNeedLoad;
end;
type
EducationIDEOptionsClass = TAbstractIDEEnvironmentOptions;
var
EducationOptions: TEduOptions = nil;
implementation
{ TEduOptionsNode }
procedure TEduOptionsNode.SetName(const AValue: string);
begin
if FName=AValue then exit;
FName:=AValue;
end;
function TEduOptionsNode.GetChilds(Index: integer): TEduOptionsNode;
begin
Result:=TEduOptionsNode(fChilds[Index]);
end;
function TEduOptionsNode.GetChildCount: integer;
begin
Result:=fChilds.Count;
end;
constructor TEduOptionsNode.Create;
begin
fChilds:=TFPList.Create;
end;
destructor TEduOptionsNode.Destroy;
begin
Clear;
FreeAndNil(fChilds);
inherited Destroy;
end;
procedure TEduOptionsNode.Clear;
begin
while ChildCount>0 do Delete(ChildCount-1);
end;
procedure TEduOptionsNode.Delete(Index: integer);
var
Child: TEduOptionsNode;
begin
Child:=Children[Index];
Remove(Index);
Child.Free;
end;
procedure TEduOptionsNode.Remove(Index: integer);
var
Child: TEduOptionsNode;
begin
Child:=Children[Index];
fChilds.Delete(Index);
Child.FParent:=nil;
Child.Unbind;
end;
procedure TEduOptionsNode.Add(Node: TEduOptionsNode);
begin
Insert(ChildCount,Node);
end;
procedure TEduOptionsNode.Insert(Index: integer; Node: TEduOptionsNode);
begin
Node.Unbind;
FChilds.Insert(Index,Node);
Node.FParent:=Self;
if Index>0 then begin
Node.FPrevSibling:=Children[Index-1];
Node.FPrevSibling.FNextSibling:=Node;
end;
if Index+1<ChildCount then begin
Node.FNextSibling:=Children[Index+1];
Node.FNextSibling.FPrevSibling:=Node;
end;
end;
procedure TEduOptionsNode.Unbind;
begin
if FParent<>nil then
FParent.fChilds.Remove(Self);
FParent:=nil;
if FPrevSibling<>nil then
FPrevSibling.FNextSibling:=FNextSibling;
if FNextSibling<>nil then
FNextSibling.FPrevSibling:=FPrevSibling;
FPrevSibling:=nil;
FNextSibling:=nil;
end;
function TEduOptionsNode.Load(Config: TConfigStorage): TModalResult;
var
i: Integer;
Child: TEduOptionsNode;
begin
for i:=0 to ChildCount-1 do begin
Child:=Children[i];
if not IsValidIdent(Child.Name) then continue;
Config.AppendBasePath(Child.Name);
try
Result:=Child.Load(Config);
if Result<>mrOK then exit;
finally
Config.UndoAppendBasePath;
end;
end;
Result:=mrOk;
end;
function TEduOptionsNode.Save(Config: TConfigStorage): TModalResult;
var
i: Integer;
Child: TEduOptionsNode;
begin
for i:=0 to ChildCount-1 do begin
Child:=Children[i];
if not IsValidIdent(Child.Name) then continue;
Config.AppendBasePath(Child.Name);
try
Result:=Child.Save(Config);
if Result<>mrOK then exit;
finally
Config.UndoAppendBasePath;
end;
end;
Result:=mrOk;
end;
procedure TEduOptionsNode.Changed;
begin
if FParent<>nil then FParent.Changed;
end;
procedure TEduOptionsNode.Apply(Enable: boolean);
var
i: Integer;
begin
for i:=0 to ChildCount-1 do
Children[i].Apply(Enable);
end;
{ TEduOptions }
procedure TEduOptions.SetFilename(const AValue: string);
begin
if FFilename=AValue then exit;
FFilename:=AValue;
end;
procedure TEduOptions.SetEnabled(const AValue: boolean);
begin
if FEnabled=AValue then exit;
FEnabled:=AValue;
Root.Changed;
Apply;
end;
constructor TEduOptions.Create;
begin
FRoot:=TEduOptsRootNode.Create;
FFilename:=DefaultEduOptionsFilename;
FNeedLoad:=true;
end;
destructor TEduOptions.Destroy;
begin
FreeAndNil(FRoot);
inherited Destroy;
end;
class function TEduOptions.GetGroupCaption: string;
begin
Result:=EduRSEducation;
end;
class function TEduOptions.GetInstance: TAbstractIDEOptions;
begin
Result:=EducationOptions;
end;
function TEduOptions.Load(Config: TConfigStorage): TModalResult;
begin
FEnabled:=Config.GetValue('Enabled',false);
Result:=FRoot.Load(Config);
end;
function TEduOptions.Save(Config: TConfigStorage): TModalResult;
begin
Config.SetDeleteValue('Enabled',Enabled,false);
Result:=FRoot.Save(Config);
end;
function TEduOptions.LoadFromFile(Filename: string): TModalResult;
var
Config: TConfigStorage;
begin
Config:=GetIDEConfigStorage(Filename,true);
try
Result:=Load(Config);
finally
Config.Free;
end;
end;
function TEduOptions.SaveToFile(Filename: string): TModalResult;
var
Config: TConfigStorage;
begin
//DebugLn(['TEduOptions.SaveToFile ',Filename]);
Config:=GetIDEConfigStorage(Filename,false);
try
Result:=Save(Config);
finally
Config.Free;
end;
end;
function TEduOptions.Load: TModalResult;
begin
Result:=LoadFromFile(Filename);
FLastSavedChangeStep:=TEduOptsRootNode(Root).ChangeStep;
end;
function TEduOptions.Save: TModalResult;
var
FullFilename: String;
begin
FullFilename:=GetFullFilename;
if FileExistsUTF8(FullFilename)
and (FLastSavedChangeStep=TEduOptsRootNode(Root).ChangeStep) then
Result:=mrOK;
Result:=SaveToFile(Filename);
FLastSavedChangeStep:=TEduOptsRootNode(Root).ChangeStep;
end;
procedure TEduOptions.DoAfterWrite(Restore: boolean);
begin
inherited DoAfterWrite(Restore);
if not Restore then begin
if EducationOptions.Save<>mrOk then
DebugLn(['TEduOptions.DoAfterWrite Failed']);
Apply;
end;
end;
procedure TEduOptions.Apply;
begin
//DebugLn(['TEduOptions.Apply ']);
Root.Apply(Enabled);
end;
function TEduOptions.GetFullFilename: string;
begin
Result:=Filename;
if FilenameIsAbsolute(Result) then exit;
Result:=AppendPathDelim(LazarusIDE.GetPrimaryConfigPath)+Result;
end;
function TEduOptions.OnProjectOpened(Sender: TObject; AProject: TLazProject
): TModalResult;
begin
Result:=mrOk;
if NeedLoad then
Load;
Apply;
end;
{ TEduOptsRootNode }
procedure TEduOptsRootNode.SetChangeStep(const AValue: integer);
begin
if FChangeStep=AValue then exit;
FChangeStep:=AValue;
end;
procedure TEduOptsRootNode.Changed;
begin
inherited Changed;
IncreaseChangeStep;
end;
procedure TEduOptsRootNode.IncreaseChangeStep;
begin
if FChangeStep=High(FChangeStep) then
FChangeStep:=low(FChangeStep)
else
inc(FChangeStep);
end;
initialization
EducationOptions:=TEduOptions.Create;
finalization
FreeAndNil(EducationOptions);
end.