mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 04:18:48 +02:00
PoChecker: starts implementing TPoCheckerSettings.
git-svn-id: trunk@46273 -
This commit is contained in:
bart
parent
c97e37c258
commit
12755f715c
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -2926,6 +2926,8 @@ components/pochecker/pochecker.pas svneol=native#text/plain
|
||||
components/pochecker/pocheckerconsts.pas svneol=native#text/pascal
|
||||
components/pochecker/pocheckermain.lfm svneol=native#text/plain
|
||||
components/pochecker/pocheckermain.pp svneol=native#text/plain
|
||||
components/pochecker/pocheckersettings.pp svneol=native#text/pascal
|
||||
components/pochecker/pocheckerxmlconfig.pp svneol=native#text/pascal
|
||||
components/pochecker/pofamilies.pp svneol=native#text/plain
|
||||
components/pochecker/resultdlg.lfm svneol=native#text/plain
|
||||
components/pochecker/resultdlg.pp svneol=native#text/plain
|
||||
|
||||
@ -69,7 +69,7 @@
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="7">
|
||||
<Units Count="8">
|
||||
<Unit0>
|
||||
<Filename Value="pochecker.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
@ -77,6 +77,7 @@
|
||||
<Unit1>
|
||||
<Filename Value="..\pofamilies.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="PoFamilies"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="..\resultdlg.pp"/>
|
||||
@ -89,10 +90,12 @@
|
||||
<Unit3>
|
||||
<Filename Value="..\simplepofiles.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="SimplePoFiles"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="..\pocheckerconsts.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="pocheckerconsts"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="..\pocheckermain.pp"/>
|
||||
@ -110,6 +113,11 @@
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="GraphStat"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="..\pocheckersettings.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="PoCheckerSettings"/>
|
||||
</Unit7>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
||||
@ -8,7 +8,7 @@ uses
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, pocheckermain, pofamilies, resultdlg, simplepofiles, pocheckerconsts,
|
||||
graphstat;
|
||||
graphstat, pocheckersettings;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
|
||||
@ -16,7 +16,7 @@
|
||||
<Description Value="Check the validity of translated PO files.
|
||||
"/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="9">
|
||||
<Files Count="11">
|
||||
<Item1>
|
||||
<Filename Value="resultdlg.pp"/>
|
||||
<UnitName Value="ResultDlg"/>
|
||||
@ -54,6 +54,14 @@
|
||||
<Filename Value="graphstat.pp"/>
|
||||
<UnitName Value="GraphStat"/>
|
||||
</Item9>
|
||||
<Item10>
|
||||
<Filename Value="pocheckersettings.pp"/>
|
||||
<UnitName Value="PoCheckerSettings"/>
|
||||
</Item10>
|
||||
<Item11>
|
||||
<Filename Value="pocheckerxmlconfig.pp"/>
|
||||
<UnitName Value="PoCheckerXMLConfig"/>
|
||||
</Item11>
|
||||
</Files>
|
||||
<i18n>
|
||||
<EnableI18N Value="True"/>
|
||||
|
||||
@ -8,7 +8,7 @@ interface
|
||||
|
||||
uses
|
||||
ResultDlg, PoFamilies, pocheckermain, SimplePoFiles, pocheckerconsts,
|
||||
GraphStat, LazarusPackageIntf;
|
||||
GraphStat, PoCheckerSettings, PoCheckerXMLConfig, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -31,13 +31,30 @@ uses
|
||||
{$ELSE}
|
||||
IDEIntf, MenuIntf,
|
||||
{$ENDIF}
|
||||
SimplePoFiles, PoFamilies, ResultDlg, pocheckerconsts;
|
||||
SimplePoFiles, PoFamilies, ResultDlg, pocheckerconsts, PoCheckerSettings;
|
||||
|
||||
type
|
||||
|
||||
{ TPoCheckerForm }
|
||||
|
||||
TPoCheckerForm = class(TForm)
|
||||
private
|
||||
PoFamily: TPoFamily;
|
||||
FChosenMasterName: string;
|
||||
FChosenChildName: string;
|
||||
FPoCheckerSettings: TPoCheckerSettings;
|
||||
procedure OnTestStart(const ATestName, APoFileName: string);
|
||||
procedure OnTestEnd(const ATestName: string; const ErrorCount: integer);
|
||||
procedure FillTestListBox;
|
||||
function GetTestTypesFromListBox: TPoTestTypes;
|
||||
function GetTestOptions: TPoTestOptions;
|
||||
procedure SetTestTypeCheckBoxes(TestTypes: TPoTestTypes);
|
||||
procedure SetTestOptionCheckBoxes(TestOptions: TPoTestOptions);
|
||||
procedure ShowError(const Msg: string);
|
||||
function TrySelectFile: boolean;
|
||||
procedure RunSelectedTests;
|
||||
procedure ClearAndDisableStatusPanel;
|
||||
published
|
||||
IgnoreFuzzyCheckBox: TCheckBox;
|
||||
UnselectAllBtn: TButton;
|
||||
SelectAllBtn: TButton;
|
||||
@ -62,21 +79,6 @@ type
|
||||
procedure SelectAllBtnClick(Sender: TObject);
|
||||
procedure SelectBasicBtnClick(Sender: TObject);
|
||||
procedure UnselectAllBtnClick(Sender: TObject);
|
||||
private
|
||||
PoFamily: TPoFamily;
|
||||
FChosenMasterName: string;
|
||||
FChosenChildName: string;
|
||||
procedure OnTestStart(const ATestName, APoFileName: string);
|
||||
procedure OnTestEnd(const ATestName: string; const ErrorCount: integer);
|
||||
procedure FillTestListBox;
|
||||
function GetTestTypesFromListBox: TPoTestTypes;
|
||||
function GetTestOptions: TPoTestOptions;
|
||||
procedure ShowError(const Msg: string);
|
||||
function TrySelectFile: boolean;
|
||||
procedure RunSelectedTests;
|
||||
procedure ClearAndDisableStatusPanel;
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
@ -104,6 +106,7 @@ var
|
||||
Lang, T: string;
|
||||
{$ENDIF}
|
||||
begin
|
||||
//debugln('TPoCheckerForm.FormCreate A:');
|
||||
{$IFDEF POCHECKERSTANDALONE}
|
||||
//Initializing translation
|
||||
Lang := GetEnvironmentVariableUTF8('LANG');
|
||||
@ -137,6 +140,15 @@ begin
|
||||
SelectAllBtn.Caption := sSelectAllTests;
|
||||
SelectBasicBtn.Caption := sSelectBasicTests;
|
||||
UnselectAllBtn.Caption := sUnselectAllTests;
|
||||
FPoCheckerSettings := TPoCheckerSettings.Create;
|
||||
FPoCheckerSettings.LoadConfig;
|
||||
//DebugLn(' TestOptions after loading = ');
|
||||
//DebugLn(' ',DbgS(FPoCheckerSettings.TestOptions));
|
||||
//debugln(' TPoCheckerForm.FormCreate: TestTypes after loading = ');
|
||||
//DebugLn(' ',DbgS(FPoCheckerSettings.TestTypes));
|
||||
SetTestTypeCheckBoxes(FPoCheckerSettings.TestTypes);
|
||||
SetTestOptionCheckBoxes(FPoCheckerSettings.TestOptions);
|
||||
|
||||
end;
|
||||
|
||||
|
||||
@ -144,6 +156,14 @@ procedure TPoCheckerForm.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
if Assigned(PoFamily) then
|
||||
PoFamily.Free;
|
||||
if Assigned(FPoCheckerSettings) then
|
||||
begin
|
||||
FPoCheckerSettings.SaveSettingsOnExit := True; //ToDo: create a checkbox for this
|
||||
FPoCheckerSettings.TestTypes := GetTestTypesFromListBox;
|
||||
FPoCheckerSettings.TestOptions := GetTestOptions;
|
||||
FPoCheckerSettings.SaveConfig;
|
||||
FPoCheckerSettings.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -262,6 +282,27 @@ begin
|
||||
Result := Result + [ptoIgnoreFuzzyStrings];
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.SetTestTypeCheckBoxes(TestTypes: TPoTestTypes);
|
||||
var
|
||||
Typ: TPoTestType;
|
||||
Index: integer;
|
||||
begin
|
||||
for Typ := Low(TPoTestType) to High(TPoTestType) do
|
||||
begin
|
||||
Index := Ord(Typ);
|
||||
if (Index < TestListBox.Count) then
|
||||
begin
|
||||
TestListBox.Checked[Index] := (Typ in TestTypes)
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerForm.SetTestOptionCheckBoxes(TestOptions: TPoTestOptions);
|
||||
begin
|
||||
FindAllPOsCheckBox.Checked := (ptoFindAllChildren in TestOptions);
|
||||
IgnoreFuzzyCheckBox.Checked := (ptoIgnoreFuzzyStrings in TestOptions);
|
||||
end;
|
||||
|
||||
|
||||
procedure TPoCheckerForm.ShowError(const Msg: string);
|
||||
begin
|
||||
|
||||
292
components/pochecker/pocheckersettings.pp
Normal file
292
components/pochecker/pocheckersettings.pp
Normal file
@ -0,0 +1,292 @@
|
||||
unit PoCheckerSettings;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LazConfigStorage,
|
||||
{$ifdef POCHECKERSTANDALONE}
|
||||
PoCheckerXMLConfig, Forms,
|
||||
{$else}
|
||||
BaseIDEIntf,
|
||||
{$endif}
|
||||
PoFamilies, LCLProc, LazFileUtils;
|
||||
|
||||
type
|
||||
|
||||
{ TPoCheckerSettings }
|
||||
|
||||
TPoCheckerSettings = class
|
||||
private
|
||||
FConfig: TConfigStorage;
|
||||
FFilename: String;
|
||||
FTestTypes: TPoTestTypes;
|
||||
FTestOptions: TPoTestOptions;
|
||||
FLoadSettings: Boolean;
|
||||
FSaveSettingsOnExit: Boolean;
|
||||
FMasterPoList: TStrings;
|
||||
FChildrenPoList: TStrings;
|
||||
function LoadTestTypes: TPoTestTypes;
|
||||
function LoadTestOptions: TPoTestOptions;
|
||||
procedure LoadMasterPoList(List: TStrings);
|
||||
procedure LoadChildrenPoList(List: TStrings);
|
||||
procedure SaveTestTypes;
|
||||
procedure SaveTestOptions;
|
||||
procedure SaveMasterPoList;
|
||||
procedure SaveChildrenPoList;
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure LoadConfig;
|
||||
procedure SaveConfig;
|
||||
|
||||
property Filename: String read FFilename;
|
||||
property SaveSettingsOnExit: Boolean read FSaveSettingsOnExit write FSaveSettingsOnExit;
|
||||
property TestTypes: TPoTestTypes read FTestTypes write FTestTypes;
|
||||
property TestOptions: TPoTestOptions read FTestOptions write FTestOptions;
|
||||
property MasterPoList: TStrings read FMasterPoList write FMasterPoList;
|
||||
property ChildrenPoList: TStrings read FChildrenPoList write FChildrenPoList;
|
||||
end;
|
||||
|
||||
function DbgS(PoTestTypes: TPoTestTypes): String; overload;
|
||||
function DbgS(PoTestOpts: TPoTestOptions): String; overload;
|
||||
|
||||
implementation
|
||||
|
||||
{ TPoCheckerSettings }
|
||||
{$ifdef pocheckerstandalone}
|
||||
function AppName: String;
|
||||
begin
|
||||
Result := 'pochecker';
|
||||
end;
|
||||
|
||||
function Vendor: String;
|
||||
begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function GetConfigPath: String;
|
||||
var
|
||||
OldOnGetApplicationName: TGetAppNameEvent;
|
||||
OldOnGetVendorName: TGetVendorNameEvent;
|
||||
begin
|
||||
Result := '';
|
||||
if Application.HasOption('primary-config-path') then
|
||||
Result := ExpandFileNameUtf8(Application.GetOptionValue('primary-config-path'))
|
||||
else if Application.HasOption('pcp') then
|
||||
Result := ExpandFileNameUtf8(Application.GetOptionValue('pcp'))
|
||||
else
|
||||
begin
|
||||
OldOnGetApplicationName := OnGetApplicationName;
|
||||
OldOnGetVendorName := OnGetVendorName;
|
||||
OnGetApplicationName := @AppName;
|
||||
OnGetVendorName := @Vendor;
|
||||
OnGetApplicationName := OldOnGetApplicationName;
|
||||
OnGetVendorName := OldOnGetVendorName;
|
||||
Result := GetAppConfigDirUtf8(False);
|
||||
end;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
const
|
||||
TestTypeNames: array[TPoTestType] of String = (
|
||||
'CheckNumberOfItems',
|
||||
'CheckForIncompatibleFormatArguments',
|
||||
'CheckMissingIdentifiers',
|
||||
'CheckForMismatchesInUntranslatedStrings',
|
||||
'CheckForDuplicateUntranslatedValues',
|
||||
'CheckStatistics'
|
||||
);
|
||||
TestoptionNames: array[TPoTestOption] of String = (
|
||||
'FindAllChildren',
|
||||
'IgnoreFuzzyStrings'
|
||||
);
|
||||
|
||||
pLoadSettings = 'General/LoadSettings/';
|
||||
pTestTypes = 'TestTypes/';
|
||||
pTestOptions = 'TestOptions/';
|
||||
pMasterPoFiles = 'MasterPoFiles';
|
||||
pChildrenPoFiles = 'ChildrenPoFiles';
|
||||
|
||||
function DbgS(PoTestTypes: TPoTestTypes): String; overload;
|
||||
var
|
||||
Typ: TPoTestType;
|
||||
begin
|
||||
Result := '[';
|
||||
for Typ := Low(TPotestType) to High(TPoTesttype) do
|
||||
begin
|
||||
if (Typ in PoTestTypes) then Result := Result + TestTypeNames[Typ];
|
||||
end;
|
||||
if (Result[Length(Result)] = ',') then System.Delete(Result,Length(Result),1);
|
||||
Result := Result + ']';
|
||||
end;
|
||||
|
||||
function DbgS(PoTestOpts: TPoTestOptions): String; overload;
|
||||
var
|
||||
Opt: TPoTestOption;
|
||||
begin
|
||||
Result := '[';
|
||||
for Opt := Low(TPotestOption) to High(TPoTestOption) do
|
||||
begin
|
||||
if (Opt in PoTestOpts) then Result := Result + TestOptionNames[opt];
|
||||
end;
|
||||
if (Result[Length(Result)] = ',') then System.Delete(Result,Length(Result),1);
|
||||
Result := Result + ']';
|
||||
end;
|
||||
|
||||
function TPoCheckerSettings.LoadTestTypes: TPoTestTypes;
|
||||
var
|
||||
tt: TPoTestType;
|
||||
Name: String;
|
||||
B: Boolean;
|
||||
begin
|
||||
Result := [];
|
||||
for tt := Low(TPoTestType) to High(TPoTestType) do
|
||||
begin
|
||||
Name := TestTypeNames[tt];
|
||||
B := FConfig.GetValue(pTestTypes + Name + '/Value',False);
|
||||
if B then Result := Result + [tt];
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPoCheckerSettings.LoadTestOptions: TPoTestOptions;
|
||||
var
|
||||
opt: TPoTestOption;
|
||||
Name: String;
|
||||
B: Boolean;
|
||||
begin
|
||||
Result := [];
|
||||
for opt := Low(TPoTestOption) to High(TPoTestOption) do
|
||||
begin
|
||||
Name := TestOptionNames[opt];
|
||||
B := FConfig.GetValue(pTestOptions + Name + '/Value',False);
|
||||
if B then Result := Result + [opt];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerSettings.LoadMasterPoList(List: TStrings);
|
||||
begin
|
||||
if not Assigned(List) then Exit;
|
||||
List.Clear;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerSettings.LoadChildrenPoList(List: TStrings);
|
||||
begin
|
||||
if not Assigned(List) then Exit;
|
||||
List.Clear;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerSettings.SaveTestTypes;
|
||||
var
|
||||
tt: TPoTestType;
|
||||
Name: String;
|
||||
begin
|
||||
for tt := Low(TPoTestTypes) to High(TPoTestTypes) do
|
||||
begin
|
||||
Name := TestTypeNames[tt];
|
||||
FConfig.SetDeleteValue(pTestTypes + Name + '/Value',(tt in FTestTypes),False);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerSettings.SaveTestOptions;
|
||||
var
|
||||
topt: TPoTestOption;
|
||||
Name: String;
|
||||
begin
|
||||
for topt := Low(TPoTestOptions) to High(TPoTestoptions) do
|
||||
begin
|
||||
Name := TestOptionNames[topt];
|
||||
FConfig.SetDeleteValue(pTestOptions + Name + '/Value',(topt in FTestOptions),False);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerSettings.SaveMasterPoList;
|
||||
begin
|
||||
FConfig.DeletePath(pMasterPoFiles);
|
||||
end;
|
||||
|
||||
procedure TPoCheckerSettings.SaveChildrenPoList;
|
||||
begin
|
||||
FConfig.DeletePath(pChildrenPoFiles);
|
||||
end;
|
||||
|
||||
constructor TPoCheckerSettings.Create;
|
||||
begin
|
||||
try
|
||||
FTestTypes := [];
|
||||
FTestOptions := [];
|
||||
{$ifdef POCHECKERSTANDALONE}
|
||||
FFilename := GetConfigPath;
|
||||
if (FFilename <> '') then FFilename := AppendPathDelim(FFilename);
|
||||
FFilename := FFilename + 'pochecker.xml';
|
||||
debugln('TPoCheckerSettings.Create: Filename = ');
|
||||
debugln('"',Filename,'"');
|
||||
|
||||
//FFilename := 'pochecker.xml';
|
||||
|
||||
FConfig := TXMLOptionsStorage.Create(FFilename, True);
|
||||
{$else}
|
||||
FFilename := 'pochecker.xml';
|
||||
FConfig := GetIDEConfigStorage(FFilename, True);
|
||||
{$endif}
|
||||
DebugLn('TPoCheckerSettings.Create: FConfig = ',DbgSName(FConfig));
|
||||
except
|
||||
Debugln('PoCheckerSettings.Create: failed to create ConfigStorage:');
|
||||
Debugln(' - Filename = ',FFilename);
|
||||
FConfig := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TPoCheckerSettings.Destroy;
|
||||
begin
|
||||
if Assigned(FConfig) then FConfig.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerSettings.LoadConfig;
|
||||
begin
|
||||
try
|
||||
FLoadSettings := FConfig.GetValue(pLoadSettings+'Value',False);
|
||||
if FLoadSettings then
|
||||
begin
|
||||
FTestTypes := LoadTestTypes;
|
||||
FTestOptions := LoadTestOptions;
|
||||
LoadMasterPoList(FMasterPoList);
|
||||
LoadChildrenPoList(FChildrenPoList);
|
||||
end;
|
||||
except
|
||||
FTestTypes := [];
|
||||
FTestOptions := [];
|
||||
debugln('TPoCheckerSettings.LoadConfig: Error loading config.');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPoCheckerSettings.SaveConfig;
|
||||
begin
|
||||
try
|
||||
FConfig.SetDeleteValue('Version','1.0','');
|
||||
FConfig.SetValue(pLoadSettings+'Value',FSaveSettingsOnExit);
|
||||
if FSaveSettingsOnExit then
|
||||
begin
|
||||
SaveTestTypes;
|
||||
SaveTestOptions;
|
||||
SaveMasterPoList;
|
||||
SaveChildrenPoList;
|
||||
end
|
||||
else
|
||||
begin
|
||||
FConfig.DeletePath(pMasterPoFiles);
|
||||
FConfig.DeletePath(pChildrenPoFiles);
|
||||
end;
|
||||
FConfig.WriteToDisk;
|
||||
except
|
||||
debugln('TPoCheckerSettings.SaveConfig: Error saving config.');
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
186
components/pochecker/pocheckerxmlconfig.pp
Normal file
186
components/pochecker/pocheckerxmlconfig.pp
Normal file
@ -0,0 +1,186 @@
|
||||
{
|
||||
/***************************************************************************
|
||||
PoCheckerXMLConfig.pp
|
||||
-----------------------------
|
||||
|
||||
***************************************************************************/
|
||||
|
||||
***************************************************************************
|
||||
* *
|
||||
* This source is free software; you can redistribute it and/or modify *
|
||||
* it under the terms of the GNU General Public License as published by *
|
||||
* the Free Software Foundation; either version 2 of the License, or *
|
||||
* (at your option) any later version. *
|
||||
* *
|
||||
* This code is distributed in the hope that it will be useful, but *
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
||||
* General Public License for more details. *
|
||||
* *
|
||||
* A copy of the GNU General Public License is available on the World *
|
||||
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
||||
* obtain it by writing to the Free Software Foundation, *
|
||||
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
||||
* *
|
||||
***************************************************************************
|
||||
}
|
||||
|
||||
// This souce is copied from the IDEOptionDefs unit
|
||||
// It provides the standalone version of PoChecker with the
|
||||
// same ConfigStorage interface as the embedded tool
|
||||
|
||||
unit PoCheckerXMLConfig;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LazConfigStorage, Laz2_XMLCfg;
|
||||
|
||||
|
||||
type
|
||||
{ TXMLOptionsStorage }
|
||||
|
||||
TXMLOptionsStorage = class(TConfigStorage)
|
||||
private
|
||||
FFreeXMLConfig: boolean;
|
||||
FXMLConfig: TXMLConfig;
|
||||
protected
|
||||
function GetFullPathValue(const APath, ADefault: String): String; override;
|
||||
function GetFullPathValue(const APath: String; ADefault: Integer): Integer; override;
|
||||
function GetFullPathValue(const APath: String; ADefault: Boolean): Boolean; override;
|
||||
procedure SetFullPathValue(const APath, AValue: String); override;
|
||||
procedure SetDeleteFullPathValue(const APath, AValue, DefValue: String); override;
|
||||
procedure SetFullPathValue(const APath: String; AValue: Integer); override;
|
||||
procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Integer); override;
|
||||
procedure SetFullPathValue(const APath: String; AValue: Boolean); override;
|
||||
procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Boolean); override;
|
||||
procedure DeleteFullPath(const APath: string); override;
|
||||
procedure DeleteFullPathValue(const APath: string); override;
|
||||
public
|
||||
constructor Create(const Filename: string; LoadFromDisk: Boolean); override;
|
||||
constructor Create(TheXMLConfig: TXMLConfig);
|
||||
constructor Create(TheXMLConfig: TXMLConfig; const StartPath: string);
|
||||
destructor Destroy; override;
|
||||
procedure Clear; override;
|
||||
property XMLConfig: TXMLConfig read FXMLConfig;
|
||||
property FreeXMLConfig: boolean read FFreeXMLConfig write FFreeXMLConfig;
|
||||
procedure WriteToDisk; override;
|
||||
function GetFilename: string; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{ TXMLOptionsStorage }
|
||||
|
||||
function TXMLOptionsStorage.GetFullPathValue(const APath, ADefault: String): String;
|
||||
begin
|
||||
Result:=XMLConfig.GetValue(APath, ADefault);
|
||||
end;
|
||||
|
||||
function TXMLOptionsStorage.GetFullPathValue(const APath: String;
|
||||
ADefault: Integer): Integer;
|
||||
begin
|
||||
Result:=XMLConfig.GetValue(APath, ADefault);
|
||||
end;
|
||||
|
||||
function TXMLOptionsStorage.GetFullPathValue(const APath: String;
|
||||
ADefault: Boolean): Boolean;
|
||||
begin
|
||||
Result:=XMLConfig.GetValue(APath, ADefault);
|
||||
end;
|
||||
|
||||
procedure TXMLOptionsStorage.SetFullPathValue(const APath, AValue: String);
|
||||
begin
|
||||
XMLConfig.SetValue(APath, AValue);
|
||||
end;
|
||||
|
||||
procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath, AValue,
|
||||
DefValue: String);
|
||||
begin
|
||||
XMLConfig.SetDeleteValue(APath, AValue, DefValue);
|
||||
end;
|
||||
|
||||
procedure TXMLOptionsStorage.SetFullPathValue(const APath: String;
|
||||
AValue: Integer);
|
||||
begin
|
||||
XMLConfig.SetValue(APath, AValue);
|
||||
end;
|
||||
|
||||
procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath: String;
|
||||
AValue, DefValue: Integer);
|
||||
begin
|
||||
XMLConfig.SetDeleteValue(APath, AValue, DefValue);
|
||||
end;
|
||||
|
||||
procedure TXMLOptionsStorage.SetFullPathValue(const APath: String;
|
||||
AValue: Boolean);
|
||||
begin
|
||||
XMLConfig.SetValue(APath, AValue);
|
||||
end;
|
||||
|
||||
procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath: String;
|
||||
AValue, DefValue: Boolean);
|
||||
begin
|
||||
XMLConfig.SetDeleteValue(APath, AValue, DefValue);
|
||||
end;
|
||||
|
||||
procedure TXMLOptionsStorage.DeleteFullPath(const APath: string);
|
||||
begin
|
||||
XMLConfig.DeletePath(APath);
|
||||
end;
|
||||
|
||||
procedure TXMLOptionsStorage.DeleteFullPathValue(const APath: string);
|
||||
begin
|
||||
XMLConfig.DeleteValue(APath);
|
||||
end;
|
||||
|
||||
constructor TXMLOptionsStorage.Create(const Filename: string;
|
||||
LoadFromDisk: Boolean);
|
||||
begin
|
||||
if LoadFromDisk then
|
||||
FXMLConfig:=TXMLConfig.Create(Filename)
|
||||
else
|
||||
FXMLConfig:=TXMLConfig.CreateClean(Filename);
|
||||
FFreeXMLConfig:=true;
|
||||
end;
|
||||
|
||||
constructor TXMLOptionsStorage.Create(TheXMLConfig: TXMLConfig);
|
||||
begin
|
||||
FXMLConfig:=TheXMLConfig;
|
||||
if FXMLConfig=nil then
|
||||
raise Exception.Create('');
|
||||
end;
|
||||
|
||||
constructor TXMLOptionsStorage.Create(TheXMLConfig: TXMLConfig;
|
||||
const StartPath: string);
|
||||
begin
|
||||
Create(TheXMLConfig);
|
||||
AppendBasePath(StartPath);
|
||||
end;
|
||||
|
||||
destructor TXMLOptionsStorage.Destroy;
|
||||
begin
|
||||
if FreeXMLConfig then FreeAndNil(FXMLConfig);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TXMLOptionsStorage.Clear;
|
||||
begin
|
||||
FXMLConfig.Clear;
|
||||
end;
|
||||
|
||||
procedure TXMLOptionsStorage.WriteToDisk;
|
||||
begin
|
||||
FXMLConfig.Flush;
|
||||
end;
|
||||
|
||||
function TXMLOptionsStorage.GetFilename: string;
|
||||
begin
|
||||
Result:=FXMLConfig.Filename;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user