home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / Placemnt.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  35KB  |  1,219 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 Placemnt;
  11.  
  12. {$I RX.INC}
  13.  
  14. interface
  15.  
  16. uses RTLConsts, Windows, Registry, Variants, Controls, Messages, Classes, Forms, IniFiles, Dialogs, VclUtils, RxHook;
  17.  
  18. type
  19.   TPlacementOption = (fpState, fpPosition, fpActiveControl);
  20.   TPlacementOptions = set of TPlacementOption;
  21.   TPlacementOperation = (poSave, poRestore);
  22. {$IFDEF WIN32}
  23.   TPlacementRegRoot = (prCurrentUser, prLocalMachine, prCurrentConfig,
  24.     prClassesRoot, prUsers, prDynData);
  25. {$ENDIF}
  26.  
  27.   TIniLink = class;
  28.  
  29. { TWinMinMaxInfo }
  30.  
  31.   TFormPlacement = class;
  32.  
  33.   TWinMinMaxInfo = class(TPersistent)
  34.   private
  35.     FOwner: TFormPlacement;
  36.     FMinMaxInfo: TMinMaxInfo;
  37.     function GetMinMaxInfo(Index: Integer): Integer;
  38.     procedure SetMinMaxInfo(Index: Integer; Value: Integer);
  39.   public
  40.     function DefaultMinMaxInfo: Boolean;
  41.     procedure Assign(Source: TPersistent); override;
  42.   published
  43.     property MaxPosLeft: Integer index 0 read GetMinMaxInfo write SetMinMaxInfo default 0;
  44.     property MaxPosTop: Integer index 1 read GetMinMaxInfo write SetMinMaxInfo default 0;
  45.     property MaxSizeHeight: Integer index 2 read GetMinMaxInfo write SetMinMaxInfo default 0;
  46.     property MaxSizeWidth: Integer index 3 read GetMinMaxInfo write SetMinMaxInfo default 0;
  47.     property MaxTrackHeight: Integer index 4 read GetMinMaxInfo write SetMinMaxInfo default 0;
  48.     property MaxTrackWidth: Integer index 5 read GetMinMaxInfo write SetMinMaxInfo default 0;
  49.     property MinTrackHeight: Integer index 6 read GetMinMaxInfo write SetMinMaxInfo default 0;
  50.     property MinTrackWidth: Integer index 7 read GetMinMaxInfo write SetMinMaxInfo default 0;
  51.   end;
  52.  
  53. { TFormPlacement }
  54.  
  55.   TFormPlacement = class(TComponent)
  56.   private
  57.     FActive: Boolean;
  58.     FIniFileName: PString;
  59.     FIniSection: PString;
  60.     FIniFile: TIniFile;
  61.     FUseRegistry: Boolean;
  62. {$IFDEF WIN32}
  63.     FRegIniFile: TRegIniFile;
  64.     FRegistryRoot: TPlacementRegRoot;
  65. {$ENDIF WIN32}
  66.     FLinks: TList;
  67.     FOptions: TPlacementOptions;
  68.     FVersion: Integer;
  69.     FSaved: Boolean;
  70.     FRestored: Boolean;
  71.     FDestroying: Boolean;
  72.     FPreventResize: Boolean;
  73.     FWinMinMaxInfo: TWinMinMaxInfo;
  74.     FDefMaximize: Boolean;
  75.     FWinHook: TRxWindowHook;
  76.     FSaveFormShow: TNotifyEvent;
  77.     FSaveFormDestroy: TNotifyEvent;
  78.     FSaveFormCloseQuery: TCloseQueryEvent;
  79.     FOnSavePlacement: TNotifyEvent;
  80.     FOnRestorePlacement: TNotifyEvent;
  81.     procedure SetEvents;
  82.     procedure RestoreEvents;
  83.     procedure SetHook;
  84.     procedure ReleaseHook;
  85.     procedure CheckToggleHook;
  86.     function CheckMinMaxInfo: Boolean;
  87.     procedure MinMaxInfoModified;
  88.     procedure SetWinMinMaxInfo(Value: TWinMinMaxInfo);
  89.     function GetIniSection: string;
  90.     procedure SetIniSection(const Value: string);
  91.     function GetIniFileName: string;
  92.     procedure SetIniFileName(const Value: string);
  93.     function GetIniFile: TObject;
  94.     procedure SetPreventResize(Value: Boolean);
  95.     procedure UpdatePreventResize;
  96.     procedure UpdatePlacement;
  97.     procedure IniNeeded(ReadOnly: Boolean);
  98.     procedure IniFree;
  99.     procedure AddLink(ALink: TIniLink);
  100.     procedure NotifyLinks(Operation: TPlacementOperation);
  101.     procedure RemoveLink(ALink: TIniLink);
  102.     procedure WndMessage(Sender: TObject; var Msg: TMessage; var Handled: Boolean);
  103.     procedure FormShow(Sender: TObject);
  104.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  105.     procedure FormDestroy(Sender: TObject);
  106.     function GetForm: TForm;
  107.   protected
  108.     procedure Loaded; override;
  109.     procedure Save; dynamic;
  110.     procedure Restore; dynamic;
  111.     procedure SavePlacement; virtual;
  112.     procedure RestorePlacement; virtual;
  113.     function DoReadString(const Section, Ident, Default: string): string; virtual;
  114.     procedure DoWriteString(const Section, Ident, Value: string); virtual;
  115.     property Form: TForm read GetForm;
  116.   public
  117.     constructor Create(AOwner: TComponent); override;
  118.     destructor Destroy; override;
  119.     procedure SaveFormPlacement;
  120.     procedure RestoreFormPlacement;
  121.     function ReadString(const Ident, Default: string): string;
  122.     procedure WriteString(const Ident, Value: string);
  123.     function ReadInteger(const Ident: string; Default: Longint): Longint;
  124.     procedure WriteInteger(const Ident: string; Value: Longint);
  125.     procedure EraseSections;
  126.     property IniFileObject: TObject read GetIniFile;
  127.     property IniFile: TIniFile read FIniFile;
  128. {$IFDEF WIN32}
  129.     property RegIniFile: TRegIniFile read FRegIniFile;
  130. {$ENDIF WIN32}
  131.   published
  132.     property Active: Boolean read FActive write FActive default True;
  133.     property IniFileName: string read GetIniFileName write SetIniFileName;
  134.     property IniSection: string read GetIniSection write SetIniSection;
  135.     property MinMaxInfo: TWinMinMaxInfo read FWinMinMaxInfo write SetWinMinMaxInfo;
  136.     property Options: TPlacementOptions read FOptions write FOptions default [fpState, fpPosition];
  137.     property PreventResize: Boolean read FPreventResize write SetPreventResize default False;
  138. {$IFDEF WIN32}
  139.     property RegistryRoot: TPlacementRegRoot read FRegistryRoot write FRegistryRoot default prCurrentUser;
  140. {$ENDIF WIN32}
  141.     property UseRegistry: Boolean read FUseRegistry write FUseRegistry default False;
  142.     property Version: Integer read FVersion write FVersion default 0;
  143.     property OnSavePlacement: TNotifyEvent read FOnSavePlacement
  144.       write FOnSavePlacement;
  145.     property OnRestorePlacement: TNotifyEvent read FOnRestorePlacement
  146.       write FOnRestorePlacement;
  147.   end;
  148.  
  149. { TFormStorage }
  150.  
  151. {$IFDEF RX_D3}
  152.   TStoredValues = class;
  153.   TStoredValue = class;
  154. {$ENDIF RX_D3}
  155.  
  156.   TFormStorage = class(TFormPlacement)
  157.   private
  158.     FStoredProps: TStrings;
  159. {$IFDEF RX_D3}
  160.     FStoredValues: TStoredValues;
  161. {$ENDIF RX_D3}
  162.     procedure SetStoredProps(Value: TStrings);
  163. {$IFDEF RX_D3}
  164.     procedure SetStoredValues(Value: TStoredValues);
  165. {$ENDIF RX_D3}
  166.   protected
  167.     procedure Loaded; override;
  168.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  169.     procedure SavePlacement; override;
  170.     procedure RestorePlacement; override;
  171.     procedure SaveProperties; virtual;
  172.     procedure RestoreProperties; virtual;
  173.     procedure WriteState(Writer: TWriter); override;
  174.   public
  175.     constructor Create(AOwner: TComponent); override;
  176.     destructor Destroy; override;
  177. {$IFDEF WIN32}
  178.     procedure SetNotification;
  179. {$ENDIF WIN32}
  180.   published
  181.     property StoredProps: TStrings read FStoredProps write SetStoredProps;
  182. {$IFDEF RX_D3}
  183.     property StoredValues: TStoredValues read FStoredValues write SetStoredValues;
  184. {$ENDIF RX_D3}
  185.   end;
  186.  
  187. { TIniLink }
  188.  
  189.   TIniLink = class(TPersistent)
  190.   private
  191.     FStorage: TFormPlacement;
  192.     FOnSave: TNotifyEvent;
  193.     FOnLoad: TNotifyEvent;
  194.     function GetIniObject: TObject;
  195.     function GetRootSection: string;
  196.     procedure SetStorage(Value: TFormPlacement);
  197.   protected
  198.     procedure SaveToIni; virtual;
  199.     procedure LoadFromIni; virtual;
  200.   public
  201.     destructor Destroy; override;
  202.     property IniObject: TObject read GetIniObject;
  203.     property Storage: TFormPlacement read FStorage write SetStorage;
  204.     property RootSection: string read GetRootSection;
  205.     property OnSave: TNotifyEvent read FOnSave write FOnSave;
  206.     property OnLoad: TNotifyEvent read FOnLoad write FOnLoad;
  207.   end;
  208.  
  209. {$IFDEF RX_D3}
  210.  
  211. { TStoredValue }
  212.  
  213.   TStoredValueEvent = procedure(Sender: TStoredValue; var Value: Variant) of object;
  214.  
  215.   TStoredValue = class(TCollectionItem)
  216.   private
  217.     FName: string;
  218.     FValue: Variant;
  219.     FKeyString: string;
  220.     FOnSave: TStoredValueEvent;
  221.     FOnRestore: TStoredValueEvent;
  222.     function IsValueStored: Boolean;
  223.     function GetStoredValues: TStoredValues;
  224.   protected
  225.     function GetDisplayName: string; override;
  226.     procedure SetDisplayName(const Value: string); override;
  227.   public
  228.     constructor Create(Collection: TCollection); override;
  229.     procedure Assign(Source: TPersistent); override;
  230.     procedure Clear;
  231.     procedure Save; virtual;
  232.     procedure Restore; virtual;
  233.     property StoredValues: TStoredValues read GetStoredValues;
  234.   published
  235.     property Name: string read FName write SetDisplayName;
  236.     property Value: Variant read FValue write FValue stored IsValueStored;
  237.     property KeyString: string read FKeyString write FKeyString;
  238.     property OnSave: TStoredValueEvent read FOnSave write FOnSave;
  239.     property OnRestore: TStoredValueEvent read FOnRestore write FOnRestore;
  240.   end;
  241.  
  242. { TStoredValues }
  243.  
  244.   TStoredValues = class({$IFDEF RX_D4}TOwnedCollection{$ELSE}TCollection{$ENDIF})
  245.   private
  246.     FStorage: TFormPlacement;
  247.     function GetValue(const Name: string): TStoredValue;
  248.     procedure SetValue(const Name: string; StoredValue: TStoredValue);
  249.     function GetItem(Index: Integer): TStoredValue;
  250.     procedure SetItem(Index: Integer; StoredValue: TStoredValue);
  251.   public
  252. {$IFDEF RX_D4}
  253.     constructor Create(AOwner: TPersistent);
  254. {$ELSE}
  255.     constructor Create;
  256. {$ENDIF}
  257.     function IndexOf(const Name: string): Integer;
  258.     procedure SaveValues; virtual;
  259.     procedure RestoreValues; virtual;
  260.     property Storage: TFormPlacement read FStorage write FStorage;
  261.     property Items[Index: Integer]: TStoredValue read GetItem write SetItem; default;
  262.     property Values[const Name: string]: TStoredValue read GetValue write SetValue;
  263.   end;
  264.  
  265. {$ENDIF RX_D3}
  266.  
  267. implementation
  268.  
  269. uses SysUtils,
  270. {$IFDEF RX_D3}
  271.   Consts,
  272. {$ENDIF RX_D3}
  273.   AppUtils, rxStrUtils, RxProps;
  274.  
  275. const
  276. { The following string should not be localized }
  277.   siActiveCtrl = 'ActiveControl';
  278.   siVisible = 'Visible';
  279.   siVersion = 'FormVersion';
  280.  
  281. { TFormPlacement }
  282.  
  283. constructor TFormPlacement.Create(AOwner: TComponent);
  284. begin
  285.   inherited Create(AOwner);
  286.   FIniFileName := NullStr;
  287.   FIniSection := NullStr;
  288.   FActive := True;
  289.   if AOwner is TForm then FOptions := [fpState, fpPosition]
  290.   else FOptions := [];
  291.   FWinHook := TRxWindowHook.Create(Self);
  292.   FWinHook.AfterMessage := WndMessage;
  293.   FWinMinMaxInfo := TWinMinMaxInfo.Create;
  294.   FWinMinMaxInfo.FOwner := Self;
  295.   FLinks := TList.Create;
  296. end;
  297.  
  298. destructor TFormPlacement.Destroy;
  299. begin
  300.   IniFree;
  301.   while FLinks.Count > 0 do RemoveLink(FLinks.Last);
  302.   FLinks.Free;
  303.   if not (csDesigning in ComponentState) then begin
  304.     ReleaseHook;
  305.     RestoreEvents;
  306.   end;
  307.   DisposeStr(FIniFileName);
  308.   DisposeStr(FIniSection);
  309.   FWinMinMaxInfo.Free;
  310.   inherited Destroy;
  311. end;
  312.  
  313. procedure TFormPlacement.Loaded;
  314. var
  315.   Loading: Boolean;
  316. begin
  317.   Loading := csLoading in ComponentState;
  318.   inherited Loaded;
  319.   if not (csDesigning in ComponentState) then begin
  320.     if Loading then SetEvents;
  321.     CheckToggleHook;
  322.   end;
  323. end;
  324.  
  325. procedure TFormPlacement.AddLink(ALink: TIniLink);
  326. begin
  327.   FLinks.Add(ALink);
  328.   ALink.FStorage := Self;
  329. end;
  330.  
  331. procedure TFormPlacement.NotifyLinks(Operation: TPlacementOperation);
  332. var
  333.   I: Integer;
  334. begin
  335.   for I := 0 to FLinks.Count - 1 do
  336.     with TIniLink(FLinks[I]) do
  337.       case Operation of
  338.         poSave: SaveToIni;
  339.         poRestore: LoadFromIni;
  340.       end;
  341. end;
  342.  
  343. procedure TFormPlacement.RemoveLink(ALink: TIniLink);
  344. begin
  345.   ALink.FStorage := nil;
  346.   FLinks.Remove(ALink);
  347. end;
  348.  
  349. function TFormPlacement.GetForm: TForm;
  350. begin
  351.   if Owner is TCustomForm then Result := TForm(Owner as TCustomForm)
  352.   else Result := nil;
  353. end;
  354.  
  355. procedure TFormPlacement.SetEvents;
  356. begin
  357.   if Owner is TCustomForm then begin
  358.     with TForm(Form) do begin
  359.       FSaveFormShow := OnShow;
  360.       OnShow := FormShow;
  361.       FSaveFormCloseQuery := OnCloseQuery;
  362.       OnCloseQuery := FormCloseQuery;
  363.       FSaveFormDestroy := OnDestroy;
  364.       OnDestroy := FormDestroy;
  365.       FDefMaximize := (biMaximize in BorderIcons);
  366.     end;
  367.     if FPreventResize then UpdatePreventResize;
  368.   end;
  369. end;
  370.  
  371. procedure TFormPlacement.RestoreEvents;
  372. begin
  373.   if (Owner <> nil) and (Owner is TCustomForm) then
  374.     with TForm(Form) do begin
  375.       OnShow := FSaveFormShow;
  376.       OnCloseQuery := FSaveFormCloseQuery;
  377.       OnDestroy := FSaveFormDestroy;
  378.     end;
  379. end;
  380.  
  381. procedure TFormPlacement.SetHook;
  382. begin
  383.   if not (csDesigning in ComponentState) and (Owner <> nil) and
  384.     (Owner is TCustomForm) then
  385.     FWinHook.WinControl := Form;
  386. end;
  387.  
  388. procedure TFormPlacement.ReleaseHook;
  389. begin
  390.   FWinHook.WinControl := nil;
  391. end;
  392.  
  393. procedure TFormPlacement.CheckToggleHook;
  394. begin
  395.   if CheckMinMaxInfo or PreventResize then SetHook else ReleaseHook;
  396. end;
  397.  
  398. function TFormPlacement.CheckMinMaxInfo: Boolean;
  399. begin
  400.   Result := not FWinMinMaxInfo.DefaultMinMaxInfo;
  401. end;
  402.  
  403. procedure TFormPlacement.MinMaxInfoModified;
  404. begin
  405.   UpdatePlacement;
  406.   if not (csLoading in ComponentState) then CheckToggleHook;
  407. end;
  408.  
  409. procedure TFormPlacement.SetWinMinMaxInfo(Value: TWinMinMaxInfo);
  410. begin
  411.   FWinMinMaxInfo.Assign(Value);
  412. end;
  413.  
  414. procedure TFormPlacement.WndMessage(Sender: TObject; var Msg: TMessage;
  415.   var Handled: Boolean);
  416. begin
  417.   if FPreventResize and (Owner is TCustomForm) then begin
  418.     case Msg.Msg of
  419.       WM_GETMINMAXINFO:
  420.         if Form.HandleAllocated and IsWindowVisible(Form.Handle) then begin
  421.           with TWMGetMinMaxInfo(Msg).MinMaxInfo^ do begin
  422.             ptMinTrackSize := Point(Form.Width, Form.Height);
  423.             ptMaxTrackSize := Point(Form.Width, Form.Height);
  424.           end;
  425.           Msg.Result := 1;
  426.         end;
  427.       WM_INITMENUPOPUP:
  428.         if TWMInitMenuPopup(Msg).SystemMenu then begin
  429.           if Form.Menu <> nil then
  430.             Form.Menu.DispatchPopup(TWMInitMenuPopup(Msg).MenuPopup);
  431.           EnableMenuItem(TWMInitMenuPopup(Msg).MenuPopup, SC_SIZE,
  432.             MF_BYCOMMAND or MF_GRAYED);
  433.           EnableMenuItem(TWMInitMenuPopup(Msg).MenuPopup, SC_MAXIMIZE,
  434.             MF_BYCOMMAND or MF_GRAYED);
  435.           Msg.Result := 1;
  436.         end;
  437.       WM_NCHITTEST:
  438.         begin
  439.           if Msg.Result in [HTLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT,
  440.             HTBOTTOMLEFT, HTTOP, HTTOPRIGHT, HTTOPLEFT]
  441.           then Msg.Result := HTNOWHERE;
  442.         end;
  443.     end;
  444.   end
  445.   else if (Msg.Msg = WM_GETMINMAXINFO) then begin
  446.     if CheckMinMaxInfo then begin
  447.       with TWMGetMinMaxInfo(Msg).MinMaxInfo^ do begin
  448.          if FWinMinMaxInfo.MinTrackWidth <> 0 then
  449.            ptMinTrackSize.X := FWinMinMaxInfo.MinTrackWidth;
  450.          if FWinMinMaxInfo.MinTrackHeight <> 0 then
  451.            ptMinTrackSize.Y := FWinMinMaxInfo.MinTrackHeight;
  452.          if FWinMinMaxInfo.MaxTrackWidth <> 0 then
  453.            ptMaxTrackSize.X := FWinMinMaxInfo.MaxTrackWidth;
  454.          if FWinMinMaxInfo.MaxTrackHeight <> 0 then
  455.            ptMaxTrackSize.Y := FWinMinMaxInfo.MaxTrackHeight;
  456.          if FWinMinMaxInfo.MaxSizeWidth <> 0 then
  457.            ptMaxSize.X := FWinMinMaxInfo.MaxSizeWidth;
  458.          if FWinMinMaxInfo.MaxSizeHeight <> 0 then
  459.            ptMaxSize.Y := FWinMinMaxInfo.MaxSizeHeight;
  460.          if FWinMinMaxInfo.MaxPosLeft <> 0 then
  461.            ptMaxPosition.X := FWinMinMaxInfo.MaxPosLeft;
  462.          if FWinMinMaxInfo.MaxPosTop <> 0 then
  463.            ptMaxPosition.Y := FWinMinMaxInfo.MaxPosTop;
  464.       end;
  465.     end
  466.     else begin
  467.       TWMGetMinMaxInfo(Msg).MinMaxInfo^.ptMaxPosition.X := 0;
  468.       TWMGetMinMaxInfo(Msg).MinMaxInfo^.ptMaxPosition.Y := 0;
  469.     end;
  470.     Msg.Result := 1;
  471.   end;
  472. end;
  473.  
  474. procedure TFormPlacement.FormShow(Sender: TObject);
  475. begin
  476.   if Active then
  477.     try
  478.       RestoreFormPlacement;
  479.     except
  480.       Application.HandleException(Self);
  481.     end;
  482.   if Assigned(FSaveFormShow) then FSaveFormShow(Sender);
  483. end;
  484.  
  485. procedure TFormPlacement.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  486. begin
  487.   if Assigned(FSaveFormCloseQuery) then
  488.     FSaveFormCloseQuery(Sender, CanClose);
  489.   if CanClose and Active and (Owner is TCustomForm) and (Form.Handle <> 0) then
  490.     try
  491.       SaveFormPlacement;
  492.     except
  493.       Application.HandleException(Self);
  494.     end;
  495. end;
  496.  
  497. procedure TFormPlacement.FormDestroy(Sender: TObject);
  498. begin
  499.   if Active and not FSaved then begin
  500.     FDestroying := True;
  501.     try
  502.       SaveFormPlacement;
  503.     except
  504.       Application.HandleException(Self);
  505.     end;
  506.     FDestroying := False;
  507.   end;
  508.   if Assigned(FSaveFormDestroy) then FSaveFormDestroy(Sender);
  509. end;
  510.  
  511. procedure TFormPlacement.UpdatePlacement;
  512. const
  513. {$IFDEF WIN32}
  514.   Metrics: array[bsSingle..bsSizeToolWin] of Word =
  515.     (SM_CXBORDER, SM_CXFRAME, SM_CXDLGFRAME, SM_CXBORDER, SM_CXFRAME);
  516. {$ELSE}
  517.   Metrics: array[bsSingle..bsDialog] of Word =
  518.     (SM_CXBORDER, SM_CXFRAME, SM_CXDLGFRAME);
  519. {$ENDIF}
  520. var
  521.   Placement: TWindowPlacement;
  522. begin
  523.   if (Owner <> nil) and (Owner is TCustomForm) and Form.HandleAllocated and
  524.   not (csLoading in ComponentState) then
  525.     if not (FPreventResize or CheckMinMaxInfo) then begin
  526.       Placement.Length := SizeOf(TWindowPlacement);
  527.       GetWindowPlacement(Form.Handle, @Placement);
  528.       if not IsWindowVisible(Form.Handle) then
  529.         Placement.ShowCmd := SW_HIDE;
  530.       if Form.BorderStyle <> bsNone then begin
  531.         Placement.ptMaxPosition.X := -GetSystemMetrics(Metrics[Form.BorderStyle]);
  532.         Placement.ptMaxPosition.Y := -GetSystemMetrics(Metrics[Form.BorderStyle] + 1);
  533.       end
  534.       else Placement.ptMaxPosition := Point(0, 0);
  535.       SetWindowPlacement(Form.Handle, @Placement);
  536.     end;
  537. end;
  538.  
  539. procedure TFormPlacement.UpdatePreventResize;
  540. var
  541.   IsActive: Boolean;
  542. begin
  543.   if not (csDesigning in ComponentState) and (Owner is TCustomForm) then
  544.   begin
  545.     if FPreventResize then
  546.       FDefMaximize := (biMaximize in Form.BorderIcons);
  547.     IsActive := Active;
  548.     Active := False;
  549.     try
  550.       if (not FPreventResize) and FDefMaximize and
  551.         (Form.BorderStyle <> bsDialog) then
  552.         Form.BorderIcons := Form.BorderIcons + [biMaximize]
  553.       else Form.BorderIcons := Form.BorderIcons - [biMaximize];
  554.     finally
  555.       Active := IsActive;
  556.     end;
  557.     if not (csLoading in ComponentState) then CheckToggleHook;
  558.   end;
  559. end;
  560.  
  561. procedure TFormPlacement.SetPreventResize(Value: Boolean);
  562. begin
  563.   if (Form <> nil) and (FPreventResize <> Value) then begin
  564.     FPreventResize := Value;
  565.     UpdatePlacement;
  566.     UpdatePreventResize;
  567.   end;
  568. end;
  569.  
  570. function TFormPlacement.GetIniFile: TObject;
  571. begin
  572. {$IFDEF WIN32}
  573.   if UseRegistry then Result := FRegIniFile
  574.   else Result := FIniFile;
  575. {$ELSE}
  576.   Result := FIniFile;
  577. {$ENDIF WIN32}
  578. end;
  579.  
  580. function TFormPlacement.GetIniFileName: string;
  581. begin
  582.   Result := FIniFileName^;
  583.   if (Result = '') and not (csDesigning in ComponentState) then begin
  584. {$IFDEF WIN32}
  585.     if UseRegistry then Result := GetDefaultIniRegKey
  586.     else Result := GetDefaultIniName;
  587. {$ELSE}
  588.     Result := GetDefaultIniName;
  589. {$ENDIF}
  590.   end;
  591. end;
  592.  
  593. procedure TFormPlacement.SetIniFileName(const Value: string);
  594. begin
  595.   AssignStr(FIniFileName, Value);
  596. end;
  597.  
  598. function TFormPlacement.GetIniSection: string;
  599. begin
  600.   Result := FIniSection^;
  601.   if (Result = '') and not (csDesigning in ComponentState) then
  602.     Result := GetDefaultSection(Owner);
  603. end;
  604.  
  605. procedure TFormPlacement.SetIniSection(const Value: string);
  606. begin
  607.   AssignStr(FIniSection, Value);
  608. end;
  609.  
  610. procedure TFormPlacement.Save;
  611. begin
  612.   if Assigned(FOnSavePlacement) then FOnSavePlacement(Self);
  613. end;
  614.  
  615. procedure TFormPlacement.Restore;
  616. begin
  617.   if Assigned(FOnRestorePlacement) then FOnRestorePlacement(Self);
  618. end;
  619.  
  620. procedure TFormPlacement.SavePlacement;
  621. begin
  622.   if Owner is TCustomForm then begin
  623. {$IFDEF WIN32}
  624.     if UseRegistry then begin
  625.       WriteFormPlacementReg(Form, FRegIniFile, IniSection);
  626.       if (fpActiveControl in Options) and (Form.ActiveControl <> nil) then
  627.         FRegIniFile.WriteString(IniSection, siActiveCtrl, Form.ActiveControl.Name);
  628.       FRegIniFile.WriteBool(IniSection, siVisible, FDestroying);
  629.     end
  630.     else begin
  631.       WriteFormPlacement(Form, FIniFile, IniSection);
  632.       if (fpActiveControl in Options) and (Form.ActiveControl <> nil) then
  633.         FIniFile.WriteString(IniSection, siActiveCtrl, Form.ActiveControl.Name);
  634.       FIniFile.WriteBool(IniSection, siVisible, FDestroying);
  635.     end;
  636. {$ELSE}
  637.     WriteFormPlacement(Form, FIniFile, IniSection);
  638.     if (fpActiveControl in Options) and (Form.ActiveControl <> nil) then
  639.       FIniFile.WriteString(IniSection, siActiveCtrl, Form.ActiveControl.Name);
  640.     FIniFile.WriteBool(IniSection, siVisible, FDestroying);
  641. {$ENDIF}
  642.   end;
  643.   NotifyLinks(poSave);
  644. end;
  645.  
  646. procedure TFormPlacement.RestorePlacement;
  647. begin
  648.   if Owner is TCustomForm then begin
  649. {$IFDEF WIN32}
  650.     if UseRegistry then
  651.       ReadFormPlacementReg(Form, FRegIniFile, IniSection, fpState in Options,
  652.         fpPosition in Options)
  653.     else
  654. {$ENDIF}
  655.       ReadFormPlacement(Form, FIniFile, IniSection, fpState in Options,
  656.         fpPosition in Options);
  657.   end;
  658.   NotifyLinks(poRestore);
  659. end;
  660.  
  661. procedure TFormPlacement.IniNeeded(ReadOnly: Boolean);
  662. begin
  663.   if IniFileObject = nil then begin
  664. {$IFDEF WIN32}
  665.     if UseRegistry then begin
  666.       FRegIniFile := TRegIniFile.Create(IniFileName);
  667. {$IFDEF RX_D5}
  668.       if ReadOnly then FRegIniFile.Access := KEY_READ;
  669. {$ENDIF}
  670.       case FRegistryRoot of
  671.         prLocalMachine:
  672.           FRegIniFile.RootKey := HKEY_LOCAL_MACHINE;
  673.         prClassesRoot: 
  674.           FRegIniFile.RootKey := HKEY_CLASSES_ROOT;
  675.         prCurrentConfig: 
  676.           FRegIniFile.RootKey := HKEY_CURRENT_CONFIG;
  677.         prUsers: 
  678.           FRegIniFile.RootKey := HKEY_USERS;
  679.         prDynData:
  680.           FRegIniFile.RootKey := HKEY_DYN_DATA;
  681.       end;
  682.     end
  683.     else
  684. {$ENDIF}
  685.     FIniFile := TIniFile.Create(IniFileName);
  686.   end;
  687. end;
  688.  
  689. procedure TFormPlacement.IniFree;
  690. begin
  691.   if IniFileObject <> nil then begin
  692.     IniFileObject.Free;
  693.     FIniFile := nil;
  694. {$IFDEF WIN32}
  695.     FRegIniFile := nil;
  696. {$ENDIF}
  697.   end;
  698. end;
  699.  
  700. function TFormPlacement.DoReadString(const Section, Ident,
  701.   Default: string): string;
  702. begin
  703.   if IniFileObject <> nil then
  704.     Result := IniReadString(IniFileObject, Section, Ident, Default)
  705.   else begin
  706.     IniNeeded(True);
  707.     try
  708.       Result := IniReadString(IniFileObject, Section, Ident, Default);
  709.     finally
  710.       IniFree;
  711.     end;
  712.   end;
  713. end;
  714.  
  715. function TFormPlacement.ReadString(const Ident, Default: string): string;
  716. begin
  717.   Result := DoReadString(IniSection, Ident, Default);
  718. end;
  719.  
  720. procedure TFormPlacement.DoWriteString(const Section, Ident, Value: string);
  721. begin
  722.   if IniFileObject <> nil then
  723.     IniWriteString(IniFileObject, Section, Ident, Value)
  724.   else begin
  725.     IniNeeded(False);
  726.     try
  727.       IniWriteString(IniFileObject, Section, Ident, Value);
  728.     finally
  729.       IniFree;
  730.     end;
  731.   end;
  732. end;
  733.  
  734. procedure TFormPlacement.WriteString(const Ident, Value: string);
  735. begin
  736.   DoWriteString(IniSection, Ident, Value);
  737. end;
  738.  
  739. function TFormPlacement.ReadInteger(const Ident: string; Default: Longint): Longint;
  740. begin
  741.   if IniFileObject <> nil then
  742.     Result := IniReadInteger(IniFileObject, IniSection, Ident, Default)
  743.   else begin
  744.     IniNeeded(True);
  745.     try
  746.       Result := IniReadInteger(IniFileObject, IniSection, Ident, Default);
  747.     finally
  748.       IniFree;
  749.     end;
  750.   end;
  751. end;
  752.  
  753. procedure TFormPlacement.WriteInteger(const Ident: string; Value: Longint);
  754. begin
  755.   if IniFileObject <> nil then
  756.     IniWriteInteger(IniFileObject, IniSection, Ident, Value)
  757.   else begin
  758.     IniNeeded(False);
  759.     try
  760.       IniWriteInteger(IniFileObject, IniSection, Ident, Value);
  761.     finally
  762.       IniFree;
  763.     end;
  764.   end;
  765. end;
  766.  
  767. procedure TFormPlacement.EraseSections;
  768. var
  769.   Lines: TStrings;
  770.   I: Integer;
  771. begin
  772.   if IniFileObject = nil then begin
  773.     IniNeeded(False);
  774.     try
  775.       Lines := TStringList.Create;
  776.       try
  777.         IniReadSections(IniFileObject, Lines);
  778.         for I := 0 to Lines.Count - 1 do begin
  779.           if (Lines[I] = IniSection) or
  780.             (IsWild(Lines[I], IniSection + '.*', False) or
  781.             IsWild(Lines[I], IniSection + '\*', False)) then
  782.             IniEraseSection(IniFileObject, Lines[I]);
  783.         end;
  784.       finally
  785.         Lines.Free;
  786.       end;
  787.     finally
  788.       IniFree;
  789.     end;
  790.   end;
  791. end;
  792.  
  793. procedure TFormPlacement.SaveFormPlacement;
  794. begin
  795.   if FRestored or not Active then begin
  796.     IniNeeded(False);
  797.     try
  798.       WriteInteger(siVersion, FVersion);
  799.       SavePlacement;
  800.       Save;
  801.       FSaved := True;
  802.     finally
  803.       IniFree;
  804.     end;
  805.   end;
  806. end;
  807.  
  808. procedure TFormPlacement.RestoreFormPlacement;
  809. var
  810.   cActive: TComponent;
  811. begin
  812.   FSaved := False;
  813.   IniNeeded(True);
  814.   try
  815.     if ReadInteger(siVersion, 0) >= FVersion then begin
  816.       RestorePlacement;
  817.       FRestored := True;
  818.       Restore;
  819.       if (fpActiveControl in Options) and (Owner is TCustomForm) then begin
  820.         cActive := Form.FindComponent(IniReadString(IniFileObject,
  821.           IniSection, siActiveCtrl, ''));
  822.         if (cActive <> nil) and (cActive is TWinControl) and
  823.           TWinControl(cActive).CanFocus then
  824.             Form.ActiveControl := TWinControl(cActive);
  825.       end;
  826.     end;
  827.     FRestored := True;
  828.   finally
  829.     IniFree;
  830.   end;
  831.   UpdatePlacement;
  832. end;
  833.  
  834. { TWinMinMaxInfo }
  835.  
  836. procedure TWinMinMaxInfo.Assign(Source: TPersistent);
  837. begin
  838.   if Source is TWinMinMaxInfo then begin
  839.     FMinMaxInfo := TWinMinMaxInfo(Source).FMinMaxInfo;
  840.     if FOwner <> nil then FOwner.MinMaxInfoModified;
  841.   end
  842.   else inherited Assign(Source);
  843. end;
  844.  
  845. function TWinMinMaxInfo.GetMinMaxInfo(Index: Integer): Integer;
  846. begin
  847.   with FMinMaxInfo do begin
  848.     case Index of
  849.       0: Result := ptMaxPosition.X;
  850.       1: Result := ptMaxPosition.Y;
  851.       2: Result := ptMaxSize.Y;
  852.       3: Result := ptMaxSize.X;
  853.       4: Result := ptMaxTrackSize.Y;
  854.       5: Result := ptMaxTrackSize.X;
  855.       6: Result := ptMinTrackSize.Y;
  856.       7: Result := ptMinTrackSize.X;
  857.       else Result := 0;
  858.     end;
  859.   end;
  860. end;
  861.  
  862. procedure TWinMinMaxInfo.SetMinMaxInfo(Index: Integer; Value: Integer);
  863. begin
  864.   if GetMinMaxInfo(Index) <> Value then begin
  865.     with FMinMaxInfo do begin
  866.       case Index of
  867.         0: ptMaxPosition.X := Value;
  868.         1: ptMaxPosition.Y := Value;
  869.         2: ptMaxSize.Y := Value;
  870.         3: ptMaxSize.X := Value;
  871.         4: ptMaxTrackSize.Y := Value;
  872.         5: ptMaxTrackSize.X := Value;
  873.         6: ptMinTrackSize.Y := Value;
  874.         7: ptMinTrackSize.X := Value;
  875.       end;
  876.     end;
  877.     if FOwner <> nil then FOwner.MinMaxInfoModified;
  878.   end;
  879. end;
  880.  
  881. function TWinMinMaxInfo.DefaultMinMaxInfo: Boolean;
  882. begin
  883.   with FMinMaxInfo do begin
  884.     Result := not ((ptMinTrackSize.X <> 0) or (ptMinTrackSize.Y <> 0) or
  885.       (ptMaxTrackSize.X <> 0) or (ptMaxTrackSize.Y <> 0) or
  886.       (ptMaxSize.X <> 0) or (ptMaxSize.Y <> 0) or
  887.       (ptMaxPosition.X <> 0) or (ptMaxPosition.Y <> 0));
  888.   end;
  889. end;
  890.  
  891. { TFormStorage }
  892.  
  893. constructor TFormStorage.Create(AOwner: TComponent);
  894. begin
  895.   inherited Create(AOwner);
  896.   FStoredProps := TStringList.Create;
  897. {$IFDEF RX_D3}
  898.   FStoredValues := TStoredValues.Create{$IFDEF RX_D4}(Self){$ENDIF RX_D4};
  899.   FStoredValues.Storage := Self;
  900. {$ENDIF RX_D3}
  901. end;
  902.  
  903. destructor TFormStorage.Destroy;
  904. begin
  905.   FStoredProps.Free;
  906.   FStoredProps := nil;
  907. {$IFDEF RX_D3}
  908.   FStoredValues.Free;
  909.   FStoredValues := nil;
  910. {$ENDIF RX_D3}
  911.   inherited Destroy;
  912. end;
  913.  
  914. {$IFDEF WIN32}
  915. procedure TFormStorage.SetNotification;
  916. var
  917.   I: Integer;
  918.   Component: TComponent;
  919. begin
  920.   for I := FStoredProps.Count - 1 downto 0 do begin
  921.     Component := TComponent(FStoredProps.Objects[I]);
  922.     if Component <> nil then Component.FreeNotification(Self);
  923.   end;
  924. end;
  925. {$ENDIF WIN32}
  926.  
  927. procedure TFormStorage.SetStoredProps(Value: TStrings);
  928. begin
  929.   FStoredProps.Assign(Value);
  930. {$IFDEF WIN32}
  931.   SetNotification;
  932. {$ENDIF}
  933. end;
  934.  
  935. {$IFDEF RX_D3}
  936. procedure TFormStorage.SetStoredValues(Value: TStoredValues);
  937. begin
  938.   FStoredValues.Assign(Value);
  939. end;
  940. {$ENDIF RX_D3}
  941.  
  942. procedure TFormStorage.Loaded;
  943. begin
  944.   inherited Loaded;
  945.   UpdateStoredList(Owner, FStoredProps, True);
  946. end;
  947.  
  948. procedure TFormStorage.WriteState(Writer: TWriter);
  949. begin
  950.   UpdateStoredList(Owner, FStoredProps, False);
  951.   inherited WriteState(Writer);
  952. end;
  953.  
  954. procedure TFormStorage.Notification(AComponent: TComponent; Operation: TOperation);
  955. var
  956.   I: Integer;
  957.   Component: TComponent;
  958. begin
  959.   inherited Notification(AComponent, Operation);
  960.   if not (csDestroying in ComponentState) and (Operation = opRemove) and
  961.     (FStoredProps <> nil) then
  962.     for I := FStoredProps.Count - 1 downto 0 do begin
  963.       Component := TComponent(FStoredProps.Objects[I]);
  964.       if Component = AComponent then FStoredProps.Delete(I);
  965.     end;
  966. end;
  967.  
  968. procedure TFormStorage.SaveProperties;
  969. begin
  970.   with TPropsStorage.Create do
  971.   try
  972.     Section := IniSection;
  973.     OnWriteString := DoWriteString;
  974. {$IFDEF WIN32}
  975.     if UseRegistry then OnEraseSection := FRegIniFile.EraseSection
  976.     else OnEraseSection := FIniFile.EraseSection;
  977. {$ELSE}
  978.     OnEraseSection := FIniFile.EraseSection;
  979. {$ENDIF WIN32}
  980.     StoreObjectsProps(Owner, FStoredProps);
  981.   finally
  982.     Free;
  983.   end;
  984. end;
  985.  
  986. procedure TFormStorage.RestoreProperties;
  987. begin
  988.   with TPropsStorage.Create do
  989.   try
  990.     Section := IniSection;
  991.     OnReadString := DoReadString;
  992.     try
  993.       LoadObjectsProps(Owner, FStoredProps);
  994.     except
  995.       { ignore any exceptions }
  996.     end;
  997.   finally
  998.     Free;
  999.   end;
  1000. end;
  1001.  
  1002. procedure TFormStorage.SavePlacement;
  1003. begin
  1004.   inherited SavePlacement;
  1005.   SaveProperties;
  1006. {$IFDEF RX_D3}
  1007.   StoredValues.SaveValues;
  1008. {$ENDIF}
  1009. end;
  1010.  
  1011. procedure TFormStorage.RestorePlacement;
  1012. begin
  1013.   inherited RestorePlacement;
  1014.   FRestored := True;
  1015.   RestoreProperties;
  1016. {$IFDEF RX_D3}
  1017.   StoredValues.RestoreValues;
  1018. {$ENDIF}
  1019. end;
  1020.  
  1021. { TIniLink }
  1022.  
  1023. destructor TIniLink.Destroy;
  1024. begin
  1025.   FOnSave := nil;
  1026.   FOnLoad := nil;
  1027.   SetStorage(nil);
  1028.   inherited Destroy;
  1029. end;
  1030.  
  1031. function TIniLink.GetIniObject: TObject;
  1032. begin
  1033.   if Assigned(FStorage) then Result := FStorage.IniFileObject
  1034.   else Result := nil;
  1035. end;
  1036.  
  1037. function TIniLink.GetRootSection: string;
  1038. begin
  1039.   if Assigned(FStorage) then Result := FStorage.FIniSection^
  1040.   else Result := '';
  1041.   if Result <> '' then Result := Result + '\';
  1042. end;
  1043.  
  1044. procedure TIniLink.SetStorage(Value: TFormPlacement);
  1045. begin
  1046.   if FStorage <> Value then begin
  1047.     if FStorage <> nil then FStorage.RemoveLink(Self);
  1048.     if Value <> nil then Value.AddLink(Self);
  1049.   end;
  1050. end;
  1051.  
  1052. procedure TIniLink.SaveToIni;
  1053. begin
  1054.   if Assigned(FOnSave) then FOnSave(Self);
  1055. end;
  1056.  
  1057. procedure TIniLink.LoadFromIni;
  1058. begin
  1059.   if Assigned(FOnLoad) then FOnLoad(Self);
  1060. end;
  1061.  
  1062. {$IFDEF RX_D3}
  1063.  
  1064. { TStoredValue }
  1065.  
  1066. constructor TStoredValue.Create(Collection: TCollection);
  1067. begin
  1068.   inherited Create(Collection);
  1069.   FValue := Unassigned;
  1070. end;
  1071.  
  1072. procedure TStoredValue.Assign(Source: TPersistent);
  1073. begin
  1074.   if (Source is TStoredValue) and (Source <> nil) then begin
  1075.     if VarIsEmpty(TStoredValue(Source).FValue) then
  1076.       Clear
  1077.     else
  1078.       Value := TStoredValue(Source).FValue;
  1079.     Name := TStoredValue(Source).Name;
  1080.     KeyString := TStoredValue(Source).KeyString;
  1081.   end;
  1082. end;
  1083.  
  1084. function TStoredValue.GetDisplayName: string;
  1085. begin
  1086.   if FName = '' then
  1087.     Result := inherited GetDisplayName
  1088.   else
  1089.     Result := FName;
  1090. end;
  1091.  
  1092. procedure TStoredValue.SetDisplayName(const Value: string);
  1093. begin
  1094.   if (Value <> '') and (AnsiCompareText(Value, FName) <> 0) and
  1095.     (Collection is TStoredValues) and (TStoredValues(Collection).IndexOf(Value) >= 0) then
  1096.     raise Exception.Create(SDuplicateString);
  1097.   FName := Value;
  1098.   inherited;
  1099. end;
  1100.  
  1101. function TStoredValue.GetStoredValues: TStoredValues;
  1102. begin
  1103.   if Collection is TStoredValues then
  1104.     Result := TStoredValues(Collection)
  1105.   else
  1106.     Result := nil;
  1107. end;
  1108.  
  1109. procedure TStoredValue.Clear;
  1110. begin
  1111.   FValue := Unassigned;
  1112. end;
  1113.  
  1114. function TStoredValue.IsValueStored: Boolean;
  1115. begin
  1116.   Result := not VarIsEmpty(FValue);
  1117. end;
  1118.  
  1119. procedure TStoredValue.Save;
  1120. var
  1121.   SaveValue: Variant;
  1122.   SaveStrValue: string;
  1123. begin
  1124.   SaveValue := Value;
  1125.   if Assigned(FOnSave) then
  1126.     FOnSave(Self, SaveValue);
  1127.   SaveStrValue := VarToStr(SaveValue);
  1128.   if KeyString <> '' then
  1129.     SaveStrValue := XorEncode(KeyString, SaveStrValue);
  1130.   StoredValues.Storage.WriteString(Name, SaveStrValue);
  1131. end;
  1132.  
  1133. procedure TStoredValue.Restore;
  1134. var
  1135.   RestoreValue: Variant;
  1136.   RestoreStrValue, DefaultStrValue: string;
  1137. begin
  1138.   DefaultStrValue := VarToStr(Value);
  1139.   if KeyString <> '' then
  1140.     DefaultStrValue := XorEncode(KeyString, DefaultStrValue);
  1141.   RestoreStrValue := StoredValues.Storage.ReadString(Name, DefaultStrValue);
  1142.   if KeyString <> '' then
  1143.     RestoreStrValue := XorDecode(KeyString, RestoreStrValue);
  1144.   RestoreValue := RestoreStrValue;
  1145.   if Assigned(FOnRestore) then
  1146.     FOnRestore(Self, RestoreValue);
  1147.   Value := RestoreValue;  
  1148. end;
  1149.  
  1150. { TStoredValues }
  1151.  
  1152. {$IFDEF RX_D4}
  1153. constructor TStoredValues.Create(AOwner: TPersistent);
  1154. begin
  1155.   inherited Create(AOwner, TStoredValue);
  1156. end;
  1157. {$ELSE}
  1158. constructor TStoredValues.Create;
  1159. begin
  1160.   inherited Create(TStoredValue);
  1161. end;
  1162. {$ENDIF}
  1163.  
  1164. function TStoredValues.IndexOf(const Name: string): Integer;
  1165. begin
  1166.   for Result := 0 to Count - 1 do
  1167.     if AnsiCompareText(Items[Result].Name, Name) = 0 then Exit;
  1168.   Result := -1;
  1169. end;
  1170.  
  1171. function TStoredValues.GetItem(Index: Integer): TStoredValue;
  1172. begin
  1173.   Result := TStoredValue(inherited Items[Index]);
  1174. end;
  1175.  
  1176. procedure TStoredValues.SetItem(Index: Integer; StoredValue: TStoredValue);
  1177. begin
  1178.   inherited SetItem(Index, TCollectionItem(StoredValue));
  1179. end;
  1180.  
  1181. function TStoredValues.GetValue(const Name: string): TStoredValue;
  1182. var
  1183.   I: Integer;
  1184. begin
  1185.   I := IndexOf(Name);
  1186.   if I < 0 then
  1187.     Result := nil
  1188.   else
  1189.     Result := Items[I];
  1190. end;
  1191.  
  1192. procedure TStoredValues.SetValue(const Name: string; StoredValue: TStoredValue);
  1193. var
  1194.   I: Integer;
  1195. begin
  1196.   I := IndexOf(Name);
  1197.   if I >= 0 then
  1198.     Items[I].Assign(StoredValue);
  1199. end;
  1200.  
  1201. procedure TStoredValues.SaveValues;
  1202. var
  1203.   I: Integer;
  1204. begin
  1205.   for I := 0 to Count - 1 do
  1206.     Items[I].Save;
  1207. end;
  1208.  
  1209. procedure TStoredValues.RestoreValues;
  1210. var
  1211.   I: Integer;
  1212. begin
  1213.   for I := 0 to Count - 1 do
  1214.     Items[I].Restore;
  1215. end;
  1216.  
  1217. {$ENDIF RX_D3}
  1218.  
  1219. end.