david
7ebea5ffa7
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@12 7f62d464-2af8-f54e-996c-e91b33f51cbe
1424 lines
43 KiB
ObjectPascal
1424 lines
43 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvPlacemnt.PAS, released on 2002-07-04.
|
|
|
|
The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
|
|
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
|
|
Copyright (c) 2001,2002 SGB Software
|
|
All Rights Reserved.
|
|
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.sourceforge.net
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvFormPlacement.pas 12083 2008-12-22 12:42:35Z obones $
|
|
|
|
unit JvFormPlacement;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
{$IFDEF HAS_UNIT_VARIANTS}
|
|
Variants,
|
|
{$ENDIF HAS_UNIT_VARIANTS}
|
|
{$IFDEF HAS_UNIT_TYPES}
|
|
Types,
|
|
{$ENDIF HAS_UNIT_TYPES}
|
|
{$IFDEF HAS_UNIT_RTLCONSTS}
|
|
RTLConsts,
|
|
{$ENDIF HAS_UNIT_RTLCONSTS}
|
|
SysUtils, Classes, Windows, Messages, Controls, Forms,
|
|
JvWndProcHook,
|
|
JvAppStorage, JvComponentBase, JvJVCLUtils, JvTypes, JvConsts;
|
|
|
|
type
|
|
TJvIniLink = class;
|
|
|
|
TJvFormPlacement = class;
|
|
|
|
TJvWinMinMaxInfo = class(TPersistent)
|
|
private
|
|
FOwner: TJvFormPlacement;
|
|
FMinMaxInfo: TMinMaxInfo;
|
|
function GetMinMaxInfo(Index: Integer): Integer;
|
|
procedure SetMinMaxInfo(Index: Integer; AValue: 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;
|
|
|
|
TJvFormPlacementVersionCheck = (fpvcNocheck, fpvcCheckGreaterEqual, fpvcCheckEqual);
|
|
|
|
TJvFormPlacement = class(TJvComponent)
|
|
private
|
|
FActive: Boolean;
|
|
FAppStorage: TJvCustomAppStorage;
|
|
FAppStoragePath: string;
|
|
FLinks: TList;
|
|
FOptions: TPlacementOptions;
|
|
FVersion: Integer;
|
|
FVersionCheck: TJvFormPlacementVersionCheck;
|
|
FSaved: Boolean;
|
|
FRestored: Boolean;
|
|
FDestroying: Boolean;
|
|
FPreventResize: Boolean;
|
|
FWinMinMaxInfo: TJvWinMinMaxInfo;
|
|
FDefMaximize: Boolean;
|
|
FWinHook: TJvWindowHook;
|
|
FSaveFormShow: TNotifyEvent;
|
|
FSaveFormDestroy: TNotifyEvent;
|
|
FSaveFormCloseQuery: TCloseQueryEvent;
|
|
FOnSavePlacement: TNotifyEvent;
|
|
FOnRestorePlacement: TNotifyEvent;
|
|
FBeforeSavePlacement: TNotifyEvent;
|
|
FAfterSavePlacement: TNotifyEvent;
|
|
FBeforeRestorePlacement: TNotifyEvent;
|
|
FAfterRestorePlacement: TNotifyEvent;
|
|
procedure SetAppStoragePath(const AValue: string);
|
|
procedure SetEvents;
|
|
procedure RestoreEvents;
|
|
procedure SetHook;
|
|
procedure ReleaseHook;
|
|
procedure CheckToggleHook;
|
|
procedure WndMessage(Sender: TObject; var Msg: TMessage; var Handled: Boolean);
|
|
function CheckMinMaxInfo: Boolean;
|
|
procedure MinMaxInfoModified;
|
|
procedure SetWinMinMaxInfo(AValue: TJvWinMinMaxInfo);
|
|
procedure SetPreventResize(AValue: Boolean);
|
|
procedure UpdatePreventResize;
|
|
procedure UpdatePlacement;
|
|
procedure AddLink(ALink: TJvIniLink);
|
|
procedure NotifyLinks(Operation: TPlacementOperation);
|
|
procedure RemoveLink(ALink: TJvIniLink);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
procedure FormDestroy(Sender: TObject);
|
|
function GetForm: TForm;
|
|
protected
|
|
procedure ResolveAppStoragePath;
|
|
procedure Loaded; override;
|
|
procedure Save; dynamic;
|
|
procedure Restore; dynamic;
|
|
procedure SavePlacement; virtual;
|
|
procedure RestorePlacement; virtual;
|
|
property Form: TForm read GetForm;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
function ConcatPaths(const Paths: array of string): string;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function IsActive: Boolean;
|
|
procedure SaveFormPlacement;
|
|
procedure RestoreFormPlacement;
|
|
function ReadString(const Ident: string; const Default: string = ''): string;
|
|
procedure WriteString(const Ident: string; const AValue: string);
|
|
function ReadBoolean(const Ident: string; Default: Boolean): Boolean;
|
|
procedure WriteBoolean(const Ident: string; AValue: Boolean);
|
|
function ReadFloat(const Ident: string; Default: Double = 0): Double;
|
|
procedure WriteFloat(const Ident: string; AValue: Double);
|
|
function ReadInteger(const Ident: string; Default: Longint = 0): Longint;
|
|
procedure WriteInteger(const Ident: string; AValue: Longint);
|
|
function ReadDateTime(const Ident: string; Default: TDateTime = 0): TDateTime;
|
|
procedure WriteDateTime(const Ident: string; AValue: TDateTime);
|
|
procedure EraseSections;
|
|
published
|
|
property Active: Boolean read FActive write FActive default True;
|
|
property AppStorage: TJvCustomAppStorage read FAppStorage write FAppStorage;
|
|
property AppStoragePath: string read FAppStoragePath write SetAppStoragePath;
|
|
property MinMaxInfo: TJvWinMinMaxInfo read FWinMinMaxInfo write SetWinMinMaxInfo;
|
|
property Options: TPlacementOptions read FOptions write FOptions default [fpState, fpSize, fpLocation];
|
|
property PreventResize: Boolean read FPreventResize write SetPreventResize default False;
|
|
property Version: Integer read FVersion write FVersion default 0;
|
|
property VersionCheck: TJvFormPlacementVersionCheck read FVersionCheck write FVersionCheck default fpvcCheckGreaterEqual;
|
|
property BeforeSavePlacement: TNotifyEvent read FBeforeSavePlacement write
|
|
FBeforeSavePlacement;
|
|
property OnSavePlacement: TNotifyEvent read FOnSavePlacement write FOnSavePlacement;
|
|
property AfterSavePlacement: TNotifyEvent read FAfterSavePlacement write
|
|
FAfterSavePlacement;
|
|
property BeforeRestorePlacement: TNotifyEvent read FBeforeRestorePlacement
|
|
write FBeforeRestorePlacement;
|
|
property OnRestorePlacement: TNotifyEvent read FOnRestorePlacement write FOnRestorePlacement;
|
|
property AfterRestorePlacement: TNotifyEvent read FAfterRestorePlacement write
|
|
FAfterRestorePlacement;
|
|
end;
|
|
|
|
TJvStoredValues = class;
|
|
TJvStoredValue = class;
|
|
TJvFormStorageStringList = class;
|
|
|
|
TJvFormStorage = class(TJvFormPlacement)
|
|
private
|
|
FStoredProps: TJvFormStorageStringList;
|
|
FStoredValues: TJvStoredValues;
|
|
FStoredPropsPath: string;
|
|
function GetStoredProps: TStrings;
|
|
procedure SetStoredProps(AValue: TStrings);
|
|
procedure SetStoredValues(AValue: TJvStoredValues);
|
|
function GetStoredValue(const Name: string): Variant;
|
|
procedure SetStoredValue(const Name: string; AValue: Variant);
|
|
function GetDefaultStoredValue(const Name: string; DefValue: Variant): Variant;
|
|
procedure SetDefaultStoredValue(const Name: string; DefValue: Variant; const AValue: Variant);
|
|
function GetStoredValuesPath: string;
|
|
procedure SetStoredValuesPath(const AValue: string);
|
|
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;
|
|
procedure SetNotification;
|
|
property StoredValue[const Name: string]: Variant read GetStoredValue write SetStoredValue;
|
|
property DefaultValue[const Name: string; DefValue: Variant]: Variant
|
|
read GetDefaultStoredValue write SetDefaultStoredValue;
|
|
published
|
|
property StoredProps: TStrings read GetStoredProps write SetStoredProps;
|
|
property StoredValues: TJvStoredValues read FStoredValues write SetStoredValues;
|
|
property StoredPropsPath: string read FStoredPropsPath write FStoredPropsPath;
|
|
property StoredValuesPath: string read GetStoredValuesPath write SetStoredValuesPath;
|
|
end;
|
|
|
|
TJvFormStorageStringList = class(TStringList)
|
|
private
|
|
FFormStorage: TJvFormStorage;
|
|
public
|
|
constructor Create(AFormStorage: TJvFormStorage);
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure LoadFromStream(Stream: TStream); override;
|
|
end;
|
|
|
|
TJvIniLink = class(TPersistent)
|
|
private
|
|
FStorage: TJvFormPlacement;
|
|
FOnSave: TNotifyEvent;
|
|
FOnLoad: TNotifyEvent;
|
|
procedure SetStorage(AValue: TJvFormPlacement);
|
|
protected
|
|
procedure SaveToIni; virtual;
|
|
procedure LoadFromIni; virtual;
|
|
public
|
|
destructor Destroy; override;
|
|
property Storage: TJvFormPlacement read FStorage write SetStorage;
|
|
property OnSave: TNotifyEvent read FOnSave write FOnSave;
|
|
property OnLoad: TNotifyEvent read FOnLoad write FOnLoad;
|
|
end;
|
|
|
|
TJvStoredValueEvent = procedure(Sender: TJvStoredValue; var AValue: Variant) of object;
|
|
|
|
TJvStoredValue = class(TCollectionItem)
|
|
private
|
|
FName: string;
|
|
FValue: Variant;
|
|
FKeyString: string;
|
|
FOnSave: TJvStoredValueEvent;
|
|
FOnRestore: TJvStoredValueEvent;
|
|
function IsValueStored: Boolean;
|
|
function GetStoredValues: TJvStoredValues;
|
|
protected
|
|
function GetDisplayName: string; override;
|
|
procedure SetDisplayName(const AValue: string); override;
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure Clear;
|
|
procedure Save; virtual;
|
|
procedure Restore; virtual;
|
|
property StoredValues: TJvStoredValues 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: TJvStoredValueEvent read FOnSave write FOnSave;
|
|
property OnRestore: TJvStoredValueEvent read FOnRestore write FOnRestore;
|
|
end;
|
|
|
|
TJvStoredValues = class(TOwnedCollection)
|
|
private
|
|
FStorage: TJvFormPlacement;
|
|
FPath: string;
|
|
function GetValue(const Name: string): TJvStoredValue;
|
|
procedure SetValue(const Name: string; StoredValue: TJvStoredValue);
|
|
function GetStoredValue(const Name: string): Variant;
|
|
procedure SetStoredValue(const Name: string; AValue: Variant);
|
|
function GetItem(Index: Integer): TJvStoredValue;
|
|
procedure SetItem(Index: Integer; StoredValue: TJvStoredValue);
|
|
public
|
|
constructor Create(AOwner: TPersistent);
|
|
function IndexOf(const Name: string): Integer;
|
|
procedure SaveValues; virtual;
|
|
procedure RestoreValues; virtual;
|
|
|
|
property Path: string read FPath write FPath;
|
|
property Storage: TJvFormPlacement read FStorage write FStorage;
|
|
property Items[Index: Integer]: TJvStoredValue read GetItem write SetItem; default;
|
|
property Values[const Name: string]: TJvStoredValue read GetValue write SetValue;
|
|
property StoredValue[const Name: string]: Variant read GetStoredValue write SetStoredValue;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_36_PREPARATION/run/JvFormPlacement.pas $';
|
|
Revision: '$Revision: 12083 $';
|
|
Date: '$Date: 2008-12-22 13:42:35 +0100 (lun., 22 déc. 2008) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
Consts,
|
|
JclStrings,
|
|
JvJCLUtils, JvPropertyStorage;
|
|
|
|
const
|
|
siActiveCtrl = 'ActiveControl'; // do not localize
|
|
siVersion = 'FormVersion'; // do not localize
|
|
cFormNameMask = '%FORM_NAME%'; // do not localize
|
|
|
|
//=== { TJvFormPlacement } ===================================================
|
|
|
|
constructor TJvFormPlacement.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FActive := True;
|
|
if AOwner is TForm then
|
|
FOptions := [fpState, fpSize, fpLocation]
|
|
else
|
|
FOptions := [];
|
|
FWinHook := TJvWindowHook.Create(Self);
|
|
FWinHook.AfterMessage := WndMessage;
|
|
FWinMinMaxInfo := TJvWinMinMaxInfo.Create;
|
|
FWinMinMaxInfo.FOwner := Self;
|
|
FLinks := TList.Create;
|
|
FVersion := 0;
|
|
FVersionCheck := fpvcCheckGreaterEqual;
|
|
FAppStoragePath := cFormNameMask;
|
|
FSaved := False;
|
|
FRestored := False;
|
|
FDestroying := False;
|
|
end;
|
|
|
|
destructor TJvFormPlacement.Destroy;
|
|
begin
|
|
while FLinks.Count > 0 do
|
|
RemoveLink(TJvIniLink(FLinks.Last));
|
|
FLinks.Free;
|
|
if not (csDesigning in ComponentState) then
|
|
begin
|
|
ReleaseHook;
|
|
RestoreEvents;
|
|
end;
|
|
FWinMinMaxInfo.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.Loaded;
|
|
var
|
|
Loading: Boolean;
|
|
begin
|
|
// Mantis 3190: Only resolve when we are loaded so that we get the correct
|
|
// form name if it's a form inheriting from another one.
|
|
Loading := csLoading in ComponentState;
|
|
inherited Loaded;
|
|
if not (csDesigning in ComponentState) then
|
|
begin
|
|
ResolveAppStoragePath;
|
|
if Loading then
|
|
SetEvents;
|
|
CheckToggleHook;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.AddLink(ALink: TJvIniLink);
|
|
begin
|
|
FLinks.Add(ALink);
|
|
ALink.FStorage := Self;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.NotifyLinks(Operation: TPlacementOperation);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to FLinks.Count - 1 do
|
|
case Operation of
|
|
poSave:
|
|
TJvIniLink(FLinks[I]).SaveToIni;
|
|
poRestore:
|
|
TJvIniLink(FLinks[I]).LoadFromIni;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.RemoveLink(ALink: TJvIniLink);
|
|
begin
|
|
ALink.FStorage := nil;
|
|
FLinks.Remove(ALink);
|
|
end;
|
|
|
|
function TJvFormPlacement.GetForm: TForm;
|
|
begin
|
|
if Owner is TCustomForm then
|
|
Result := TForm(Owner as TCustomForm)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.SetAppStoragePath(const AValue: string);
|
|
begin
|
|
if (AValue <> '') and ({$IFDEF COMPILER12_UP}AValue[Length(AValue)]{$ELSE}AnsiLastChar(AValue){$ENDIF COMPILER12_UP} <> '\') then
|
|
FAppStoragePath := AValue + '\'
|
|
else
|
|
FAppStoragePath := AValue;
|
|
|
|
// Mantis 3190: Do not resolve if we are loding, this is way too early to
|
|
// get a valid form name if this form is inheriting from another one.
|
|
if not (csDesigning in ComponentState) and not (csLoading in ComponentState) then
|
|
begin
|
|
ResolveAppStoragePath;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.SetEvents;
|
|
begin
|
|
if Owner is TCustomForm then
|
|
begin
|
|
FSaveFormShow := TForm(Form).OnShow;
|
|
TForm(Form).OnShow := FormShow;
|
|
FSaveFormCloseQuery := TForm(Form).OnCloseQuery;
|
|
TForm(Form).OnCloseQuery := FormCloseQuery;
|
|
FSaveFormDestroy := TForm(Form).OnDestroy;
|
|
TForm(Form).OnDestroy := FormDestroy;
|
|
FDefMaximize := (biMaximize in TForm(Form).BorderIcons);
|
|
if FPreventResize then
|
|
UpdatePreventResize;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.RestoreEvents;
|
|
begin
|
|
if (Owner <> nil) and (Owner is TCustomForm) then
|
|
begin
|
|
TForm(Form).OnShow := FSaveFormShow;
|
|
TForm(Form).OnCloseQuery := FSaveFormCloseQuery;
|
|
TForm(Form).OnDestroy := FSaveFormDestroy;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure TJvFormPlacement.SetHook;
|
|
begin
|
|
if not (csDesigning in ComponentState) and (Owner <> nil) and
|
|
(Owner is TCustomForm) then
|
|
FWinHook.Control := Form;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.ReleaseHook;
|
|
begin
|
|
FWinHook.Control := nil;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.CheckToggleHook;
|
|
begin
|
|
if CheckMinMaxInfo or PreventResize then
|
|
SetHook
|
|
else
|
|
ReleaseHook;
|
|
end;
|
|
|
|
|
|
|
|
function TJvFormPlacement.CheckMinMaxInfo: Boolean;
|
|
begin
|
|
Result := not FWinMinMaxInfo.DefaultMinMaxInfo;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.MinMaxInfoModified;
|
|
begin
|
|
UpdatePlacement;
|
|
if not (csLoading in ComponentState) then
|
|
CheckToggleHook;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.SetWinMinMaxInfo(AValue: TJvWinMinMaxInfo);
|
|
begin
|
|
FWinMinMaxInfo.Assign(AValue);
|
|
end;
|
|
|
|
|
|
procedure TJvFormPlacement.WndMessage(Sender: TObject; var Msg: TMessage;
|
|
var Handled: Boolean);
|
|
{$IFDEF CLR}
|
|
var
|
|
MinMax: TMinMaxInfo;
|
|
InitMenuPopup: TWMInitMenuPopup;
|
|
{$ELSE}
|
|
type
|
|
PWMInitMenuPopup = ^TWMInitMenuPopup;
|
|
var
|
|
MinMax: PMinMaxInfo;
|
|
InitMenuPopup: PWMInitMenuPopup;
|
|
{$ENDIF CLR}
|
|
begin
|
|
if FPreventResize and (Owner is TCustomForm) then
|
|
begin
|
|
case Msg.Msg of
|
|
WM_GETMINMAXINFO:
|
|
if Form.HandleAllocated and IsWindowVisible(Form.Handle) then
|
|
begin
|
|
{$IFDEF CLR}
|
|
MinMax := TWMGetMinMaxInfo.Create(Msg).MinMaxInfo;
|
|
{$ELSE}
|
|
MinMax := TWMGetMinMaxInfo(Msg).MinMaxInfo;
|
|
{$ENDIF CLR}
|
|
MinMax.ptMinTrackSize := Point(Form.Width, Form.Height);
|
|
MinMax.ptMaxTrackSize := Point(Form.Width, Form.Height);
|
|
{$IFDEF CLR}
|
|
TWMGetMinMaxInfo.Create(Msg).MinMaxInfo := MinMax;
|
|
{$ENDIF CLR}
|
|
Msg.Result := 1;
|
|
end;
|
|
WM_INITMENUPOPUP:
|
|
begin
|
|
{$IFDEF CLR}
|
|
InitMenuPopup := TWMInitMenuPopup.Create(Msg);
|
|
{$ELSE}
|
|
InitMenuPopup := PWMInitMenuPopup(@Msg);
|
|
{$ENDIF CLR}
|
|
if InitMenuPopup.SystemMenu then
|
|
begin
|
|
if Form.Menu <> nil then
|
|
Form.Menu.DispatchPopup(InitMenuPopup.MenuPopup);
|
|
EnableMenuItem(InitMenuPopup.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_GRAYED);
|
|
EnableMenuItem(InitMenuPopup.MenuPopup, SC_MAXIMIZE, MF_BYCOMMAND or MF_GRAYED);
|
|
Msg.Result := 1;
|
|
end;
|
|
end;
|
|
WM_NCHITTEST:
|
|
begin
|
|
if Integer(Msg.Result) in [HTLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT,
|
|
HTBOTTOMLEFT, HTTOP, HTTOPRIGHT, HTTOPLEFT] then
|
|
Msg.Result := HTNOWHERE;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if Msg.Msg = WM_GETMINMAXINFO then
|
|
begin
|
|
{$IFDEF CLR}
|
|
MinMax := TWMGetMinMaxInfo.Create(Msg).MinMaxInfo;
|
|
{$ELSE}
|
|
MinMax := TWMGetMinMaxInfo(Msg).MinMaxInfo;
|
|
{$ENDIF CLR}
|
|
if CheckMinMaxInfo then
|
|
begin
|
|
with MinMax{$IFNDEF CLR}^{$ENDIF} do
|
|
begin
|
|
if FWinMinMaxInfo.MinTrackWidth <> 0 then
|
|
ptMinTrackSize.X := FWinMinMaxInfo.MinTrackWidth;
|
|
if FWinMinMaxInfo.MinTrackHeight <> 0 then
|
|
ptMinTrackSize.Y := FWinMinMaxInfo.MinTrackHeight;
|
|
if FWinMinMaxInfo.MaxTrackWidth <> 0 then
|
|
ptMaxTrackSize.X := FWinMinMaxInfo.MaxTrackWidth;
|
|
if FWinMinMaxInfo.MaxTrackHeight <> 0 then
|
|
ptMaxTrackSize.Y := FWinMinMaxInfo.MaxTrackHeight;
|
|
if FWinMinMaxInfo.MaxSizeWidth <> 0 then
|
|
ptMaxSize.X := FWinMinMaxInfo.MaxSizeWidth;
|
|
if FWinMinMaxInfo.MaxSizeHeight <> 0 then
|
|
ptMaxSize.Y := FWinMinMaxInfo.MaxSizeHeight;
|
|
if FWinMinMaxInfo.MaxPosLeft <> 0 then
|
|
ptMaxPosition.X := FWinMinMaxInfo.MaxPosLeft;
|
|
if FWinMinMaxInfo.MaxPosTop <> 0 then
|
|
ptMaxPosition.Y := FWinMinMaxInfo.MaxPosTop;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
MinMax.ptMaxPosition.X := 0;
|
|
MinMax.ptMaxPosition.Y := 0;
|
|
end;
|
|
{$IFDEF CLR}
|
|
TWMGetMinMaxInfo.Create(Msg).MinMaxInfo := MinMax;
|
|
{$ENDIF CLR}
|
|
Msg.Result := 1;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TJvFormPlacement.FormShow(Sender: TObject);
|
|
begin
|
|
if IsActive and not FRestored then
|
|
try
|
|
RestoreFormPlacement;
|
|
except
|
|
Application.HandleException(Self);
|
|
end;
|
|
if Assigned(FSaveFormShow) then
|
|
FSaveFormShow(Sender);
|
|
end;
|
|
|
|
procedure TJvFormPlacement.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
begin
|
|
if Assigned(FSaveFormCloseQuery) then
|
|
FSaveFormCloseQuery(Sender, CanClose);
|
|
if CanClose and IsActive and (Owner is TCustomForm) and (Form.Handle <> NullHandle) then
|
|
try
|
|
SaveFormPlacement;
|
|
except
|
|
Application.HandleException(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.FormDestroy(Sender: TObject);
|
|
begin
|
|
if IsActive and not FSaved then
|
|
begin
|
|
FDestroying := True;
|
|
try
|
|
SaveFormPlacement;
|
|
except
|
|
Application.HandleException(Self);
|
|
end;
|
|
FDestroying := False;
|
|
end;
|
|
if Assigned(FSaveFormDestroy) then
|
|
FSaveFormDestroy(Sender);
|
|
end;
|
|
|
|
|
|
|
|
procedure TJvFormPlacement.UpdatePlacement;
|
|
const
|
|
Metrics: array [bsSingle..bsSizeToolWin] of Word =
|
|
(SM_CXBORDER, SM_CXFRAME, SM_CXDLGFRAME, SM_CXBORDER, SM_CXFRAME);
|
|
var
|
|
Placement: TWindowPlacement;
|
|
begin
|
|
if (Owner <> nil) and (Owner is TCustomForm) and Form.HandleAllocated and
|
|
not (csLoading in ComponentState) then
|
|
if not (FPreventResize or CheckMinMaxInfo) then
|
|
begin
|
|
Placement.Length := SizeOf(TWindowPlacement);
|
|
GetWindowPlacement(Form.Handle, {$IFNDEF CLR}@{$ENDIF} Placement);
|
|
if not IsWindowVisible(Form.Handle) then
|
|
Placement.ShowCmd := SW_HIDE;
|
|
if Form.BorderStyle <> bsNone then
|
|
begin
|
|
Placement.ptMaxPosition.X := -GetSystemMetrics(Metrics[Form.BorderStyle]);
|
|
Placement.ptMaxPosition.Y := -GetSystemMetrics(Succ(Metrics[Form.BorderStyle]));
|
|
end
|
|
else
|
|
Placement.ptMaxPosition := Point(0, 0);
|
|
SetWindowPlacement(Form.Handle, {$IFNDEF CLR}@{$ENDIF} Placement);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.UpdatePreventResize;
|
|
var
|
|
IsActive: Boolean;
|
|
begin
|
|
if not (csDesigning in ComponentState) and (Owner is TCustomForm) then
|
|
begin
|
|
if FPreventResize then
|
|
FDefMaximize := (biMaximize in Form.BorderIcons);
|
|
IsActive := Active;
|
|
Active := False;
|
|
try
|
|
if (not FPreventResize) and FDefMaximize and
|
|
(Form.BorderStyle <> bsDialog) then
|
|
Form.BorderIcons := Form.BorderIcons + [biMaximize]
|
|
else
|
|
Form.BorderIcons := Form.BorderIcons - [biMaximize];
|
|
finally
|
|
Active := IsActive;
|
|
end;
|
|
if not (csLoading in ComponentState) then
|
|
CheckToggleHook;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.SetPreventResize(AValue: Boolean);
|
|
begin
|
|
if (Form <> nil) and (FPreventResize <> AValue) then
|
|
begin
|
|
FPreventResize := AValue;
|
|
UpdatePlacement;
|
|
UpdatePreventResize;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.Save;
|
|
begin
|
|
if Assigned(FOnSavePlacement) then
|
|
FOnSavePlacement(Self);
|
|
end;
|
|
|
|
procedure TJvFormPlacement.Restore;
|
|
begin
|
|
if Assigned(FOnRestorePlacement) then
|
|
FOnRestorePlacement(Self);
|
|
end;
|
|
|
|
procedure TJvFormPlacement.SavePlacement;
|
|
begin
|
|
if Owner is TCustomForm then
|
|
begin
|
|
if Options <> [fpActiveControl] then
|
|
begin
|
|
InternalSaveFormPlacement(Form, AppStorage, AppStoragePath, Options);
|
|
if (fpActiveControl in Options) and (Form.ActiveControl <> nil) then
|
|
AppStorage.WriteString(AppStoragePath + siActiveCtrl, Form.ActiveControl.Name);
|
|
end;
|
|
end;
|
|
NotifyLinks(poSave);
|
|
end;
|
|
|
|
procedure TJvFormPlacement.RestorePlacement;
|
|
begin
|
|
if Owner is TCustomForm then
|
|
InternalRestoreFormPlacement(Form, AppStorage, AppStoragePath, Options);
|
|
NotifyLinks(poRestore);
|
|
end;
|
|
|
|
function TJvFormPlacement.ConcatPaths(const Paths: array of string): string;
|
|
begin
|
|
if Assigned(AppStorage) then
|
|
Result := AppStorage.ConcatPaths(Paths)
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TJvFormPlacement.ReadString(const Ident: string; const Default: string = ''): string;
|
|
begin
|
|
if Assigned(AppStorage) and (Ident <> '') then
|
|
Result := AppStorage.ReadString(AppStorage.ConcatPaths([AppStoragePath, AppStorage.TranslatePropertyName(Self, Ident, True)]), Default)
|
|
else
|
|
Result := Default;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.WriteString(const Ident, AValue: string);
|
|
begin
|
|
if Assigned(AppStorage) and (Ident <> '') then
|
|
AppStorage.WriteString(AppStorage.ConcatPaths([AppStoragePath, AppStorage.TranslatePropertyName(Self, Ident, False)]), AValue);
|
|
end;
|
|
|
|
function TJvFormPlacement.ReadBoolean(const Ident: string; Default: Boolean): Boolean;
|
|
begin
|
|
if Assigned(AppStorage) and (Ident <> '') then
|
|
Result := AppStorage.ReadBoolean(AppStorage.ConcatPaths([AppStoragePath, AppStorage.TranslatePropertyName(Self, Ident, True)]), Default)
|
|
else
|
|
Result := Default;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.WriteBoolean(const Ident: string; AValue: Boolean);
|
|
begin
|
|
if Assigned(AppStorage) and (Ident <> '') then
|
|
AppStorage.WriteBoolean(AppStorage.ConcatPaths([AppStoragePath, AppStorage.TranslatePropertyName(Self, Ident, False)]), AValue);
|
|
end;
|
|
|
|
function TJvFormPlacement.ReadFloat(const Ident: string; Default: Double = 0): Double;
|
|
begin
|
|
if Assigned(AppStorage) and (Ident <> '') then
|
|
Result := AppStorage.ReadFloat(AppStorage.ConcatPaths([AppStoragePath, AppStorage.TranslatePropertyName(Self, Ident, True)]), Default)
|
|
else
|
|
Result := Default;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.WriteFloat(const Ident: string; AValue: Double);
|
|
begin
|
|
if Assigned(AppStorage) and (Ident <> '') then
|
|
AppStorage.WriteFloat(AppStorage.ConcatPaths([AppStoragePath, AppStorage.TranslatePropertyName(Self, Ident, False)]), AValue);
|
|
end;
|
|
|
|
function TJvFormPlacement.ReadInteger(const Ident: string; Default: Longint = 0): Longint;
|
|
begin
|
|
if Assigned(AppStorage) and (Ident <> '') then
|
|
Result := AppStorage.ReadInteger(AppStorage.ConcatPaths([AppStoragePath, AppStorage.TranslatePropertyName(Self, Ident, True)]), Default)
|
|
else
|
|
Result := Default;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.WriteInteger(const Ident: string; AValue: Longint);
|
|
begin
|
|
if Assigned(AppStorage) and (Ident <> '') then
|
|
AppStorage.WriteInteger(AppStorage.ConcatPaths([AppStoragePath, AppStorage.TranslatePropertyName(Self, Ident, False)]), AValue);
|
|
end;
|
|
|
|
function TJvFormPlacement.ReadDateTime(const Ident: string; Default: TDateTime = 0): TDateTime;
|
|
begin
|
|
if Assigned(AppStorage) and (Ident <> '') then
|
|
Result := AppStorage.ReadDateTime(AppStorage.ConcatPaths([AppStoragePath, AppStorage.TranslatePropertyName(Self, Ident, True)]), Default)
|
|
else
|
|
Result := Default;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.WriteDateTime(const Ident: string; AValue: TDateTime);
|
|
begin
|
|
if Assigned(AppStorage) and (Ident <> '') then
|
|
AppStorage.WriteDateTime(AppStorage.ConcatPaths([AppStoragePath, AppStorage.TranslatePropertyName(Self, Ident, False)]), AValue);
|
|
end;
|
|
|
|
procedure TJvFormPlacement.EraseSections;
|
|
begin
|
|
AppStorage.DeleteSubTree(AppStoragePath);
|
|
end;
|
|
|
|
function TJvFormPlacement.IsActive: Boolean;
|
|
begin
|
|
Result := Active and (AppStorage <> nil);
|
|
end;
|
|
|
|
procedure TJvFormPlacement.SaveFormPlacement;
|
|
begin
|
|
if Assigned(AppStorage) then
|
|
begin
|
|
ResolveAppStoragePath; //need to resolve if not resolved yet (for Frames)
|
|
|
|
if Assigned(FBeforeSavePlacement) then
|
|
FBeforeSavePlacement(Self);
|
|
if VersionCheck <> fpvcNocheck then
|
|
WriteInteger(siVersion, FVersion);
|
|
Save;
|
|
SavePlacement;
|
|
if Assigned(FAfterSavePlacement) then
|
|
FAfterSavePlacement(Self);
|
|
FSaved := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.RestoreFormPlacement;
|
|
var
|
|
ActiveCtl: TComponent;
|
|
ReadVersion: Integer;
|
|
ContinueRestore: Boolean;
|
|
begin
|
|
if Assigned(AppStorage) then
|
|
begin
|
|
ResolveAppStoragePath; //need to resolve if not resolved yet (for Frames)
|
|
|
|
FSaved := False;
|
|
ReadVersion := ReadInteger(siVersion, 0);
|
|
case VersionCheck of
|
|
fpvcNocheck:
|
|
ContinueRestore := True;
|
|
fpvcCheckGreaterEqual:
|
|
ContinueRestore := ReadVersion >= FVersion;
|
|
fpvcCheckEqual:
|
|
ContinueRestore := ReadVersion = FVersion;
|
|
else
|
|
ContinueRestore := False;
|
|
end;
|
|
if ContinueRestore then
|
|
begin
|
|
if Assigned(FBeforeRestorePlacement) then
|
|
FBeforeRestorePlacement(Self);
|
|
RestorePlacement;
|
|
FRestored := True;
|
|
Restore;
|
|
if (fpActiveControl in Options) and (Owner is TCustomForm) then
|
|
begin
|
|
ActiveCtl := Form.FindComponent(AppStorage.ReadString(AppStorage.ConcatPaths([AppStoragePath, siActiveCtrl]), ''));
|
|
if (ActiveCtl <> nil) and (ActiveCtl is TWinControl) and
|
|
TWinControl(ActiveCtl).CanFocus then
|
|
Form.ActiveControl := TWinControl(ActiveCtl);
|
|
end;
|
|
if Assigned(FAfterRestorePlacement) then
|
|
FAfterRestorePlacement(Self);
|
|
end;
|
|
FRestored := True;
|
|
end;
|
|
UpdatePlacement;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = AppStorage) then
|
|
AppStorage := nil;
|
|
end;
|
|
|
|
//=== { TJvWinMinMaxInfo } ===================================================
|
|
|
|
procedure TJvWinMinMaxInfo.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TJvWinMinMaxInfo then
|
|
begin
|
|
FMinMaxInfo := TJvWinMinMaxInfo(Source).FMinMaxInfo;
|
|
if FOwner <> nil then
|
|
FOwner.MinMaxInfoModified;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TJvWinMinMaxInfo.GetMinMaxInfo(Index: Integer): Integer;
|
|
begin
|
|
case Index of
|
|
0:
|
|
Result := FMinMaxInfo.ptMaxPosition.X;
|
|
1:
|
|
Result := FMinMaxInfo.ptMaxPosition.Y;
|
|
2:
|
|
Result := FMinMaxInfo.ptMaxSize.Y;
|
|
3:
|
|
Result := FMinMaxInfo.ptMaxSize.X;
|
|
4:
|
|
Result := FMinMaxInfo.ptMaxTrackSize.Y;
|
|
5:
|
|
Result := FMinMaxInfo.ptMaxTrackSize.X;
|
|
6:
|
|
Result := FMinMaxInfo.ptMinTrackSize.Y;
|
|
7:
|
|
Result := FMinMaxInfo.ptMinTrackSize.X;
|
|
else
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvWinMinMaxInfo.SetMinMaxInfo(Index: Integer; AValue: Integer);
|
|
begin
|
|
if GetMinMaxInfo(Index) <> AValue then
|
|
begin
|
|
case Index of
|
|
0:
|
|
FMinMaxInfo.ptMaxPosition.X := AValue;
|
|
1:
|
|
FMinMaxInfo.ptMaxPosition.Y := AValue;
|
|
2:
|
|
FMinMaxInfo.ptMaxSize.Y := AValue;
|
|
3:
|
|
FMinMaxInfo.ptMaxSize.X := AValue;
|
|
4:
|
|
FMinMaxInfo.ptMaxTrackSize.Y := AValue;
|
|
5:
|
|
FMinMaxInfo.ptMaxTrackSize.X := AValue;
|
|
6:
|
|
FMinMaxInfo.ptMinTrackSize.Y := AValue;
|
|
7:
|
|
FMinMaxInfo.ptMinTrackSize.X := AValue;
|
|
end;
|
|
if FOwner <> nil then
|
|
FOwner.MinMaxInfoModified;
|
|
end;
|
|
end;
|
|
|
|
function TJvWinMinMaxInfo.DefaultMinMaxInfo: Boolean;
|
|
begin
|
|
Result := not ((FMinMaxInfo.ptMinTrackSize.X <> 0) or
|
|
(FMinMaxInfo.ptMinTrackSize.Y <> 0) or
|
|
(FMinMaxInfo.ptMaxTrackSize.X <> 0) or
|
|
(FMinMaxInfo.ptMaxTrackSize.Y <> 0) or
|
|
(FMinMaxInfo.ptMaxSize.X <> 0) or
|
|
(FMinMaxInfo.ptMaxSize.Y <> 0) or
|
|
(FMinMaxInfo.ptMaxPosition.X <> 0) or
|
|
(FMinMaxInfo.ptMaxPosition.Y <> 0));
|
|
end;
|
|
|
|
//=== { TJvFormStorage } =====================================================
|
|
|
|
constructor TJvFormStorage.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FStoredProps := TJvFormStorageStringList.Create(Self);
|
|
FStoredValues := TJvStoredValues.Create(Self);
|
|
FStoredValues.Storage := Self;
|
|
end;
|
|
|
|
destructor TJvFormStorage.Destroy;
|
|
begin
|
|
FStoredProps.Free;
|
|
FStoredProps := nil;
|
|
FStoredValues.Free;
|
|
FStoredValues := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvFormStorage.SetNotification;
|
|
var
|
|
I: Integer;
|
|
Component: TComponent;
|
|
begin
|
|
for I := StoredProps.Count - 1 downto 0 do
|
|
begin
|
|
Component := TComponent(StoredProps.Objects[I]);
|
|
if Component <> nil then
|
|
Component.FreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
function TJvFormStorage.GetStoredProps: TStrings;
|
|
begin
|
|
Result := FStoredProps;
|
|
end;
|
|
|
|
procedure TJvFormStorage.SetStoredProps(AValue: TStrings);
|
|
begin
|
|
FStoredProps.Assign(AValue);
|
|
SetNotification;
|
|
end;
|
|
|
|
procedure TJvFormStorage.SetStoredValues(AValue: TJvStoredValues);
|
|
begin
|
|
FStoredValues.Assign(AValue);
|
|
end;
|
|
|
|
function TJvFormStorage.GetStoredValue(const Name: string): Variant;
|
|
begin
|
|
Result := StoredValues.StoredValue[Name];
|
|
end;
|
|
|
|
procedure TJvFormStorage.SetStoredValue(const Name: string; AValue: Variant);
|
|
begin
|
|
StoredValues.StoredValue[Name] := AValue;
|
|
end;
|
|
|
|
procedure TJvFormStorage.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
UpdateStoredList(Owner, FStoredProps, True);
|
|
end;
|
|
|
|
procedure TJvFormStorage.WriteState(Writer: TWriter);
|
|
begin
|
|
UpdateStoredList(Owner, FStoredProps, False);
|
|
inherited WriteState(Writer);
|
|
end;
|
|
|
|
procedure TJvFormStorage.Notification(AComponent: TComponent; Operation: TOperation);
|
|
var
|
|
I: Integer;
|
|
Component: TComponent;
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if not (csDestroying in ComponentState) and (Operation = opRemove) and
|
|
(FStoredProps <> nil) then
|
|
for I := FStoredProps.Count - 1 downto 0 do
|
|
begin
|
|
Component := TComponent(FStoredProps.Objects[I]);
|
|
if Component = AComponent then
|
|
FStoredProps.Delete(I);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormStorage.SaveProperties;
|
|
var
|
|
PropertyStorage: TJvPropertyStorage;
|
|
begin
|
|
PropertyStorage := TJvPropertyStorage.Create;
|
|
try
|
|
PropertyStorage.AppStoragePath := ConcatPaths ([AppStoragePath, StoredPropsPath]);
|
|
PropertyStorage.AppStorage := AppStorage;
|
|
PropertyStorage.StoreObjectsProps(Owner, FStoredProps);
|
|
finally
|
|
PropertyStorage.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormStorage.RestoreProperties;
|
|
var
|
|
PropertyStorage: TJvPropertyStorage;
|
|
begin
|
|
PropertyStorage := TJvPropertyStorage.Create;
|
|
try
|
|
PropertyStorage.AppStoragePath := ConcatPaths ([AppStoragePath, StoredPropsPath]);
|
|
PropertyStorage.AppStorage := AppStorage;
|
|
try
|
|
PropertyStorage.LoadObjectsProps(Owner, FStoredProps);
|
|
except
|
|
{ ignore any exceptions }
|
|
end;
|
|
finally
|
|
PropertyStorage.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormStorage.SavePlacement;
|
|
Var
|
|
JvAppStorageHandler: IJvAppStorageHandler;
|
|
begin
|
|
if FRestored then
|
|
begin
|
|
inherited SavePlacement;
|
|
if Supports(Owner, IJvAppStorageHandler, JvAppStorageHandler)then
|
|
JvAppStorageHandler.WriteToAppStorage(AppStorage, AppStoragePath);
|
|
SaveProperties;
|
|
StoredValues.SaveValues;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvFormStorage.RestorePlacement;
|
|
Var
|
|
JvAppStorageHandler: IJvAppStorageHandler;
|
|
begin
|
|
inherited RestorePlacement;
|
|
FRestored := True;
|
|
if Supports(Owner, IJvAppStorageHandler, JvAppStorageHandler)then
|
|
JvAppStorageHandler.ReadFromAppStorage(AppStorage, AppStoragePath);
|
|
RestoreProperties;
|
|
StoredValues.RestoreValues;
|
|
end;
|
|
|
|
//=== { TJvIniLink } =========================================================
|
|
|
|
destructor TJvIniLink.Destroy;
|
|
begin
|
|
FOnSave := nil;
|
|
FOnLoad := nil;
|
|
SetStorage(nil);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvIniLink.SetStorage(AValue: TJvFormPlacement);
|
|
begin
|
|
if FStorage <> AValue then
|
|
begin
|
|
if FStorage <> nil then
|
|
FStorage.RemoveLink(Self);
|
|
if AValue <> nil then
|
|
AValue.AddLink(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvIniLink.SaveToIni;
|
|
begin
|
|
if Assigned(FOnSave) then
|
|
FOnSave(Self);
|
|
end;
|
|
|
|
procedure TJvIniLink.LoadFromIni;
|
|
begin
|
|
if Assigned(FOnLoad) then
|
|
FOnLoad(Self);
|
|
end;
|
|
|
|
//=== { TJvStoredValue } =====================================================
|
|
|
|
constructor TJvStoredValue.Create(Collection: TCollection);
|
|
begin
|
|
inherited Create(Collection);
|
|
FValue := Unassigned;
|
|
end;
|
|
|
|
procedure TJvStoredValue.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TJvStoredValue then
|
|
begin
|
|
if VarIsEmpty(TJvStoredValue(Source).Value) then
|
|
Clear
|
|
else
|
|
Value := TJvStoredValue(Source).Value;
|
|
Name := TJvStoredValue(Source).Name;
|
|
KeyString := TJvStoredValue(Source).KeyString;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TJvStoredValue.GetDisplayName: string;
|
|
begin
|
|
if FName = '' then
|
|
Result := inherited GetDisplayName
|
|
else
|
|
Result := FName;
|
|
end;
|
|
|
|
procedure TJvStoredValue.SetDisplayName(const AValue: string);
|
|
begin
|
|
if (AValue <> '') and (AnsiCompareText(AValue, FName) <> 0) and
|
|
(Collection is TJvStoredValues) and (TJvStoredValues(Collection).IndexOf(AValue) >= 0) then
|
|
{$IFDEF CLR}
|
|
raise EJVCLException.Create(SDuplicateString);
|
|
{$ELSE}
|
|
raise EJVCLException.CreateRes(@SDuplicateString);
|
|
{$ENDIF CLR}
|
|
FName := AValue;
|
|
inherited SetDisplayName(AValue);
|
|
end;
|
|
|
|
function TJvStoredValue.GetStoredValues: TJvStoredValues;
|
|
begin
|
|
if Collection is TJvStoredValues then
|
|
Result := TJvStoredValues(Collection)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TJvStoredValue.Clear;
|
|
begin
|
|
FValue := Unassigned;
|
|
end;
|
|
|
|
function TJvStoredValue.IsValueStored: Boolean;
|
|
begin
|
|
Result := not VarIsEmpty(FValue);
|
|
end;
|
|
|
|
procedure TJvStoredValue.Save;
|
|
var
|
|
SaveValue: Variant;
|
|
SaveStrValue: string;
|
|
PathName: string;
|
|
begin
|
|
PathName := StoredValues.Storage.ConcatPaths([StoredValues.Path, Name]);
|
|
SaveValue := Value;
|
|
if Assigned(FOnSave) then
|
|
FOnSave(Self, SaveValue);
|
|
if KeyString <> '' then
|
|
begin
|
|
SaveStrValue := VarToStr(SaveValue);
|
|
SaveStrValue := XorEncode(KeyString, SaveStrValue);
|
|
StoredValues.Storage.WriteString(PathName, SaveStrValue);
|
|
end
|
|
else
|
|
if VarIsInt(SaveValue) then
|
|
StoredValues.Storage.WriteInteger(PathName, SaveValue)
|
|
else
|
|
if VarType(SaveValue) in [varSingle, varDouble, varCurrency] then
|
|
StoredValues.Storage.WriteFloat(PathName, SaveValue)
|
|
else
|
|
if VarType(SaveValue) in [varDate] then
|
|
StoredValues.Storage.WriteDateTime(PathName, SaveValue)
|
|
else
|
|
if VarType(SaveValue) in [varBoolean] then
|
|
StoredValues.Storage.WriteBoolean(PathName, SaveValue)
|
|
else
|
|
StoredValues.Storage.WriteString(PathName, SaveValue);
|
|
end;
|
|
|
|
procedure TJvStoredValue.Restore;
|
|
var
|
|
RestoreValue: Variant;
|
|
RestoreStrValue, DefaultStrValue: string;
|
|
PathName: string;
|
|
begin
|
|
PathName := StoredValues.Storage.ConcatPaths([StoredValues.Path, Name]);
|
|
if KeyString <> '' then
|
|
begin
|
|
DefaultStrValue := VarToStr(Value);
|
|
DefaultStrValue := XorEncode(KeyString, DefaultStrValue);
|
|
RestoreStrValue := StoredValues.Storage.ReadString(PathName, DefaultStrValue);
|
|
RestoreStrValue := XorDecode(KeyString, RestoreStrValue);
|
|
RestoreValue := RestoreStrValue;
|
|
end
|
|
else
|
|
if VarIsInt(Value) then
|
|
RestoreValue := StoredValues.Storage.ReadInteger(PathName, Value)
|
|
else
|
|
if VarType(Value) in [varSingle, varDouble, varCurrency] then
|
|
RestoreValue := StoredValues.Storage.ReadFloat(PathName, Value)
|
|
else
|
|
if VarType(Value) in [varDate] then
|
|
RestoreValue := StoredValues.Storage.ReadDateTime(PathName, Value)
|
|
else
|
|
if VarType(Value) in [varBoolean] then
|
|
RestoreValue := StoredValues.Storage.ReadBoolean(PathName, Value)
|
|
else
|
|
RestoreValue := StoredValues.Storage.ReadString(PathName, Value);
|
|
if Assigned(FOnRestore) then
|
|
FOnRestore(Self, RestoreValue);
|
|
Value := RestoreValue;
|
|
end;
|
|
|
|
//=== { TJvStoredValues } ====================================================
|
|
|
|
constructor TJvStoredValues.Create(AOwner: TPersistent);
|
|
begin
|
|
inherited Create(AOwner, TJvStoredValue);
|
|
end;
|
|
|
|
function TJvStoredValues.IndexOf(const Name: string): Integer;
|
|
begin
|
|
for Result := 0 to Count - 1 do
|
|
if AnsiCompareText(Items[Result].Name, Name) = 0 then
|
|
Exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJvStoredValues.GetItem(Index: Integer): TJvStoredValue;
|
|
begin
|
|
Result := TJvStoredValue(inherited Items[Index]);
|
|
end;
|
|
|
|
procedure TJvStoredValues.SetItem(Index: Integer; StoredValue: TJvStoredValue);
|
|
begin
|
|
inherited SetItem(Index, TCollectionItem(StoredValue));
|
|
end;
|
|
|
|
function TJvStoredValues.GetStoredValue(const Name: string): Variant;
|
|
var
|
|
StoredValue: TJvStoredValue;
|
|
begin
|
|
StoredValue := GetValue(Name);
|
|
if StoredValue = nil then
|
|
Result := Null
|
|
else
|
|
Result := StoredValue.Value;
|
|
end;
|
|
|
|
procedure TJvStoredValues.SetStoredValue(const Name: string; AValue: Variant);
|
|
var
|
|
StoredValue: TJvStoredValue;
|
|
begin
|
|
StoredValue := GetValue(Name);
|
|
if StoredValue = nil then
|
|
begin
|
|
StoredValue := TJvStoredValue(Add);
|
|
StoredValue.Name := Name;
|
|
StoredValue.Value := AValue;
|
|
end
|
|
else
|
|
StoredValue.Value := AValue;
|
|
end;
|
|
|
|
function TJvStoredValues.GetValue(const Name: string): TJvStoredValue;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := IndexOf(Name);
|
|
if I < 0 then
|
|
Result := nil
|
|
else
|
|
Result := Items[I];
|
|
end;
|
|
|
|
procedure TJvStoredValues.SetValue(const Name: string; StoredValue: TJvStoredValue);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := IndexOf(Name);
|
|
if I >= 0 then
|
|
Items[I].Assign(StoredValue);
|
|
end;
|
|
|
|
procedure TJvStoredValues.SaveValues;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Count - 1 do
|
|
Items[I].Save;
|
|
end;
|
|
|
|
procedure TJvStoredValues.RestoreValues;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Count - 1 do
|
|
Items[I].Restore;
|
|
end;
|
|
|
|
function TJvFormStorage.GetDefaultStoredValue(const Name: string; DefValue: Variant): Variant;
|
|
begin
|
|
Result := StoredValue[Name];
|
|
if Result = Null then
|
|
Result := DefValue;
|
|
end;
|
|
|
|
procedure TJvFormStorage.SetDefaultStoredValue(const Name: string;
|
|
DefValue: Variant; const AValue: Variant);
|
|
begin
|
|
if AValue = Null then
|
|
StoredValue[Name] := DefValue
|
|
else
|
|
StoredValue[Name] := AValue;
|
|
end;
|
|
|
|
function TJvFormStorage.GetStoredValuesPath: string;
|
|
begin
|
|
Result := FStoredValues.Path;
|
|
end;
|
|
|
|
procedure TJvFormStorage.SetStoredValuesPath(const AValue: string);
|
|
begin
|
|
FStoredValues.Path := AValue;
|
|
end;
|
|
|
|
procedure TJvFormPlacement.ResolveAppStoragePath;
|
|
|
|
function GetFullFrameName(AOwner: TComponent): String;
|
|
var
|
|
Own: String;
|
|
begin
|
|
if AOwner = nil then
|
|
Result := ''
|
|
else
|
|
begin
|
|
Own := GetFullFrameName(AOwner.Owner);
|
|
if Own <> '' then
|
|
Own := Own + '.';
|
|
Result := Own + AOwner.Name;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if (StrFind(cFormNameMask, FAppStoragePath) <> 0) and
|
|
Assigned(Owner) then
|
|
if (Owner is TCustomForm) then
|
|
StrReplace(FAppStoragePath, cFormNameMask, Owner.Name, [rfIgnoreCase])
|
|
else if (Owner is TCustomFrame) then
|
|
StrReplace(FAppStoragePath, cFormNameMask,
|
|
GetFullFrameName(Owner), [rfIgnoreCase])
|
|
end;
|
|
|
|
{ TJvFormStorageStringList }
|
|
|
|
procedure TJvFormStorageStringList.Assign(Source: TPersistent);
|
|
begin
|
|
inherited;
|
|
if not (csLoading in FFormStorage.ComponentState) then
|
|
UpdateStoredList(FFormStorage.Owner, Self, True);
|
|
end;
|
|
|
|
constructor TJvFormStorageStringList.Create(AFormStorage: TJvFormStorage);
|
|
begin
|
|
inherited Create;
|
|
FFormStorage := AFormStorage;
|
|
end;
|
|
|
|
procedure TJvFormStorageStringList.LoadFromStream(Stream: TStream);
|
|
begin
|
|
inherited;
|
|
if not (csLoading in FFormStorage.ComponentState) then
|
|
UpdateStoredList(FFormStorage.Owner, Self, True);
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|
|
|