placemnt.pas

RX Library contains a large number of components, objects and routines for Borland Delphi with full

{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1995, 1996 AO ROSNO             }
{         Copyright (c) 1997 Master-Bank                }
{                                                       }
{*******************************************************}

unit Placemnt;

{$I RX.INC}

interface

uses RTLConsts, Variants, Windows, Registry, Controls, Messages, Classes, Forms, IniFiles, Dialogs, VclUtils, RxHook;

type
  TPlacementOption = (fpState, fpPosition, fpActiveControl);
  TPlacementOptions = set of TPlacementOption;
  TPlacementOperation = (poSave, poRestore);
{$IFDEF WIN32}
  TPlacementRegRoot = (prCurrentUser, prLocalMachine, prCurrentConfig,
    prClassesRoot, prUsers, prDynData);
{$ENDIF}

  TIniLink = class;

{ TWinMinMaxInfo }

  TFormPlacement = class;

  TWinMinMaxInfo = class(TPersistent)
  private
    FOwner: TFormPlacement;
    FMinMaxInfo: TMinMaxInfo;
    function GetMinMaxInfo(Index: Integer): Integer;
    procedure SetMinMaxInfo(Index: Integer; Value: Integer);
  public
    function DefaultMinMaxInfo: Boolean;
    procedure Assign(Source: TPersistent); override;
  published
    property MaxPosLeft: Integer index 0 read GetMinMaxInfo write SetMinMaxInfo default 0;
    property MaxPosTop: Integer index 1 read GetMinMaxInfo write SetMinMaxInfo default 0;
    property MaxSizeHeight: Integer index 2 read GetMinMaxInfo write SetMinMaxInfo default 0;
    property MaxSizeWidth: Integer index 3 read GetMinMaxInfo write SetMinMaxInfo default 0;
    property MaxTrackHeight: Integer index 4 read GetMinMaxInfo write SetMinMaxInfo default 0;
    property MaxTrackWidth: Integer index 5 read GetMinMaxInfo write SetMinMaxInfo default 0;
    property MinTrackHeight: Integer index 6 read GetMinMaxInfo write SetMinMaxInfo default 0;
    property MinTrackWidth: Integer index 7 read GetMinMaxInfo write SetMinMaxInfo default 0;
  end;

{ TFormPlacement }

  TFormPlacement = class(TComponent)
  private
    FActive: Boolean;
    FIniFileName: String;
    FIniSection: String;
    FIniFile: TIniFile;
    FUseRegistry: Boolean;
{$IFDEF WIN32}
    FRegIniFile: TRegIniFile;
    FRegistryRoot: TPlacementRegRoot;
{$ENDIF WIN32}
    FLinks: TList;
    FOptions: TPlacementOptions;
    FVersion: Integer;
    FSaved: Boolean;
    FRestored: Boolean;
    FDestroying: Boolean;
    FPreventResize: Boolean;
    FWinMinMaxInfo: TWinMinMaxInfo;
    FDefMaximize: Boolean;
    FWinHook: TRxWindowHook;
    FSaveFormShow: TNotifyEvent;
    FSaveFormDestroy: TNotifyEvent;
    FSaveFormCloseQuery: TCloseQueryEvent;
    FOnSavePlacement: TNotifyEvent;
    FOnRestorePlacement: TNotifyEvent;
    procedure SetEvents;
    procedure RestoreEvents;
    procedure SetHook;
    procedure ReleaseHook;
    procedure CheckToggleHook;
    function CheckMinMaxInfo: Boolean;
    procedure MinMaxInfoModified;
    procedure SetWinMinMaxInfo(Value: TWinMinMaxInfo);
    function GetIniSection: string;
    procedure SetIniSection(const Value: string);
    function GetIniFileName: string;
    procedure SetIniFileName(const Value: string);
    function GetIniFile: TObject;
    procedure SetPreventResize(Value: Boolean);
    procedure UpdatePreventResize;
    procedure UpdatePlacement;
    procedure IniNeeded(ReadOnly: Boolean);
    procedure IniFree;
    procedure AddLink(ALink: TIniLink);
    procedure NotifyLinks(Operation: TPlacementOperation);
    procedure RemoveLink(ALink: TIniLink);
    procedure WndMessage(Sender: TObject; var Msg: TMessage; var Handled: Boolean);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    function GetForm: TForm;
  protected
    procedure Loaded; override;
    procedure Save; dynamic;
    procedure Restore; dynamic;
    procedure SavePlacement; virtual;
    procedure RestorePlacement; virtual;
    function DoReadString(const Section, Ident, Default: string): string; virtual;
    procedure DoWriteString(const Section, Ident, Value: string); virtual;
    property Form: TForm read GetForm;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SaveFormPlacement;
    procedure RestoreFormPlacement;
    function ReadString(const Ident, Default: string): string;
    procedure WriteString(const Ident, Value: string);
    function ReadInteger(const Ident: string; Default: Longint): Longint;
    procedure WriteInteger(const Ident: string; Value: Longint);
    procedure EraseSections;
    property IniFileObject: TObject read GetIniFile;
    property IniFile: TIniFile read FIniFile;
{$IFDEF WIN32}
    property RegIniFile: TRegIniFile read FRegIniFile;
{$ENDIF WIN32}
  published
    property Active: Boolean read FActive write FActive default True;
    property IniFileName: string read GetIniFileName write SetIniFileName;
    property IniSection: string read GetIniSection write SetIniSection;
    property MinMaxInfo: TWinMinMaxInfo read FWinMinMaxInfo write SetWinMinMaxInfo;
    property Options: TPlacementOptions read FOptions write FOptions default [fpState, fpPosition];
    property PreventResize: Boolean read FPreventResize write SetPreventResize default False;
{$IFDEF WIN32}
    property RegistryRoot: TPlacementRegRoot read FRegistryRoot write FRegistryRoot default prCurrentUser;
{$ENDIF WIN32}
    property UseRegistry: Boolean read FUseRegistry write FUseRegistry default False;
    property Version: Integer read FVersion write FVersion default 0;
    property OnSavePlacement: TNotifyEvent read FOnSavePlacement
      write FOnSavePlacement;
    property OnRestorePlacement: TNotifyEvent read FOnRestorePlacement
      write FOnRestorePlacement;
  end;

{ TFormStorage }

{$IFDEF RX_D3}
  TStoredValues = class;
  TStoredValue = class;
{$ENDIF RX_D3}

  TFormStorage = class(TFormPlacement)
  private
    FStoredProps: TStrings;
{$IFDEF RX_D3}
    FStoredValues: TStoredValues;
{$ENDIF RX_D3}
    procedure SetStoredProps(Value: TStrings);
{$IFDEF RX_D3}
    procedure SetStoredValues(Value: TStoredValues);
    function GetStoredValue(const Name: string): Variant;
    procedure SetStoredValue(const Name: string; Value: Variant);
{$ENDIF RX_D3}
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SavePlacement; override;
    procedure RestorePlacement; override;
    procedure SaveProperties; virtual;
    procedure RestoreProperties; virtual;
    procedure WriteState(Writer: TWriter); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
{$IFDEF WIN32}
    procedure SetNotification;
{$ENDIF WIN32}
{$IFDEF RX_D3}
    property StoredValue[const Name: string]: Variant read GetStoredValue write SetStoredValue;
{$ENDIF RX_D3}
  published
    property StoredProps: TStrings read FStoredProps write SetStoredProps;
{$IFDEF RX_D3}
    property StoredValues: TStoredValues read FStoredValues write SetStoredValues;
{$ENDIF RX_D3}
  end;

{ TIniLink }

  TIniLink = class(TPersistent)
  private
    FStorage: TFormPlacement;
    FOnSave: TNotifyEvent;
    FOnLoad: TNotifyEvent;
    function GetIniObject: TObject;
    function GetRootSection: string;
    procedure SetStorage(Value: TFormPlacement);
  protected
    procedure SaveToIni; virtual;
    procedure LoadFromIni; virtual;
  public
    destructor Destroy; override;
    property IniObject: TObject read GetIniObject;
    property Storage: TFormPlacement read FStorage write SetStorage;
    property RootSection: string read GetRootSection;
    property OnSave: TNotifyEvent read FOnSave write FOnSave;
    property OnLoad: TNotifyEvent read FOnLoad write FOnLoad;
  end;

{$IFDEF RX_D3}

{ TStoredValue }

  TStoredValueEvent = procedure(Sender: TStoredValue; var Value: Variant) of object;

  TStoredValue = class(TCollectionItem)
  private
    FName: string;
    FValue: Variant;
    FKeyString: string;
    FOnSave: TStoredValueEvent;
    FOnRestore: TStoredValueEvent;
    function IsValueStored: Boolean;
    function GetStoredValues: TStoredValues;
  protected
    function GetDisplayName: string; override;
    procedure SetDisplayName(const Value: string); override;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    procedure Save; virtual;
    procedure Restore; virtual;
    property StoredValues: TStoredValues read GetStoredValues;
  published
    property Name: string read FName write SetDisplayName;
    property Value: Variant read FValue write FValue stored IsValueStored;
    property KeyString: string read FKeyString write FKeyString;
    property OnSave: TStoredValueEvent read FOnSave write FOnSave;
    property OnRestore: TStoredValueEvent read FOnRestore write FOnRestore;
  end;

{ TStoredValues }

  TStoredValues = class({$IFDEF RX_D4}TOwnedCollection{$ELSE}TCollection{$ENDIF})
  private
    FStorage: TFormPlacement;
    function GetValue(const Name: string): TStoredValue;
    procedure SetValue(const Name: string; StoredValue: TStoredValue);
    function GetStoredValue(const Name: string): Variant;
    procedure SetStoredValue(const Name: string; Value: Variant);
    function GetItem(Index: Integer): TStoredValue;
    procedure SetItem(Index: Integer; StoredValue: TStoredValue);
  public
{$IFDEF RX_D4}
    constructor Create(AOwner: TPersistent);
{$ELSE}
    constructor Create;
{$ENDIF}
    function IndexOf(const Name: string): Integer;
    procedure SaveValues; virtual;
    procedure RestoreValues; virtual;
    property Storage: TFormPlacement read FStorage write FStorage;
    property Items[Index: Integer]: TStoredValue read GetItem write SetItem; default;
    property Values[const Name: string]: TStoredValue read GetValue write SetValue;
    property StoredValue[const Name: string]: Variant read GetStoredValue write SetStoredValue;
  end;

{$ENDIF RX_D3}

implementation

uses SysUtils,
{$IFDEF RX_D3}
  Consts,
{$ENDIF RX_D3}
  AppUtils, rxStrUtils, RxProps;

const
{ The following string should not be localized }
  siActiveCtrl = 'ActiveControl';
  siVisible = 'Visible';
  siVersion = 'FormVersion';

{ TFormPlacement }

constructor TFormPlacement.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIniFileName := EmptyStr;
  FIniSection := EmptyStr;
  FActive := True;
  if AOwner is TForm then FOptions := [fpState, fpPosition]
  else FOptions := [];
  FWinHook := TRxWindowHook.Create(Self);
  FWinHook.AfterMessage := WndMessage;
  FWinMinMaxInfo := TWinMinMaxInfo.Create;
  FWinMinMaxInfo.FOwner := Self;
  FLinks := TList.Create;
end;

destructor TFormPlacement.Destroy;
begin
  IniFree;
  while FLinks.Count > 0 do RemoveLink(FLinks.Last);
  FLinks.Free;
  if not (csDesigning in ComponentState) then begin
    ReleaseHook;
    RestoreEvents;
  end;
  //DisposeStr(FIniFileName);
  //DisposeStr(FIniSection);
  FWinMinMaxInfo.Free;
  inherited Destroy;
end;

procedure TFormPlacement.Loaded;
var
  Loading: Boolean;
begin
  Loading := csLoading in ComponentState;
  inherited Loaded;
  if not (csDesigning in ComponentState) then begin
    if Loading then SetEvents;
    CheckToggleHook;
  end;
end;

procedure TFormPlacement.AddLink(ALink: TIniLink);
begin
  FLinks.Add(ALink);
  ALink.FStorage := Self;
end;

procedure TFormPlacement.NotifyLinks(Operation: TPlacementOperation);
var
  I: Integer;
begin
  for I := 0 to FLinks.Count - 1 do
    with TIniLink(FLinks[I]) do
      case Operation of
        poSave: SaveToIni;
        poRestore: LoadFromIni;
      end;
end;

procedure TFormPlacement.RemoveLink(ALink: TIniLink);
begin
  ALink.FStorage := nil;
  FLinks.Remove(ALink);
end;

function TFormPlacement.GetForm: TForm;
begin
  if Owner is TCustomForm then Result := TForm(Owner as TCustomForm)
  else Result := nil;
end;

procedure TFormPlacement.SetEvents;
begin
  if Owner is TCustomForm then begin
    with TForm(Form) do begin
      FSaveFormShow := OnShow;
      OnShow := FormShow;
      FSaveFormCloseQuery := OnCloseQuery;
      OnCloseQuery := FormCloseQuery;
      FSaveFormDestroy := OnDestroy;
      OnDestroy := FormDestroy;
      FDefMaximize := (biMaximize in BorderIcons);
    end;
    if FPreventResize then UpdatePreventResize;
  end;
end;

procedure TFormPlacement.RestoreEvents;
begin
  if (Owner <> nil) and (Owner is TCustomForm) then
    with TForm(Form) do begin
      OnShow := FSaveFormShow;
      OnCloseQuery := FSaveFormCloseQuery;
      OnDestroy := FSaveFormDestroy;
    end;
end;

procedure TFormPlacement.SetHook;
begin
  if not (csDesigning in ComponentState) and (Owner <> nil) and
    (Owner is TCustomForm) then
    FWinHook.WinControl := Form;
end;

procedure TFormPlacement.ReleaseHook;
begin
  FWinHook.WinControl := nil;
end;

procedure TFormPlacement.CheckToggleHook;
begin
  if CheckMinMaxInfo or PreventResize then SetHook else ReleaseHook;
end;

function TFormPlacement.CheckMinMaxInfo: Boolean;
begin
  Result := not FWinMinMaxInfo.DefaultMinMaxInfo;
end;

procedure TFormPlacement.MinMaxInfoModified;
begin
  UpdatePlacement;
  if not (csLoading in ComponentState) then CheckToggleHook;
end;

procedure TFormPlacement.SetWinMinMaxInfo(Value: TWinMinMaxInfo);
begin
  FWinMinMaxInfo.Assign(Value);
end;

procedure TFormPlacement.WndMessage(Sender: TObject; var Msg: TMessage;
  var Handled: Boolean);