new module - class for store config values in memory
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1663 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
parent
3be59f2c78
commit
2fd42a1d1c
432
components/rx/rxconfigvalues.pas
Normal file
432
components/rx/rxconfigvalues.pas
Normal file
@ -0,0 +1,432 @@
|
||||
{ rxConfigValues unit
|
||||
|
||||
Copyright (C) 2005-2010 Lagunov Aleksey alexs@hotbox.ru
|
||||
original conception from rx library for Delphi (c)
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU Library General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version with the following modification:
|
||||
|
||||
As a special exception, the copyright holders of this library give you
|
||||
permission to link this library with independent modules to produce an
|
||||
executable, regardless of the license terms of these independent modules,and
|
||||
to copy and distribute the resulting executable under terms of your choice,
|
||||
provided that you also meet, for each linked independent module, the terms
|
||||
and conditions of the license of that module. An independent module is a
|
||||
module which is not derived from or based on this library. If you modify
|
||||
this library, you may extend this exception to your version of the library,
|
||||
but you are not obligated to do so. If you do not wish to do so, delete this
|
||||
exception statement from your version.
|
||||
|
||||
This program 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 Library General Public License
|
||||
for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public License
|
||||
along with this library; if not, write to the Free Software Foundation,
|
||||
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
}
|
||||
|
||||
unit rxConfigValues;
|
||||
|
||||
{$I rx.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
const
|
||||
cvtInteger = 1; // целое
|
||||
cvtString = 2; // строка
|
||||
cvtBoolean = 3; // логическая
|
||||
cvtDateTime = 4; // дата
|
||||
cvtFloat = 5; // вещественное
|
||||
|
||||
type
|
||||
|
||||
{ TConfigValue }
|
||||
|
||||
TConfigValue = class
|
||||
private
|
||||
FModified:boolean;
|
||||
FName: string;
|
||||
FDataType:byte;
|
||||
FValue:Variant;
|
||||
function GetAsBoolean: boolean;
|
||||
function GetAsDateTime: TDateTime;
|
||||
function GetAsFloat: Double;
|
||||
function GetAsInteger: integer;
|
||||
function GetAsString: string;
|
||||
procedure SetAsBoolean(const AValue: boolean);
|
||||
procedure SetAsDateTime(const AValue: TDateTime);
|
||||
procedure SetAsFloat(const AValue: Double);
|
||||
procedure SetAsInteger(const AValue: integer);
|
||||
procedure SetAsString(const AValue: string);
|
||||
function GetValue: string;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
property Name:string read FName;
|
||||
property AsString:string read GetAsString write SetAsString;
|
||||
property AsInteger:integer read GetAsInteger write SetAsInteger;
|
||||
property AsFloat:Double read GetAsFloat write SetAsFloat;
|
||||
property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
|
||||
property AsDateTime:TDateTime read GetAsDateTime write SetAsDateTime;
|
||||
property Modified:boolean read FModified;
|
||||
property DataType:byte read FDataType;
|
||||
property Value:string read GetValue;
|
||||
end;
|
||||
|
||||
{ TConfigValues }
|
||||
|
||||
TConfigValues = class
|
||||
private
|
||||
FItems:TList;
|
||||
function CreateValue(AName:string; AType:byte):TConfigValue;
|
||||
function GetCount: integer;
|
||||
function GetItem(Index:Integer): TConfigValue;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure BeginUpdate;
|
||||
procedure EndUpdate;
|
||||
procedure Clear;
|
||||
function ParamByName(AName:string):TConfigValue;
|
||||
function ByNameAsInteger(AName:string; DefValue:integer):integer;
|
||||
function ByNameAsString(AName:string; DefValue:string):string;
|
||||
function ByNameAsFloat(AName:string; DefValue:Double):Double;
|
||||
function ByNameAsBoolean(AName:string; DefValue:Boolean):Boolean;
|
||||
function ByNameAsDateTime(AName:string; DefValue:TDateTime):TDateTime;
|
||||
procedure SetByNameAsInteger(AName:string; AValue:integer);
|
||||
procedure SetByNameAsString(AName:string; AValue:string);
|
||||
procedure SetByNameAsFloat(AName:string; ADefValue:Double);
|
||||
procedure SetByNameAsBoolean(AName:string; ADefValue:Boolean);
|
||||
procedure SetByNameAsDateTime(AName:string; ADefValue:TDateTime);
|
||||
public
|
||||
property Items[Index:Integer]:TConfigValue read GetItem;default;
|
||||
property Count:integer read GetCount;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TConfigValues }
|
||||
|
||||
function TConfigValues.CreateValue(AName: string; AType: byte): TConfigValue;
|
||||
begin
|
||||
Result:=TConfigValue.Create;
|
||||
Result.FDataType:=AType;
|
||||
Result.FName:=AName;
|
||||
FItems.Add(Result);
|
||||
end;
|
||||
|
||||
function TConfigValues.GetCount: integer;
|
||||
begin
|
||||
Result:=FItems.Count;
|
||||
end;
|
||||
|
||||
function TConfigValues.GetItem(Index:Integer): TConfigValue;
|
||||
begin
|
||||
Result:=TConfigValue(FItems[Index]);
|
||||
end;
|
||||
|
||||
constructor TConfigValues.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FItems:=TList.Create;
|
||||
end;
|
||||
|
||||
destructor TConfigValues.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
FreeAndNil(FItems);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TConfigValues.BeginUpdate;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TConfigValues.EndUpdate;
|
||||
var
|
||||
i:integer;
|
||||
begin
|
||||
for i:=0 to FItems.Count - 1 do
|
||||
TConfigValue(FItems[i]).FModified:=false;
|
||||
end;
|
||||
|
||||
procedure TConfigValues.Clear;
|
||||
var
|
||||
i:integer;
|
||||
begin
|
||||
for i:=0 to FItems.Count - 1 do
|
||||
TConfigValue(FItems[i]).Free;
|
||||
FItems.Clear;
|
||||
end;
|
||||
|
||||
function TConfigValues.ParamByName(AName: string): TConfigValue;
|
||||
var
|
||||
i:integer;
|
||||
begin
|
||||
AName:=AnsiUpperCase(AName);
|
||||
Result:=nil;
|
||||
for i:=0 to FItems.Count - 1 do
|
||||
begin
|
||||
if AnsiUpperCase(TConfigValue(FItems[i]).FName) = AName then
|
||||
begin
|
||||
Result:=TConfigValue(FItems[i]);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TConfigValues.ByNameAsInteger(AName: string; DefValue: integer
|
||||
): integer;
|
||||
var
|
||||
P:TConfigValue;
|
||||
begin
|
||||
P:=ParamByName(AName);
|
||||
if Assigned(P) then
|
||||
Result:=P.AsInteger
|
||||
else
|
||||
Result:=DefValue;
|
||||
end;
|
||||
|
||||
function TConfigValues.ByNameAsString(AName: string; DefValue: string): string;
|
||||
var
|
||||
P:TConfigValue;
|
||||
begin
|
||||
P:=ParamByName(AName);
|
||||
if Assigned(P) then
|
||||
Result:=P.AsString
|
||||
else
|
||||
Result:=DefValue;
|
||||
end;
|
||||
|
||||
function TConfigValues.ByNameAsFloat(AName: string; DefValue: Double): Double;
|
||||
var
|
||||
P:TConfigValue;
|
||||
begin
|
||||
P:=ParamByName(AName);
|
||||
if Assigned(P) then
|
||||
Result:=P.AsFloat
|
||||
else
|
||||
Result:=DefValue;
|
||||
end;
|
||||
|
||||
function TConfigValues.ByNameAsBoolean(AName: string; DefValue: Boolean
|
||||
): Boolean;
|
||||
var
|
||||
P:TConfigValue;
|
||||
begin
|
||||
P:=ParamByName(AName);
|
||||
if Assigned(P) then
|
||||
Result:=P.AsBoolean
|
||||
else
|
||||
Result:=DefValue;
|
||||
end;
|
||||
|
||||
function TConfigValues.ByNameAsDateTime(AName: string; DefValue: TDateTime
|
||||
): TDateTime;
|
||||
var
|
||||
P:TConfigValue;
|
||||
begin
|
||||
P:=ParamByName(AName);
|
||||
if Assigned(P) then
|
||||
Result:=P.AsDateTime
|
||||
else
|
||||
Result:=DefValue;
|
||||
end;
|
||||
|
||||
procedure TConfigValues.SetByNameAsInteger(AName: string; AValue: integer);
|
||||
var
|
||||
P:TConfigValue;
|
||||
begin
|
||||
P:=ParamByName(AName);
|
||||
if not Assigned(P) then
|
||||
P:=CreateValue(AName, cvtInteger);
|
||||
P.AsInteger:=AValue;
|
||||
end;
|
||||
|
||||
procedure TConfigValues.SetByNameAsString(AName: string; AValue: string);
|
||||
var
|
||||
P:TConfigValue;
|
||||
begin
|
||||
P:=ParamByName(AName);
|
||||
if not Assigned(P) then
|
||||
P:=CreateValue(AName, cvtString);
|
||||
P.AsString:=AValue;
|
||||
end;
|
||||
|
||||
procedure TConfigValues.SetByNameAsFloat(AName: string; ADefValue: Double);
|
||||
var
|
||||
P:TConfigValue;
|
||||
begin
|
||||
P:=ParamByName(AName);
|
||||
if not Assigned(P) then
|
||||
P:=CreateValue(AName, cvtFloat);
|
||||
P.AsFloat:=ADefValue;
|
||||
end;
|
||||
|
||||
procedure TConfigValues.SetByNameAsBoolean(AName: string; ADefValue: Boolean);
|
||||
var
|
||||
P:TConfigValue;
|
||||
begin
|
||||
P:=ParamByName(AName);
|
||||
if not Assigned(P) then
|
||||
P:=CreateValue(AName, cvtBoolean);
|
||||
P.AsBoolean:=ADefValue;
|
||||
end;
|
||||
|
||||
procedure TConfigValues.SetByNameAsDateTime(AName: string; ADefValue: TDateTime
|
||||
);
|
||||
var
|
||||
P:TConfigValue;
|
||||
begin
|
||||
P:=ParamByName(AName);
|
||||
if not Assigned(P) then
|
||||
P:=CreateValue(AName, cvtDateTime);
|
||||
P.AsDateTime:=ADefValue;
|
||||
end;
|
||||
|
||||
{ TConfigValue }
|
||||
|
||||
function TConfigValue.GetAsBoolean: boolean;
|
||||
begin
|
||||
if FDataType = cvtBoolean then
|
||||
Result:=FValue
|
||||
else
|
||||
raise Exception.CreateFmt('Variable %s is not boolean', [FName]);
|
||||
end;
|
||||
|
||||
function TConfigValue.GetAsDateTime: TDateTime;
|
||||
begin
|
||||
if FDataType = cvtDateTime then
|
||||
Result:=FValue
|
||||
else
|
||||
raise Exception.CreateFmt('Variable %s is not date/time', [FName]);
|
||||
end;
|
||||
|
||||
function TConfigValue.GetAsFloat: Double;
|
||||
begin
|
||||
if FDataType = cvtFloat then
|
||||
Result:=FValue
|
||||
else
|
||||
raise Exception.CreateFmt('Variable %s is not float', [FName]);
|
||||
end;
|
||||
|
||||
function TConfigValue.GetAsInteger: integer;
|
||||
begin
|
||||
if FDataType = cvtInteger then
|
||||
Result:=FValue
|
||||
else
|
||||
raise Exception.CreateFmt('Variable %s is not integer', [FName]);
|
||||
end;
|
||||
|
||||
function TConfigValue.GetAsString: string;
|
||||
begin
|
||||
if FDataType = cvtString then
|
||||
Result:=FValue
|
||||
else
|
||||
raise Exception.CreateFmt('Variable %s is not string', [FName]);
|
||||
end;
|
||||
|
||||
procedure TConfigValue.SetAsBoolean(const AValue: boolean);
|
||||
begin
|
||||
if FDataType = cvtBoolean then
|
||||
begin
|
||||
if FValue<>AValue then
|
||||
begin
|
||||
FValue:=AValue;
|
||||
FModified:=true;
|
||||
end
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('Variable %s is not boolean', [FName]);
|
||||
end;
|
||||
|
||||
procedure TConfigValue.SetAsDateTime(const AValue: TDateTime);
|
||||
begin
|
||||
if FDataType = cvtDateTime then
|
||||
begin
|
||||
if FValue<>AValue then
|
||||
begin
|
||||
FValue:=AValue;
|
||||
FModified:=true;
|
||||
end
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('Variable %s is not date/time', [FName]);
|
||||
end;
|
||||
|
||||
procedure TConfigValue.SetAsFloat(const AValue: Double);
|
||||
begin
|
||||
if FDataType = cvtFloat then
|
||||
begin
|
||||
if FValue<>AValue then
|
||||
begin
|
||||
FValue:=AValue;
|
||||
FModified:=true;
|
||||
end
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('Variable %s is not float', [FName]);
|
||||
end;
|
||||
|
||||
procedure TConfigValue.SetAsInteger(const AValue: integer);
|
||||
begin
|
||||
if FDataType = cvtInteger then
|
||||
begin
|
||||
if (FValue = null) or (FValue<>AValue) then
|
||||
begin
|
||||
FValue:=AValue;
|
||||
FModified:=true;
|
||||
end
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('Variable %s is not integer', [FName]);
|
||||
end;
|
||||
|
||||
procedure TConfigValue.SetAsString(const AValue: string);
|
||||
begin
|
||||
if FDataType = cvtString then
|
||||
begin
|
||||
if FValue<>AValue then
|
||||
begin
|
||||
FValue:=AValue;
|
||||
FModified:=true;
|
||||
end
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('Variable %s is not string', [FName]);
|
||||
end;
|
||||
|
||||
constructor TConfigValue.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FModified:=false;
|
||||
FValue:=null;
|
||||
end;
|
||||
|
||||
destructor TConfigValue.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TConfigValue.GetValue: string;
|
||||
begin
|
||||
case FDataType of
|
||||
cvtInteger : Result:=IntToStr(AsInteger);
|
||||
cvtString : Result:=AsString;
|
||||
cvtBoolean : Result:=IntToStr(Ord(AsBoolean));
|
||||
cvtDateTime: Result:=DateTimeToStr(AsDateTime);
|
||||
cvtFloat : Str(AsFloat, Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -27,7 +27,7 @@ translate to Lazarus by alexs in 2005 - 2009
|
||||
<License Value="free ware
|
||||
"/>
|
||||
<Version Major="2" Minor="1" Release="2" Build="105"/>
|
||||
<Files Count="58">
|
||||
<Files Count="59">
|
||||
<Item1>
|
||||
<Filename Value="rxlookup.pas"/>
|
||||
<UnitName Value="rxlookup"/>
|
||||
@ -263,6 +263,10 @@ translate to Lazarus by alexs in 2005 - 2009
|
||||
<Filename Value="rxdbcolorbox.pas"/>
|
||||
<UnitName Value="RxDBColorBox"/>
|
||||
</Item58>
|
||||
<Item59>
|
||||
<Filename Value="rxconfigvalues.pas"/>
|
||||
<UnitName Value="rxConfigValues"/>
|
||||
</Item59>
|
||||
</Files>
|
||||
<LazDoc Paths="docs\;\usr\local\share\lazarus\components\rxnew\docs\"/>
|
||||
<i18n>
|
||||
|
||||
@ -16,7 +16,7 @@ uses
|
||||
rxspin, RxDBSpinEdit, RegisterRxDB, RxTimeEdit, RxDBTimeEdit, RxDBCtrls,
|
||||
rxfilterby, rxconst, rxFileUtils, RxVersInfo, RxAboutDialog,
|
||||
rxAboutFormUnit, dbcurredit, RxViewsPanel, RxSystemServices,
|
||||
RegisterRxTools, RxDBColorBox, LazarusPackageIntf;
|
||||
RegisterRxTools, RxDBColorBox, rxConfigValues, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user