diff --git a/Test/X2UtilsSettingsTest.cfg b/Test/X2UtilsSettingsTest.cfg index d55d496..17482c8 100644 --- a/Test/X2UtilsSettingsTest.cfg +++ b/Test/X2UtilsSettingsTest.cfg @@ -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 diff --git a/Test/X2UtilsSettingsTest.dof b/Test/X2UtilsSettingsTest.dof index 0b28a25..6615fff 100644 --- a/Test/X2UtilsSettingsTest.dof +++ b/Test/X2UtilsSettingsTest.dof @@ -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 diff --git a/Test/X2UtilsSettingsTest.dpr b/Test/X2UtilsSettingsTest.dpr index c8c967e..d52d2de 100644 --- a/Test/X2UtilsSettingsTest.dpr +++ b/Test/X2UtilsSettingsTest.dpr @@ -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 diff --git a/X2UtBinaryTree.pas b/X2UtBinaryTree.pas index 0e6e363..e2c1590 100644 --- a/X2UtBinaryTree.pas +++ b/X2UtBinaryTree.pas @@ -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; diff --git a/X2UtHashes.pas b/X2UtHashes.pas index f9e7efb..4cee768 100644 --- a/X2UtHashes.pas +++ b/X2UtHashes.pas @@ -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; diff --git a/X2UtSettings.pas b/X2UtSettings.pas index 7f6799d..d5304ca 100644 --- a/X2UtSettings.pas +++ b/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. diff --git a/X2UtSettingsINI.pas b/X2UtSettingsINI.pas index 848e8c8..c8e1c40 100644 --- a/X2UtSettingsINI.pas +++ b/X2UtSettingsINI.pas @@ -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; diff --git a/X2UtSettingsRegistry.pas b/X2UtSettingsRegistry.pas index fba420d..3e24562 100644 --- a/X2UtSettingsRegistry.pas +++ b/X2UtSettingsRegistry.pas @@ -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);