1 { $Id: propertystorage.pas 52248 2016-04-25 12:36:52Z bart $ }
2 {
3 *****************************************************************************
4 This file is part of the Lazarus Component Library (LCL)
5
6 See the file COPYING.modifiedLGPL.txt, included in this distribution,
7 for details about the license.
8 *****************************************************************************
9 }
10 unit PropertyStorage;
11
12 {$mode objfpc}{$H+}
13
14 interface
15
16
17 uses
18 Classes, SysUtils, RTLConsts, RTTIUtils;
19
20 Type
21 TPlacementOperation = (poSave, poRestore);
22 TCustomPropertyStorage = Class;
23 TStoredValue = Class;
24 TStoredValues = Class;
25
26 { TStoredValue }
27
28 {$ifdef storevariant}
29 TStoredType = Variant;
30 {$else}
31 TStoredType = AnsiString;
32 {$endif}
33
34 TStoredValueEvent = procedure(Sender: TStoredValue;
35 var Value: TStoredType) of object;
36
37 TStoredValue = class(TCollectionItem)
38 private
39 FName: string;
40 FValue: TStoredType;
41 FKeyString: string;
42 FOnSave: TStoredValueEvent;
43 FOnRestore: TStoredValueEvent;
IsValueStorednull44 function IsValueStored: Boolean;
GetStoredValuesnull45 function GetStoredValues: TStoredValues;
46 protected
GetDisplayNamenull47 function GetDisplayName: string; override;
48 procedure SetDisplayName(const AValue: string); override;
49 public
50 constructor Create(ACollection: TCollection); override;
51 procedure Assign(Source: TPersistent); override;
52 procedure Clear;
53 procedure Save; virtual;
54 procedure Restore; virtual;
55 property StoredValues: TStoredValues read GetStoredValues;
56 published
57 property Name: string read FName write SetDisplayName;
58 property Value: TStoredType read FValue write FValue stored IsValueStored;
59 property KeyString: string read FKeyString write FKeyString;
60 property OnSave: TStoredValueEvent read FOnSave write FOnSave;
61 property OnRestore: TStoredValueEvent read FOnRestore write FOnRestore;
62 end;
63
64
65 { TStoredValues }
66
67 TStoredValues = class(TOwnedCollection)
68 private
69 FStorage: TCustomPropertyStorage;
GetValuenull70 function GetValue(const AName: string): TStoredValue;
71 procedure SetValue(const AName: string; AStoredValue: TStoredValue);
GetStoredValuenull72 function GetStoredValue(const AName: string): TStoredType;
73 procedure SetStoredValue(const AName: string; Value: TStoredType);
GetItemnull74 function GetItem(Index: Integer): TStoredValue;
75 procedure SetItem(Index: Integer; AStoredValue: TStoredValue);
76 public
77 constructor Create(AOwner: TPersistent);
IndexOfnull78 function IndexOf(const AName: string): Integer;
79 procedure SaveValues; virtual;
80 procedure RestoreValues; virtual;
81 property Storage: TCustomPropertyStorage read FStorage write FStorage;
82 property Items[Index: Integer]: TStoredValue read GetItem write SetItem; default;
83 property Values[const Name: string]: TStoredValue read GetValue write SetValue;
84 property StoredValue[const Name: string]: TStoredType read GetStoredValue write SetStoredValue;
85 end;
86
87
88 { TCustomPropertyStorage }
89
90 TPropertyStorageLink = class(TPersistent)
91 private
92 FStorage: TCustomPropertyStorage;
93 FOnSave: TNotifyEvent;
94 FOnLoad: TNotifyEvent;
GetRootSectionnull95 function GetRootSection: string;
96 procedure SetStorage(Value: TCustomPropertyStorage);
97 protected
98 procedure SaveProperties; virtual;
99 procedure LoadProperties; virtual;
100 public
101 destructor Destroy; override;
102 property Storage: TCustomPropertyStorage read FStorage write SetStorage;
103 property RootSection: string read GetRootSection;
104 property OnSave: TNotifyEvent read FOnSave write FOnSave;
105 property OnLoad: TNotifyEvent read FOnLoad write FOnLoad;
106 end;
107
108 { TCustomPropertyStorage }
109
110 TPropertyStorageSaveExceptionEvent = procedure(Sender: TObject;
111 const ExClassName: String;
112 const ExMessage: String) of object;
113
114 TCustomPropertyStorage = Class (TComponent)
115 private
116 FOnRestoringProperties: TNotifyEvent;
117 FOnSavingProperties: TNotifyEvent;
118 FStoredValues: TStoredValues;
119 FActive: Boolean;
120 FLinks: TList;
121 FSaved: Boolean;
122 FOnSaveProperties: TNotifyEvent;
123 FOnRestoreProperties: TNotifyEvent;
124 FOnSaveException:TPropertyStorageSaveExceptionEvent;
125 procedure AddLink(ALink: TPropertyStorageLink);
126 procedure RemoveLink(ALink: TPropertyStorageLink);
127 procedure NotifyLinks(Operation: TPlacementOperation);
128 procedure SetStoredValues(Value: TStoredValues);
GetStoredValuenull129 function GetStoredValue(const AName: string): TStoredType;
130 procedure SetStoredValue(const AName: string; Value: TStoredType);
131 protected
GetRootnull132 function GetRoot: TComponent; virtual;
RootSectionnull133 function RootSection: String; Virtual;
134 procedure SaveProperties; virtual;
135 procedure RestoreProperties; virtual;
136 procedure GetPropertyList(List: TStrings); virtual; abstract;
137 procedure FinishPropertyList(List: TStrings); virtual;
DoReadIntegernull138 function DoReadInteger(const Section, Ident : String; DefaultValue: Integer): Integer; Virtual;
DoReadStringnull139 function DoReadString(const Section, Ident, DefaultValue: string): string; Virtual; Abstract;
140 procedure DoWriteString(const Section, Ident, Value: string); Virtual; Abstract;
141 procedure DoWriteInteger(const Section, Ident : String; Value: Integer); Virtual;
142 procedure DoEraseSections(const ARootSection : String);virtual;abstract;
143 public
144 constructor Create(AOwner: TComponent); override;
145 destructor Destroy; override;
146 procedure Save; virtual;
147 procedure Restore; virtual;
148 // Public Read/Write methods
149 procedure StorageNeeded(ReadOnly: Boolean);Virtual;
150 procedure FreeStorage; Virtual;
ReadBooleannull151 function ReadBoolean(const Ident: string; DefaultValue: Boolean): Boolean;
ReadStringnull152 function ReadString(const Ident, DefaultValue: string): string;
ReadIntegernull153 function ReadInteger(const Ident: string; DefaultValue: Longint): Longint;
154 procedure ReadRect(const Ident: string; out ARect: TRect;
155 const Default: TRect);
156 procedure ReadStrings(const Ident: string; const List: TStrings;
157 const DefaultList: TStrings = nil);
158 procedure WriteString(const Ident, Value: string);
159 procedure WriteInteger(const Ident: string; Value: Longint);
160 procedure WriteBoolean(const Ident: string; Value: Boolean);
161 procedure WriteRect(const Ident: string; const Value: TRect);
162 procedure WriteStrings(const Ident: string; const List: TStrings);
163 procedure EraseSections;
164 public
165 property StoredValue[const AName: string]: TStoredType read GetStoredValue write SetStoredValue;
166 property Root: TComponent read GetRoot;
167 property Active: Boolean read FActive write FActive default True;
168 property StoredValues: TStoredValues read FStoredValues write SetStoredValues;
169 property OnSavingProperties: TNotifyEvent read FOnSavingProperties write FOnSavingProperties;
170 property OnSaveProperties: TNotifyEvent read FOnSaveProperties write FOnSaveProperties;
171 property OnRestoringProperties: TNotifyEvent read FOnRestoringProperties write FOnRestoringProperties;
172 property OnRestoreProperties: TNotifyEvent read FOnRestoreProperties write FOnRestoreProperties;
173 property OnSaveException: TPropertyStorageSaveExceptionEvent read FOnSaveException write FOnSaveException;
174 end;
175
176 implementation
177
XorEncodenull178 function XorEncode(const Key, Source: string): string;
179 var
180 I: Integer;
181 C: Byte;
182 begin
183 Result := '';
184 for I := 1 to Length(Source) do begin
185 if Length(Key) > 0 then
186 C := Byte(Key[1 + ((I - 1) mod Length(Key))]) xor Byte(Source[I])
187 else
188 C := Byte(Source[I]);
189 Result := Result + AnsiLowerCase(IntToHex(C, 2));
190 end;
191 end;
192
XorDecodenull193 function XorDecode(const Key, Source: string): string;
194 var
195 I: Integer;
196 C: Char;
197
198 begin
199 Result := '';
200 for I := 0 to Length(Source) div 2 - 1 do begin
201 C := Chr(StrToIntDef('$' + Copy(Source, (I * 2) + 1, 2), Ord(' ')));
202 if Length(Key) > 0 then
203 C := Chr(Byte(Key[1 + (I mod Length(Key))]) xor Byte(C));
204 Result := Result + C;
205 end;
206 end;
207
208
209 { TPropertyStorageLink }
210
211 destructor TPropertyStorageLink.Destroy;
212 begin
213 FOnSave := nil;
214 FOnLoad := nil;
215 SetStorage(nil);
216 inherited Destroy;
217 end;
218
TPropertyStorageLink.GetRootSectionnull219 function TPropertyStorageLink.GetRootSection: string;
220 begin
221 if Assigned(FStorage) then
222 Result:=FStorage.RootSection
223 else
224 Result:='';
225 if Result<>'' then
226 Result:=Result+'\';
227 end;
228
229 procedure TPropertyStorageLink.SetStorage(Value: TCustomPropertyStorage);
230 begin
231 if FStorage <> Value then
232 begin
233 if FStorage <> nil then
234 FStorage.RemoveLink(Self);
235 if Value <> nil then
236 Value.AddLink(Self);
237 end;
238 end;
239
240 procedure TPropertyStorageLink.SaveProperties;
241 begin
242 if Assigned(FOnSave) then
243 FOnSave(Self);
244 end;
245
246 procedure TPropertyStorageLink.LoadProperties;
247 begin
248 if Assigned(FOnLoad) then
249 FOnLoad(Self);
250 end;
251
252 { TStoredValue }
253
254 constructor TStoredValue.Create(ACollection: TCollection);
255 begin
256 inherited Create(ACollection);
257 {$ifdef storevariant}
258 FValue := Unassigned;
259 {$else}
260 FValue:='';
261 {$endif}
262 end;
263
264 procedure TStoredValue.Assign(Source: TPersistent);
265 begin
266 if (Source is TStoredValue) and (Source <> nil) then
267 begin
268 {$ifdef storevariant}
269 if VarIsEmpty(TStoredValue(Source).FValue) then
270 Clear
271 else
272 {$endif}
273 Value := TStoredValue(Source).FValue;
274 Name := TStoredValue(Source).Name;
275 KeyString := TStoredValue(Source).KeyString;
276 end;
277 end;
278
TStoredValue.GetDisplayNamenull279 function TStoredValue.GetDisplayName: string;
280 begin
281 if FName = '' then
282 Result := inherited GetDisplayName
283 else
284 Result := FName;
285 end;
286
287 procedure TStoredValue.SetDisplayName(const AValue: string);
288 begin
289 if (AValue <> '') and (AnsiCompareText(AValue, FName) <> 0)
290 and (Collection is TStoredValues)
291 and (TStoredValues(Collection).IndexOf(AValue) >= 0) then
292 raise Exception.Create(SDuplicateString);
293 FName := AValue;
294 inherited;
295 end;
296
TStoredValue.GetStoredValuesnull297 function TStoredValue.GetStoredValues: TStoredValues;
298 begin
299 if Collection is TStoredValues then
300 Result := TStoredValues(Collection)
301 else
302 Result := nil;
303 end;
304
305 procedure TStoredValue.Clear;
306 begin
307 {$ifdef storevariant}
308 FValue := Unassigned;
309 {$else}
310 FValue := '';
311 {$endif}
312 end;
313
TStoredValue.IsValueStorednull314 function TStoredValue.IsValueStored: Boolean;
315 begin
316 {$ifdef storevariant}
317 Result := not VarIsEmpty(FValue);
318 {$else}
319 Result := (FValue<>'');
320 {$endif}
321 end;
322
323 procedure TStoredValue.Save;
324 var
325 SaveValue: TStoredType;
326 SaveStrValue: string;
327 begin
328 SaveValue := Value;
329 if Assigned(FOnSave) then
330 FOnSave(Self, SaveValue);
331 {$ifdef storevariant}
332 SaveStrValue := VarToStr(SaveValue);
333 {$else}
334 SaveStrValue := SaveValue;
335 {$endif}
336 if KeyString <> '' then
337 SaveStrValue := XorEncode(KeyString, SaveStrValue);
338 StoredValues.Storage.WriteString(Name, SaveStrValue);
339 end;
340
341 procedure TStoredValue.Restore;
342 var
343 RestoreValue: TStoredType;
344 RestoreStrValue, DefaultStrValue: string;
345 begin
346 {$ifdef storevariant}
347 DefaultStrValue := VarToStr(Value);
348 {$else}
349 DefaultStrValue := Value;
350 {$endif}
351 if KeyString <> '' then
352 DefaultStrValue := XorEncode(KeyString, DefaultStrValue);
353 RestoreStrValue := StoredValues.Storage.ReadString(Name, DefaultStrValue);
354 if KeyString <> '' then
355 RestoreStrValue := XorDecode(KeyString, RestoreStrValue);
356 RestoreValue := RestoreStrValue;
357 if Assigned(FOnRestore) then
358 FOnRestore(Self, RestoreValue);
359 Value := RestoreValue;
360 end;
361
362 { TStoredValues }
363
364 constructor TStoredValues.Create(AOwner: TPersistent);
365 begin
366 inherited Create(AOwner, TStoredValue);
367 If AOwner is TCustomPropertyStorage then
368 FStorage:=TCustomPropertyStorage(AOwner);
369 end;
370
IndexOfnull371 function TStoredValues.IndexOf(const AName: string): Integer;
372 begin
373 for Result := 0 to Count - 1 do
374 if AnsiCompareText(Items[Result].Name, AName) = 0 then Exit;
375 Result := -1;
376 end;
377
GetItemnull378 function TStoredValues.GetItem(Index: Integer): TStoredValue;
379 begin
380 Result := TStoredValue(inherited Items[Index]);
381 end;
382
383 procedure TStoredValues.SetItem(Index: Integer; AStoredValue: TStoredValue);
384 begin
385 inherited SetItem(Index, TCollectionItem(AStoredValue));
386 end;
387
TStoredValues.GetStoredValuenull388 function TStoredValues.GetStoredValue(const AName: string): TStoredType;
389 var
390 AStoredValue: TStoredValue;
391 begin
392 AStoredValue := GetValue(AName);
393 if AStoredValue = nil then
394 {$ifdef storevariant}
395 Result := Null
396 {$else}
397 Result := ''
398 {$endif}
399 else
400 Result := AStoredValue.Value;
401 end;
402
403 procedure TStoredValues.SetStoredValue(const AName: string; Value: TStoredType);
404 var
405 AStoredValue: TStoredValue;
406 begin
407 AStoredValue := GetValue(AName);
408 if AStoredValue = nil then begin
409 AStoredValue := TStoredValue(Add);
410 AStoredValue.Name := AName;
411 AStoredValue.Value := Value;
412 end
413 else AStoredValue.Value := Value;
414 end;
415
TStoredValues.GetValuenull416 function TStoredValues.GetValue(const AName: string): TStoredValue;
417 var
418 I: Integer;
419 begin
420 I := IndexOf(AName);
421 if I < 0 then
422 Result := nil
423 else
424 Result := Items[I];
425 end;
426
427 procedure TStoredValues.SetValue(const AName: string; AStoredValue: TStoredValue);
428 var
429 I: Integer;
430 begin
431 I := IndexOf(AName);
432 if I >= 0 then
433 Items[I].Assign(AStoredValue);
434 end;
435
436 procedure TStoredValues.SaveValues;
437 var
438 I: Integer;
439 begin
440 for I := 0 to Count - 1 do
441 Items[I].Save;
442 end;
443
444 procedure TStoredValues.RestoreValues;
445 var
446 I: Integer;
447 begin
448 for I := 0 to Count - 1 do
449 Items[I].Restore;
450 end;
451
452 { TCustomPropertyStorage }
453
454 constructor TCustomPropertyStorage.Create(AOwner: TComponent);
455 begin
456 inherited Create(AOwner);
457 FActive := True;
458 FLinks := TList.Create;
459 FStoredValues:=TStoredValues.Create(Self);
460 FStoredValues.Storage:=Self;
461 end;
462
463 destructor TCustomPropertyStorage.Destroy;
464 begin
465 FreeStorage;
466 FStoredValues.Free;
467 while FLinks.Count > 0 do
468 RemoveLink(TPropertyStorageLink(FLinks.Last));
469 FreeAndNil(FLinks);
470 inherited Destroy;
471 end;
472
473 procedure TCustomPropertyStorage.AddLink(ALink: TPropertyStorageLink);
474 begin
475 FLinks.Add(ALink);
476 ALink.FStorage := Self;
477 end;
478
479 procedure TCustomPropertyStorage.NotifyLinks(Operation: TPlacementOperation);
480 var
481 I: Integer;
482 begin
483 for I := 0 to FLinks.Count - 1 do
484 with TPropertyStorageLink(FLinks[I]) do
485 case Operation of
486 poSave: SaveProperties;
487 poRestore: LoadProperties;
488 end;
489 end;
490
491 procedure TCustomPropertyStorage.RemoveLink(ALink: TPropertyStorageLink);
492 begin
493 ALink.FStorage := nil;
494 FLinks.Remove(ALink);
495 end;
496
GetRootnull497 function TCustomPropertyStorage.GetRoot: TComponent;
498 begin
499 Result:=Owner;
500 end;
501
TCustomPropertyStorage.RootSectionnull502 function TCustomPropertyStorage.RootSection : string;
503
504 var
505 ARoot: TPersistent;
506 Prepend: String;
507
508 begin
509 Result:='';
510 ARoot:=Root;
511 while ARoot<>nil do begin
512 if (ARoot is TComponent) and (TComponent(ARoot).Name<>'') then
513 Prepend:=TComponent(ARoot).Name
514 else begin
515 Prepend:=ARoot.ClassName;
516 ARoot:=nil;
517 end;
518 if Result<>'' then
519 Result:=Prepend+'.'+Result
520 else
521 Result:=Prepend;
522 if not (ARoot is TComponent) then break;
523 ARoot:=TComponent(ARoot).Owner;
524 end;
525 end;
526
527
528 procedure TCustomPropertyStorage.Save;
529 begin
530 if Active and not (csDesigning in ComponentState) then begin
531 StorageNeeded(False);
532 Try
533 if Assigned(FOnSavingProperties) then
534 FOnSavingProperties(Self);
535 try
536 SaveProperties;
537 FStoredValues.SaveValues;
538 NotifyLinks(poSave);
539 if Assigned(FOnSaveProperties) then
540 FOnSaveProperties(Self);
541 FSaved := True;
542 except
543 on E: Exception do
544 begin
545 if Assigned(FOnSaveException) then
546 FOnSaveException(Self, E.ClassName, E.Message);
547 end;
548 end;
549 Finally
550 FreeStorage;
551 end;
552 end;
553 end;
554
555 procedure TCustomPropertyStorage.Restore;
556 begin
557 if Active and not (csDesigning in ComponentState) then begin
558 FSaved := False;
559 StorageNeeded(True);
560 try
561 if Assigned(FOnRestoringProperties) then
562 FOnRestoringProperties(Self);
563 FStoredValues.RestoreValues;
564 RestoreProperties;
565 NotifyLinks(poRestore);
566 if Assigned(FOnRestoreProperties) then
567 FOnRestoreProperties(Self);
568 finally
569 FreeStorage;
570 end;
571 end;
572 end;
573
574 procedure TCustomPropertyStorage.SaveProperties;
575
576 Var
577 AStoredList : TStringList;
578 begin
579 AStoredList:=TStringList.Create;
580 Try
581 GetPropertyList(AStoredList);
582 FinishPropertyList(AStoredList);
583 StorageNeeded(False);
584 Try
585 with TPropsStorage.Create do
586 try
587 Section := RootSection;
588 OnWriteString := @DoWriteString;
589 OnEraseSection := @DoEraseSections;
590 StoreObjectsProps(Owner,AStoredList);
591 finally
592 Free;
593 end;
594 Finally
595 FreeStorage;
596 end;
597 finally
598 AStoredList.Free;
599 end;
600 end;
601
602 procedure TCustomPropertyStorage.RestoreProperties;
603
604 Var
605 L : TStringList;
606
607 begin
608 L:=TStringList.Create;
609 Try
610 GetPropertyList(L);
611 FinishPropertyList(L);
612 StorageNeeded(True);
613 Try
614 with TPropsStorage.Create do
615 try
616 Section := RootSection;
617 OnReadString := @DoReadString;
618 try
619 LoadObjectsProps(Owner,L);
620 except
621 { ignore any exceptions }
622 // ToDo: Why?
623 end;
624 finally
625 Free;
626 end;
627 Finally
628 FreeStorage;
629 end;
630 finally
631 L.Free;
632 end;
633 end;
634
635 procedure TCustomPropertyStorage.FinishPropertyList(List: TStrings);
636 var
637 i: Integer;
638 CompName: string;
639 PropName: string;
640 ARoot: TComponent;
641 AComponent: TComponent;
642 begin
643 // set Objects (i.e. the component of each property)
644 ARoot:=Root;
645 for i:=List.Count-1 downto 0 do begin
646 if ParseStoredItem(List[I], CompName, PropName) then begin
647 if CompareText(ARoot.Name,CompName)=0 then
648 List.Objects[i]:=ARoot
649 else begin
650 AComponent:=Root.FindComponent(CompName);
651 if AComponent<>nil then
652 List.Objects[i]:=AComponent
653 else
654 List.Delete(i);
655 end;
656 end else begin
657 List.Delete(i);
658 end;
659 end;
660 end;
661
TCustomPropertyStorage.DoReadIntegernull662 function TCustomPropertyStorage.DoReadInteger(const Section, Ident: String;
663 DefaultValue: Integer): Integer;
664 begin
665 Result:=StrToIntDef(DoReadString(Section,Ident,IntToStr(DefaultValue)),DefaultValue);
666 end;
667
668 procedure TCustomPropertyStorage.DoWriteInteger(const Section, Ident: String;
669 Value: Integer);
670 begin
671 DoWriteString(Section,Ident,IntToStr(Value))
672 end;
673
674 procedure TCustomPropertyStorage.StorageNeeded(ReadOnly: Boolean);
675 begin
676 end;
677
678 procedure TCustomPropertyStorage.FreeStorage;
679 begin
680 end;
681
ReadStringnull682 function TCustomPropertyStorage.ReadString(const Ident, DefaultValue: string): string;
683 begin
684 StorageNeeded(True);
685 try
686 Result := DoReadString(RootSection, Ident, DefaultValue);
687 finally
688 FreeStorage;
689 end;
690 end;
691
692 procedure TCustomPropertyStorage.WriteString(const Ident, Value: string);
693 begin
694 StorageNeeded(False);
695 try
696 DoWriteString(RootSection, Ident, Value);
697 finally
698 FreeStorage;
699 end;
700 end;
701
TCustomPropertyStorage.ReadIntegernull702 function TCustomPropertyStorage.ReadInteger(const Ident: string; DefaultValue: Longint): Longint;
703 begin
704 StorageNeeded(True);
705 try
706 Result := DoReadInteger(RootSection, Ident, DefaultValue);
707 finally
708 FreeStorage;
709 end;
710 end;
711
ReadBooleannull712 function TCustomPropertyStorage.ReadBoolean(const Ident: string; DefaultValue: Boolean): Boolean;
713 begin
714 Result := ReadInteger(Ident, Ord(DefaultValue)) <> Ord(False);
715 end;
716
717 procedure TCustomPropertyStorage.ReadRect(const Ident: string;
718 out ARect: TRect; const Default: TRect);
719 begin
720 ARect.Left:=ReadInteger(Ident+'Left',Default.Left);
721 ARect.Top:=ReadInteger(Ident+'Top',Default.Top);
722 ARect.Right:=ReadInteger(Ident+'Right',Default.Right);
723 ARect.Bottom:=ReadInteger(Ident+'Bottom',Default.Bottom);
724 end;
725
726 procedure TCustomPropertyStorage.ReadStrings(const Ident: string;
727 const List: TStrings; const DefaultList: TStrings);
728 var
729 sl: TStringList;
730 NewCount: LongInt;
731 i: Integer;
732 begin
733 if ReadString(Ident+'Count','')='' then begin
734 // use default
735 if DefaultList<>nil then
736 List.Assign(DefaultList)
737 else
738 List.Clear;
739 exit;
740 end;
741 // read list into a temporary list and then use Assign to copy in one step
742 sl:=TStringList.Create;
743 try
744 NewCount:=ReadInteger(Ident+'Count',0);
745 for i:=0 to NewCount-1 do
746 sl.Add(ReadString(Ident+'Item'+IntToStr(i+1),''));
747 List.Assign(sl);
748 finally
749 sl.Free;
750 end;
751 end;
752
753 procedure TCustomPropertyStorage.WriteInteger(const Ident: string; Value: Longint);
754 begin
755 StorageNeeded(False);
756 try
757 DoWriteInteger(RootSection, Ident, Value);
758 finally
759 FreeStorage;
760 end;
761 end;
762
763 procedure TCustomPropertyStorage.WriteBoolean(const Ident: string; Value: Boolean);
764 begin
765 WriteInteger(Ident, Ord(Value));
766 end;
767
768 procedure TCustomPropertyStorage.WriteRect(const Ident: string;
769 const Value: TRect);
770 begin
771 WriteInteger(Ident+'Left',Value.Left);
772 WriteInteger(Ident+'Top',Value.Top);
773 WriteInteger(Ident+'Right',Value.Right);
774 WriteInteger(Ident+'Bottom',Value.Bottom);
775 end;
776
777 procedure TCustomPropertyStorage.WriteStrings(const Ident: string;
778 const List: TStrings);
779 var
780 i: Integer;
781 begin
782 WriteInteger(Ident+'Count',List.Count);
783 for i:=0 to List.Count-1 do
784 WriteString(Ident+'Item'+IntToStr(i+1),List[i]);
785 end;
786
787 procedure TCustomPropertyStorage.EraseSections;
788 begin
789 StorageNeeded(False);
790 try
791 DoEraseSections(RootSection);
792 finally
793 FreeStorage;
794 end;
795 end;
796
797 procedure TCustomPropertyStorage.SetStoredValues(Value: TStoredValues);
798 begin
799 FStoredValues.Assign(Value);
800 end;
801
GetStoredValuenull802 function TCustomPropertyStorage.GetStoredValue(const AName: string): TStoredType;
803 begin
804 Result := StoredValues.StoredValue[AName];
805 end;
806
807 procedure TCustomPropertyStorage.SetStoredValue(const AName: string; Value: TStoredType);
808 begin
809 StoredValues.StoredValue[AName] := Value;
810 end;
811
812
813 end.
814