/components/rx/placement.pp

   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{$mode objfpc}
  11{$h+}
  12
  13unit Placement;
  14
  15interface
  16
  17uses Controls, Classes, LazUTF8, Forms, IniFiles, Dialogs, RTTIUtils;
  18
  19  
  20type
  21  TPlacementOption = (fpState, fpPosition, fpActiveControl);
  22  TPlacementOptions = set of TPlacementOption;
  23  TPlacementOperation = (poSave, poRestore);
  24
  25  TIniLink       = Class;
  26  TFormPlacement = Class;
  27  TStoredValue   = Class;
  28  TStoredValues  = Class;
  29  
  30
  31{ TStoredValue }
  32
  33{$ifdef storevariant}
  34  TStoredType = Variant;
  35{$else}
  36  TStoredType = AnsiString;
  37{$endif}  
  38
  39  TStoredValueEvent = procedure(Sender: TStoredValue; var Value: TStoredType) of object;
  40
  41  TStoredValue = class(TCollectionItem)
  42  private
  43    FName: string;
  44    FValue: TStoredType;
  45    FKeyString: string;
  46    FOnSave: TStoredValueEvent;
  47    FOnRestore: TStoredValueEvent;
  48    function IsValueStored: Boolean;
  49    function GetStoredValues: TStoredValues;
  50  protected
  51    function GetDisplayName: string; override;
  52    procedure SetDisplayName(const Value: string); override;
  53  public
  54    constructor Create(ACollection: TCollection); override;
  55    procedure Assign(Source: TPersistent); override;
  56    procedure Clear;
  57    procedure Save; virtual;
  58    procedure Restore; virtual;
  59    property StoredValues: TStoredValues read GetStoredValues;
  60  published
  61    property Name: string read FName write SetDisplayName;
  62    property Value: TStoredType read FValue write FValue stored IsValueStored;
  63    property KeyString: string read FKeyString write FKeyString;
  64    property OnSave: TStoredValueEvent read FOnSave write FOnSave;
  65    property OnRestore: TStoredValueEvent read FOnRestore write FOnRestore;
  66  end;
  67
  68{ TStoredValues }
  69
  70  TStoredValues = class(TOwnedCollection)
  71  private
  72    FStorage: TFormPlacement;
  73    function GetValue(const AName: string): TStoredValue;
  74    procedure SetValue(const AName: string; StoredValue: TStoredValue);
  75    function GetStoredValue(const AName: string): TStoredType;
  76    procedure SetStoredValue(const AName: string; Value: TStoredType);
  77    function GetItem(Index: Integer): TStoredValue;
  78    procedure SetItem(Index: Integer; StoredValue: TStoredValue);
  79  public
  80    constructor Create(AOwner: TPersistent);
  81    function IndexOf(const AName: string): Integer;
  82    procedure SaveValues; virtual;
  83    procedure RestoreValues; virtual;
  84    property Storage: TFormPlacement read FStorage write FStorage;
  85    property Items[Index: Integer]: TStoredValue read GetItem write SetItem; default;
  86    property Values[const Name: string]: TStoredValue read GetValue write SetValue;
  87    property StoredValue[const Name: string]: TStoredType read GetStoredValue write SetStoredValue;
  88  end;
  89
  90{ TFormPlacement }
  91
  92  TFormPlacement = class(TComponent)
  93  private
  94    FActive: Boolean;
  95    FIniFileName: String;
  96    FIniSection: String;
  97    FIniFile: TCustomIniFile;
  98    FLinks: TList;
  99    FOptions: TPlacementOptions;
 100    FVersion: Integer;
 101    FSaved: Boolean;
 102    FRestored: Boolean;
 103    FDestroying: Boolean;
 104    //FDefMaximize: Boolean;
 105    FSaveFormShow: TNotifyEvent;
 106    FSaveFormDestroy: TNotifyEvent;
 107    FSaveFormCloseQuery: TCloseQueryEvent;
 108    FOnSavePlacement: TNotifyEvent;
 109    FOnRestorePlacement: TNotifyEvent;
 110    procedure SetEvents;
 111    procedure RestoreEvents;
 112    function  GetIniSection: string;
 113    procedure SetIniSection(const Value: string);
 114    function  GetIniFileName: string;
 115    procedure SetIniFileName(const Value: string);
 116    procedure AddLink(ALink: TIniLink);
 117    procedure NotifyLinks(Operation: TPlacementOperation);
 118    procedure RemoveLink(ALink: TIniLink);
 119    procedure FormShow(Sender: TObject);
 120    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 121    procedure FormDestroy(Sender: TObject);
 122    function GetForm: TForm;
 123  protected
 124    procedure IniNeeded(ReadOnly: Boolean);Virtual;
 125    procedure IniFree;Virtual;
 126    procedure Loaded; override;
 127    procedure Save; dynamic;
 128    procedure Restore; dynamic;
 129    procedure SavePlacement; virtual;
 130    procedure RestorePlacement; virtual;
 131    function  DoReadString(const Section, Ident, Default: string): string; virtual;
 132    procedure DoWriteString(const Section, Ident, Value: string); virtual;
 133    property  Form: TForm read GetForm;
 134  public
 135    constructor Create(AOwner: TComponent); override;
 136    destructor Destroy; override;
 137    procedure SaveFormPlacement;
 138    procedure RestoreFormPlacement;
 139    function ReadString(const Ident, Default: string): string;
 140    procedure WriteString(const Ident, Value: string);
 141    function ReadInteger(const Ident: string; Default: Longint): Longint;
 142    procedure WriteInteger(const Ident: string; Value: Longint);
 143    procedure EraseSections;
 144    property IniFile: TCustomIniFile read FIniFile;
 145  published
 146    property Active: Boolean read FActive write FActive default True;
 147    property IniFileName: string read GetIniFileName write SetIniFileName;
 148    property IniSection: string read GetIniSection write SetIniSection;
 149    property Options: TPlacementOptions read FOptions write FOptions default [fpState, fpPosition];
 150    property Version: Integer read FVersion write FVersion default 0;
 151    property OnSavePlacement: TNotifyEvent read FOnSavePlacement write FOnSavePlacement;
 152    property OnRestorePlacement: TNotifyEvent read FOnRestorePlacement  write FOnRestorePlacement;
 153  end;
 154
 155{ TFormStorage }
 156
 157  TFormStorage = class(TFormPlacement)
 158  private
 159    FStoredProps: TStrings;
 160    FStoredValues: TStoredValues;
 161    procedure SetStoredProps(Value: TStrings);
 162    procedure SetStoredValues(Value: TStoredValues);
 163    function GetStoredValue(const AName: string): TstoredType;
 164    procedure SetStoredValue(const AName: string; Value: TStoredType);
 165  protected
 166    procedure Loaded; override;
 167    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
 168    procedure SavePlacement; override;
 169    procedure RestorePlacement; override;
 170    procedure SaveProperties; virtual;
 171    procedure RestoreProperties; virtual;
 172    procedure WriteState(Writer: TWriter); override;
 173  public
 174    constructor Create(AOwner: TComponent); override;
 175    destructor Destroy; override;
 176    procedure SetNotification;
 177    property StoredValue[const AName: string]: TStoredType read GetStoredValue write SetStoredValue;
 178  published
 179    property StoredProps: TStrings read FStoredProps write SetStoredProps;
 180    property StoredValues: TStoredValues read FStoredValues write SetStoredValues;
 181  end;
 182
 183{ TIniLink }
 184
 185  TIniLink = class(TPersistent)
 186  private
 187    FStorage: TFormPlacement;
 188    FOnSave: TNotifyEvent;
 189    FOnLoad: TNotifyEvent;
 190    function GetIniObject: TCustomIniFile;
 191    function GetRootSection: string;
 192    procedure SetStorage(Value: TFormPlacement);
 193  protected
 194    procedure SaveToIni; virtual;
 195    procedure LoadFromIni; virtual;
 196  public
 197    destructor Destroy; override;
 198    property IniObject: TCustomInifile read GetIniObject;
 199    property Storage: TFormPlacement read FStorage write SetStorage;
 200    property RootSection: string read GetRootSection;
 201    property OnSave: TNotifyEvent read FOnSave write FOnSave;
 202    property OnLoad: TNotifyEvent read FOnLoad write FOnLoad;
 203  end;
 204
 205
 206implementation
 207
 208uses SysUtils, AppUtils, RTLConsts;
 209
 210const
 211{ The following strings should not be localized }
 212  siActiveCtrl = 'ActiveControl';
 213  siVisible = 'Visible';
 214  siVersion = 'FormVersion';
 215
 216function XorEncode(const Key, Source: string): string;
 217var
 218  I: Integer;
 219  C: Byte;
 220begin
 221  Result := '';
 222  for I := 1 to Length(Source) do begin
 223    if Length(Key) > 0 then
 224      C := Byte(Key[1 + ((I - 1) mod Length(Key))]) xor Byte(Source[I])
 225    else
 226      C := Byte(Source[I]);
 227    Result := Result + AnsiLowerCase(IntToHex(C, 2));
 228  end;
 229end;
 230
 231function XorDecode(const Key, Source: string): string;
 232var
 233  I: Integer;
 234  C: Char;
 235  
 236begin
 237  Result := '';
 238  for I := 0 to Length(Source) div 2 - 1 do begin
 239    C := Chr(StrToIntDef('$' + Copy(Source, (I * 2) + 1, 2), Ord(' ')));
 240    if Length(Key) > 0 then
 241      C := Chr(Byte(Key[1 + (I mod Length(Key))]) xor Byte(C));
 242    Result := Result + C;
 243  end;
 244end;
 245                            
 246
 247Function GetDefaultIniName : String;
 248
 249begin
 250{$ifdef unix}
 251  Result:=IncludeTrailingPathDelimiter(GetEnvironmentVariableUTF8('HOME'))
 252          +'.'+ExtractFileName(Application.ExeName)
 253
 254{$else}
 255  Result:=ChangeFileExt(Application.ExeName,'.ini');
 256{$endif}
 257end;
 258
 259function FindPart(const HelpWilds, InputStr: string): Integer;
 260
 261var
 262  I, J: Integer;
 263  Diff: Integer;
 264  
 265begin
 266  I := Pos('?', HelpWilds);
 267  if I = 0 then begin
 268    { if no '?' in HelpWilds }
 269    Result := Pos(HelpWilds, InputStr);
 270    Exit;
 271  end;
 272  { '?' in HelpWilds }
 273  Diff := Length(InputStr) - Length(HelpWilds);
 274  if Diff < 0 then begin
 275    Result := 0;
 276    Exit;
 277  end;
 278  { now move HelpWilds over InputStr }
 279  for I := 0 to Diff do begin
 280    for J := 1 to Length(HelpWilds) do begin
 281      if (InputStr[I + J] = HelpWilds[J]) or
 282        (HelpWilds[J] = '?') then
 283      begin
 284        if J = Length(HelpWilds) then begin
 285          Result := I + 1;
 286          Exit;
 287        end;
 288      end
 289      else Break;
 290    end;
 291  end;
 292  Result := 0;
 293end;
 294
 295
 296
 297function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
 298
 299 function SearchNext(var Wilds: string): Integer;
 300 { looking for next *, returns position and string until position }
 301 begin
 302   Result := Pos('*', Wilds);
 303   if Result > 0 then Wilds := Copy(Wilds, 1, Result - 1);
 304 end;
 305
 306var
 307  CWild, CInputWord: Integer; { counter for positions }
 308  I, LenHelpWilds: Integer;
 309  MaxInputWord, MaxWilds: Integer; { Length of InputStr and Wilds }
 310  HelpWilds: string;
 311begin
 312  if Wilds = InputStr then begin
 313    Result := True;
 314    Exit;
 315  end;
 316  repeat { delete '**', because '**' = '*' }
 317    I := Pos('**', Wilds);
 318    if I > 0 then
 319      Wilds := Copy(Wilds, 1, I - 1) + '*' + Copy(Wilds, I + 2, MaxInt);
 320  until I = 0;
 321  if Wilds = '*' then begin { for fast end, if Wilds only '*' }
 322    Result := True;
 323    Exit;
 324  end;
 325  MaxInputWord := Length(InputStr);
 326  MaxWilds := Length(Wilds);
 327  if IgnoreCase then begin { upcase all letters }
 328    InputStr := AnsiUpperCase(InputStr);
 329    Wilds := AnsiUpperCase(Wilds);
 330  end;
 331  if (MaxWilds = 0) or (MaxInputWord = 0) then begin
 332    Result := False;
 333    Exit;
 334  end;
 335  CInputWord := 1;
 336  CWild := 1;
 337  Result := True;
 338  repeat
 339    if InputStr[CInputWord] = Wilds[CWild] then begin { equal letters }
 340      { goto next letter }
 341      Inc(CWild);
 342      Inc(CInputWord);
 343      Continue;
 344    end;
 345    if Wilds[CWild] = '?' then begin { equal to '?' }
 346      { goto next letter }
 347      Inc(CWild);
 348      Inc(CInputWord);
 349      Continue;
 350    end;
 351    if Wilds[CWild] = '*' then begin { handling of '*' }
 352      HelpWilds := Copy(Wilds, CWild + 1, MaxWilds);
 353      I := SearchNext(HelpWilds);
 354      LenHelpWilds := Length(HelpWilds);
 355      if I = 0 then begin
 356        { no '*' in the rest, compare the ends }
 357        if HelpWilds = '' then Exit; { '*' is the last letter }
 358        { check the rest for equal Length and no '?' }
 359        for I := 0 to LenHelpWilds - 1 do begin
 360          if (HelpWilds[LenHelpWilds - I] <> InputStr[MaxInputWord - I]) and
 361            (HelpWilds[LenHelpWilds - I]<> '?') then
 362          begin
 363            Result := False;
 364            Exit;
 365          end;
 366        end;
 367        Exit;
 368      end;
 369      { handle all to the next '*' }
 370      Inc(CWild, 1 + LenHelpWilds);
 371      I := FindPart(HelpWilds, Copy(InputStr, CInputWord, MaxInt));
 372      if I= 0 then begin
 373        Result := False;
 374        Exit;
 375      end;
 376      CInputWord := I + LenHelpWilds;
 377      Continue;
 378    end;
 379    Result := False;
 380    Exit;
 381  until (CInputWord > MaxInputWord) or (CWild > MaxWilds);
 382  { no completed evaluation }
 383  if CInputWord <= MaxInputWord then Result := False;
 384  if (CWild <= MaxWilds) and (Wilds[MaxWilds] <> '*') then Result := False;
 385end;
 386
 387{ TFormPlacement }
 388
 389constructor TFormPlacement.Create(AOwner: TComponent);
 390begin
 391  inherited Create(AOwner);
 392  FActive := True;
 393  if (AOwner is TForm) then
 394    FOptions := [fpState, fpPosition]
 395  else
 396    FOptions := [];
 397  FLinks := TList.Create;
 398end;
 399
 400destructor TFormPlacement.Destroy;
 401begin
 402  IniFree;
 403  while FLinks.Count > 0 do
 404    RemoveLink(TiniLink(FLinks.Last));
 405  FreeAndNil(FLinks);
 406  if not (csDesigning in ComponentState) then
 407    RestoreEvents;
 408  inherited Destroy;
 409end;
 410
 411procedure TFormPlacement.Loaded;
 412var
 413  IsLoading: Boolean;
 414begin
 415  IsLoading := csLoading in ComponentState;
 416  inherited Loaded;
 417  if not (csDesigning in ComponentState) then
 418    begin
 419    if IsLoading then
 420      SetEvents;
 421    end;
 422end;
 423
 424procedure TFormPlacement.AddLink(ALink: TIniLink);
 425begin
 426  FLinks.Add(ALink);
 427  ALink.FStorage := Self;
 428end;
 429
 430procedure TFormPlacement.NotifyLinks(Operation: TPlacementOperation);
 431var
 432  I: Integer;
 433begin
 434  for I := 0 to FLinks.Count - 1 do
 435    with TIniLink(FLinks[I]) do
 436      case Operation of
 437        poSave: SaveToIni;
 438        poRestore: LoadFromIni;
 439      end;
 440end;
 441
 442procedure TFormPlacement.RemoveLink(ALink: TIniLink);
 443begin
 444  ALink.FStorage := nil;
 445  FLinks.Remove(ALink);
 446end;
 447
 448function TFormPlacement.GetForm: TForm;
 449begin
 450  if (Owner is TCustomForm) then
 451    Result := TForm(Owner as TCustomForm)
 452  else
 453    Result := nil;
 454end;
 455
 456procedure TFormPlacement.SetEvents;
 457begin
 458  if (Owner is TCustomForm) then
 459    begin
 460    with TForm(Form) do
 461      begin
 462      FSaveFormShow := OnShow;
 463      OnShow := @FormShow;
 464      FSaveFormCloseQuery := OnCloseQuery;
 465      OnCloseQuery := @FormCloseQuery;
 466      FSaveFormDestroy := OnDestroy;
 467      OnDestroy := @FormDestroy;
 468      end;
 469    end;
 470end;
 471
 472procedure TFormPlacement.RestoreEvents;
 473begin
 474  if (Owner <> nil) and (Owner is TCustomForm) then
 475    with TForm(Form) do
 476      begin
 477      OnShow := FSaveFormShow;
 478      OnCloseQuery := FSaveFormCloseQuery;
 479      OnDestroy := FSaveFormDestroy;
 480      end;
 481end;
 482
 483
 484procedure TFormPlacement.FormShow(Sender: TObject);
 485begin
 486  if Active then
 487    try
 488      RestoreFormPlacement;
 489    except
 490      Application.HandleException(Self);
 491    end;
 492  if Assigned(FSaveFormShow) then FSaveFormShow(Sender);
 493end;
 494
 495procedure TFormPlacement.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 496begin
 497  if Assigned(FSaveFormCloseQuery) then
 498    FSaveFormCloseQuery(Sender, CanClose);
 499  if CanClose and Active and (Owner is TCustomForm) and (Form.Handle <> 0) then
 500    try
 501      SaveFormPlacement;
 502    except
 503      Application.HandleException(Self);
 504    end;
 505end;
 506
 507procedure TFormPlacement.FormDestroy(Sender: TObject);
 508begin
 509  if Active and not FSaved then
 510    begin
 511    FDestroying := True;
 512    try
 513      SaveFormPlacement;
 514    except
 515      Application.HandleException(Self);
 516    end;
 517    FDestroying := False;
 518    end;
 519  if Assigned(FSaveFormDestroy) then
 520    FSaveFormDestroy(Sender);
 521end;
 522
 523
 524
 525function TFormPlacement.GetIniFileName: string;
 526begin
 527  Result := FIniFileName;
 528  if (Result = '') and not (csDesigning in ComponentState) then
 529    Result := GetDefaultIniName;
 530end;
 531
 532procedure TFormPlacement.SetIniFileName(const Value: string);
 533begin
 534  FIniFileName:=Value;
 535end;
 536
 537function TFormPlacement.GetIniSection: string;
 538begin
 539  Result := FIniSection;
 540  if (Result = '') and not (csDesigning in ComponentState) then
 541    Result := GetDefaultSection(Owner);
 542end;
 543
 544procedure TFormPlacement.SetIniSection(const Value: string);
 545begin
 546  FIniSection:=Value;
 547end;
 548
 549procedure TFormPlacement.Save;
 550begin
 551  if Assigned(FOnSavePlacement) then
 552    FOnSavePlacement(Self);
 553end;
 554
 555procedure TFormPlacement.Restore;
 556begin
 557  if Assigned(FOnRestorePlacement) then FOnRestorePlacement(Self);
 558end;
 559
 560procedure TFormPlacement.SavePlacement;
 561begin
 562  if (Owner is TCustomForm) then
 563    begin
 564    if (Options * [fpState, fpPosition] <> []) then
 565      begin
 566      WriteFormPlacement(Form, IniFile, IniSection);
 567      IniFile.WriteBool(IniSection, siVisible, FDestroying);
 568      end;
 569    if (fpActiveControl in Options) and (Form.ActiveControl <> nil) then
 570      IniFile.WriteString(IniSection, siActiveCtrl, Form.ActiveControl.Name);
 571    end;
 572  NotifyLinks(poSave);
 573end;
 574
 575procedure TFormPlacement.RestorePlacement;
 576begin
 577  if Owner is TCustomForm then
 578    ReadFormPlacement(Form, IniFile, IniSection, fpState in Options, fpPosition in Options);
 579  NotifyLinks(poRestore);
 580end;
 581
 582procedure TFormPlacement.IniNeeded(ReadOnly: Boolean);
 583begin
 584  if ReadOnly then ;
 585  if IniFile = nil then
 586    FIniFile := TIniFile.Create(UTF8ToSys(IniFileName));
 587end;
 588
 589procedure TFormPlacement.IniFree;
 590begin
 591  if IniFile <> nil then
 592    FreeAndNil(FIniFile);
 593end;
 594
 595function TFormPlacement.DoReadString(const Section, Ident,
 596  Default: string): string;
 597begin
 598  if IniFile <> nil then
 599    Result := IniFile.ReadString(Section, Ident, Default)
 600  else
 601    begin
 602    IniNeeded(True);
 603    try
 604      Result := Inifile.ReadString(Section, Ident, Default);
 605    finally
 606      IniFree;
 607    end;
 608  end;
 609end;
 610
 611function TFormPlacement.ReadString(const Ident, Default: string): string;
 612begin
 613  Result := DoReadString(IniSection, Ident, Default);
 614end;
 615
 616procedure TFormPlacement.DoWriteString(const Section, Ident, Value: string);
 617begin
 618  if IniFile<>nil then
 619    IniFile.WriteString(Section, Ident, Value)
 620  else begin
 621    IniNeeded(False);
 622    try
 623      IniFile.WriteString(Section, Ident, Value);
 624    finally
 625      IniFree;
 626    end;
 627  end;
 628end;
 629
 630procedure TFormPlacement.WriteString(const Ident, Value: string);
 631begin
 632  DoWriteString(IniSection, Ident, Value);
 633end;
 634
 635function TFormPlacement.ReadInteger(const Ident: string; Default: Longint): Longint;
 636begin
 637  if (IniFile<>nil) then
 638    Result := IniFile.ReadInteger(IniSection, Ident, Default)
 639  else
 640    begin
 641    IniNeeded(True);
 642    try
 643      Result := Inifile.ReadInteger(IniSection, Ident, Default);
 644    finally
 645      IniFree;
 646    end;
 647  end;
 648end;
 649
 650procedure TFormPlacement.WriteInteger(const Ident: string; Value: Longint);
 651begin
 652  if IniFile<>nil then
 653    IniFile.WriteInteger(IniSection, Ident, Value)
 654  else begin
 655    IniNeeded(False);
 656    try
 657      Inifile.WriteInteger(IniSection, Ident, Value);
 658    finally
 659      IniFree;
 660    end;
 661  end;
 662end;
 663
 664
 665procedure TFormPlacement.EraseSections;
 666var
 667  Lines: TStrings;
 668  I: Integer;
 669begin
 670  if IniFile= nil then begin
 671    IniNeeded(False);
 672    try
 673      Lines := TStringList.Create;
 674      try
 675        Inifile.ReadSections(Lines);
 676        for I := 0 to Lines.Count - 1 do begin
 677          if (Lines[I] = IniSection) or
 678            (IsWild(Lines[I], IniSection + '.*', False) or
 679            IsWild(Lines[I], IniSection + '\*', False)) then
 680            Inifile.EraseSection(Lines[I]);
 681        end;
 682      finally
 683        Lines.Free;
 684      end;
 685    finally
 686      IniFree;
 687    end;
 688  end;
 689end;
 690
 691procedure TFormPlacement.SaveFormPlacement;
 692begin
 693  if FRestored or not Active then begin
 694    IniNeeded(False);
 695    try
 696      WriteInteger(siVersion, FVersion);
 697      SavePlacement;
 698      Save;
 699      FSaved := True;
 700    finally
 701      IniFree;
 702    end;
 703  end;
 704end;
 705
 706procedure TFormPlacement.RestoreFormPlacement;
 707var
 708  cActive: TComponent;
 709begin
 710  FSaved := False;
 711  IniNeeded(True);
 712  try
 713    if ReadInteger(siVersion, 0) >= FVersion then begin
 714      RestorePlacement;
 715      FRestored := True;
 716      Restore;
 717      if (fpActiveControl in Options) and (Owner is TCustomForm) then
 718        begin
 719        cActive := Form.FindComponent(Inifile.ReadString(IniSection, siActiveCtrl, ''));
 720        if (cActive <> nil) and (cActive is TWinControl) and
 721          TWinControl(cActive).CanFocus then
 722            Form.ActiveControl := TWinControl(cActive);
 723      end;
 724    end;
 725    FRestored := True;
 726  finally
 727    IniFree;
 728  end;
 729end;
 730
 731{ TFormStorage }
 732
 733constructor TFormStorage.Create(AOwner: TComponent);
 734begin
 735  inherited Create(AOwner);
 736  FStoredProps:=TStringList.Create;
 737  FStoredValues:=TStoredValues.Create(Self);
 738  FStoredValues.Storage := Self;
 739end;
 740
 741destructor TFormStorage.Destroy;
 742begin
 743  FreeAndNil(FStoredValues);
 744  FreeAndNil(FStoredProps);
 745  inherited Destroy;
 746end;
 747
 748procedure TFormStorage.SetNotification;
 749var
 750  I: Integer;
 751  Component: TComponent;
 752begin
 753  for I := FStoredProps.Count - 1 downto 0 do begin
 754    Component := TComponent(FStoredProps.Objects[I]);
 755    if Component <> nil then Component.FreeNotification(Self);
 756  end;
 757end;
 758
 759procedure TFormStorage.SetStoredProps(Value: TStrings);
 760begin
 761  FStoredProps.Assign(Value);
 762  SetNotification;
 763end;
 764
 765procedure TFormStorage.SetStoredValues(Value: TStoredValues);
 766begin
 767  FStoredValues.Assign(Value);
 768end;
 769  
 770function TFormStorage.GetStoredValue(const AName: string): TStoredType;
 771begin
 772  Result := StoredValues.StoredValue[AName];
 773end;
 774    
 775procedure TFormStorage.SetStoredValue(const AName: string; Value: TStoredType);
 776begin
 777  StoredValues.StoredValue[AName] := Value;
 778end;
 779      
 780
 781procedure TFormStorage.Loaded;
 782begin
 783  inherited Loaded;
 784  UpdateStoredList(Owner, FStoredProps, True);
 785end;
 786
 787procedure TFormStorage.WriteState(Writer: TWriter);
 788begin
 789  UpdateStoredList(Owner, FStoredProps, False);
 790  inherited WriteState(Writer);
 791end;
 792
 793procedure TFormStorage.Notification(AComponent: TComponent; Operation: TOperation);
 794var
 795  I: Integer;
 796  Component: TComponent;
 797begin
 798  inherited Notification(AComponent, Operation);
 799  if not (csDestroying in ComponentState) and (Operation = opRemove) and
 800    (FStoredProps <> nil) then
 801    for I := FStoredProps.Count - 1 downto 0 do begin
 802      Component := TComponent(FStoredProps.Objects[I]);
 803      if Component = AComponent then FStoredProps.Delete(I);
 804    end;
 805end;
 806
 807procedure TFormStorage.SaveProperties;
 808begin
 809  with TPropsStorage.Create do
 810  try
 811    Section := IniSection;
 812    OnWriteString := @DoWriteString;
 813    OnEraseSection := @IniFile.EraseSection;
 814    StoreObjectsProps(Owner, FStoredProps);
 815  finally
 816    Free;
 817  end;
 818end;
 819
 820procedure TFormStorage.RestoreProperties;
 821begin
 822  with TPropsStorage.Create do
 823  try
 824    Section := IniSection;
 825    OnReadString := @DoReadString;
 826    try
 827      LoadObjectsProps(Owner, FStoredProps);
 828    except
 829      { ignore any exceptions }
 830    end;
 831  finally
 832    Free;
 833  end;
 834end;
 835
 836procedure TFormStorage.SavePlacement;
 837begin
 838  inherited SavePlacement;
 839  SaveProperties;
 840{$IFDEF RX_D3}
 841  StoredValues.SaveValues;
 842{$ENDIF}
 843end;
 844
 845procedure TFormStorage.RestorePlacement;
 846begin
 847  inherited RestorePlacement;
 848  FRestored := True;
 849  RestoreProperties;
 850{$IFDEF RX_D3}
 851  StoredValues.RestoreValues;
 852{$ENDIF}
 853end;
 854
 855{ TIniLink }
 856
 857destructor TIniLink.Destroy;
 858begin
 859  FOnSave := nil;
 860  FOnLoad := nil;
 861  SetStorage(nil);
 862  inherited Destroy;
 863end;
 864
 865function TIniLink.GetIniObject: TCustomInifile;
 866begin
 867  if Assigned(FStorage) then
 868    Result := FStorage.IniFile
 869  else Result := nil;
 870end;
 871
 872function TIniLink.GetRootSection: string;
 873begin
 874  if Assigned(FStorage) then
 875     Result := FStorage.FIniSection
 876  else
 877    Result := '';
 878  if Result <> '' then
 879    Result := Result + '\';
 880end;
 881
 882procedure TIniLink.SetStorage(Value: TFormPlacement);
 883begin
 884  if FStorage <> Value then
 885    begin
 886    if FStorage <> nil then
 887      FStorage.RemoveLink(Self);
 888    if Value <> nil then
 889      Value.AddLink(Self);
 890  end;
 891end;
 892
 893procedure TIniLink.SaveToIni;
 894begin
 895  if Assigned(FOnSave) then FOnSave(Self);
 896end;
 897
 898procedure TIniLink.LoadFromIni;
 899begin
 900  if Assigned(FOnLoad) then FOnLoad(Self);
 901end;
 902
 903{ TStoredValue }
 904
 905constructor TStoredValue.Create(ACollection: TCollection);
 906begin
 907  inherited Create(ACollection);
 908{$ifdef storevariant}
 909  FValue := Unassigned;
 910{$else}
 911  FValue:='';
 912{$endif}
 913end;
 914
 915procedure TStoredValue.Assign(Source: TPersistent);
 916begin
 917  if (Source is TStoredValue) and (Source <> nil) then
 918    begin
 919{$ifdef storevariant}
 920    if VarIsEmpty(TStoredValue(Source).FValue) then
 921      Clear
 922    else
 923{$endif}
 924      Value := TStoredValue(Source).FValue;
 925    Name := TStoredValue(Source).Name;
 926    KeyString := TStoredValue(Source).KeyString;
 927    end;
 928end;
 929
 930function TStoredValue.GetDisplayName: string;
 931begin
 932  if FName = '' then
 933    Result := inherited GetDisplayName
 934  else
 935    Result := FName;
 936end;
 937
 938procedure TStoredValue.SetDisplayName(const Value: string);
 939begin
 940  if (Value <> '') and (AnsiCompareText(Value, FName) <> 0) and
 941    (Collection is TStoredValues) and (TStoredValues(Collection).IndexOf(Value) >= 0) then
 942    raise Exception.Create(SDuplicateString);
 943  FName := Value;
 944  inherited;
 945end;
 946
 947function TStoredValue.GetStoredValues: TStoredValues;
 948begin
 949  if Collection is TStoredValues then
 950    Result := TStoredValues(Collection)
 951  else
 952    Result := nil;
 953end;
 954
 955procedure TStoredValue.Clear;
 956begin
 957{$ifdef storevariant}
 958  FValue := Unassigned;
 959{$else}
 960  FValue := '';
 961{$endif}
 962end;
 963
 964function TStoredValue.IsValueStored: Boolean;
 965begin
 966{$ifdef storevariant}
 967  Result := not VarIsEmpty(FValue);
 968{$else}
 969  Result := (FValue<>'');
 970{$endif}
 971end;
 972
 973procedure TStoredValue.Save;
 974var
 975  SaveValue: TStoredType;
 976  SaveStrValue: string;
 977begin
 978  SaveValue := Value;
 979  if Assigned(FOnSave) then
 980    FOnSave(Self, SaveValue);
 981{$ifdef storevariant}
 982  SaveStrValue := VarToStr(SaveValue);
 983{$else}
 984  SaveStrValue := SaveValue;
 985{$endif}
 986  if KeyString <> '' then
 987    SaveStrValue := XorEncode(KeyString, SaveStrValue);
 988  StoredValues.Storage.WriteString(Name, SaveStrValue);
 989end;
 990
 991procedure TStoredValue.Restore;
 992var
 993  RestoreValue: TStoredType;
 994  RestoreStrValue, DefaultStrValue: string;
 995begin
 996{$ifdef storevariant}
 997  DefaultStrValue := VarToStr(Value);
 998{$else}
 999  DefaultStrValue := Value;
1000{$endif}
1001  if KeyString <> '' then
1002    DefaultStrValue := XorEncode(KeyString, DefaultStrValue);
1003  RestoreStrValue := StoredValues.Storage.ReadString(Name, DefaultStrValue);
1004  if KeyString <> '' then
1005    RestoreStrValue := XorDecode(KeyString, RestoreStrValue);
1006  RestoreValue := RestoreStrValue;
1007  if Assigned(FOnRestore) then
1008    FOnRestore(Self, RestoreValue);
1009  Value := RestoreValue;
1010end;
1011
1012{ TStoredValues }
1013
1014constructor TStoredValues.Create(AOwner: TPersistent);
1015begin
1016  inherited Create(AOwner, TStoredValue);
1017end;
1018
1019function TStoredValues.IndexOf(const AName: string): Integer;
1020begin
1021  for Result := 0 to Count - 1 do
1022    if AnsiCompareText(Items[Result].Name, AName) = 0 then Exit;
1023  Result := -1;
1024end;
1025
1026function TStoredValues.GetItem(Index: Integer): TStoredValue;
1027begin
1028  Result := TStoredValue(inherited Items[Index]);
1029end;
1030
1031procedure TStoredValues.SetItem(Index: Integer; StoredValue: TStoredValue);
1032begin
1033  inherited SetItem(Index, TCollectionItem(StoredValue));
1034end;
1035
1036function TStoredValues.GetStoredValue(const AName: string): TStoredType;
1037var
1038  AStoredValue: TStoredValue;
1039begin
1040  AStoredValue := GetValue(AName);
1041  if AStoredValue = nil then
1042{$ifdef storevariant}
1043    Result := Null
1044{$else}
1045    Result := ''
1046{$endif}
1047  else
1048    Result := AStoredValue.Value;
1049end;
1050
1051procedure TStoredValues.SetStoredValue(const AName: string; Value: TStoredType);
1052var
1053  AStoredValue: TStoredValue;
1054begin
1055  AStoredValue := GetValue(AName);
1056  if AStoredValue = nil then begin
1057    AStoredValue := TStoredValue(Add);
1058    AStoredValue.Name := AName;
1059    AStoredValue.Value := Value;
1060  end
1061  else AStoredValue.Value := Value;
1062end;
1063
1064function TStoredValues.GetValue(const AName: string): TStoredValue;
1065var
1066  I: Integer;
1067begin
1068  I := IndexOf(AName);
1069  if I < 0 then
1070    Result := nil
1071  else
1072    Result := Items[I];
1073end;
1074
1075procedure TStoredValues.SetValue(const AName: string; StoredValue: TStoredValue);
1076var
1077  I: Integer;
1078begin
1079  I := IndexOf(AName);
1080  if I >= 0 then
1081    Items[I].Assign(StoredValue);
1082end;
1083
1084procedure TStoredValues.SaveValues;
1085var
1086  I: Integer;
1087begin
1088  for I := 0 to Count - 1 do
1089    Items[I].Save;
1090end;
1091
1092procedure TStoredValues.RestoreValues;
1093var
1094  I: Integer;
1095begin
1096  for I := 0 to Count - 1 do
1097    Items[I].Restore;
1098end;
1099
1100end.