home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / RXPROPS.PAS < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  28KB  |  929 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997 Master-Bank                }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit RXProps;
  11.  
  12. interface
  13.  
  14. {$I RX.INC}
  15.  
  16. uses SysUtils, Classes, Graphics, Controls, Forms, TypInfo, VclUtils;
  17.  
  18. type
  19.  
  20. { TPropInfoList }
  21.  
  22.   TPropInfoList = class(TObject)
  23.   private
  24.     FList: PPropList;
  25.     FCount: Integer;
  26.     FSize: Integer;
  27.     function Get(Index: Integer): PPropInfo;
  28.   public
  29.     constructor Create(AObject: TObject; Filter: TTypeKinds);
  30.     destructor Destroy; override;
  31.     function Contains(P: PPropInfo): Boolean;
  32.     function Find(const AName: string): PPropInfo;
  33.     procedure Delete(Index: Integer);
  34.     procedure Intersect(List: TPropInfoList);
  35.     property Count: Integer read FCount;
  36.     property Items[Index: Integer]: PPropInfo read Get; default;
  37.   end;
  38.  
  39. { TPropsStorage }
  40.  
  41.   TReadStrEvent = function(const ASection, Item, Default: string): string of object;
  42.   TWriteStrEvent = procedure(const ASection, Item, Value: string) of object;
  43.   TEraseSectEvent = procedure(const ASection: string) of object;
  44.  
  45.   TPropsStorage = class(TObject)
  46.   private
  47.     FObject: TObject;
  48.     FOwner: TComponent;
  49.     FPrefix: string;
  50.     FSection: string;
  51.     FOnReadString: TReadStrEvent;
  52.     FOnWriteString: TWriteStrEvent;
  53.     FOnEraseSection: TEraseSectEvent;
  54.     function StoreIntegerProperty(PropInfo: PPropInfo): string;
  55.     function StoreCharProperty(PropInfo: PPropInfo): string;
  56.     function StoreEnumProperty(PropInfo: PPropInfo): string;
  57.     function StoreFloatProperty(PropInfo: PPropInfo): string;
  58.     function StoreStringProperty(PropInfo: PPropInfo): string;
  59.     function StoreSetProperty(PropInfo: PPropInfo): string;
  60.     function StoreClassProperty(PropInfo: PPropInfo): string;
  61.     function StoreStringsProperty(PropInfo: PPropInfo): string;
  62.     function StoreComponentProperty(PropInfo: PPropInfo): string;
  63. {$IFDEF WIN32}
  64.     function StoreLStringProperty(PropInfo: PPropInfo): string;
  65.     function StoreWCharProperty(PropInfo: PPropInfo): string;
  66.     function StoreVariantProperty(PropInfo: PPropInfo): string;
  67.     procedure LoadLStringProperty(const S: string; PropInfo: PPropInfo);
  68.     procedure LoadWCharProperty(const S: string; PropInfo: PPropInfo);
  69.     procedure LoadVariantProperty(const S: string; PropInfo: PPropInfo);
  70. {$ENDIF}
  71. {$IFDEF RX_D4}
  72.     function StoreInt64Property(PropInfo: PPropInfo): string;
  73.     procedure LoadInt64Property(const S: string; PropInfo: PPropInfo);
  74. {$ENDIF}
  75.     procedure LoadIntegerProperty(const S: string; PropInfo: PPropInfo);
  76.     procedure LoadCharProperty(const S: string; PropInfo: PPropInfo);
  77.     procedure LoadEnumProperty(const S: string; PropInfo: PPropInfo);
  78.     procedure LoadFloatProperty(const S: string; PropInfo: PPropInfo);
  79.     procedure LoadStringProperty(const S: string; PropInfo: PPropInfo);
  80.     procedure LoadSetProperty(const S: string; PropInfo: PPropInfo);
  81.     procedure LoadClassProperty(const S: string; PropInfo: PPropInfo);
  82.     procedure LoadStringsProperty(const S: string; PropInfo: PPropInfo);
  83.     procedure LoadComponentProperty(const S: string; PropInfo: PPropInfo);
  84.     function CreateInfoList(AComponent: TComponent; StoredList: TStrings): TStrings;
  85.     procedure FreeInfoLists(Info: TStrings);
  86.   protected
  87.     function ReadString(const ASection, Item, Default: string): string; virtual;
  88.     procedure WriteString(const ASection, Item, Value: string); virtual;
  89.     procedure EraseSection(const ASection: string); virtual;
  90.     function GetItemName(const APropName: string): string; virtual;
  91.     function CreateStorage: TPropsStorage; virtual;
  92.   public
  93.     procedure StoreAnyProperty(PropInfo: PPropInfo);
  94.     procedure LoadAnyProperty(PropInfo: PPropInfo);
  95.     procedure StoreProperties(PropList: TStrings);
  96.     procedure LoadProperties(PropList: TStrings);
  97.     procedure LoadObjectsProps(AComponent: TComponent; StoredList: TStrings);
  98.     procedure StoreObjectsProps(AComponent: TComponent; StoredList: TStrings);
  99.     property AObject: TObject read FObject write FObject;
  100.     property Prefix: string read FPrefix write FPrefix;
  101.     property Section: string read FSection write FSection;
  102.     property OnReadString: TReadStrEvent read FOnReadString write FOnReadString;
  103.     property OnWriteString: TWriteStrEvent read FOnWriteString write FOnWriteString;
  104.     property OnEraseSection: TEraseSectEvent read FOnEraseSection write FOnEraseSection;
  105.   end;
  106.  
  107. { Utility routines }
  108.  
  109. procedure UpdateStoredList(AComponent: TComponent; AStoredList: TStrings; FromForm: Boolean);
  110. function CreateStoredItem(const CompName, PropName: string): string;
  111. function ParseStoredItem(const Item: string; var CompName, PropName: string): Boolean;
  112.  
  113. const
  114. {$IFDEF WIN32}
  115.   sPropNameDelimiter: string = '_';
  116. {$ELSE}
  117.   sPropNameDelimiter: Char = '_';
  118. {$ENDIF}
  119.  
  120. implementation
  121.  
  122. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, Str16, {$ENDIF}
  123.   Consts, rxStrUtils;
  124.  
  125. const
  126.   sCount = 'Count';
  127.   sItem = 'Item%d';
  128.   sNull = '(null)';
  129.  
  130. type
  131.   TCardinalSet = set of 0..SizeOf(Cardinal) * 8 - 1;
  132.  
  133. {$IFNDEF WIN32}
  134. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  135. begin
  136.   Result := TypInfo.GetEnumName(TypeInfo, Value)^;
  137. end;
  138. {$ENDIF}
  139.  
  140. function GetPropType(PropInfo: PPropInfo): PTypeInfo;
  141. begin
  142. {$IFDEF RX_D3}
  143.   Result := PropInfo^.PropType^;
  144. {$ELSE}
  145.   Result := PropInfo^.PropType;
  146. {$ENDIF}
  147. end;
  148.  
  149. { TPropInfoList }
  150.  
  151. constructor TPropInfoList.Create(AObject: TObject; Filter: TTypeKinds);
  152. begin
  153.   if AObject <> nil then begin
  154.     FCount := GetPropList(AObject.ClassInfo, Filter, nil);
  155.     FSize := FCount * SizeOf(Pointer);
  156.     GetMem(FList, FSize);
  157.     GetPropList(AObject.ClassInfo, Filter, FList);
  158.   end
  159.   else begin
  160.     FCount := 0;
  161.     FList := nil;
  162.   end;
  163. end;
  164.  
  165. destructor TPropInfoList.Destroy;
  166. begin
  167.   if FList <> nil then FreeMem(FList, FSize);
  168. end;
  169.  
  170. function TPropInfoList.Contains(P: PPropInfo): Boolean;
  171. var
  172.   I: Integer;
  173. begin
  174.   for I := 0 to FCount - 1 do
  175.     with FList^[I]^ do
  176.       if (PropType = P^.PropType) and (CompareText(Name, P^.Name) = 0) then
  177.       begin
  178.         Result := True;
  179.         Exit;
  180.       end;
  181.   Result := False;
  182. end;
  183.  
  184. function TPropInfoList.Find(const AName: string): PPropInfo;
  185. var
  186.   I: Integer;
  187. begin
  188.   for I := 0 to FCount - 1 do
  189.     with FList^[I]^ do
  190.       if (CompareText(Name, AName) = 0) then
  191.       begin
  192.         Result := FList^[I];
  193.         Exit;
  194.       end;
  195.   Result := nil;
  196. end;
  197.  
  198. procedure TPropInfoList.Delete(Index: Integer);
  199. begin
  200.   Dec(FCount);
  201.   if Index < FCount then Move(FList^[Index + 1], FList^[Index],
  202.     (FCount - Index) * SizeOf(Pointer));
  203. end;
  204.  
  205. function TPropInfoList.Get(Index: Integer): PPropInfo;
  206. begin
  207.   Result := FList^[Index];
  208. end;
  209.  
  210. procedure TPropInfoList.Intersect(List: TPropInfoList);
  211. var
  212.   I: Integer;
  213. begin
  214.   for I := FCount - 1 downto 0 do
  215.     if not List.Contains(FList^[I]) then Delete(I);
  216. end;
  217.  
  218. { Utility routines }
  219.  
  220. function CreateStoredItem(const CompName, PropName: string): string;
  221. begin
  222.   Result := '';
  223.   if (CompName <> '') and (PropName <> '') then
  224.     Result := CompName + '.' + PropName;
  225. end;
  226.  
  227. function ParseStoredItem(const Item: string; var CompName, PropName: string): Boolean;
  228. var
  229.   I: Integer;
  230. begin
  231.   Result := False;
  232.   if Length(Item) = 0 then Exit;
  233.   I := Pos('.', Item);
  234.   if I > 0 then begin
  235.     CompName := Trim(Copy(Item, 1, I - 1));
  236.     PropName := Trim(Copy(Item, I + 1, MaxInt));
  237.     Result := (Length(CompName) > 0) and (Length(PropName) > 0);
  238.   end;
  239. end;
  240.  
  241. function ReplaceComponentName(const Item, CompName: string): string;
  242. var
  243.   ACompName, APropName: string;
  244. begin
  245.   Result := '';
  246.   if ParseStoredItem(Item, ACompName, APropName) then
  247.     Result := CreateStoredItem(CompName, APropName);
  248. end;
  249.  
  250. procedure UpdateStoredList(AComponent: TComponent; AStoredList: TStrings; FromForm: Boolean);
  251. var
  252.   I: Integer;
  253.   Component: TComponent;
  254.   CompName, PropName: string;
  255. begin
  256.   if (AStoredList = nil) or (AComponent = nil) then Exit;
  257.   for I := AStoredList.Count - 1 downto 0 do begin
  258.     if ParseStoredItem(AStoredList[I], CompName, PropName) then
  259.     begin
  260.       if FromForm then begin
  261.         Component := AComponent.FindComponent(CompName);
  262.         if Component = nil then AStoredList.Delete(I)
  263.         else AStoredList.Objects[I] := Component;
  264.       end
  265.       else begin
  266.         Component := TComponent(AStoredList.Objects[I]);
  267.         if Component <> nil then
  268.           AStoredList[I] := ReplaceComponentName(AStoredList[I], Component.Name)
  269.         else AStoredList.Delete(I);
  270.       end;
  271.     end
  272.     else AStoredList.Delete(I);
  273.   end;
  274. end;
  275.  
  276. {$IFDEF WIN32}
  277. function FindGlobalComponent(const Name: string): TComponent;
  278. var
  279.   I: Integer;
  280. begin
  281.   for I := 0 to Screen.FormCount - 1 do begin
  282.     Result := Screen.Forms[I];
  283.     if CompareText(Name, Result.Name) = 0 then Exit;
  284.   end;
  285.   for I := 0 to Screen.DataModuleCount - 1 do begin
  286.     Result := Screen.DataModules[I];
  287.     if CompareText(Name, Result.Name) = 0 then Exit;
  288.   end;
  289.   Result := nil;
  290. end;
  291. {$ENDIF}
  292.  
  293. { TPropsStorage }
  294.  
  295. function TPropsStorage.GetItemName(const APropName: string): string;
  296. begin
  297.   Result := Prefix + APropName;
  298. end;
  299.  
  300. procedure TPropsStorage.LoadAnyProperty(PropInfo: PPropInfo);
  301. var
  302.   S, Def: string;
  303. begin
  304.   try
  305.     if PropInfo <> nil then begin
  306.       case PropInfo^.PropType^.Kind of
  307.         tkInteger: Def := StoreIntegerProperty(PropInfo);
  308.         tkChar: Def := StoreCharProperty(PropInfo);
  309.         tkEnumeration: Def := StoreEnumProperty(PropInfo);
  310.         tkFloat: Def := StoreFloatProperty(PropInfo);
  311. {$IFDEF WIN32}
  312.         tkWChar: Def := StoreWCharProperty(PropInfo);
  313.         tkLString: Def := StoreLStringProperty(PropInfo);
  314.   {$IFNDEF RX_D3} { - Delphi 2.0, C++Builder 1.0 }
  315.         tkLWString: Def := StoreLStringProperty(PropInfo);
  316.   {$ENDIF}
  317.         tkVariant: Def := StoreVariantProperty(PropInfo);
  318. {$ENDIF WIN32}
  319. {$IFDEF RX_D4}
  320.         tkInt64: Def := StoreInt64Property(PropInfo);
  321. {$ENDIF}
  322.         tkString: Def := StoreStringProperty(PropInfo);
  323.         tkSet: Def := StoreSetProperty(PropInfo);
  324.         tkClass: Def := '';
  325.         else Exit;
  326.       end;
  327.       if (Def <> '') or (PropInfo^.PropType^.Kind in [tkString, tkClass])
  328. {$IFDEF WIN32}
  329.         or (PropInfo^.PropType^.Kind in [tkLString,
  330.           {$IFNDEF RX_D3} tkLWString, {$ENDIF} tkWChar])
  331. {$ENDIF WIN32}
  332.       then
  333.         S := Trim(ReadString(Section, GetItemName(PropInfo^.Name), Def))
  334.       else S := '';
  335.       case PropInfo^.PropType^.Kind of
  336.         tkInteger: LoadIntegerProperty(S, PropInfo);
  337.         tkChar: LoadCharProperty(S, PropInfo);
  338.         tkEnumeration: LoadEnumProperty(S, PropInfo);
  339.         tkFloat: LoadFloatProperty(S, PropInfo);
  340. {$IFDEF WIN32}
  341.         tkWChar: LoadWCharProperty(S, PropInfo);
  342.         tkLString: LoadLStringProperty(S, PropInfo);
  343.   {$IFNDEF RX_D3} { - Delphi 2.0, C++Builder 1.0 }
  344.         tkLWString: LoadLStringProperty(S, PropInfo);
  345.   {$ENDIF}
  346.         tkVariant: LoadVariantProperty(S, PropInfo);
  347. {$ENDIF WIN32}
  348. {$IFDEF RX_D4}
  349.         tkInt64: LoadInt64Property(S, PropInfo);
  350. {$ENDIF}
  351.         tkString: LoadStringProperty(S, PropInfo);
  352.         tkSet: LoadSetProperty(S, PropInfo);
  353.         tkClass: LoadClassProperty(S, PropInfo);
  354.       end;
  355.     end;
  356.   except
  357.     { ignore any exception }
  358.   end;
  359. end;
  360.  
  361. procedure TPropsStorage.StoreAnyProperty(PropInfo: PPropInfo);
  362. var
  363.   S: string;
  364. begin
  365.   if PropInfo <> nil then begin
  366.     case PropInfo^.PropType^.Kind of
  367.       tkInteger: S := StoreIntegerProperty(PropInfo);
  368.       tkChar: S := StoreCharProperty(PropInfo);
  369.       tkEnumeration: S := StoreEnumProperty(PropInfo);
  370.       tkFloat: S := StoreFloatProperty(PropInfo);
  371. {$IFDEF WIN32}
  372.       tkLString: S := StoreLStringProperty(PropInfo);
  373.   {$IFNDEF RX_D3} { - Delphi 2.0, C++Builder 1.0 }
  374.       tkLWString: S := StoreLStringProperty(PropInfo);
  375.   {$ENDIF}
  376.       tkWChar: S := StoreWCharProperty(PropInfo);
  377.       tkVariant: S := StoreVariantProperty(PropInfo);
  378. {$ENDIF WIN32}
  379. {$IFDEF RX_D4}
  380.       tkInt64: S := StoreInt64Property(PropInfo);
  381. {$ENDIF}
  382.       tkString: S := StoreStringProperty(PropInfo);
  383.       tkSet: S := StoreSetProperty(PropInfo);
  384.       tkClass: S := StoreClassProperty(PropInfo);
  385.       else Exit;
  386.     end;
  387.     if (S <> '') or (PropInfo^.PropType^.Kind in [tkString
  388.       {$IFDEF WIN32}, tkLString, {$IFNDEF RX_D3} tkLWString, {$ENDIF}
  389.       tkWChar {$ENDIF WIN32}]) then
  390.       WriteString(Section, GetItemName(PropInfo^.Name), Trim(S));
  391.   end;
  392. end;
  393.  
  394. function TPropsStorage.StoreIntegerProperty(PropInfo: PPropInfo): string;
  395. begin
  396.   Result := IntToStr(GetOrdProp(FObject, PropInfo));
  397. end;
  398.  
  399. function TPropsStorage.StoreCharProperty(PropInfo: PPropInfo): string;
  400. begin
  401.   Result := Char(GetOrdProp(FObject, PropInfo));
  402. end;
  403.  
  404. function TPropsStorage.StoreEnumProperty(PropInfo: PPropInfo): string;
  405. begin
  406.   Result := GetEnumName(GetPropType(PropInfo), GetOrdProp(FObject, PropInfo));
  407. end;
  408.  
  409. function TPropsStorage.StoreFloatProperty(PropInfo: PPropInfo): string;
  410. const
  411. {$IFDEF WIN32}
  412.   Precisions: array[TFloatType] of Integer = (7, 15, 18, 18, 19);
  413. {$ELSE}
  414.   Precisions: array[TFloatType] of Integer = (7, 15, 18, 18);
  415. {$ENDIF}
  416. begin
  417.   Result := ReplaceStr(FloatToStrF(GetFloatProp(FObject, PropInfo), ffGeneral,
  418.     Precisions[GetTypeData(GetPropType(PropInfo))^.FloatType], 0), 
  419.     DecimalSeparator, '.');
  420. end;
  421.  
  422. function TPropsStorage.StoreStringProperty(PropInfo: PPropInfo): string;
  423. begin
  424.   Result := GetStrProp(FObject, PropInfo);
  425. end;
  426.  
  427. {$IFDEF WIN32}
  428. function TPropsStorage.StoreLStringProperty(PropInfo: PPropInfo): string;
  429. begin
  430.   Result := GetStrProp(FObject, PropInfo);
  431. end;
  432.  
  433. function TPropsStorage.StoreWCharProperty(PropInfo: PPropInfo): string;
  434. begin
  435.   Result := Char(GetOrdProp(FObject, PropInfo));
  436. end;
  437.  
  438. function TPropsStorage.StoreVariantProperty(PropInfo: PPropInfo): string;
  439. begin
  440.   Result := GetVariantProp(FObject, PropInfo);
  441. end;
  442. {$ENDIF}
  443.  
  444. {$IFDEF RX_D4}
  445. function TPropsStorage.StoreInt64Property(PropInfo: PPropInfo): string;
  446. begin
  447.   Result := IntToStr(GetInt64Prop(FObject, PropInfo));
  448. end;
  449. {$ENDIF}
  450.  
  451. function TPropsStorage.StoreSetProperty(PropInfo: PPropInfo): string;
  452. var
  453.   TypeInfo: PTypeInfo;
  454.   W: Cardinal;
  455.   I: Integer;
  456. begin
  457.   Result := '[';
  458.   W := GetOrdProp(FObject, PropInfo);
  459.   TypeInfo := GetTypeData(GetPropType(PropInfo))^.CompType{$IFDEF RX_D3}^{$ENDIF};
  460.   for I := 0 to SizeOf(TCardinalSet) * 8 - 1 do
  461.     if I in TCardinalSet(W) then begin
  462.       if Length(Result) <> 1 then Result := Result + ',';
  463.       Result := Result + GetEnumName(TypeInfo, I);
  464.     end;
  465.   Result := Result + ']';
  466. end;
  467.  
  468. function TPropsStorage.StoreStringsProperty(PropInfo: PPropInfo): string;
  469. var
  470.   List: TObject;
  471.   I: Integer;
  472.   SectName: string;
  473. begin
  474.   Result := '';
  475.   List := TObject(GetOrdProp(Self.FObject, PropInfo));
  476.   SectName := Format('%s.%s', [Section, GetItemName(PropInfo^.Name)]);
  477.   EraseSection(SectName);
  478.   if (List is TStrings) and (TStrings(List).Count > 0) then begin
  479.     WriteString(SectName, sCount, IntToStr(TStrings(List).Count));
  480.     for I := 0 to TStrings(List).Count - 1 do
  481.       WriteString(SectName, Format(sItem, [I]), TStrings(List)[I]);
  482.   end;
  483. end;
  484.  
  485. function TPropsStorage.StoreComponentProperty(PropInfo: PPropInfo): string;
  486. var
  487.   Comp: TComponent;
  488.   RootName: string;
  489. begin
  490.   Comp := TComponent(GetOrdProp(FObject, PropInfo));
  491.   if Comp <> nil then begin
  492.     Result := Comp.Name;
  493.     if (Comp.Owner <> nil) and (Comp.Owner <> FOwner) then begin
  494.       RootName := Comp.Owner.Name;
  495.       if RootName = '' then begin
  496.         RootName := Comp.Owner.ClassName;
  497.         if (RootName <> '') and (UpCase(RootName[1]) = 'T') then
  498.           Delete(RootName, 1, 1);
  499.       end;
  500.       Result := Format('%s.%s', [RootName, Result]);
  501.     end;
  502.   end
  503.   else Result := sNull;
  504. end;
  505.  
  506. function TPropsStorage.StoreClassProperty(PropInfo: PPropInfo): string;
  507. var
  508.   Saver: TPropsStorage;
  509.   I: Integer;
  510.   Obj: TObject;
  511.  
  512.   procedure StoreObjectProps(Obj: TObject; const APrefix, ASection: string);
  513.   var
  514.     I: Integer;
  515.     Props: TPropInfoList;
  516.   begin
  517.     with Saver do begin
  518.       AObject := Obj;
  519.       Prefix := APrefix;
  520.       Section := ASection;
  521.       FOnWriteString := Self.FOnWriteString;
  522.       FOnEraseSection := Self.FOnEraseSection;
  523.       Props := TPropInfoList.Create(AObject, tkProperties);
  524.       try
  525.         for I := 0 to Props.Count - 1 do StoreAnyProperty(Props.Items[I]);
  526.       finally
  527.         Props.Free;
  528.       end;
  529.     end;
  530.   end;
  531.  
  532. begin
  533.   Result := '';
  534.   Obj := TObject(GetOrdProp(Self.FObject, PropInfo));
  535.   if (Obj <> nil) then begin
  536.     if Obj is TStrings then StoreStringsProperty(PropInfo)
  537. {$IFDEF WIN32}
  538.     else if Obj is TCollection then begin
  539.       EraseSection(Format('%s.%s', [Section, Prefix + PropInfo^.Name]));
  540.       Saver := CreateStorage;
  541.       try
  542.         WriteString(Section, Format('%s.%s', [Prefix + PropInfo^.Name, sCount]),
  543.           IntToStr(TCollection(Obj).Count));
  544.         for I := 0 to TCollection(Obj).Count - 1 do begin
  545.           StoreObjectProps(TCollection(Obj).Items[I],
  546.             Format(sItem, [I]) + sPropNameDelimiter,
  547.             Format('%s.%s', [Section, Prefix + PropInfo^.Name]));
  548.         end;
  549.       finally
  550.         Saver.Free;
  551.       end;
  552.     end
  553. {$ENDIF}
  554.     else if Obj is TComponent then begin
  555.       Result := StoreComponentProperty(PropInfo);
  556.       Exit;
  557.     end;
  558.   end;
  559.   Saver := CreateStorage;
  560.   try
  561.     with Saver do begin
  562.       StoreObjectProps(Obj, Self.Prefix + PropInfo^.Name, Self.Section);
  563.     end;
  564.   finally
  565.     Saver.Free;
  566.   end;
  567. end;
  568.  
  569. procedure TPropsStorage.LoadIntegerProperty(const S: string; PropInfo: PPropInfo);
  570. begin
  571.   SetOrdProp(FObject, PropInfo, StrToIntDef(S, 0));
  572. end;
  573.  
  574. procedure TPropsStorage.LoadCharProperty(const S: string; PropInfo: PPropInfo);
  575. begin
  576.   SetOrdProp(FObject, PropInfo, Integer(S[1]));
  577. end;
  578.  
  579. procedure TPropsStorage.LoadEnumProperty(const S: string; PropInfo: PPropInfo);
  580. var
  581.   I: Integer;
  582.   EnumType: PTypeInfo;
  583. begin
  584.   EnumType := GetPropType(PropInfo);
  585.   with GetTypeData(EnumType)^ do
  586.     for I := MinValue to MaxValue do
  587.       if CompareText(GetEnumName(EnumType, I), S) = 0 then
  588.       begin
  589.         SetOrdProp(FObject, PropInfo, I);
  590.         Exit;
  591.       end;
  592. end;
  593.  
  594. procedure TPropsStorage.LoadFloatProperty(const S: string; PropInfo: PPropInfo);
  595. begin
  596.   SetFloatProp(FObject, PropInfo, StrToFloat(ReplaceStr(S, '.',
  597.     DecimalSeparator)));
  598. end;
  599.  
  600. {$IFDEF RX_D4}
  601. procedure TPropsStorage.LoadInt64Property(const S: string; PropInfo: PPropInfo);
  602. begin
  603.   SetInt64Prop(FObject, PropInfo, StrToInt64Def(S, 0));
  604. end;
  605. {$ENDIF}
  606.  
  607. {$IFDEF WIN32}
  608. procedure TPropsStorage.LoadLStringProperty(const S: string; PropInfo: PPropInfo);
  609. begin
  610.   SetStrProp(FObject, PropInfo, S);
  611. end;
  612.  
  613. procedure TPropsStorage.LoadWCharProperty(const S: string; PropInfo: PPropInfo);
  614. begin
  615.   SetOrdProp(FObject, PropInfo, Longint(S[1]));
  616. end;
  617.  
  618. procedure TPropsStorage.LoadVariantProperty(const S: string; PropInfo: PPropInfo);
  619. begin
  620.   SetVariantProp(FObject, PropInfo, S);
  621. end;
  622. {$ENDIF}
  623.  
  624. procedure TPropsStorage.LoadStringProperty(const S: string; PropInfo: PPropInfo);
  625. begin
  626.   SetStrProp(FObject, PropInfo, S);
  627. end;
  628.  
  629. procedure TPropsStorage.LoadSetProperty(const S: string; PropInfo: PPropInfo);
  630. const
  631.   Delims = [' ', ',', '[', ']'];
  632. var
  633.   TypeInfo: PTypeInfo;
  634.   W: Cardinal;
  635.   I, N: Integer;
  636.   Count: Integer;
  637.   EnumName: string;
  638. begin
  639.   W := 0;
  640.   TypeInfo := GetTypeData(GetPropType(PropInfo))^.CompType{$IFDEF RX_D3}^{$ENDIF};
  641.   Count := WordCount(S, Delims);
  642.   for N := 1 to Count do begin
  643.     EnumName := ExtractWord(N, S, Delims);
  644.     try
  645.       I := GetEnumValue(TypeInfo, EnumName);
  646.       if I >= 0 then Include(TCardinalSet(W), I);
  647.     except
  648.     end;
  649.   end;
  650.   SetOrdProp(FObject, PropInfo, W);
  651. end;
  652.  
  653. procedure TPropsStorage.LoadStringsProperty(const S: string; PropInfo: PPropInfo);
  654. var
  655.   List: TObject;
  656.   Temp: TStrings;
  657.   I, Cnt: Integer;
  658.   SectName: string;
  659. begin
  660.   List := TObject(GetOrdProp(Self.FObject, PropInfo));
  661.   if (List is TStrings) then begin
  662.     SectName := Format('%s.%s', [Section, GetItemName(PropInfo^.Name)]);
  663.     Cnt := StrToIntDef(Trim(ReadString(SectName, sCount, '0')), 0);
  664.     if Cnt > 0 then begin
  665.       Temp := TStringList.Create;
  666.       try
  667.         for I := 0 to Cnt - 1 do
  668.           Temp.Add(ReadString(SectName, Format(sItem, [I]), ''));
  669.         TStrings(List).Assign(Temp);
  670.       finally
  671.         Temp.Free;
  672.       end;
  673.     end;
  674.   end;
  675. end;
  676.  
  677. procedure TPropsStorage.LoadComponentProperty(const S: string; PropInfo: PPropInfo);
  678. {$IFDEF WIN32}
  679. var
  680.   RootName, Name: string;
  681.   Root: TComponent;
  682.   P: Integer;
  683. begin
  684.   if Trim(S) = '' then Exit;
  685.   if CompareText(SNull, Trim(S)) = 0 then begin
  686.     SetOrdProp(FObject, PropInfo, Longint(nil));
  687.     Exit;
  688.   end;
  689.   P := Pos('.', S);
  690.   if P > 0 then begin
  691.     RootName := Trim(Copy(S, 1, P - 1));
  692.     Name := Trim(Copy(S, P + 1, MaxInt));
  693.   end
  694.   else begin
  695.     RootName := '';
  696.     Name := Trim(S);
  697.   end;
  698.   if RootName <> '' then Root := FindGlobalComponent(RootName)
  699.   else Root := FOwner;
  700.   if (Root <> nil) then
  701.     SetOrdProp(FObject, PropInfo, Longint(Root.FindComponent(Name)));
  702. end;
  703. {$ELSE}
  704. begin
  705.   if Trim(S) = '' then Exit;
  706.   if CompareText(SNull, Trim(S)) = 0 then begin
  707.     SetOrdProp(FObject, PropInfo, Longint(nil));
  708.     Exit;
  709.   end;
  710.   if (FOwner <> nil) then
  711.     SetOrdProp(FObject, PropInfo, Longint(FOwner.FindComponent(Trim(S))));
  712. end;
  713. {$ENDIF}
  714.  
  715. procedure TPropsStorage.LoadClassProperty(const S: string; PropInfo: PPropInfo);
  716. var
  717.   Loader: TPropsStorage;
  718.   I: Integer;
  719. {$IFDEF WIN32}
  720.   Cnt: Integer;
  721.   Recreate: Boolean;
  722. {$ENDIF}
  723.   Obj: TObject;
  724.  
  725.   procedure LoadObjectProps(Obj: TObject; const APrefix, ASection: string);
  726.   var
  727.     I: Integer;
  728.     Props: TPropInfoList;
  729.   begin
  730.     with Loader do begin
  731.       AObject := Obj;
  732.       Prefix := APrefix;
  733.       Section := ASection;
  734.       FOnReadString := Self.FOnReadString;
  735.       Props := TPropInfoList.Create(AObject, tkProperties);
  736.       try
  737.         for I := 0 to Props.Count - 1 do LoadAnyProperty(Props.Items[I]);
  738.       finally
  739.         Props.Free;
  740.       end;
  741.     end;
  742.   end;
  743.  
  744. begin
  745.   Obj := TObject(GetOrdProp(Self.FObject, PropInfo));
  746.   if (Obj <> nil) then begin
  747.     if Obj is TStrings then LoadStringsProperty(S, PropInfo)
  748. {$IFDEF WIN32}
  749.     else if Obj is TCollection then begin
  750.       Loader := CreateStorage;
  751.       try
  752.         Cnt := TCollection(Obj).Count;
  753.         Cnt := StrToIntDef(ReadString(Section, Format('%s.%s',
  754.           [Prefix + PropInfo^.Name, sCount]), IntToStr(Cnt)), Cnt);
  755.         Recreate := TCollection(Obj).Count <> Cnt;
  756.         TCollection(Obj).BeginUpdate;
  757.         try
  758.           if Recreate then TCollection(Obj).Clear;
  759.           for I := 0 to Cnt - 1 do begin
  760.             if Recreate then TCollection(Obj).Add;
  761.             LoadObjectProps(TCollection(Obj).Items[I],
  762.               Format(sItem, [I]) + sPropNameDelimiter,
  763.               Format('%s.%s', [Section, Prefix + PropInfo^.Name]));
  764.           end;
  765.         finally
  766.           TCollection(Obj).EndUpdate;
  767.         end;
  768.       finally
  769.         Loader.Free;
  770.       end;
  771.     end
  772. {$ENDIF}
  773.     else if Obj is TComponent then begin
  774.       LoadComponentProperty(S, PropInfo);
  775.       Exit;
  776.     end;
  777.   end;
  778.   Loader := CreateStorage;
  779.   try
  780.     LoadObjectProps(Obj, Self.Prefix + PropInfo^.Name, Self.Section);
  781.   finally
  782.     Loader.Free;
  783.   end;
  784. end;
  785.  
  786. procedure TPropsStorage.StoreProperties(PropList: TStrings);
  787. var
  788.   I: Integer;
  789.   Props: TPropInfoList;
  790. begin
  791.   Props := TPropInfoList.Create(AObject, tkProperties);
  792.   try
  793.     for I := 0 to PropList.Count - 1 do
  794.       StoreAnyProperty(Props.Find(PropList[I]));
  795.   finally
  796.     Props.Free;
  797.   end;
  798. end;
  799.  
  800. procedure TPropsStorage.LoadProperties(PropList: TStrings);
  801. var
  802.   I: Integer;
  803.   Props: TPropInfoList;
  804. begin
  805.   Props := TPropInfoList.Create(AObject, tkProperties);
  806.   try
  807.     for I := 0 to PropList.Count - 1 do
  808.       LoadAnyProperty(Props.Find(PropList[I]));
  809.   finally
  810.     Props.Free;
  811.   end;
  812. end;
  813.  
  814. function TPropsStorage.CreateInfoList(AComponent: TComponent; StoredList: TStrings): TStrings;
  815. var
  816.   I: Integer;
  817.   Obj: TComponent;
  818.   Props: TPropInfoList;
  819. begin
  820.   UpdateStoredList(AComponent, StoredList, False);
  821.   Result := TStringList.Create;
  822.   try
  823.     TStringList(Result).Sorted := True;
  824.     for I := 0 to StoredList.Count - 1 do begin
  825.       Obj := TComponent(StoredList.Objects[I]);
  826.       if Result.IndexOf(Obj.Name) < 0 then begin
  827.         Props := TPropInfoList.Create(Obj, tkProperties);
  828.         try
  829.           Result.AddObject(Obj.Name, Props);
  830.         except
  831.           Props.Free;
  832.           raise;
  833.         end;
  834.       end;
  835.     end;
  836.   except
  837.     Result.Free;
  838.     Result := nil;
  839.   end;
  840. end;
  841.  
  842. procedure TPropsStorage.FreeInfoLists(Info: TStrings);
  843. var
  844.   I: Integer;
  845. begin
  846.   for I := Info.Count - 1 downto 0 do Info.Objects[I].Free;
  847.   Info.Free;
  848. end;
  849.  
  850. procedure TPropsStorage.LoadObjectsProps(AComponent: TComponent; StoredList: TStrings);
  851. var
  852.   Info: TStrings;
  853.   I, Idx: Integer;
  854.   Props: TPropInfoList;
  855.   CompName, PropName: string;
  856. begin
  857.   Info := CreateInfoList(AComponent, StoredList);
  858.   if Info <> nil then
  859.   try
  860.     FOwner := AComponent;
  861.     for I := 0 to StoredList.Count - 1 do begin
  862.       if ParseStoredItem(StoredList[I], CompName, PropName) then begin
  863.         AObject := StoredList.Objects[I];
  864.         Prefix := TComponent(AObject).Name;
  865.         Idx := Info.IndexOf(Prefix);
  866.         if Idx >= 0 then begin
  867.           Prefix := Prefix + sPropNameDelimiter;
  868.           Props := TPropInfoList(Info.Objects[Idx]);
  869.           if Props <> nil then LoadAnyProperty(Props.Find(PropName));
  870.         end;
  871.       end;
  872.     end;
  873.   finally
  874.     FOwner := nil;
  875.     FreeInfoLists(Info);
  876.   end;
  877. end;
  878.  
  879. procedure TPropsStorage.StoreObjectsProps(AComponent: TComponent; StoredList: TStrings);
  880. var
  881.   Info: TStrings;
  882.   I, Idx: Integer;
  883.   Props: TPropInfoList;
  884.   CompName, PropName: string;
  885. begin
  886.   Info := CreateInfoList(AComponent, StoredList);
  887.   if Info <> nil then
  888.   try
  889.     FOwner := AComponent;
  890.     for I := 0 to StoredList.Count - 1 do begin
  891.       if ParseStoredItem(StoredList[I], CompName, PropName) then begin
  892.         AObject := StoredList.Objects[I];
  893.         Prefix := TComponent(AObject).Name;
  894.         Idx := Info.IndexOf(Prefix);
  895.         if Idx >= 0 then begin
  896.           Prefix := Prefix + sPropNameDelimiter;
  897.           Props := TPropInfoList(Info.Objects[Idx]);
  898.           if Props <> nil then StoreAnyProperty(Props.Find(PropName));
  899.         end;
  900.       end;
  901.     end;
  902.   finally
  903.     FOwner := nil;
  904.     FreeInfoLists(Info);
  905.   end;
  906. end;
  907.  
  908. function TPropsStorage.CreateStorage: TPropsStorage;
  909. begin
  910.   Result := TPropsStorage.Create;
  911. end;
  912.  
  913. function TPropsStorage.ReadString(const ASection, Item, Default: string): string;
  914. begin
  915.   if Assigned(FOnReadString) then Result := FOnReadString(ASection, Item, Default)
  916.   else Result := '';
  917. end;
  918.  
  919. procedure TPropsStorage.WriteString(const ASection, Item, Value: string);
  920. begin
  921.   if Assigned(FOnWriteString) then FOnWriteString(ASection, Item, Value);
  922. end;
  923.  
  924. procedure TPropsStorage.EraseSection(const ASection: string);
  925. begin
  926.   if Assigned(FOnEraseSection) then FOnEraseSection(ASection);
  927. end;
  928.  
  929. end.