Fixed: LookupNode did not return newly created nodes
Fixed: Settings definitions, removed range support
This commit is contained in:
parent
594de2b48a
commit
4d7c80a247
@ -32,5 +32,6 @@
|
||||
-M
|
||||
-$M16384,1048576
|
||||
-K$00400000
|
||||
-LE"c:\delphi6\Projects\Bpl"
|
||||
-LN"c:\delphi6\Projects\Bpl"
|
||||
-LE"c:\program files\borland\delphi6\Projects\Bpl"
|
||||
-LN"c:\program files\borland\delphi6\Projects\Bpl"
|
||||
-DmadExcept
|
||||
|
||||
@ -47,7 +47,7 @@ PackageDLLOutputDir=
|
||||
PackageDCPOutputDir=
|
||||
SearchPath=
|
||||
Packages=vcl;rtl;vclx;indy;madBasic_;madDisAsm_;dsnap;dbrtl;xmlrtl;inet;soaprtl
|
||||
Conditionals=
|
||||
Conditionals=madExcept
|
||||
DebugSourceDirs=
|
||||
UsePackages=0
|
||||
[Parameters]
|
||||
@ -56,17 +56,13 @@ HostApplication=
|
||||
Launcher=
|
||||
UseLauncher=0
|
||||
DebugCWD=
|
||||
[Language]
|
||||
ActiveLang=
|
||||
ProjectLang=
|
||||
RootDir=
|
||||
[Version Info]
|
||||
IncludeVerInfo=0
|
||||
AutoIncBuild=1
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
Release=0
|
||||
Build=2
|
||||
Build=8
|
||||
Debug=0
|
||||
PreRelease=0
|
||||
Special=0
|
||||
@ -77,7 +73,7 @@ CodePage=1252
|
||||
[Version Info Keys]
|
||||
CompanyName=
|
||||
FileDescription=
|
||||
FileVersion=1.0.0.2
|
||||
FileVersion=1.0.0.8
|
||||
InternalName=
|
||||
LegalCopyright=
|
||||
LegalTrademarks=
|
||||
@ -86,6 +82,121 @@ ProductName=
|
||||
ProductVersion=
|
||||
Comments=
|
||||
[Excluded Packages]
|
||||
c:\delphi6\Projects\Bpl\DIPasDocD6.bpl=DiPasDoc - Designtime
|
||||
c:\program files\borland\delphi6\Bin\dclcds60.bpl=Borland Base Cached ClientDataset Component
|
||||
C:\Program Files\Borland\Delphi6\Bin\dclmid60.bpl=Borland MyBase DataAccess Components
|
||||
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\ThemeManager6.bpl=Windows XP Theme Manager
|
||||
H:\Downloads\commentexpert.bpl=Comment Expert v1.0 Alpha
|
||||
c:\program files\borland\delphi6\Projects\Bpl\VirtualTreesD6D.bpl=Virtual Treeview
|
||||
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\JvCoreD6D.bpl=JVCL Core Components
|
||||
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\JvStdCtrlsD6D.bpl=JVCL Standard Controls
|
||||
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tbx_d6.bpl=Toolbar2000 -- TBX Extensions (Alex Denisov)
|
||||
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tb2k_d6.bpl=Toolbar2000 Components (Jordan Russell)
|
||||
c:\program files\borland\delphi6\Projects\Bpl\tbxdsgn_d6.bpl=Toolbar2000 -- TBX Extensions Design Package (Alex Denisov)
|
||||
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tb2kdsgn_d6.bpl=Toolbar2000 Design Package (Jordan Russell)
|
||||
c:\program files\borland\delphi6\Bin\applet60.bpl=Borland Control Panel Applet Package
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvJansD6D.bpl=JVCL Jans Components
|
||||
c:\program files\borland\delphi6\Projects\Bpl\dclIndyCore60.bpl=Indy 10 Core Design Time
|
||||
c:\program files\borland\delphi6\Projects\Bpl\dclIndyProtocols60.bpl=Indy 10 Protocols Design Time
|
||||
c:\program files\borland\delphi6\Projects\Bpl\P164_D60.bpl=TurboPower OfficePartner 1.64 Design-time package - VCL60
|
||||
c:\program files\borland\delphi6\Projects\Bpl\v103_d60.bpl=TurboPower VisualPlanIt 1.03 designtime package - VCL60
|
||||
c:\program files\borland\delphi6\Projects\Bpl\BalloonD6.bpl=Balloon 2.0
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvCustomD6D.bpl=JVCL Custom Controls
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvCtrlsD6D.bpl=JVCL Visual Controls
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvWizardD6D.bpl=JVCL Wizard Design Time Package
|
||||
c:\program files\borland\delphi6\Projects\Bpl\dclIndy60.bpl=Internet Direct (Indy) for D6 Property and Component Editors
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\ThreadNameExpert60.bpl=JCL Thread Name IDE expert for Delphi 6
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvDlgsD6D.bpl=JVCL Dialog Components
|
||||
c:\program files\borland\delphi6\Projects\Bpl\asqlite.bpl=Aducom Software -- SQLite Design Time Components
|
||||
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\aSQLitepkg.bpl=Aducom Software -- SQLite RunTime Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvAppFrmD6D.bpl=JVCL Application and Form Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvBandsD6D.bpl=JVCL Band Objects
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvCmpD6D.bpl=JVCL Non-Visual Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvCryptD6D.bpl=JVCL Encryption and Compression Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvDockingD6D.bpl=JVCL Docking Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvDotNetCtrlsD6D.bpl=JVCL DotNet Controls
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvGlobusD6D.bpl=JVCL Globus Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvHMID6D.bpl=JVCL HMI Controls design time unit
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvInterpreterD6D.bpl=JVCL Interpreter Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvManagedThreadsD6D.bpl=JVCL Managed Threads
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvMMD6D.bpl=JVCL Multimedia and Image Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvNetD6D.bpl=JVCL Network Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvPageCompsD6D.bpl=JVCL Page Style Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvPluginD6D.bpl=JVCL Plugin Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvPrintPreviewD6D.bpl=JVCL Print Preview Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvSystemD6D.bpl=JVCL System Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvTimeFrameworkD6D.bpl=JVCL Time Framework
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvValidatorsD6D.bpl=JVCL Validators and Error Provider Components
|
||||
C:\Program Files\Borland\Delphi6\Projects\Bpl\JvXPCtrlsD6D.bpl=JVCL XP Controls
|
||||
c:\program files\borland\delphi6\Projects\Bpl\GJLSoftwareD5.bpl=GJL Software ExDBGrid Components
|
||||
c:\program files\borland\delphi6\Projects\Bpl\FREEREP6.bpl=FreeReport 2.32 Components
|
||||
c:\program files\borland\delphi6\Projects\Bpl\PageControlExD6.bpl=PageControlEx
|
||||
c:\program files\borland\delphi6\Projects\Bpl\ZCore.bpl=Zeos Core Classes and Intefaces
|
||||
c:\program files\borland\delphi6\Projects\Bpl\ZParse.bpl=Zeos Parsing Classes and Intefaces
|
||||
c:\program files\borland\delphi6\Projects\Bpl\ZParseSql.bpl=Zeos SQL Parsing Classes and Intefaces
|
||||
c:\program files\borland\delphi6\Projects\Bpl\ZPlain.bpl=Zeos Plain Database API
|
||||
c:\program files\borland\delphi6\Projects\Bpl\ZDbc.bpl=Zeos Low Level Database API
|
||||
c:\program files\borland\delphi6\Projects\Bpl\ZComponent.bpl=Zeos Database Components
|
||||
c:\program files\borland\delphi6\Projects\Bpl\IconXPD6.bpl=IconXP
|
||||
c:\program files\borland\delphi6\Projects\Bpl\NLDVDBT_D6D.bpl=NLDVirtualDBTree
|
||||
c:\program files\borland\delphi6\Projects\Bpl\ff2_d60.bpl=TurboPower FlashFiler Designtime Package - VCL60
|
||||
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\GR32_D6.bpl=Graphics32
|
||||
c:\program files\borland\delphi6\Projects\Bpl\GR32_DSGN_D6.bpl=Graphics32 Design Time Package
|
||||
c:\program files\borland\delphi6\Projects\Bpl\PNGImage_D6.bpl=PNGImage
|
||||
c:\program files\borland\delphi6\Projects\Bpl\SynEdit_D6.bpl=SynEdit component suite
|
||||
c:\program files\borland\delphi6\Projects\Bpl\DelphiX_for5.bpl=DelphiX - DirectX components for Delphi
|
||||
c:\program files\borland\delphi6\Projects\Bpl\NLDMBD6D.bpl=NLDMessageBox
|
||||
c:\program files\borland\delphi6\Bin\dcl31w60.bpl=Delphi 1.0 Compatibility Components
|
||||
c:\program files\borland\delphi6\Projects\Bpl\NLDTrayIconD6.bpl=NLDTrayIcon donated by SVG_1986
|
||||
c:\program files\borland\delphi6\Projects\Bpl\ServerListD6D.bpl=SOF2Manager - Server List Designtime
|
||||
C:\WINDOWS\System32\ibevnt60.bpl=Borland Interbase Event Alerter Component
|
||||
c:\delphi6\Projects\Bpl\PsychoTidyD6.bpl=PsychoTidy IDE Expert
|
||||
F:\Delphi\Components\madCollection\madBasic\Delphi 6\madHelp_.bpl=madHelp 1.1 · www.madshi.net
|
||||
F:\Delphi\Components\madCollection\madRemote\Delphi 6\madRemote_.bpl=madRemote 1.1a · www.madshi.net
|
||||
F:\Delphi\Components\madCollection\madKernel\Delphi 6\madKernel_.bpl=madKernel 1.2z · www.madshi.net
|
||||
F:\Delphi\Components\madCollection\madCodeHook\Delphi 6\madCodeHook_.bpl=madCodeHook 2.0a · www.madshi.net
|
||||
F:\Delphi\Components\madCollection\madSecurity\Delphi 6\madSecurity_.bpl=madSecurity 1.1n · www.madshi.net
|
||||
F:\Delphi\Components\madCollection\madShell\Delphi 6\madShell_.bpl=madShell 1.3i · www.madshi.net
|
||||
c:\program files\borland\delphi6\Projects\Bpl\BMSpinEditD6.bpl=BMSpinEdit
|
||||
c:\program files\borland\delphi6\Projects\Bpl\GLScene6.bpl=GLScene - OpenGL 3D library
|
||||
c:\program files\borland\delphi6\Projects\Bpl\TntUnicodeVcl_D60.bpl=Tnt Unicode Controls
|
||||
c:\program files\borland\delphi6\Bin\dclsmp60.bpl=Borland Sample Components
|
||||
c:\program files\borland\delphi6\Projects\Bpl\X2MultiMon_D6D.bpl=X2MultiMon Designtime Package
|
||||
F:\Delphi\Components\ZipForge\Lib\Delphi 6\dclZipForged6.bpl=ZipForge Package
|
||||
c:\program files\borland\delphi6\Bin\dclado60.bpl=Borland ADO DB Components
|
||||
c:\program files\borland\delphi6\Bin\dclbde60.bpl=Borland BDE DB Components
|
||||
C:\Program Files\Borland\Delphi6\Bin\dbx60.bpl=Borland SQL Explorer UI Package
|
||||
c:\program files\borland\delphi6\Bin\DCLIB60.bpl=InterBase Data Access Components
|
||||
c:\program files\borland\delphi6\Bin\dclbdecds60.bpl=Borland Local BDE ClientDataset Components
|
||||
c:\program files\borland\delphi6\Bin\dclqrt60.bpl=QuickReport Components
|
||||
c:\program files\borland\delphi6\Bin\dcltee60.bpl=TeeChart Components
|
||||
c:\program files\borland\delphi6\Bin\dcldss60.bpl=Borland Decision Cube Components
|
||||
c:\program files\borland\delphi6\Bin\dcltqr60.bpl=TeeChart for QuickReport Components
|
||||
c:\program files\borland\delphi6\Bin\dclclxdb60.bpl=Borland CLX Database Components
|
||||
C:\Program Files\Borland\Delphi6\Bin\dclclxstd60.bpl=Borland CLX Standard Components
|
||||
c:\program files\borland\delphi6\Bin\dclmcn60.bpl=Borland DataSnap Connection Components
|
||||
c:\program files\borland\delphi6\Bin\dclemacsedit60.bpl=Borland Editor Emacs Enhancements
|
||||
c:\program files\borland\delphi6\Bin\dclshlctrls60.bpl=Shell Control Property and Component Editors
|
||||
c:\program files\borland\delphi6\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package
|
||||
c:\program files\borland\delphi6\Bin\dclwbm60.bpl=Borland InternetExpress Components
|
||||
c:\program files\borland\delphi6\Bin\dclie60.bpl=Internet Explorer Components
|
||||
c:\program files\borland\delphi6\Bin\dclwebsnap60.bpl=Borland WebSnap Components
|
||||
c:\program files\borland\delphi6\Bin\dclite60.bpl=Borland Integrated Translation Environment
|
||||
c:\program files\borland\delphi6\Bin\dcldbx60.bpl=Borland dbExpress Components
|
||||
c:\program files\borland\delphi6\Bin\dcldbxcds60.bpl=Borland Local DBX ClientDataset Components
|
||||
F:\Delphi\Components\DevExpress\OrgChart Suite\Lib\dcldxOrgCD6.bpl=ExpressOrgChart by Developer Express Inc.
|
||||
F:\Delphi\Components\DevExpress\OrgChart Suite\Lib\dcldxDBOrD6.bpl=ExpressDBOrgChart by Developer Express Inc.
|
||||
[Included Packages]
|
||||
C:\Program Files\Borland\Delphi6\Bin\dclstd60.bpl=Borland Standard Components
|
||||
c:\program files\borland\delphi6\Bin\dclsmpedit60.bpl=Borland Editor Script Enhancements
|
||||
C:\Program Files\Borland\Delphi6\Bin\dcldb60.bpl=Borland Database Components
|
||||
C:\Program Files\Borland\Delphi6\Bin\dclact60.bpl=Borland ActionBar Components
|
||||
F:\Delphi\Components\madCollection\madBasic\Delphi 6\madBasic_.bpl=madBasic 1.1f · www.madshi.net
|
||||
F:\Delphi\Components\madCollection\madDisAsm\Delphi 6\madDisAsm_.bpl=madDisAsm 2.0a · www.madshi.net
|
||||
F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExcept_.bpl=madExcept 2.6a · www.madshi.net
|
||||
F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptWizard_.bpl=madExceptWizard 2.6 · www.madshi.net
|
||||
C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\ThemeManager6.bpl=Windows XP Theme Manager
|
||||
c:\program files\borland\delphi6\Projects\Bpl\SysILS.bpl=(untitled)
|
||||
c:\program files\borland\delphi6\Projects\Bpl\DragDropD6.bpl=Drag and Drop Component Suite
|
||||
c:\program files\borland\delphi6\Bin\dclnet60.bpl=Borland Internet Components
|
||||
c:\program files\borland\delphi6\Bin\dclsoap60.bpl=Borland SOAP Components
|
||||
c:\program files\borland\delphi6\Projects\Bpl\ColorPickerButtonD6.bpl=ColorPickerButton
|
||||
F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptIde_.bpl=madExceptIde 1.0b · www.madshi.net
|
||||
|
||||
@ -3,6 +3,8 @@ program X2UtilsSettingsTest;
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
madExcept,
|
||||
madLinkDisAsm,
|
||||
Classes,
|
||||
SysUtils,
|
||||
Variants,
|
||||
@ -12,6 +14,14 @@ uses
|
||||
X2UtSettingsINI in '..\X2UtSettingsINI.pas',
|
||||
X2UtSettingsRegistry in '..\X2UtSettingsRegistry.pas';
|
||||
|
||||
type
|
||||
TCheck = class(TObject)
|
||||
public
|
||||
class procedure CheckValue(const AAction: TX2SettingsAction;
|
||||
const ASection, AName: String;
|
||||
var AValue: Variant);
|
||||
end;
|
||||
|
||||
procedure TraverseSection(const ASettings: TX2SettingsFactory;
|
||||
const ASection: String = '';
|
||||
const AIndent: Integer = 0);
|
||||
@ -65,6 +75,21 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TCheck }
|
||||
class procedure TCheck.CheckValue;
|
||||
begin
|
||||
if AAction = saWrite then
|
||||
begin
|
||||
if AValue < 0 then
|
||||
AValue := 0
|
||||
else if AValue > 15 then
|
||||
AValue := 15
|
||||
else
|
||||
if (AValue > 5) and (AValue < 10) then
|
||||
AValue := 5;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
Settings: TX2SettingsFactory;
|
||||
@ -98,7 +123,7 @@ begin
|
||||
}
|
||||
|
||||
// Test for the definitions
|
||||
Settings.Define('Test', 'Value', 5, [0, 5, 10, 15]);
|
||||
Settings.Define('Test', 'Value', 5, TCheck.CheckValue);
|
||||
|
||||
with Settings['Test'] do
|
||||
try
|
||||
|
||||
@ -566,6 +566,7 @@ begin
|
||||
if Assigned(pBalance) then
|
||||
BalanceInsert(pBalance^);
|
||||
|
||||
Result := pCurrent^;
|
||||
break;
|
||||
end else
|
||||
break;
|
||||
@ -1107,7 +1108,8 @@ var
|
||||
pNode: PX2BTreeNode;
|
||||
|
||||
begin
|
||||
pNode := LookupNode(Index);
|
||||
Result := '';
|
||||
pNode := LookupNode(Index);
|
||||
if Assigned(pNode) then
|
||||
Result := PString(GetNodeData(pNode))^;
|
||||
end;
|
||||
|
||||
@ -484,7 +484,8 @@ var
|
||||
|
||||
begin
|
||||
Assert(Length(Key) > 0, RSEmptyKey);
|
||||
pItem := LookupItem(Key, pNode);
|
||||
Result := nil;
|
||||
pItem := LookupItem(Key, pNode);
|
||||
if Assigned(pItem) then
|
||||
Result := PPointer(GetItemData(pItem))^;
|
||||
end;
|
||||
@ -545,7 +546,8 @@ var
|
||||
|
||||
begin
|
||||
Assert(Length(Key) > 0, RSEmptyKey);
|
||||
pItem := LookupItem(Key, pNode);
|
||||
Result := '';
|
||||
pItem := LookupItem(Key, pNode);
|
||||
if Assigned(pItem) then
|
||||
Result := PString(GetItemData(pItem))^;
|
||||
end;
|
||||
|
||||
313
X2UtSettings.pas
313
X2UtSettings.pas
@ -32,26 +32,27 @@ type
|
||||
EX2SettingsExists = class(Exception);
|
||||
|
||||
//:$ Callback method for defines
|
||||
TX2SettingsCallback = procedure(const ASection, AName: String;
|
||||
TX2SettingsAction = (saRead, saWrite);
|
||||
TX2SettingsCallback = procedure(const AAction: TX2SettingsAction;
|
||||
const ASection, AName: String;
|
||||
var AValue: Variant) of object;
|
||||
|
||||
{
|
||||
:$ Internal representation of a persistent setting
|
||||
}
|
||||
TX2SettingsRanges = array of array[0..1] of Variant;
|
||||
|
||||
TX2SettingsDefine = class(TObject)
|
||||
private
|
||||
FCallback: TX2SettingsCallback;
|
||||
FRanges: TX2SettingsRanges;
|
||||
FValue: Variant;
|
||||
public
|
||||
constructor Create(const AValue: Variant;
|
||||
const ARanges: array of const;
|
||||
const ACallback: TX2SettingsCallback);
|
||||
|
||||
procedure Action(const AAction: TX2SettingsAction;
|
||||
const ASection, AName: String;
|
||||
var AValue: Variant);
|
||||
|
||||
property Callback: TX2SettingsCallback read FCallback;
|
||||
property Ranges: TX2SettingsRanges read FRanges;
|
||||
property Value: Variant read FValue;
|
||||
end;
|
||||
|
||||
@ -74,6 +75,11 @@ type
|
||||
function InternalReadInteger(const AName: String; out AValue: Integer): Boolean; virtual; abstract;
|
||||
function InternalReadString(const AName: String; out AValue: String): Boolean; virtual; abstract;
|
||||
|
||||
procedure InternalWriteBool(const AName: String; AValue: Boolean); virtual; abstract;
|
||||
procedure InternalWriteFloat(const AName: String; AValue: Double); virtual; abstract;
|
||||
procedure InternalWriteInteger(const AName: String; AValue: Integer); virtual; abstract;
|
||||
procedure InternalWriteString(const AName, AValue: String); virtual; abstract;
|
||||
|
||||
property Factory: TX2SettingsFactory read FFactory;
|
||||
property Section: String read FSection;
|
||||
public
|
||||
@ -109,16 +115,16 @@ type
|
||||
function ReadString(const AName, ADefault: String): String; overload; virtual;
|
||||
|
||||
//:$ Writes a boolean value to the settings.
|
||||
procedure WriteBool(const AName: String; AValue: Boolean); virtual; abstract;
|
||||
procedure WriteBool(const AName: String; AValue: Boolean); virtual;
|
||||
|
||||
//:$ Writes a floating point value to the settings.
|
||||
procedure WriteFloat(const AName: String; AValue: Double); virtual; abstract;
|
||||
procedure WriteFloat(const AName: String; AValue: Double); virtual;
|
||||
|
||||
//:$ Writes an integer value to the settings.
|
||||
procedure WriteInteger(const AName: String; AValue: Integer); virtual; abstract;
|
||||
procedure WriteInteger(const AName: String; AValue: Integer); virtual;
|
||||
|
||||
//:$ Writes a string value to the settings.
|
||||
procedure WriteString(const AName, AValue: String); virtual; abstract;
|
||||
procedure WriteString(const AName, AValue: String); virtual;
|
||||
|
||||
//:$ Checks if the specified setting exists.
|
||||
function ValueExists(const AName: String): Boolean; virtual; abstract;
|
||||
@ -147,6 +153,7 @@ type
|
||||
FDefines: TX2ObjectHash;
|
||||
protected
|
||||
function GetSection(const ASection: String): TX2Settings; virtual; abstract;
|
||||
function GetDefine(const ASection, AName: String): TX2SettingsDefine; virtual;
|
||||
public
|
||||
constructor Create();
|
||||
destructor Destroy(); override;
|
||||
@ -160,21 +167,9 @@ type
|
||||
|
||||
//:$ Defines a persistent setting
|
||||
//:: Persistent settings are a way for the application to register it's
|
||||
//:: configuration settings on startup with a default value and a range.
|
||||
//:: When reading a setting it will be checked against the specified range
|
||||
//:: (if supplied), or if not found, the registered default value will be
|
||||
//:: returned. This allows the setting to be read in many places without
|
||||
//:: having to do all the checks every time. In addition you may provide
|
||||
//:: a callback method to handle more advanced checks.
|
||||
//:: /n/n
|
||||
//:: Ranges must be specified as an array where each pair of values
|
||||
//:: specifies the minimum and maximum value of that range. The type
|
||||
//:: of the values in the ranges must be the same as the type of the
|
||||
//:: value, and is used later on for type checking. The only exception
|
||||
//:: to this rule is that you are allowed to specify integer ranges for
|
||||
//:: a floating value.
|
||||
//:: configuration settings on startup with a default value and a possible
|
||||
//:: callback method to perform centralized checks.
|
||||
procedure Define(const ASection, AName: String; const AValue: Variant;
|
||||
const ARanges: array of const;
|
||||
const ACallback: TX2SettingsCallback = nil);
|
||||
end;
|
||||
|
||||
@ -200,57 +195,237 @@ end;
|
||||
|
||||
|
||||
{============================ TX2Settings
|
||||
Read
|
||||
Reading
|
||||
========================================}
|
||||
function TX2Settings.ReadBool(const AName: String): Boolean;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
|
||||
if not InternalReadBool(AName, Result) then
|
||||
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
||||
if Assigned(pDefine) then
|
||||
Result := pDefine.Value
|
||||
else
|
||||
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
||||
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := Result;
|
||||
pDefine.Action(saRead, FSection, AName, vValue);
|
||||
Result := vValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2Settings.ReadBool(const AName: String;
|
||||
const ADefault: Boolean): Boolean;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
if not InternalReadBool(AName, Result) then
|
||||
Result := ADefault;
|
||||
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := Result;
|
||||
pDefine.Action(saRead, FSection, AName, vValue);
|
||||
Result := vValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2Settings.ReadFloat(const AName: String): Double;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
|
||||
if not InternalReadFloat(AName, Result) then
|
||||
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
||||
if Assigned(pDefine) then
|
||||
Result := pDefine.Value
|
||||
else
|
||||
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
||||
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := Result;
|
||||
pDefine.Action(saRead, FSection, AName, vValue);
|
||||
Result := vValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2Settings.ReadFloat(const AName: String;
|
||||
const ADefault: Double): Double;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
if not InternalReadFloat(AName, Result) then
|
||||
Result := ADefault;
|
||||
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := Result;
|
||||
pDefine.Action(saRead, FSection, AName, vValue);
|
||||
Result := vValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2Settings.ReadInteger(const AName: String): Integer;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
|
||||
if not InternalReadInteger(AName, Result) then
|
||||
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
||||
if Assigned(pDefine) then
|
||||
Result := pDefine.Value
|
||||
else
|
||||
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
||||
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := Result;
|
||||
pDefine.Action(saRead, FSection, AName, vValue);
|
||||
Result := vValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2Settings.ReadInteger(const AName: String;
|
||||
const ADefault: Integer): Integer;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
if not InternalReadInteger(AName, Result) then
|
||||
Result := ADefault;
|
||||
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := Result;
|
||||
pDefine.Action(saRead, FSection, AName, vValue);
|
||||
Result := vValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2Settings.ReadString(const AName: String): String;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
|
||||
if not InternalReadString(AName, Result) then
|
||||
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
||||
if Assigned(pDefine) then
|
||||
Result := pDefine.Value
|
||||
else
|
||||
raise EX2SettingsUndefined.CreateFmt(RSUndefined, [AName]);
|
||||
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := Result;
|
||||
pDefine.Action(saRead, FSection, AName, vValue);
|
||||
Result := vValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TX2Settings.ReadString(const AName, ADefault: String): String;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
if not InternalReadString(AName, Result) then
|
||||
Result := ADefault;
|
||||
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := Result;
|
||||
pDefine.Action(saRead, FSection, AName, vValue);
|
||||
Result := vValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{============================ TX2Settings
|
||||
Writing
|
||||
========================================}
|
||||
procedure TX2Settings.WriteBool;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := AValue;
|
||||
pDefine.Action(saWrite, FSection, AName, vValue);
|
||||
end;
|
||||
|
||||
InternalWriteBool(AName, vValue);
|
||||
end;
|
||||
|
||||
procedure TX2Settings.WriteFloat;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := AValue;
|
||||
pDefine.Action(saWrite, FSection, AName, vValue);
|
||||
end;
|
||||
|
||||
InternalWriteFloat(AName, vValue);
|
||||
end;
|
||||
|
||||
procedure TX2Settings.WriteInteger;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := AValue;
|
||||
pDefine.Action(saWrite, FSection, AName, vValue);
|
||||
end;
|
||||
|
||||
InternalWriteInteger(AName, vValue);
|
||||
end;
|
||||
|
||||
procedure TX2Settings.WriteString;
|
||||
var
|
||||
pDefine: TX2SettingsDefine;
|
||||
vValue: Variant;
|
||||
|
||||
begin
|
||||
pDefine := FFactory.GetDefine(FSection, AName);
|
||||
if Assigned(pDefine) then
|
||||
begin
|
||||
vValue := AValue;
|
||||
pDefine.Action(saWrite, FSection, AName, vValue);
|
||||
end;
|
||||
|
||||
InternalWriteInteger(AName, vValue);
|
||||
end;
|
||||
|
||||
|
||||
@ -276,7 +451,7 @@ procedure TX2SettingsFactory.Define;
|
||||
function CheckVarType(const AValue: Variant): TVarType;
|
||||
begin
|
||||
case VarType(AValue) of
|
||||
varBoolean: break;
|
||||
varBoolean: Result := varBoolean;
|
||||
varByte,
|
||||
varSmallint,
|
||||
varInteger,
|
||||
@ -294,7 +469,6 @@ procedure TX2SettingsFactory.Define;
|
||||
end;
|
||||
|
||||
var
|
||||
iIndex: Integer;
|
||||
sHash: String;
|
||||
vtValue: TVarType;
|
||||
|
||||
@ -305,38 +479,14 @@ begin
|
||||
|
||||
// Validate type
|
||||
vtValue := CheckVarType(AValue);
|
||||
|
||||
// Validate ranges
|
||||
if High(ARanges) mod 2 <> 0 then
|
||||
raise EX2SettingsRange.Create(RSInvalidRange);
|
||||
|
||||
for iIndex := 0 to High(ARanges) do
|
||||
case ARanges[iIndex].VType of
|
||||
vtBoolean:
|
||||
if vtValue <> varBoolean then
|
||||
raise EX2SettingsType.Create(RSInvalidType);
|
||||
vtInteger:
|
||||
if not (vtValue in [varInteger, varDouble]) then
|
||||
raise EX2SettingsType.Create(RSInvalidType);
|
||||
vtExtended:
|
||||
if vtValue <> varDouble then
|
||||
raise EX2SettingsType.Create(RSInvalidType);
|
||||
vtString,
|
||||
vtPChar,
|
||||
vtChar,
|
||||
vtWideChar,
|
||||
vtPWideChar,
|
||||
vtWideString,
|
||||
vtAnsiString:
|
||||
if vtValue <> varString then
|
||||
raise EX2SettingsType.Create(RSInvalidType);
|
||||
vtVariant:
|
||||
if vtValue <> CheckVarType(ARanges[iIndex].VVariant^) then
|
||||
raise EX2SettingsType.Create(RSInvalidType);
|
||||
end;
|
||||
|
||||
FDefines[sHash] := TX2SettingsDefine.Create(VarAsType(AValue, vtValue),
|
||||
ARanges, ACallback);
|
||||
ACallback);
|
||||
end;
|
||||
|
||||
|
||||
function TX2SettingsFactory.GetDefine;
|
||||
begin
|
||||
Result := TX2SettingsDefine(FDefines[ASection + #0 + AName]);
|
||||
end;
|
||||
|
||||
|
||||
@ -344,44 +494,15 @@ end;
|
||||
Initialization
|
||||
========================================}
|
||||
constructor TX2SettingsDefine.Create;
|
||||
function VarRecToVariant(const AVarRec: TVarRec): Variant;
|
||||
begin
|
||||
case AVarRec.VType of
|
||||
vtBoolean: Result := AVarRec.VBoolean;
|
||||
vtInteger: Result := AVarRec.VInteger;
|
||||
vtExtended: Result := VarAsType(AVarRec.VExtended^, varDouble);
|
||||
vtString: Result := AVarRec.VString^;
|
||||
vtPChar: Result := String(AVarRec.VPChar);
|
||||
vtPWideChar: Result := String(AVarRec.VPWideChar^);
|
||||
vtWideChar: Result := String(AVarRec.VWideChar);
|
||||
vtWideString: Result := String(AVarRec.VWideString^);
|
||||
vtAnsiString: Result := String(AVarRec.VAnsiString^);
|
||||
vtVariant: Result := AVarRec.VVariant^;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
iCount: Integer;
|
||||
iIndex: Integer;
|
||||
iRange: Integer;
|
||||
|
||||
begin
|
||||
FValue := AValue;
|
||||
FCallback := ACallback;
|
||||
end;
|
||||
|
||||
// Copy ranges
|
||||
iCount := (High(ARanges) + 1) div 2;
|
||||
iIndex := 0;
|
||||
|
||||
SetLength(FRanges, iCount);
|
||||
|
||||
for iRange := 0 to iCount - 1 do
|
||||
begin
|
||||
FRanges[iRange][0] := VarRecToVariant(ARanges[iIndex]);
|
||||
FRanges[iRange][1] := VarRecToVariant(ARanges[iIndex + 1]);
|
||||
|
||||
Inc(iIndex, 2);
|
||||
end;
|
||||
procedure TX2SettingsDefine.Action;
|
||||
begin
|
||||
if Assigned(FCallback) then
|
||||
FCallback(AAction, ASection, AName, AValue);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -29,12 +29,12 @@ type
|
||||
function InternalReadFloat(const AName: String; out AValue: Double): Boolean; override;
|
||||
function InternalReadInteger(const AName: String; out AValue: Integer): Boolean; override;
|
||||
function InternalReadString(const AName: String; out AValue: String): Boolean; override;
|
||||
public
|
||||
procedure WriteBool(const AName: String; AValue: Boolean); override;
|
||||
procedure WriteFloat(const AName: String; AValue: Double); override;
|
||||
procedure WriteInteger(const AName: String; AValue: Integer); override;
|
||||
procedure WriteString(const AName, AValue: String); override;
|
||||
|
||||
procedure InternalWriteBool(const AName: String; AValue: Boolean); override;
|
||||
procedure InternalWriteFloat(const AName: String; AValue: Double); override;
|
||||
procedure InternalWriteInteger(const AName: String; AValue: Integer); override;
|
||||
procedure InternalWriteString(const AName, AValue: String); override;
|
||||
public
|
||||
function ValueExists(const AName: String): Boolean; override;
|
||||
|
||||
procedure GetSectionNames(const ADest: TStrings); override;
|
||||
@ -135,22 +135,22 @@ end;
|
||||
{========================= TX2INISettings
|
||||
Write
|
||||
========================================}
|
||||
procedure TX2INISettings.WriteBool;
|
||||
procedure TX2INISettings.InternalWriteBool;
|
||||
begin
|
||||
FData.WriteBool(FSection, AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2INISettings.WriteFloat;
|
||||
procedure TX2INISettings.InternalWriteFloat;
|
||||
begin
|
||||
FData.WriteFloat(FSection, AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2INISettings.WriteInteger;
|
||||
procedure TX2INISettings.InternalWriteInteger;
|
||||
begin
|
||||
FData.WriteInteger(FSection, AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2INISettings.WriteString;
|
||||
procedure TX2INISettings.InternalWriteString;
|
||||
begin
|
||||
FData.WriteString(FSection, AName, AValue);
|
||||
end;
|
||||
|
||||
@ -38,12 +38,12 @@ type
|
||||
function InternalReadFloat(const AName: String; out AValue: Double): Boolean; override;
|
||||
function InternalReadInteger(const AName: String; out AValue: Integer): Boolean; override;
|
||||
function InternalReadString(const AName: String; out AValue: String): Boolean; override;
|
||||
public
|
||||
procedure WriteBool(const AName: String; AValue: Boolean); override;
|
||||
procedure WriteFloat(const AName: String; AValue: Double); override;
|
||||
procedure WriteInteger(const AName: String; AValue: Integer); override;
|
||||
procedure WriteString(const AName, AValue: String); override;
|
||||
|
||||
procedure InternalWriteBool(const AName: String; AValue: Boolean); override;
|
||||
procedure InternalWriteFloat(const AName: String; AValue: Double); override;
|
||||
procedure InternalWriteInteger(const AName: String; AValue: Integer); override;
|
||||
procedure InternalWriteString(const AName, AValue: String); override;
|
||||
public
|
||||
function ValueExists(const AName: String): Boolean; override;
|
||||
|
||||
procedure GetSectionNames(const ADest: TStrings); override;
|
||||
@ -197,25 +197,25 @@ end;
|
||||
{==================== TX2RegistrySettings
|
||||
Write
|
||||
========================================}
|
||||
procedure TX2RegistrySettings.WriteBool;
|
||||
procedure TX2RegistrySettings.InternalWriteBool;
|
||||
begin
|
||||
if OpenWrite() then
|
||||
FData.WriteBool(AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2RegistrySettings.WriteFloat;
|
||||
procedure TX2RegistrySettings.InternalWriteFloat;
|
||||
begin
|
||||
if OpenWrite() then
|
||||
FData.WriteFloat(AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2RegistrySettings.WriteInteger;
|
||||
procedure TX2RegistrySettings.InternalWriteInteger;
|
||||
begin
|
||||
if OpenWrite() then
|
||||
FData.WriteInteger(AName, AValue);
|
||||
end;
|
||||
|
||||
procedure TX2RegistrySettings.WriteString;
|
||||
procedure TX2RegistrySettings.InternalWriteString;
|
||||
begin
|
||||
if OpenWrite() then
|
||||
FData.WriteString(AName, AValue);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user