Skip to content

Commit e815ebd

Browse files
author
delphidabbler
committed
Update PJWdwState components to v5.6.1 of 28 Oct 2014
1 parent b0a885b commit e815ebd

File tree

1 file changed

+193
-39
lines changed

1 file changed

+193
-39
lines changed

Src/3rdParty/PJWdwState.pas

Lines changed: 193 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,10 @@
33
* v. 2.0. If a copy of the MPL was not distributed with this file, You can
44
* obtain one at http://mozilla.org/MPL/2.0/
55
*
6-
* Copyright (C) 1999-2013, Peter Johnson (www.delphidabbler.com).
6+
* Copyright (C) 1999-2014, Peter Johnson (www.delphidabbler.com).
77
*
8-
* $Rev$
9-
* $Date$
8+
* $Rev: 1966 $
9+
* $Date: 2014-10-28 01:20:04 +0000 (Tue, 28 Oct 2014) $
1010
*
1111
* DelphiDabbler Window state components.
1212
}
@@ -15,11 +15,14 @@
1515
unit PJWdwState;
1616

1717
// Conditional defines
18-
// Note: Delphi 1/2 not included since code will not compile on these compilers
18+
// Note: There is no version checking for Delphi 1 and 2 not since this unit
19+
// will not compile with those compilers.
1920
{$DEFINE WarnDirs} // $WARN compiler directives available
2021
{$DEFINE RegAccessFlags} // TRegistry access flags available
22+
{$DEFINE RequiresFileCtrl} // FileCtrl unit is required for ForceDirectories
2123
{$UNDEF RTLNameSpaces} // Don't qualify RTL units names with namespaces
2224
{$UNDEF TScrollStyleMoved} // TScrollStyle hasn't moved to System.UITypes units
25+
{$UNDEF SupportsPathDelim} // PathDelim and related routine not defined
2326
{$IFDEF VER100} // Delphi 3
2427
{$UNDEF WarnDirs}
2528
{$UNDEF RegAccessFlags}
@@ -32,15 +35,18 @@
3235
{$UNDEF WarnDirs}
3336
{$UNDEF RegAccessFlags}
3437
{$ENDIF}
35-
{$IFDEF VER140} // Delphi 6
36-
{$UNDEF WarnDirs}
37-
{$ENDIF}
3838
{$IFDEF CONDITIONALEXPRESSIONS}
39-
{$IF CompilerVersion >= 23.0} // Delphi XE2
39+
{$IF CompilerVersion >= 24.0} // Delphi XE3 and later
40+
{$LEGACYIFEND ON} // NOTE: this must come before all $IFEND directives
41+
{$DEFINE TScrollStyleMoved}
42+
{$IFEND}
43+
{$IF CompilerVersion >= 23.0} // Delphi XE2 and later
4044
{$DEFINE RTLNameSpaces}
4145
{$IFEND}
42-
{$IF CompilerVersion >= 24.0} // Delphi XE3
43-
{$DEFINE TScrollStyleMoved}
46+
{$IF CompilerVersion >= 14.0} // Delphi 6 and later
47+
{$DEFINE SupportsPathDelim}
48+
{$UNDEF WarnDirs}
49+
{$UNDEF RequiresFileCtrl}
4450
{$IFEND}
4551
{$ENDIF}
4652

@@ -54,7 +60,11 @@ interface
5460
System.Classes, Vcl.Controls, Winapi.Messages, Winapi.Windows, Vcl.Forms,
5561
System.SysUtils, System.Win.Registry;
5662
{$ELSE}
57-
Classes, Controls, Messages, Windows, Forms, SysUtils, Registry;
63+
Classes, Controls, Messages, Windows, Forms, SysUtils, Registry
64+
{$IFDEF RequiresFileCtrl}
65+
, FileCtrl // needed for ForceDirectories since it's not in SysUtils yet.
66+
{$ENDIF}
67+
;
5868
{$ENDIF}
5969

6070

@@ -65,6 +75,7 @@ interface
6575
// instructs MDI child components they can restore their windows
6676
PJM_RESTOREMDICHILD = WM_USER + 1;
6777

78+
6879
type
6980

7081
TPJCustomWdwState = class;
@@ -637,15 +648,42 @@ TPJWdwState = class(TPJCustomWdwState)
637648
{
638649
TPJWdwStateGetRegData:
639650
Type of event that is triggered just before registry is accessed. It allows
640-
handler to change the registry HKEY and sub key to be used.
641-
@param RootKey [in/out] Registry root key. Default value passed in. May be
642-
changed in event handler.
651+
handler to change the registry root key and sub key to be used.
652+
@param RootKey [in/out] Registry root key. Default HKEY value passed in.
653+
May be changed in event handler.
643654
@param SubKey [in/out] Registry sub key. Default value passed in. May be
644655
changed in event handler.
645656
}
646657
TPJWdwStateGetRegData = procedure(var RootKey: HKEY;
647658
var SubKey: string) of object;
648659

660+
{TPJRegRootKey:
661+
Enumeration of values that represent the registry root keys supported by
662+
TPJRegWdwState. Each value represents and maps to the similarly named
663+
HKEY_* constant, as shown in the comments.
664+
}
665+
TPJRegRootKey = (
666+
hkClassesRoot, // HKEY_CLASSES_ROOT
667+
hkCurrentUser, // HKEY_CURRENT_USER
668+
hkLocalMachine, // HKEY_LOCAL_MACHINE
669+
hkUsers, // HKEY_USERS
670+
hkPerformanceData, // HKEY_PERFORMANCE_DATA
671+
hkCurrentConfig, // HKEY_CURRENT_CONFIG
672+
hkDynData // HKEY_DYN_DATA
673+
);
674+
675+
{
676+
TPJWdwStateGetRegDataEx:
677+
Type of event that is triggered just before registry is accessed. It allows
678+
handler to change the registry root key and sub key to be used.
679+
@param RootKeyEx [in/out] Registry root key. Default TPJRegRootKey value
680+
passed in. May be changed in event handler.
681+
@param SubKey [in/out] Registry sub key. Default value passed in. May be
682+
changed in event handler.
683+
}
684+
TPJWdwStateGetRegDataEx = procedure(var RootKeyEx: TPJRegRootKey;
685+
var SubKey: string) of object;
686+
649687
{
650688
TPJWdwStateRegAccessEvent:
651689
Type of event that is triggered after registry is opened, ready for access.
@@ -668,23 +706,34 @@ TPJWdwState = class(TPJCustomWdwState)
668706
}
669707
TPJRegWdwState = class(TPJCustomWdwState)
670708
private // properties
671-
fRootKey: HKEY;
672-
{Value of RootKey property}
709+
fRootKeyEx: TPJRegRootKey;
710+
{Value of RootKeyEx property}
673711
fSubKey: string;
674712
{Value of SubKey property}
675713
fOnGetRegData: TPJWdwStateGetRegData;
676714
{Event handler for OnGetRegData event}
715+
fOnGetRegDataEx: TPJWdwStateGetRegDataEx;
716+
{Event handler for OnGetRegDataEx event}
677717
fOnGettingRegData: TPJWdwStateRegAccessEvent; // Added by BJM
678718
{Event handler for OnGettingRegData event}
679719
fOnPuttingRegData: TPJWdwStateRegAccessEvent; // Added by BJM
680720
{Event handler for OnPuttingRegData event}
721+
function GetRootKey: HKEY;
722+
{Read accessor for RootKey property.
723+
@return Required property value.
724+
}
725+
procedure SetRootKey(const Value: HKEY);
726+
{Write accessor for RootKey property.
727+
@param Value [in] New property value.
728+
@exception ERangeError raised if value is not a recognised HKEY_* value.
729+
}
681730
procedure SetSubKey(const Value: string);
682731
{Write accessor method for SubKey property.
683732
@param Value [in] New property value. If Value='' then the property is
684733
set to \Software\<App File Name>\Window\<Form Name>.
685734
}
686735
protected
687-
procedure GetRegInfo(var ARootKey: HKEY; var ASubKey: string);
736+
procedure GetRegInfo(var ARootKey: TPJRegRootKey; var ASubKey: string);
688737
{Triggers OnGetRegData event to get registry root key and sub key to be
689738
used when restoring / saving window state.
690739
@param ARootKey [in/out] Required root key value. Set to value of
@@ -729,19 +778,35 @@ TPJRegWdwState = class(TPJCustomWdwState)
729778
// Published inherited property
730779
property OnReadWdwState;
731780
// New properties
732-
property RootKey: HKEY read fRootKey write fRootKey
781+
property RootKey: HKEY read GetRootKey write SetRootKey
733782
default HKEY_CURRENT_USER;
734-
{Registry root key to use. Must be set to a valid HKEY value}
783+
{Registry root key to use. Must be set to a valid HKEY value. Setting this
784+
property also sets RootKeyEx to a corresponding value}
785+
property RootKeyEx: TPJRegRootKey read fRootKeyEx write fRootKeyEx
786+
stored False default hkCurrentUser;
787+
{Registry root key to use as specified by a value from the TPJRegRootKey
788+
enumeration. Setting this property also sets RootKey to a corresponding
789+
value.
790+
NOTE: This property is provided to make it easier to set root keys at
791+
design time to avoid remembering the root key value as an integer}
735792
property SubKey: string read fSubKey write SetSubKey;
736793
{The sub-key below root key where window state is to be stored. If set to
737794
empty string the value of '/Software/<Program Name>/Window/<Form Name>'
738795
is used}
739796
property OnGetRegData: TPJWdwStateGetRegData
740797
read fOnGetRegData write fOnGetRegData;
741798
{Event triggered just before registry is read when restoring and saving
742-
window state. Allows handler to change registry HKEY and subkey to be used
743-
to store window state. If this event is handled then RootKey and SubKey
744-
properties are ignored}
799+
window state. Allows handler to change root key and subkey to be used to
800+
store window state. Root key is specified via its HKEY value. If this
801+
event is handled then RootKey, RootKeyEx and SubKey properties are all
802+
ignored}
803+
property OnGetRegDataEx: TPJWdwStateGetRegDataEx
804+
read fOnGetRegDataEx write fOnGetRegDataEx;
805+
{Event triggered just before registry is read when restoring and saving
806+
window state. Allows handler to change root key and subkey to be used to
807+
store window state. Root key is specified via its TPJRegRootKey value. If
808+
this event is handled then RootKey, RootKeyEx and SubKey properties are
809+
all ignored}
745810
property OnGettingRegData: TPJWdwStateRegAccessEvent // Added by BJM
746811
read fOnGettingRegData write fOnGettingRegData;
747812
{Event triggered when component is reading window state data from
@@ -786,6 +851,26 @@ procedure Register;
786851
);
787852
end;
788853

854+
{$IFNDEF SupportsPathDelim}
855+
// Definitions used for versions of Delphi that don't implement the following
856+
// constant and function in SysUtils.
857+
858+
const
859+
// File path delimiter
860+
PathDelim = '/';
861+
862+
// Ensures that given directory or path ends with exactly one path delimiter.
863+
function IncludeTrailingPathDelimiter(const PathOrDir: string): string;
864+
begin
865+
Result := PathOrDir;
866+
// remove all trailing path delimiters if any, to get rid of any duplicates
867+
while (Result <> '') and (Result[Length(Result)] = PathDelim) do
868+
Result := Copy(Result, 1, Length(Result) - 1);
869+
// add a single trailing delimiter
870+
Result := Result + PathDelim;
871+
end;
872+
{$ENDIF}
873+
789874
{ TPJWdwStateHook }
790875

791876
procedure TPJWdwStateHook.CMShowingChanged(var Msg: TMessage);
@@ -1647,6 +1732,43 @@ procedure TPJWdwState.SaveWdwState(const Left, Top, Width, Height,
16471732

16481733
{ TPJRegWdwState }
16491734

1735+
resourcestring
1736+
// Error messages
1737+
sErrBadHKEY = '%d is not a valid HKEY value.';
1738+
1739+
const
1740+
// Map of supported HKEY_ constants onto corresponding TPJRegRootKey values.
1741+
RegRootKeyMap: array[TPJRegRootKey] of HKEY = (
1742+
HKEY_CLASSES_ROOT, // hkClassesRoot
1743+
HKEY_CURRENT_USER, // hkCurrentUser
1744+
HKEY_LOCAL_MACHINE, // hkLocalMachine
1745+
HKEY_USERS, // hkUsers
1746+
HKEY_PERFORMANCE_DATA, // hkPerformanceData
1747+
HKEY_CURRENT_CONFIG, // hkCurrentConfig
1748+
HKEY_DYN_DATA // hkDynData
1749+
);
1750+
1751+
function TryHKEYToCode(const RootKey: HKEY; var Value: TPJRegRootKey): Boolean;
1752+
{Attempts to convert a HKEY value into the corresponding TPJRegRootKey value.
1753+
@param RootKey [in] HKEY value to convert.
1754+
@param Value [in/out] Set to TPJRegRootKey value corresponding to RootKey.
1755+
Value is undefined if RootKey has no corresponding TPJRegRootKey value.
1756+
@return True if RootKey is valid and has corresponding TPJRegRootKey value
1757+
or False of not.
1758+
}
1759+
var
1760+
Code: TPJRegRootKey;
1761+
begin
1762+
Result := True;
1763+
for Code := Low(TPJRegRootKey) to High(TPJRegRootKey) do
1764+
if RegRootKeyMap[Code] = RootKey then
1765+
begin
1766+
Value := Code;
1767+
Exit;
1768+
end;
1769+
Result := False;
1770+
end;
1771+
16501772
function ReadRegInt(const Reg: TRegistry; const AName: string;
16511773
const ADefault: Integer): Integer;
16521774
{Reads integer value from current sub key in registry, using a default value
@@ -1709,26 +1831,45 @@ constructor TPJRegWdwState.Create(AOwner: TComponent);
17091831
}
17101832
begin
17111833
inherited Create(AOwner);
1712-
fRootKey := HKEY_CURRENT_USER;
1834+
fRootKeyEx := hkCurrentUser;
17131835
SetSubKey('');
17141836
end;
17151837

1716-
procedure TPJRegWdwState.GetRegInfo(var ARootKey: HKEY;
1838+
procedure TPJRegWdwState.GetRegInfo(var ARootKey: TPJRegRootKey;
17171839
var ASubKey: string);
1718-
{Triggers OnGetRegData event to get registry root key and sub key to be used
1719-
when restoring / saving window state.
1840+
{Triggers the OnGetRegDateEx event or, if that is not assigned, the
1841+
OnGetRegData event, to get registry root key and sub key to be used when
1842+
restoring / saving window state.
17201843
@param ARootKey [in/out] Required root key value. Set to value of RootKey
17211844
property by default. May be changed in event handler.
17221845
@param ASubKey [in/ou] Required sub key. Set to value of SubKey property
17231846
when called. May be changed in event handler.
17241847
}
1848+
var
1849+
RootHKey: HKEY; // used to get root key via its HKEY value
17251850
begin
1726-
// Use RootKey and SubKey property values by default
1727-
ARootKey := RootKey;
1851+
// Use RootKeyEx and SubKey property values by default
1852+
ARootKey := RootKeyEx;
17281853
ASubKey := SubKey;
1729-
// Allow user to change these by handling OnGetRegData event
1730-
if Assigned(fOnGetRegData) then
1731-
fOnGetRegData(ARootKey, ASubKey);
1854+
// Allow user to change these by handling either OnGetRegDataEx or
1855+
// OnGetRegData event
1856+
if Assigned(fOnGetRegDataEx) then
1857+
fOnGetRegDataEx(ARootKey, ASubKey)
1858+
else if Assigned(fOnGetRegData) then
1859+
begin
1860+
RootHKey := RegRootKeyMap[ARootKey];
1861+
fOnGetRegData(RootHKey, ASubKey);
1862+
if not TryHKEYToCode(RootHKey, ARootKey) then
1863+
raise ERangeError.CreateFmt(sErrBadHKEY, [RootHKey]);
1864+
end;
1865+
end;
1866+
1867+
function TPJRegWdwState.GetRootKey: HKEY;
1868+
{Read accessor for RootKey property.
1869+
@return Required property value.
1870+
}
1871+
begin
1872+
Result := RegRootKeyMap[fRootKeyEx];
17321873
end;
17331874

17341875
procedure TPJRegWdwState.ReadWdwState(var Left, Top, Width, Height,
@@ -1747,16 +1888,16 @@ procedure TPJRegWdwState.ReadWdwState(var Left, Top, Width, Height,
17471888
value is the ordinal value of a TWindowState value.
17481889
}
17491890
var
1750-
Reg: TRegistry; // instance of registry object used to read info
1751-
ARootKey: HKEY; // registry root key where window state is stored
1752-
ASubKey: string; // sub key of registry from which to read window state
1891+
Reg: TRegistry; // instance of registry object used to read info
1892+
ARootKey: TPJRegRootKey; // registry root key where window state is stored
1893+
ASubKey: string; // registry sub key from which to read window state
17531894
begin
17541895
// Get registry keys from which to read window state
17551896
GetRegInfo(ARootKey, ASubKey);
17561897
// Open registry at required key
17571898
Reg := SafeCreateReg;
17581899
try
1759-
Reg.RootKey := ARootKey;
1900+
Reg.RootKey := RegRootKeyMap[ARootKey];
17601901
if Reg.OpenKey(ASubKey, False) then
17611902
begin
17621903
// Read position, size and state of window
@@ -1785,16 +1926,16 @@ procedure TPJRegWdwState.SaveWdwState(const Left, Top, Width, Height,
17851926
value of a TWindowState value.
17861927
}
17871928
var
1788-
Reg: TRegistry; // instance of registry object class used to write info
1789-
ARootKey: HKEY; // registry root key where window state is stored
1790-
ASubKey: string; // sub key of registry in which to save window state
1929+
Reg: TRegistry; // instance of registry object used to write info
1930+
ARootKey: TPJRegRootKey; // registry root key where window state is stored
1931+
ASubKey: string; // sub key of registry in which to save window state
17911932
begin
17921933
// Get registry keys in which to save window state
17931934
GetRegInfo(ARootKey, ASubKey);
17941935
// Open registry at required key
17951936
Reg := SafeCreateReg;
17961937
try
1797-
Reg.RootKey := ARootKey;
1938+
Reg.RootKey := RegRootKeyMap[ARootKey];
17981939
if Reg.OpenKey(ASubKey, True) then
17991940
begin
18001941
// Write window size, position and state from registry
@@ -1812,6 +1953,19 @@ procedure TPJRegWdwState.SaveWdwState(const Left, Top, Width, Height,
18121953
end;
18131954
end;
18141955

1956+
procedure TPJRegWdwState.SetRootKey(const Value: HKEY);
1957+
{Write accessor for RootKey property.
1958+
@param Value [in] New property value.
1959+
@exception ERangeError raised if value is not a recognised HKEY_* value.
1960+
}
1961+
begin
1962+
if not TryHKEYToCode(Value, fRootKeyEx) then
1963+
begin
1964+
fRootKeyEx := hkCurrentUser;
1965+
raise ERangeError.CreateFmt(sErrBadHKEY, [Value]);
1966+
end;
1967+
end;
1968+
18151969
procedure TPJRegWdwState.SetSubKey(const Value: string);
18161970
{Write accessor method for SubKey property.
18171971
@param Value [in] New property value. If Value='' then the property is set

0 commit comments

Comments
 (0)