paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-01 21:30:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed bug (actually feature) in 23645

Browse Source 
git-svn-id: trunk@26875 -
This commit is contained in:
michael 2014-02-25 09:19:32 +00:00
parent 921c785cc7
commit 48eacbae41
1 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
packages/fcl-base/src/rttiutils.pp
View File

@ -62,13 +62,16 @@ type
TReadStrEvent = function(const ASection, Item, Default: string): string of object; TReadStrEvent = function(const ASection, Item, Default: string): string of object;
TWriteStrEvent = procedure(const ASection, Item, Value: string) of object; TWriteStrEvent = procedure(const ASection, Item, Value: string) of object;
TEraseSectEvent = procedure(const ASection: string) of object; TEraseSectEvent = procedure(const ASection: string) of object;
TPropStorageOption = (psoAlwaysStoreStringsCount);
TPropStorageOptions = set of TPropStorageOption;
TPropsStorage = class(TObject) TPropsStorage = class(TObject)
private private
FObject: TObject; FObject: TObject;
FOwner: TComponent; FOwner: TComponent;
FPrefix: string; FPrefix: string;
FSection: string; FSection: string;
FOptions : TPropStorageOptions;
FOnReadString: TReadStrEvent; FOnReadString: TReadStrEvent;
FOnWriteString: TWriteStrEvent; FOnWriteString: TWriteStrEvent;
FOnEraseSection: TEraseSectEvent; FOnEraseSection: TEraseSectEvent;
@ -113,6 +116,7 @@ type
procedure LoadProperties(PropList: TStrings); procedure LoadProperties(PropList: TStrings);
procedure LoadObjectsProps(AComponent: TComponent; StoredList: TStrings); procedure LoadObjectsProps(AComponent: TComponent; StoredList: TStrings);
procedure StoreObjectsProps(AComponent: TComponent; StoredList: TStrings); procedure StoreObjectsProps(AComponent: TComponent; StoredList: TStrings);
Property Options : TPropStorageOptions Read FOptions Write FOptions;
property AObject: TObject read FObject write FObject; property AObject: TObject read FObject write FObject;
property Prefix: string read FPrefix write FPrefix; property Prefix: string read FPrefix write FPrefix;
property Section: string read FSection write FSection; property Section: string read FSection write FSection;
@ -465,11 +469,13 @@ begin
List := TObject(GetObjectProp(Self.FObject, PropInfo)); List := TObject(GetObjectProp(Self.FObject, PropInfo));
SectName := Format('%s.%s', [Section, GetItemName(PropInfo^.Name)]); SectName := Format('%s.%s', [Section, GetItemName(PropInfo^.Name)]);
EraseSection(SectName); EraseSection(SectName);
if (List is TStrings) and (TStrings(List).Count > 0) then begin if (List is TStrings)
and ((TStrings(List).Count > 0) or (psoAlwaysStoreStringsCount in Options)) then
begin
WriteString(SectName, sCount, IntToStr(TStrings(List).Count)); WriteString(SectName, sCount, IntToStr(TStrings(List).Count));
for I := 0 to TStrings(List).Count - 1 do for I := 0 to TStrings(List).Count - 1 do
WriteString(SectName, Format(sItem, [I]), TStrings(List)[I]); WriteString(SectName, Format(sItem, [I]), TStrings(List)[I]);
end; end;
end; end;
function TPropsStorage.StoreComponentProperty(PropInfo: PPropInfo): string; function TPropsStorage.StoreComponentProperty(PropInfo: PPropInfo): string;