3
3
* v. 2.0. If a copy of the MPL was not distributed with this file, You can
4
4
* obtain one at http://mozilla.org/MPL/2.0/
5
5
*
6
- * Copyright (C) 1999-2013 , Peter Johnson (www.delphidabbler.com).
6
+ * Copyright (C) 1999-2014 , Peter Johnson (www.delphidabbler.com).
7
7
*
8
- * $Rev$
9
- * $Date$
8
+ * $Rev: 1966 $
9
+ * $Date: 2014-10-28 01:20:04 +0000 (Tue, 28 Oct 2014) $
10
10
*
11
11
* DelphiDabbler Window state components.
12
12
}
15
15
unit PJWdwState;
16
16
17
17
// 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.
19
20
{ $DEFINE WarnDirs} // $WARN compiler directives available
20
21
{ $DEFINE RegAccessFlags} // TRegistry access flags available
22
+ { $DEFINE RequiresFileCtrl} // FileCtrl unit is required for ForceDirectories
21
23
{ $UNDEF RTLNameSpaces} // Don't qualify RTL units names with namespaces
22
24
{ $UNDEF TScrollStyleMoved} // TScrollStyle hasn't moved to System.UITypes units
25
+ { $UNDEF SupportsPathDelim} // PathDelim and related routine not defined
23
26
{ $IFDEF VER100} // Delphi 3
24
27
{ $UNDEF WarnDirs}
25
28
{ $UNDEF RegAccessFlags}
32
35
{ $UNDEF WarnDirs}
33
36
{ $UNDEF RegAccessFlags}
34
37
{ $ENDIF}
35
- { $IFDEF VER140} // Delphi 6
36
- { $UNDEF WarnDirs}
37
- { $ENDIF}
38
38
{ $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
40
44
{ $DEFINE RTLNameSpaces}
41
45
{ $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}
44
50
{ $IFEND}
45
51
{ $ENDIF}
46
52
@@ -54,7 +60,11 @@ interface
54
60
System.Classes, Vcl.Controls, Winapi.Messages, Winapi.Windows, Vcl.Forms,
55
61
System.SysUtils, System.Win.Registry;
56
62
{ $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
+ ;
58
68
{ $ENDIF}
59
69
60
70
@@ -65,6 +75,7 @@ interface
65
75
// instructs MDI child components they can restore their windows
66
76
PJM_RESTOREMDICHILD = WM_USER + 1 ;
67
77
78
+
68
79
type
69
80
70
81
TPJCustomWdwState = class ;
@@ -637,15 +648,42 @@ TPJWdwState = class(TPJCustomWdwState)
637
648
{
638
649
TPJWdwStateGetRegData:
639
650
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.
643
654
@param SubKey [in/out] Registry sub key. Default value passed in. May be
644
655
changed in event handler.
645
656
}
646
657
TPJWdwStateGetRegData = procedure(var RootKey: HKEY;
647
658
var SubKey: string) of object ;
648
659
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
+
649
687
{
650
688
TPJWdwStateRegAccessEvent:
651
689
Type of event that is triggered after registry is opened, ready for access.
@@ -668,23 +706,34 @@ TPJWdwState = class(TPJCustomWdwState)
668
706
}
669
707
TPJRegWdwState = class (TPJCustomWdwState)
670
708
private // properties
671
- fRootKey: HKEY ;
672
- { Value of RootKey property}
709
+ fRootKeyEx: TPJRegRootKey ;
710
+ { Value of RootKeyEx property}
673
711
fSubKey: string;
674
712
{ Value of SubKey property}
675
713
fOnGetRegData: TPJWdwStateGetRegData;
676
714
{ Event handler for OnGetRegData event}
715
+ fOnGetRegDataEx: TPJWdwStateGetRegDataEx;
716
+ { Event handler for OnGetRegDataEx event}
677
717
fOnGettingRegData: TPJWdwStateRegAccessEvent; // Added by BJM
678
718
{ Event handler for OnGettingRegData event}
679
719
fOnPuttingRegData: TPJWdwStateRegAccessEvent; // Added by BJM
680
720
{ 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
+ }
681
730
procedure SetSubKey (const Value : string);
682
731
{ Write accessor method for SubKey property.
683
732
@param Value [in] New property value. If Value='' then the property is
684
733
set to \Software\<App File Name>\Window\<Form Name>.
685
734
}
686
735
protected
687
- procedure GetRegInfo (var ARootKey: HKEY ; var ASubKey: string);
736
+ procedure GetRegInfo (var ARootKey: TPJRegRootKey ; var ASubKey: string);
688
737
{ Triggers OnGetRegData event to get registry root key and sub key to be
689
738
used when restoring / saving window state.
690
739
@param ARootKey [in/out] Required root key value. Set to value of
@@ -729,19 +778,35 @@ TPJRegWdwState = class(TPJCustomWdwState)
729
778
// Published inherited property
730
779
property OnReadWdwState;
731
780
// New properties
732
- property RootKey: HKEY read fRootKey write fRootKey
781
+ property RootKey: HKEY read GetRootKey write SetRootKey
733
782
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}
735
792
property SubKey: string read fSubKey write SetSubKey;
736
793
{ The sub-key below root key where window state is to be stored. If set to
737
794
empty string the value of '/Software/<Program Name>/Window/<Form Name>'
738
795
is used}
739
796
property OnGetRegData: TPJWdwStateGetRegData
740
797
read fOnGetRegData write fOnGetRegData;
741
798
{ 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}
745
810
property OnGettingRegData: TPJWdwStateRegAccessEvent // Added by BJM
746
811
read fOnGettingRegData write fOnGettingRegData;
747
812
{ Event triggered when component is reading window state data from
@@ -786,6 +851,26 @@ procedure Register;
786
851
);
787
852
end ;
788
853
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
+
789
874
{ TPJWdwStateHook }
790
875
791
876
procedure TPJWdwStateHook.CMShowingChanged (var Msg: TMessage);
@@ -1647,6 +1732,43 @@ procedure TPJWdwState.SaveWdwState(const Left, Top, Width, Height,
1647
1732
1648
1733
{ TPJRegWdwState }
1649
1734
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
+
1650
1772
function ReadRegInt (const Reg: TRegistry; const AName: string;
1651
1773
const ADefault: Integer): Integer;
1652
1774
{ Reads integer value from current sub key in registry, using a default value
@@ -1709,26 +1831,45 @@ constructor TPJRegWdwState.Create(AOwner: TComponent);
1709
1831
}
1710
1832
begin
1711
1833
inherited Create(AOwner);
1712
- fRootKey := HKEY_CURRENT_USER ;
1834
+ fRootKeyEx := hkCurrentUser ;
1713
1835
SetSubKey(' ' );
1714
1836
end ;
1715
1837
1716
- procedure TPJRegWdwState.GetRegInfo (var ARootKey: HKEY ;
1838
+ procedure TPJRegWdwState.GetRegInfo (var ARootKey: TPJRegRootKey ;
1717
1839
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.
1720
1843
@param ARootKey [in/out] Required root key value. Set to value of RootKey
1721
1844
property by default. May be changed in event handler.
1722
1845
@param ASubKey [in/ou] Required sub key. Set to value of SubKey property
1723
1846
when called. May be changed in event handler.
1724
1847
}
1848
+ var
1849
+ RootHKey: HKEY; // used to get root key via its HKEY value
1725
1850
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 ;
1728
1853
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];
1732
1873
end ;
1733
1874
1734
1875
procedure TPJRegWdwState.ReadWdwState (var Left, Top, Width, Height,
@@ -1747,16 +1888,16 @@ procedure TPJRegWdwState.ReadWdwState(var Left, Top, Width, Height,
1747
1888
value is the ordinal value of a TWindowState value.
1748
1889
}
1749
1890
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
1753
1894
begin
1754
1895
// Get registry keys from which to read window state
1755
1896
GetRegInfo(ARootKey, ASubKey);
1756
1897
// Open registry at required key
1757
1898
Reg := SafeCreateReg;
1758
1899
try
1759
- Reg.RootKey := ARootKey;
1900
+ Reg.RootKey := RegRootKeyMap[ ARootKey] ;
1760
1901
if Reg.OpenKey(ASubKey, False) then
1761
1902
begin
1762
1903
// Read position, size and state of window
@@ -1785,16 +1926,16 @@ procedure TPJRegWdwState.SaveWdwState(const Left, Top, Width, Height,
1785
1926
value of a TWindowState value.
1786
1927
}
1787
1928
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
1791
1932
begin
1792
1933
// Get registry keys in which to save window state
1793
1934
GetRegInfo(ARootKey, ASubKey);
1794
1935
// Open registry at required key
1795
1936
Reg := SafeCreateReg;
1796
1937
try
1797
- Reg.RootKey := ARootKey;
1938
+ Reg.RootKey := RegRootKeyMap[ ARootKey] ;
1798
1939
if Reg.OpenKey(ASubKey, True) then
1799
1940
begin
1800
1941
// Write window size, position and state from registry
@@ -1812,6 +1953,19 @@ procedure TPJRegWdwState.SaveWdwState(const Left, Top, Width, Height,
1812
1953
end ;
1813
1954
end ;
1814
1955
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
+
1815
1969
procedure TPJRegWdwState.SetSubKey (const Value : string);
1816
1970
{ Write accessor method for SubKey property.
1817
1971
@param Value [in] New property value. If Value='' then the property is set
0 commit comments