jcl-checkins-diff Mailing List for JEDI Code Library (Page 8)

Brought to you by: mthoma, obones, outchy, rrossmair

jcl-checkins-diff — SVN file check-in notifications with file differences included

You can subscribe to this list here.

2006	Jan	Feb	Mar	Apr (20)	May (48)	Jun (8)	Jul (23)	Aug (41)	Sep (42)	Oct (22)	Nov (17)	Dec (36)
2007	Jan (43)	Feb (42)	Mar (17)	Apr (39)	May (16)	Jun (35)	Jul (37)	Aug (47)	Sep (49)	Oct (9)	Nov (52)	Dec (37)
2008	Jan (48)	Feb (21)	Mar (7)	Apr (2)	May (5)	Jun (17)	Jul (17)	Aug (40)	Sep (58)	Oct (38)	Nov (19)	Dec (32)
2009	Jan (67)	Feb (46)	Mar (54)	Apr (34)	May (37)	Jun (52)	Jul (67)	Aug (72)	Sep (48)	Oct (35)	Nov (27)	Dec (12)
2010	Jan (56)	Feb (46)	Mar (19)	Apr (14)	May (21)	Jun (3)	Jul (13)	Aug (48)	Sep (34)	Oct (51)	Nov (16)	Dec (32)
2011	Jan (36)	Feb (14)	Mar (12)	Apr (3)	May (5)	Jun (24)	Jul (15)	Aug (30)	Sep (21)	Oct (4)	Nov (25)	Dec (23)
2012	Jan (45)	Feb (42)	Mar (19)	Apr (14)	May (13)	Jun (7)	Jul (3)	Aug (46)	Sep (21)	Oct (10)	Nov (2)	Dec
2013	Jan (5)	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec

Flat | Threaded

<< < 1 .. 6 7 8 9 10 .. 92 > >> (Page 8 of 92)

[Jcl-checkins-diff] SF.net SVN: jcl:[3717] trunk/jcl/source/common

From: <jg...@us...> - 2012-02-12 07:43:29

Revision: 3717
          http://jcl.svn.sourceforge.net/jcl/?rev=3717&view=rev
Author:   jgsoft
Date:     2012-02-12 07:43:23 +0000 (Sun, 12 Feb 2012)
Log Message:
-----------
Minor fixes to handling out-of-place archive updates in JclCompression when using streams rather than files

Modified Paths:
--------------
    trunk/jcl/source/common/JclCompression.pas
    trunk/jcl/source/common/JclResources.pas

Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas	2012-02-11 18:25:21 UTC (rev 3716)
+++ trunk/jcl/source/common/JclCompression.pas	2012-02-12 07:43:23 UTC (rev 3717)
@@ -1115,7 +1115,7 @@
 
   // called when tmp volumes will replace volumes after out-of-place update
   TJclCompressionReplaceEvent = function (Sender: TObject; const SrcFileName, DestFileName: TFileName;
-    var SrcStream, DestStream: TStream; var OwnsSrcStream, OwnsDestStream: Boolean): Boolean;
+    var SrcStream, DestStream: TStream; var OwnsSrcStream, OwnsDestStream: Boolean): Boolean of object;
 
   // ancestor class for all archives that update files out-of-place (by creating a copy of the volumes)
   TJclOutOfPlaceUpdateArchive = class(TJclUpdateArchive, IInterface)
@@ -5525,6 +5525,7 @@
           CopiedSize := StreamCopy(SrcStream, DestStream);
           // reset size
           DestStream.Size := CopiedSize;
+          Handled := True;
         end;
         // identity
         // else
@@ -5571,14 +5572,15 @@
   begin
     AOwnsStream := VolumeFileNameMask <> '';
     AVolume := nil;
-    AFileName := FindUnusedFileName(Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '.tmp');
+    if VolumeFileNameMask = '' then AFileName := ''
+      else AFileName := FindUnusedFileName(Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '.tmp');
     if (Index >= 0) and (Index < FVolumes.Count) then
     begin
       AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
       Result := AVolume.TmpStream;
       AOwnsStream := AVolume.OwnsTmpStream;
       AFileName := AVolume.TmpFileName;
-      if AFileName = '' then
+      if (AFileName = '') and (AVolume.FileName <> '') then
         AFileName := FindUnusedFileName(AVolume.FileName, '.tmp');
     end;
 

Modified: trunk/jcl/source/common/JclResources.pas
===================================================================
--- trunk/jcl/source/common/JclResources.pas	2012-02-11 18:25:21 UTC (rev 3716)
+++ trunk/jcl/source/common/JclResources.pas	2012-02-12 07:43:23 UTC (rev 3717)
@@ -1128,7 +1128,7 @@
   RsCompressionCramFSName            = 'CramFS archive';
   RsCompressionCramFSExtensions      = '*.cramfs';
   RsCompressionDuplicate             = 'The file %s already exists in the archive';
-  RsCompressionReplaceError          = 'At least one compression volumes could not be replaced after an archive out-of-place update';
+  RsCompressionReplaceError          = 'At least one compression volume could not be replaced after an archive out-of-place update';
 
 //=== JclConsole =============================================================
 resourcestring

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3716] trunk/jcl/source/common/JclSimpleXml.pas

From: <jfu...@us...> - 2012-02-11 18:25:27

Revision: 3716
          http://jcl.svn.sourceforge.net/jcl/?rev=3716&view=rev
Author:   jfudickar
Date:     2012-02-11 18:25:21 +0000 (Sat, 11 Feb 2012)
Log Message:
-----------
Mantis  
- 0005786 + 0005564 + 0005218: Improved Performance by using TMemoryStream in TJclSimpleXML.SaveToFile
- 0005785: Improved MemoryConsumption by replacing THashedStringList with TStringList

Modified Paths:
--------------
    trunk/jcl/source/common/JclSimpleXml.pas

Modified: trunk/jcl/source/common/JclSimpleXml.pas
===================================================================
--- trunk/jcl/source/common/JclSimpleXml.pas	2012-02-06 03:36:34 UTC (rev 3715)
+++ trunk/jcl/source/common/JclSimpleXml.pas	2012-02-11 18:25:21 UTC (rev 3716)
@@ -51,14 +51,12 @@
   {$ENDIF MSWINDOWS}
   System.SysUtils, System.Classes,
   System.Variants,
-  System.IniFiles,
   {$ELSE ~HAS_UNITSCOPE}
   {$IFDEF MSWINDOWS}
   Windows, // Delphi 2005 inline
   {$ENDIF MSWINDOWS}
   SysUtils, Classes,
   Variants,
-  IniFiles,
   {$ENDIF ~HAS_UNITSCOPE}
   JclBase, JclStreams;
 
@@ -167,7 +165,7 @@
 
   TJclSimpleXMLProps = class(TObject)
   private
-    FProperties: THashedStringList;
+    FProperties: TStringList;
     FParent: TJclSimpleXMLElem;
     function GetCount: Integer;
     function GetItemNamedDefault(const Name, Default: string): TJclSimpleXMLProp;
@@ -222,7 +220,7 @@
 
   TJclSimpleXMLElemsProlog = class(TObject)
   private
-    FElems: THashedStringList;
+    FElems: TStringList;
     FSimpleXml: TJclSimpleXml;
     function GetCount: Integer;
     function GetItem(const Index: Integer): TJclSimpleXMLElem;
@@ -328,9 +326,9 @@
     function GetItemNamed(const Name: string): TJclSimpleXMLElem;
     function GetNamedElems(const Name: string): TJclSimpleXMLNamedElems;
   protected
-    FElems: THashedStringList;
+    FElems: TStringList;
     FCompare: TJclSimpleXMLElemCompare;
-    FNamedElems: THashedStringList;
+    FNamedElems: TStringList;
     function GetItem(const Index: Integer): TJclSimpleXMLElem;
     procedure AddChild(const Value: TJclSimpleXMLElem);
     procedure AddChildFirst(const Value: TJclSimpleXMLElem);
@@ -1231,17 +1229,12 @@
 
 procedure TJclSimpleXML.SaveToFile(const FileName: TFileName; Encoding: TJclStringEncoding; CodePage: Word);
 var
-  Stream: TFileStream;
+  Stream: TMemoryStream;
 begin
-  if {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FileExists(FileName) then
-  begin
-    Stream := TFileStream.Create(FileName, fmOpenWrite);
-    Stream.Size := 0;
-  end
-  else
-    Stream := TFileStream.Create(FileName, fmCreate);
+  Stream := TMemoryStream.Create;
   try
     SaveToStream(Stream, Encoding, CodePage);
+    Stream.SaveToFile(FileName);
   finally
     Stream.Free;
   end;
@@ -2062,7 +2055,7 @@
 procedure TJclSimpleXMLElems.CreateElems;
 begin
   if FElems = nil then
-    FElems := THashedStringList.Create;
+    FElems := TStringList.Create;
 end;
 
 procedure TJclSimpleXMLElems.Delete(const Index: Integer);
@@ -2183,7 +2176,7 @@
   NamedIndex: Integer;
 begin
   if FNamedElems = nil then
-    FNamedElems := THashedStringList.Create;
+    FNamedElems := TStringList.Create;
   NamedIndex := FNamedElems.IndexOf(Name);
   if NamedIndex = -1 then
   begin
@@ -2509,7 +2502,7 @@
   Elem: TJclSimpleXMLProp;
 begin
   if FProperties = nil then
-    FProperties := THashedStringList.Create;
+    FProperties := TStringList.Create;
   Elem := TJclSimpleXMLProp.Create(Name);
   FProperties.AddObject(Name, Elem);
   Elem.Value := Value;
@@ -2540,7 +2533,7 @@
   Elem: TJclSimpleXMLProp;
 begin
   if FProperties = nil then
-    FProperties := THashedStringList.Create;
+    FProperties := TStringList.Create;
   Elem := TJclSimpleXMLProp.Create(Name);
   FProperties.InsertObject(Index, Name, Elem);
   Elem.Value := Value;
@@ -3682,7 +3675,7 @@
 constructor TJclSimpleXMLElemsProlog.Create;
 begin
   inherited Create;
-  FElems := THashedStringList.Create;
+  FElems := TStringList.Create;
 end;
 
 destructor TJclSimpleXMLElemsProlog.Destroy;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3715] trunk/jcl/source/common/JclCompression.pas

From: <jg...@us...> - 2012-02-06 03:36:40

Revision: 3715
          http://jcl.svn.sourceforge.net/jcl/?rev=3715&view=rev
Author:   jgsoft
Date:     2012-02-06 03:36:34 +0000 (Mon, 06 Feb 2012)
Log Message:
-----------
Using TJclUpdateArchive to extract an item into a stream with Item.OwnStream set to False caused the stream to be freed immediately after extraction because TJclUpdateArchive.ValidateExtraction() set Item.FileName even when Assigned(AStream).  TJclDecompressArchive.ValidateExtraction() did not set Item.FileName when Assigned(AStream).  I have changed TJclUpdateArchive.ValidateExtraction() to behave in the same way, fixing the bug.

Modified Paths:
--------------
    trunk/jcl/source/common/JclCompression.pas

Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas	2012-02-03 20:06:34 UTC (rev 3714)
+++ trunk/jcl/source/common/JclCompression.pas	2012-02-06 03:36:34 UTC (rev 3715)
@@ -5443,7 +5443,7 @@
 
   AItem := Items[Index];
 
-  if FileName = '' then
+  if (FileName = '') and not Assigned(AStream) then
   begin
     PackedName := AItem.PackedName;
 

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3714] trunk/jcl/source

From: <ou...@us...> - 2012-02-03 20:06:43

Revision: 3714
          http://jcl.svn.sourceforge.net/jcl/?rev=3714&view=rev
Author:   outchy
Date:     2012-02-03 20:06:34 +0000 (Fri, 03 Feb 2012)
Log Message:
-----------
Move hash to range function from JclHashMaps.pas to JclAlgorithms.pas.

Modified Paths:
--------------
    trunk/jcl/source/common/JclAlgorithms.pas
    trunk/jcl/source/common/JclHashMaps.pas
    trunk/jcl/source/prototypes/JclAlgorithms.pas
    trunk/jcl/source/prototypes/JclHashMaps.pas
    trunk/jcl/source/prototypes/containers/JclHashMaps.imp
    trunk/jcl/source/prototypes/containers/JclHashMaps.int

Modified: trunk/jcl/source/common/JclAlgorithms.pas
===================================================================
--- trunk/jcl/source/common/JclAlgorithms.pas	2012-02-03 18:37:35 UTC (rev 3713)
+++ trunk/jcl/source/common/JclAlgorithms.pas	2012-02-03 20:06:34 UTC (rev 3714)
@@ -123,6 +123,13 @@
 function UnicodeStrSimpleHashConvertI(const AString: UnicodeString): Integer;
 {$ENDIF SUPPORTS_UNICODE_STRING}
 
+type
+  // Hash Function
+  // Result must be in 0..Range-1
+  TJclHashToRangeFunction = function(Key, Range: Integer): Integer;
+
+function JclSimpleHashToRange(Key, Range: Integer): Integer;
+
 // move array algorithms
 procedure MoveArray(var List: TDynIInterfaceArray; FromIndex, ToIndex, Count: SizeInt); overload;
 procedure MoveArray(var List: TDynAnsiStringArray; FromIndex, ToIndex, Count: SizeInt); overload;
@@ -1108,6 +1115,14 @@
   Result := SizeInt(AObject) and MaxInt;
 end;
 
+function JclSimpleHashToRange(Key, Range: Integer): Integer;
+// return a value between 0 and (Range-1) based on integer-hash Key
+const
+  A = 0.6180339887; // (sqrt(5) - 1) / 2
+begin
+  Result := Trunc(Range * (Frac(Abs(Key * A))));
+end;
+
 procedure FinalizeArrayBeforeMove(var List: TDynIInterfaceArray; FromIndex, ToIndex, Count: SizeInt); overload;
 {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
 begin

Modified: trunk/jcl/source/common/JclHashMaps.pas
===================================================================
--- trunk/jcl/source/common/JclHashMaps.pas	2012-02-03 18:37:35 UTC (rev 3713)
+++ trunk/jcl/source/common/JclHashMaps.pas	2012-02-03 20:06:34 UTC (rev 3714)
@@ -56,10 +56,6 @@
 
 
 type
-  // Hash Function
-  // Result must be in 0..Range-1
-  TJclHashFunction = function(Key, Range: Integer): Integer;
-
   TJclIntfIntfHashMapEntry = record
     Key: IInterface;
     Value: IInterface;
@@ -83,14 +79,14 @@
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
     FBuckets: array of TJclIntfIntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -134,14 +130,14 @@
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
     FBuckets: array of TJclAnsiStrIntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -186,14 +182,14 @@
     function ValuesEqual(const A, B: AnsiString): Boolean;
   private
     FBuckets: array of TJclIntfAnsiStrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -237,14 +233,14 @@
     function ValuesEqual(const A, B: AnsiString): Boolean;
   private
     FBuckets: array of TJclAnsiStrAnsiStrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -288,14 +284,14 @@
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
     FBuckets: array of TJclWideStrIntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -340,14 +336,14 @@
     function ValuesEqual(const A, B: WideString): Boolean;
   private
     FBuckets: array of TJclIntfWideStrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -391,14 +387,14 @@
     function ValuesEqual(const A, B: WideString): Boolean;
   private
     FBuckets: array of TJclWideStrWideStrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -445,14 +441,14 @@
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
     FBuckets: array of TJclUnicodeStrIntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -501,14 +497,14 @@
     function ValuesEqual(const A, B: UnicodeString): Boolean;
   private
     FBuckets: array of TJclIntfUnicodeStrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -556,14 +552,14 @@
     function ValuesEqual(const A, B: UnicodeString): Boolean;
   private
     FBuckets: array of TJclUnicodeStrUnicodeStrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -677,14 +673,14 @@
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
     FBuckets: array of TJclSingleIntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -729,14 +725,14 @@
     function ValuesEqual(const A, B: Single): Boolean;
   private
     FBuckets: array of TJclIntfSingleHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -780,14 +776,14 @@
     function ValuesEqual(const A, B: Single): Boolean;
   private
     FBuckets: array of TJclSingleSingleHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -831,14 +827,14 @@
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
     FBuckets: array of TJclDoubleIntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -883,14 +879,14 @@
     function ValuesEqual(const A, B: Double): Boolean;
   private
     FBuckets: array of TJclIntfDoubleHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -934,14 +930,14 @@
     function ValuesEqual(const A, B: Double): Boolean;
   private
     FBuckets: array of TJclDoubleDoubleHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -985,14 +981,14 @@
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
     FBuckets: array of TJclExtendedIntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1037,14 +1033,14 @@
     function ValuesEqual(const A, B: Extended): Boolean;
   private
     FBuckets: array of TJclIntfExtendedHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1088,14 +1084,14 @@
     function ValuesEqual(const A, B: Extended): Boolean;
   private
     FBuckets: array of TJclExtendedExtendedHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1208,14 +1204,14 @@
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
     FBuckets: array of TJclIntegerIntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1260,14 +1256,14 @@
     function ValuesEqual(A, B: Integer): Boolean;
   private
     FBuckets: array of TJclIntfIntegerHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1311,14 +1307,14 @@
     function ValuesEqual(A, B: Integer): Boolean;
   private
     FBuckets: array of TJclIntegerIntegerHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1362,14 +1358,14 @@
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
     FBuckets: array of TJclCardinalIntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1414,14 +1410,14 @@
     function ValuesEqual(A, B: Cardinal): Boolean;
   private
     FBuckets: array of TJclIntfCardinalHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1465,14 +1461,14 @@
     function ValuesEqual(A, B: Cardinal): Boolean;
   private
     FBuckets: array of TJclCardinalCardinalHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1516,14 +1512,14 @@
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
     FBuckets: array of TJclInt64IntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1568,14 +1564,14 @@
     function ValuesEqual(const A, B: Int64): Boolean;
   private
     FBuckets: array of TJclIntfInt64HashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1619,14 +1615,14 @@
     function ValuesEqual(const A, B: Int64): Boolean;
   private
     FBuckets: array of TJclInt64Int64HashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1670,14 +1666,14 @@
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
     FBuckets: array of TJclPtrIntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1722,14 +1718,14 @@
     function ValuesEqual(A, B: Pointer): Boolean;
   private
     FBuckets: array of TJclIntfPtrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1773,14 +1769,14 @@
     function ValuesEqual(A, B: Pointer): Boolean;
   private
     FBuckets: array of TJclPtrPtrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1830,14 +1826,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclIntfHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1887,14 +1883,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclAnsiStrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -1944,14 +1940,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclWideStrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -2004,14 +2000,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclUnicodeStrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -2085,14 +2081,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclSingleHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -2142,14 +2138,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclDoubleHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -2199,14 +2195,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclExtendedHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -2279,14 +2275,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclIntegerHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -2336,14 +2332,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclCardinalHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -2393,14 +2389,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclInt64HashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -2450,14 +2446,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclPtrHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -2512,14 +2508,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TJclHashMapBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -2582,14 +2578,14 @@
     property OwnsValues: Boolean read FOwnsValues;
   private
     FBuckets: array of TBucket;
-    FHashFunction: TJclHashFunction;
+    FHashToRangeFunction: TJclHashToRangeFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
     procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
   public
     constructor Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
     destructor Destroy; override;
-    property HashFunction: TJclHashFunction read FHashFunction write FHashFunction;
+    property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction;
     { IJclPackable }
     procedure Pack; override;
     procedure SetCapacity(Value: Integer); override;
@@ -2696,8 +2692,6 @@
   //DOM-IGNORE-END
   {$ENDIF SUPPORTS_GENERICS}
 
-function HashMul(Key, Range: Integer): Integer;
-
 {$IFDEF UNITVERSIONING}
 const
   UnitVersioning: TUnitVersionInfo = (
@@ -2720,14 +2714,6 @@
   {$ENDIF ~HAS_UNITSCOPE}
   JclResources;
 
-function HashMul(Key, Range: Integer): Integer;
-// return a value between 0 and (Range-1) based on integer-hash Key
-const
-  A = 0.6180339887; // (sqrt(5) - 1) / 2
-begin
-  Result := Trunc(Range * (Frac(Abs(Key * A))));
-end;
-
 //=== { TJclIntfIntfHashMapBucket } ==========================================
 
 procedure TJclIntfIntfHashMapBucket.MoveArray(FromIndex, ToIndex, Count: Integer);
@@ -2760,7 +2746,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclIntfIntfHashMap.Destroy;
@@ -2822,7 +2808,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclIntfIntfHashMap then
-    TJclIntfIntfHashMap(Dest).HashFunction := HashFunction;
+    TJclIntfIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclIntfIntfHashMap.Clear;
@@ -2870,7 +2856,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -2929,7 +2915,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := nil;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -2970,7 +2956,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := nil;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -3166,7 +3152,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, nil)) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -3338,7 +3324,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclAnsiStrIntfHashMap.Destroy;
@@ -3400,7 +3386,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclAnsiStrIntfHashMap then
-    TJclAnsiStrIntfHashMap(Dest).HashFunction := HashFunction;
+    TJclAnsiStrIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclAnsiStrIntfHashMap.Clear;
@@ -3448,7 +3434,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -3507,7 +3493,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := nil;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -3548,7 +3534,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := nil;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -3744,7 +3730,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, nil)) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -3916,7 +3902,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclIntfAnsiStrHashMap.Destroy;
@@ -3978,7 +3964,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclIntfAnsiStrHashMap then
-    TJclIntfAnsiStrHashMap(Dest).HashFunction := HashFunction;
+    TJclIntfAnsiStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclIntfAnsiStrHashMap.Clear;
@@ -4026,7 +4012,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -4085,7 +4071,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -4126,7 +4112,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -4322,7 +4308,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, '')) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -4499,7 +4485,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclAnsiStrAnsiStrHashMap.Destroy;
@@ -4561,7 +4547,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclAnsiStrAnsiStrHashMap then
-    TJclAnsiStrAnsiStrHashMap(Dest).HashFunction := HashFunction;
+    TJclAnsiStrAnsiStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclAnsiStrAnsiStrHashMap.Clear;
@@ -4609,7 +4595,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -4668,7 +4654,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -4709,7 +4695,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -4905,7 +4891,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, '')) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -5077,7 +5063,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclWideStrIntfHashMap.Destroy;
@@ -5139,7 +5125,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclWideStrIntfHashMap then
-    TJclWideStrIntfHashMap(Dest).HashFunction := HashFunction;
+    TJclWideStrIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclWideStrIntfHashMap.Clear;
@@ -5187,7 +5173,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -5246,7 +5232,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := nil;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -5287,7 +5273,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := nil;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -5483,7 +5469,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, nil)) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -5655,7 +5641,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclIntfWideStrHashMap.Destroy;
@@ -5717,7 +5703,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclIntfWideStrHashMap then
-    TJclIntfWideStrHashMap(Dest).HashFunction := HashFunction;
+    TJclIntfWideStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclIntfWideStrHashMap.Clear;
@@ -5765,7 +5751,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -5824,7 +5810,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -5865,7 +5851,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -6061,7 +6047,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, '')) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -6238,7 +6224,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclWideStrWideStrHashMap.Destroy;
@@ -6300,7 +6286,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclWideStrWideStrHashMap then
-    TJclWideStrWideStrHashMap(Dest).HashFunction := HashFunction;
+    TJclWideStrWideStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclWideStrWideStrHashMap.Clear;
@@ -6348,7 +6334,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -6407,7 +6393,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -6448,7 +6434,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -6644,7 +6630,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, '')) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -6819,7 +6805,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclUnicodeStrIntfHashMap.Destroy;
@@ -6881,7 +6867,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclUnicodeStrIntfHashMap then
-    TJclUnicodeStrIntfHashMap(Dest).HashFunction := HashFunction;
+    TJclUnicodeStrIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclUnicodeStrIntfHashMap.Clear;
@@ -6929,7 +6915,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -6988,7 +6974,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := nil;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -7029,7 +7015,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := nil;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -7225,7 +7211,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, nil)) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -7402,7 +7388,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclIntfUnicodeStrHashMap.Destroy;
@@ -7464,7 +7450,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclIntfUnicodeStrHashMap then
-    TJclIntfUnicodeStrHashMap(Dest).HashFunction := HashFunction;
+    TJclIntfUnicodeStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclIntfUnicodeStrHashMap.Clear;
@@ -7512,7 +7498,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -7571,7 +7557,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -7612,7 +7598,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -7808,7 +7794,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, '')) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -7990,7 +7976,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclUnicodeStrUnicodeStrHashMap.Destroy;
@@ -8052,7 +8038,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclUnicodeStrUnicodeStrHashMap then
-    TJclUnicodeStrUnicodeStrHashMap(Dest).HashFunction := HashFunction;
+    TJclUnicodeStrUnicodeStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclUnicodeStrUnicodeStrHashMap.Clear;
@@ -8100,7 +8086,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -8159,7 +8145,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -8200,7 +8186,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := '';
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -8396,7 +8382,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, '')) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -8570,7 +8556,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclSingleIntfHashMap.Destroy;
@@ -8632,7 +8618,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclSingleIntfHashMap then
-    TJclSingleIntfHashMap(Dest).HashFunction := HashFunction;
+    TJclSingleIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclSingleIntfHashMap.Clear;
@@ -8680,7 +8666,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -8739,7 +8725,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := nil;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -8780,7 +8766,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := nil;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -8976,7 +8962,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, 0.0) and not ValuesEqual(Value, nil)) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -9148,7 +9134,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclIntfSingleHashMap.Destroy;
@@ -9210,7 +9196,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclIntfSingleHashMap then
-    TJclIntfSingleHashMap(Dest).HashFunction := HashFunction;
+    TJclIntfSingleHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclIntfSingleHashMap.Clear;
@@ -9258,7 +9244,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -9317,7 +9303,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := 0.0;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
     begin
       for I := 0 to Bucket.Size - 1 do
@@ -9358,7 +9344,7 @@
   {$ENDIF THREADSAFE}
     Found := False;
     Result := 0.0;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -9554,7 +9540,7 @@
   {$ENDIF THREADSAFE}
     if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, 0.0)) then
     begin
-      Index := FHashFunction(Hash(Key), FCapacity);
+      Index := FHashToRangeFunction(Hash(Key), FCapacity);
       Bucket := FBuckets[Index];
       if Bucket <> nil then
       begin
@@ -9731,7 +9717,7 @@
 begin
   inherited Create;
   SetCapacity(ACapacity);
-  FHashFunction := HashMul;
+  FHashToRangeFunction := JclSimpleHashToRange;
 end;
 
 destructor TJclSingleSingleHashMap.Destroy;
@@ -9793,7 +9779,7 @@
 begin
   inherited AssignPropertiesto(Dest);
   if Dest is TJclSingleSingleHashMap then
-    TJclSingleSingleHashMap(Dest).HashFunction := HashFunction;
+    TJclSingleSingleHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction;
 end;
 
 procedure TJclSingleSingleHashMap.Clear;
@@ -9841,7 +9827,7 @@
   try
   {$ENDIF THREADSAFE}
     Result := False;
-    Bucket := FBuckets[FHashFunction(Hash(Key), FCapacity)];
+    Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)];
     if Bucket <> nil then
       for I := 0 to Bucket.Size - 1 do
         if KeysEqual(Bucket.Entries[I].Key, Key) then
@@ -9900,7 +9886,7 @@
   try
   {$ENDIF THREADSAFE}
     R...
 
[truncated message content]

[Jcl-checkins-diff] SF.net SVN: jcl:[3713] trunk/jcl/source/common

From: <ou...@us...> - 2012-02-03 18:37:43

Revision: 3713
          http://jcl.svn.sourceforge.net/jcl/?rev=3713&view=rev
Author:   outchy
Date:     2012-02-03 18:37:35 +0000 (Fri, 03 Feb 2012)
Log Message:
-----------
type name cleanup.

Modified Paths:
--------------
    trunk/jcl/source/common/JclHashMaps.pas
    trunk/jcl/source/common/JclPreProcessorContainerKnownMaps.pas
    trunk/jcl/source/common/JclSortedMaps.pas

Modified: trunk/jcl/source/common/JclHashMaps.pas
===================================================================
--- trunk/jcl/source/common/JclHashMaps.pas	2012-02-03 18:25:51 UTC (rev 3712)
+++ trunk/jcl/source/common/JclHashMaps.pas	2012-02-03 18:37:35 UTC (rev 3713)
@@ -60,15 +60,15 @@
   // Result must be in 0..Range-1
   TJclHashFunction = function(Key, Range: Integer): Integer;
 
-  TJclIntfIntfHashEntry = record
+  TJclIntfIntfHashMapEntry = record
     Key: IInterface;
     Value: IInterface;
   end;
 
-  TJclIntfIntfBucket = class
+  TJclIntfIntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfIntfHashEntry;
+    Entries: array of TJclIntfIntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -82,7 +82,7 @@
     function KeysEqual(const A, B: IInterface): Boolean;
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
-    FBuckets: array of TJclIntfIntfBucket;
+    FBuckets: array of TJclIntfIntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -111,15 +111,15 @@
     function Values: IJclIntfCollection;
   end;
 
-  TJclAnsiStrIntfHashEntry = record
+  TJclAnsiStrIntfHashMapEntry = record
     Key: AnsiString;
     Value: IInterface;
   end;
 
-  TJclAnsiStrIntfBucket = class
+  TJclAnsiStrIntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclAnsiStrIntfHashEntry;
+    Entries: array of TJclAnsiStrIntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -133,7 +133,7 @@
     function KeysEqual(const A, B: AnsiString): Boolean;
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
-    FBuckets: array of TJclAnsiStrIntfBucket;
+    FBuckets: array of TJclAnsiStrIntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -162,15 +162,15 @@
     function Values: IJclIntfCollection;
   end;
 
-  TJclIntfAnsiStrHashEntry = record
+  TJclIntfAnsiStrHashMapEntry = record
     Key: IInterface;
     Value: AnsiString;
   end;
 
-  TJclIntfAnsiStrBucket = class
+  TJclIntfAnsiStrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfAnsiStrHashEntry;
+    Entries: array of TJclIntfAnsiStrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -185,7 +185,7 @@
     function KeysEqual(const A, B: IInterface): Boolean;
     function ValuesEqual(const A, B: AnsiString): Boolean;
   private
-    FBuckets: array of TJclIntfAnsiStrBucket;
+    FBuckets: array of TJclIntfAnsiStrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -214,15 +214,15 @@
     function Values: IJclAnsiStrCollection;
   end;
 
-  TJclAnsiStrAnsiStrHashEntry = record
+  TJclAnsiStrAnsiStrHashMapEntry = record
     Key: AnsiString;
     Value: AnsiString;
   end;
 
-  TJclAnsiStrAnsiStrBucket = class
+  TJclAnsiStrAnsiStrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclAnsiStrAnsiStrHashEntry;
+    Entries: array of TJclAnsiStrAnsiStrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -236,7 +236,7 @@
     function KeysEqual(const A, B: AnsiString): Boolean;
     function ValuesEqual(const A, B: AnsiString): Boolean;
   private
-    FBuckets: array of TJclAnsiStrAnsiStrBucket;
+    FBuckets: array of TJclAnsiStrAnsiStrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -265,15 +265,15 @@
     function Values: IJclAnsiStrCollection;
   end;
 
-  TJclWideStrIntfHashEntry = record
+  TJclWideStrIntfHashMapEntry = record
     Key: WideString;
     Value: IInterface;
   end;
 
-  TJclWideStrIntfBucket = class
+  TJclWideStrIntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclWideStrIntfHashEntry;
+    Entries: array of TJclWideStrIntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -287,7 +287,7 @@
     function KeysEqual(const A, B: WideString): Boolean;
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
-    FBuckets: array of TJclWideStrIntfBucket;
+    FBuckets: array of TJclWideStrIntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -316,15 +316,15 @@
     function Values: IJclIntfCollection;
   end;
 
-  TJclIntfWideStrHashEntry = record
+  TJclIntfWideStrHashMapEntry = record
     Key: IInterface;
     Value: WideString;
   end;
 
-  TJclIntfWideStrBucket = class
+  TJclIntfWideStrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfWideStrHashEntry;
+    Entries: array of TJclIntfWideStrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -339,7 +339,7 @@
     function KeysEqual(const A, B: IInterface): Boolean;
     function ValuesEqual(const A, B: WideString): Boolean;
   private
-    FBuckets: array of TJclIntfWideStrBucket;
+    FBuckets: array of TJclIntfWideStrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -368,15 +368,15 @@
     function Values: IJclWideStrCollection;
   end;
 
-  TJclWideStrWideStrHashEntry = record
+  TJclWideStrWideStrHashMapEntry = record
     Key: WideString;
     Value: WideString;
   end;
 
-  TJclWideStrWideStrBucket = class
+  TJclWideStrWideStrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclWideStrWideStrHashEntry;
+    Entries: array of TJclWideStrWideStrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -390,7 +390,7 @@
     function KeysEqual(const A, B: WideString): Boolean;
     function ValuesEqual(const A, B: WideString): Boolean;
   private
-    FBuckets: array of TJclWideStrWideStrBucket;
+    FBuckets: array of TJclWideStrWideStrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -420,15 +420,15 @@
   end;
 
   {$IFDEF SUPPORTS_UNICODE_STRING}
-  TJclUnicodeStrIntfHashEntry = record
+  TJclUnicodeStrIntfHashMapEntry = record
     Key: UnicodeString;
     Value: IInterface;
   end;
 
-  TJclUnicodeStrIntfBucket = class
+  TJclUnicodeStrIntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclUnicodeStrIntfHashEntry;
+    Entries: array of TJclUnicodeStrIntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
   {$ENDIF SUPPORTS_UNICODE_STRING}
@@ -444,7 +444,7 @@
     function KeysEqual(const A, B: UnicodeString): Boolean;
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
-    FBuckets: array of TJclUnicodeStrIntfBucket;
+    FBuckets: array of TJclUnicodeStrIntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -475,15 +475,15 @@
   {$ENDIF SUPPORTS_UNICODE_STRING}
 
   {$IFDEF SUPPORTS_UNICODE_STRING}
-  TJclIntfUnicodeStrHashEntry = record
+  TJclIntfUnicodeStrHashMapEntry = record
     Key: IInterface;
     Value: UnicodeString;
   end;
 
-  TJclIntfUnicodeStrBucket = class
+  TJclIntfUnicodeStrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfUnicodeStrHashEntry;
+    Entries: array of TJclIntfUnicodeStrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
   {$ENDIF SUPPORTS_UNICODE_STRING}
@@ -500,7 +500,7 @@
     function KeysEqual(const A, B: IInterface): Boolean;
     function ValuesEqual(const A, B: UnicodeString): Boolean;
   private
-    FBuckets: array of TJclIntfUnicodeStrBucket;
+    FBuckets: array of TJclIntfUnicodeStrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -531,15 +531,15 @@
   {$ENDIF SUPPORTS_UNICODE_STRING}
 
   {$IFDEF SUPPORTS_UNICODE_STRING}
-  TJclUnicodeStrUnicodeStrHashEntry = record
+  TJclUnicodeStrUnicodeStrHashMapEntry = record
     Key: UnicodeString;
     Value: UnicodeString;
   end;
 
-  TJclUnicodeStrUnicodeStrBucket = class
+  TJclUnicodeStrUnicodeStrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclUnicodeStrUnicodeStrHashEntry;
+    Entries: array of TJclUnicodeStrUnicodeStrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
   {$ENDIF SUPPORTS_UNICODE_STRING}
@@ -555,7 +555,7 @@
     function KeysEqual(const A, B: UnicodeString): Boolean;
     function ValuesEqual(const A, B: UnicodeString): Boolean;
   private
-    FBuckets: array of TJclUnicodeStrUnicodeStrBucket;
+    FBuckets: array of TJclUnicodeStrUnicodeStrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -586,16 +586,16 @@
   {$ENDIF SUPPORTS_UNICODE_STRING}
 
   {$IFDEF CONTAINER_ANSISTR}
-  TJclStrIntfHashEntry = TJclAnsiStrIntfHashEntry;
-  TJclStrIntfBucket = TJclAnsiStrIntfBucket;
+  TJclStrIntfHashMapEntry = TJclAnsiStrIntfHashMapEntry;
+  TJclStrIntfHashMapBucket = TJclAnsiStrIntfHashMapBucket;
   {$ENDIF CONTAINER_ANSISTR}
   {$IFDEF CONTAINER_WIDESTR}
-  TJclStrIntfHashEntry = TJclWideStrIntfHashEntry;
-  TJclStrIntfBucket = TJclWideStrIntfBucket;
+  TJclStrIntfHashMapEntry = TJclWideStrIntfHashMapEntry;
+  TJclStrIntfHashMapBucket = TJclWideStrIntfHashMapBucket;
   {$ENDIF CONTAINER_WIDESTR}
   {$IFDEF CONTAINER_UNICODESTR}
-  TJclStrIntfHashEntry = TJclUnicodeStrIntfHashEntry;
-  TJclStrIntfBucket = TJclUnicodeStrIntfBucket;
+  TJclStrIntfHashMapEntry = TJclUnicodeStrIntfHashMapEntry;
+  TJclStrIntfHashMapBucket = TJclUnicodeStrIntfHashMapBucket;
   {$ENDIF CONTAINER_UNICODESTR}
 
   {$IFDEF CONTAINER_ANSISTR}
@@ -609,16 +609,16 @@
   {$ENDIF CONTAINER_UNICODESTR}
 
   {$IFDEF CONTAINER_ANSISTR}
-  TJclIntfStrHashEntry = TJclIntfAnsiStrHashEntry;
-  TJclIntfStrBucket = TJclIntfAnsiStrBucket;
+  TJclIntfStrHashMapEntry = TJclIntfAnsiStrHashMapEntry;
+  TJclIntfStrHashMapBucket = TJclIntfAnsiStrHashMapBucket;
   {$ENDIF CONTAINER_ANSISTR}
   {$IFDEF CONTAINER_WIDESTR}
-  TJclIntfStrHashEntry = TJclIntfWideStrHashEntry;
-  TJclIntfStrBucket = TJclIntfWideStrBucket;
+  TJclIntfStrHashMapEntry = TJclIntfWideStrHashMapEntry;
+  TJclIntfStrHashMapBucket = TJclIntfWideStrHashMapBucket;
   {$ENDIF CONTAINER_WIDESTR}
   {$IFDEF CONTAINER_UNICODESTR}
-  TJclIntfStrHashEntry = TJclIntfUnicodeStrHashEntry;
-  TJclIntfStrBucket = TJclIntfUnicodeStrBucket;
+  TJclIntfStrHashMapEntry = TJclIntfUnicodeStrHashMapEntry;
+  TJclIntfStrHashMapBucket = TJclIntfUnicodeStrHashMapBucket;
   {$ENDIF CONTAINER_UNICODESTR}
 
   {$IFDEF CONTAINER_ANSISTR}
@@ -632,16 +632,16 @@
   {$ENDIF CONTAINER_UNICODESTR}
 
   {$IFDEF CONTAINER_ANSISTR}
-  TJclStrStrHashEntry = TJclAnsiStrAnsiStrHashEntry;
-  TJclStrStrBucket = TJclAnsiStrAnsiStrBucket;
+  TJclStrStrHashMapEntry = TJclAnsiStrAnsiStrHashMapEntry;
+  TJclStrStrHashMapBucket = TJclAnsiStrAnsiStrHashMapBucket;
   {$ENDIF CONTAINER_ANSISTR}
   {$IFDEF CONTAINER_WIDESTR}
-  TJclStrStrHashEntry = TJclWideStrWideStrHashEntry;
-  TJclStrStrBucket = TJclWideStrWideStrBucket;
+  TJclStrStrHashMapEntry = TJclWideStrWideStrHashMapEntry;
+  TJclStrStrHashMapBucket = TJclWideStrWideStrHashMapBucket;
   {$ENDIF CONTAINER_WIDESTR}
   {$IFDEF CONTAINER_UNICODESTR}
-  TJclStrStrHashEntry = TJclUnicodeStrUnicodeStrHashEntry;
-  TJclStrStrBucket = TJclUnicodeStrUnicodeStrBucket;
+  TJclStrStrHashMapEntry = TJclUnicodeStrUnicodeStrHashMapEntry;
+  TJclStrStrHashMapBucket = TJclUnicodeStrUnicodeStrHashMapBucket;
   {$ENDIF CONTAINER_UNICODESTR}
 
   {$IFDEF CONTAINER_ANSISTR}
@@ -654,15 +654,15 @@
   TJclStrStrHashMap = TJclUnicodeStrUnicodeStrHashMap;
   {$ENDIF CONTAINER_UNICODESTR}
 
-  TJclSingleIntfHashEntry = record
+  TJclSingleIntfHashMapEntry = record
     Key: Single;
     Value: IInterface;
   end;
 
-  TJclSingleIntfBucket = class
+  TJclSingleIntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclSingleIntfHashEntry;
+    Entries: array of TJclSingleIntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -676,7 +676,7 @@
     function KeysEqual(const A, B: Single): Boolean;
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
-    FBuckets: array of TJclSingleIntfBucket;
+    FBuckets: array of TJclSingleIntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -705,15 +705,15 @@
     function Values: IJclIntfCollection;
   end;
 
-  TJclIntfSingleHashEntry = record
+  TJclIntfSingleHashMapEntry = record
     Key: IInterface;
     Value: Single;
   end;
 
-  TJclIntfSingleBucket = class
+  TJclIntfSingleHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfSingleHashEntry;
+    Entries: array of TJclIntfSingleHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -728,7 +728,7 @@
     function KeysEqual(const A, B: IInterface): Boolean;
     function ValuesEqual(const A, B: Single): Boolean;
   private
-    FBuckets: array of TJclIntfSingleBucket;
+    FBuckets: array of TJclIntfSingleHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -757,15 +757,15 @@
     function Values: IJclSingleCollection;
   end;
 
-  TJclSingleSingleHashEntry = record
+  TJclSingleSingleHashMapEntry = record
     Key: Single;
     Value: Single;
   end;
 
-  TJclSingleSingleBucket = class
+  TJclSingleSingleHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclSingleSingleHashEntry;
+    Entries: array of TJclSingleSingleHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -779,7 +779,7 @@
     function KeysEqual(const A, B: Single): Boolean;
     function ValuesEqual(const A, B: Single): Boolean;
   private
-    FBuckets: array of TJclSingleSingleBucket;
+    FBuckets: array of TJclSingleSingleHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -808,15 +808,15 @@
     function Values: IJclSingleCollection;
   end;
 
-  TJclDoubleIntfHashEntry = record
+  TJclDoubleIntfHashMapEntry = record
     Key: Double;
     Value: IInterface;
   end;
 
-  TJclDoubleIntfBucket = class
+  TJclDoubleIntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclDoubleIntfHashEntry;
+    Entries: array of TJclDoubleIntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -830,7 +830,7 @@
     function KeysEqual(const A, B: Double): Boolean;
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
-    FBuckets: array of TJclDoubleIntfBucket;
+    FBuckets: array of TJclDoubleIntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -859,15 +859,15 @@
     function Values: IJclIntfCollection;
   end;
 
-  TJclIntfDoubleHashEntry = record
+  TJclIntfDoubleHashMapEntry = record
     Key: IInterface;
     Value: Double;
   end;
 
-  TJclIntfDoubleBucket = class
+  TJclIntfDoubleHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfDoubleHashEntry;
+    Entries: array of TJclIntfDoubleHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -882,7 +882,7 @@
     function KeysEqual(const A, B: IInterface): Boolean;
     function ValuesEqual(const A, B: Double): Boolean;
   private
-    FBuckets: array of TJclIntfDoubleBucket;
+    FBuckets: array of TJclIntfDoubleHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -911,15 +911,15 @@
     function Values: IJclDoubleCollection;
   end;
 
-  TJclDoubleDoubleHashEntry = record
+  TJclDoubleDoubleHashMapEntry = record
     Key: Double;
     Value: Double;
   end;
 
-  TJclDoubleDoubleBucket = class
+  TJclDoubleDoubleHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclDoubleDoubleHashEntry;
+    Entries: array of TJclDoubleDoubleHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -933,7 +933,7 @@
     function KeysEqual(const A, B: Double): Boolean;
     function ValuesEqual(const A, B: Double): Boolean;
   private
-    FBuckets: array of TJclDoubleDoubleBucket;
+    FBuckets: array of TJclDoubleDoubleHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -962,15 +962,15 @@
     function Values: IJclDoubleCollection;
   end;
 
-  TJclExtendedIntfHashEntry = record
+  TJclExtendedIntfHashMapEntry = record
     Key: Extended;
     Value: IInterface;
   end;
 
-  TJclExtendedIntfBucket = class
+  TJclExtendedIntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclExtendedIntfHashEntry;
+    Entries: array of TJclExtendedIntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -984,7 +984,7 @@
     function KeysEqual(const A, B: Extended): Boolean;
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
-    FBuckets: array of TJclExtendedIntfBucket;
+    FBuckets: array of TJclExtendedIntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1013,15 +1013,15 @@
     function Values: IJclIntfCollection;
   end;
 
-  TJclIntfExtendedHashEntry = record
+  TJclIntfExtendedHashMapEntry = record
     Key: IInterface;
     Value: Extended;
   end;
 
-  TJclIntfExtendedBucket = class
+  TJclIntfExtendedHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfExtendedHashEntry;
+    Entries: array of TJclIntfExtendedHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1036,7 +1036,7 @@
     function KeysEqual(const A, B: IInterface): Boolean;
     function ValuesEqual(const A, B: Extended): Boolean;
   private
-    FBuckets: array of TJclIntfExtendedBucket;
+    FBuckets: array of TJclIntfExtendedHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1065,15 +1065,15 @@
     function Values: IJclExtendedCollection;
   end;
 
-  TJclExtendedExtendedHashEntry = record
+  TJclExtendedExtendedHashMapEntry = record
     Key: Extended;
     Value: Extended;
   end;
 
-  TJclExtendedExtendedBucket = class
+  TJclExtendedExtendedHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclExtendedExtendedHashEntry;
+    Entries: array of TJclExtendedExtendedHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1087,7 +1087,7 @@
     function KeysEqual(const A, B: Extended): Boolean;
     function ValuesEqual(const A, B: Extended): Boolean;
   private
-    FBuckets: array of TJclExtendedExtendedBucket;
+    FBuckets: array of TJclExtendedExtendedHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1117,16 +1117,16 @@
   end;
 
   {$IFDEF MATH_SINGLE_PRECISION}
-  TJclFloatIntfHashEntry = TJclSingleIntfHashEntry;
-  TJclFloatIntfBucket = TJclSingleIntfBucket;
+  TJclFloatIntfHashMapEntry = TJclSingleIntfHashMapEntry;
+  TJclFloatIntfHashMapBucket = TJclSingleIntfHashMapBucket;
   {$ENDIF MATH_SINGLE_PRECISION}
   {$IFDEF MATH_DOUBLE_PRECISION}
-  TJclFloatIntfHashEntry = TJclDoubleIntfHashEntry;
-  TJclFloatIntfBucket = TJclDoubleIntfBucket;
+  TJclFloatIntfHashMapEntry = TJclDoubleIntfHashMapEntry;
+  TJclFloatIntfHashMapBucket = TJclDoubleIntfHashMapBucket;
   {$ENDIF MATH_DOUBLE_PRECISION}
   {$IFDEF MATH_EXTENDED_PRECISION}
-  TJclFloatIntfHashEntry = TJclExtendedIntfHashEntry;
-  TJclFloatIntfBucket = TJclExtendedIntfBucket;
+  TJclFloatIntfHashMapEntry = TJclExtendedIntfHashMapEntry;
+  TJclFloatIntfHashMapBucket = TJclExtendedIntfHashMapBucket;
   {$ENDIF MATH_EXTENDED_PRECISION}
 
   {$IFDEF MATH_SINGLE_PRECISION}
@@ -1140,16 +1140,16 @@
   {$ENDIF MATH_EXTENDED_PRECISION}
 
   {$IFDEF MATH_SINGLE_PRECISION}
-  TJclIntfFloatHashEntry = TJclIntfSingleHashEntry;
-  TJclIntfFloatBucket = TJclIntfSingleBucket;
+  TJclIntfFloatHashMapEntry = TJclIntfSingleHashMapEntry;
+  TJclIntfFloatHashMapBucket = TJclIntfSingleHashMapBucket;
   {$ENDIF MATH_SINGLE_PRECISION}
   {$IFDEF MATH_DOUBLE_PRECISION}
-  TJclIntfFloatHashEntry = TJclIntfDoubleHashEntry;
-  TJclIntfFloatBucket = TJclIntfDoubleBucket;
+  TJclIntfFloatHashMapEntry = TJclIntfDoubleHashMapEntry;
+  TJclIntfFloatHashMapBucket = TJclIntfDoubleHashMapBucket;
   {$ENDIF MATH_DOUBLE_PRECISION}
   {$IFDEF MATH_EXTENDED_PRECISION}
-  TJclIntfFloatHashEntry = TJclIntfExtendedHashEntry;
-  TJclIntfFloatBucket = TJclIntfExtendedBucket;
+  TJclIntfFloatHashMapEntry = TJclIntfExtendedHashMapEntry;
+  TJclIntfFloatHashMapBucket = TJclIntfExtendedHashMapBucket;
   {$ENDIF MATH_EXTENDED_PRECISION}
 
   {$IFDEF MATH_SINGLE_PRECISION}
@@ -1163,16 +1163,16 @@
   {$ENDIF MATH_EXTENDED_PRECISION}
 
   {$IFDEF MATH_SINGLE_PRECISION}
-  TJclFloatFloatHashEntry = TJclSingleSingleHashEntry;
-  TJclFloatFloatBucket = TJclSingleSingleBucket;
+  TJclFloatFloatHashMapEntry = TJclSingleSingleHashMapEntry;
+  TJclFloatFloatHashMapBucket = TJclSingleSingleHashMapBucket;
   {$ENDIF MATH_SINGLE_PRECISION}
   {$IFDEF MATH_DOUBLE_PRECISION}
-  TJclFloatFloatHashEntry = TJclDoubleDoubleHashEntry;
-  TJclFloatFloatBucket = TJclDoubleDoubleBucket;
+  TJclFloatFloatHashMapEntry = TJclDoubleDoubleHashMapEntry;
+  TJclFloatFloatHashMapBucket = TJclDoubleDoubleHashMapBucket;
   {$ENDIF MATH_DOUBLE_PRECISION}
   {$IFDEF MATH_EXTENDED_PRECISION}
-  TJclFloatFloatHashEntry = TJclExtendedExtendedHashEntry;
-  TJclFloatFloatBucket = TJclExtendedExtendedBucket;
+  TJclFloatFloatHashMapEntry = TJclExtendedExtendedHashMapEntry;
+  TJclFloatFloatHashMapBucket = TJclExtendedExtendedHashMapBucket;
   {$ENDIF MATH_EXTENDED_PRECISION}
 
   {$IFDEF MATH_SINGLE_PRECISION}
@@ -1185,15 +1185,15 @@
   TJclFloatFloatHashMap = TJclExtendedExtendedHashMap;
   {$ENDIF MATH_EXTENDED_PRECISION}
 
-  TJclIntegerIntfHashEntry = record
+  TJclIntegerIntfHashMapEntry = record
     Key: Integer;
     Value: IInterface;
   end;
 
-  TJclIntegerIntfBucket = class
+  TJclIntegerIntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntegerIntfHashEntry;
+    Entries: array of TJclIntegerIntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1207,7 +1207,7 @@
     function KeysEqual(A, B: Integer): Boolean;
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
-    FBuckets: array of TJclIntegerIntfBucket;
+    FBuckets: array of TJclIntegerIntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1236,15 +1236,15 @@
     function Values: IJclIntfCollection;
   end;
 
-  TJclIntfIntegerHashEntry = record
+  TJclIntfIntegerHashMapEntry = record
     Key: IInterface;
     Value: Integer;
   end;
 
-  TJclIntfIntegerBucket = class
+  TJclIntfIntegerHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfIntegerHashEntry;
+    Entries: array of TJclIntfIntegerHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1259,7 +1259,7 @@
     function KeysEqual(const A, B: IInterface): Boolean;
     function ValuesEqual(A, B: Integer): Boolean;
   private
-    FBuckets: array of TJclIntfIntegerBucket;
+    FBuckets: array of TJclIntfIntegerHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1288,15 +1288,15 @@
     function Values: IJclIntegerCollection;
   end;
 
-  TJclIntegerIntegerHashEntry = record
+  TJclIntegerIntegerHashMapEntry = record
     Key: Integer;
     Value: Integer;
   end;
 
-  TJclIntegerIntegerBucket = class
+  TJclIntegerIntegerHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntegerIntegerHashEntry;
+    Entries: array of TJclIntegerIntegerHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1310,7 +1310,7 @@
     function KeysEqual(A, B: Integer): Boolean;
     function ValuesEqual(A, B: Integer): Boolean;
   private
-    FBuckets: array of TJclIntegerIntegerBucket;
+    FBuckets: array of TJclIntegerIntegerHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1339,15 +1339,15 @@
     function Values: IJclIntegerCollection;
   end;
 
-  TJclCardinalIntfHashEntry = record
+  TJclCardinalIntfHashMapEntry = record
     Key: Cardinal;
     Value: IInterface;
   end;
 
-  TJclCardinalIntfBucket = class
+  TJclCardinalIntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclCardinalIntfHashEntry;
+    Entries: array of TJclCardinalIntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1361,7 +1361,7 @@
     function KeysEqual(A, B: Cardinal): Boolean;
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
-    FBuckets: array of TJclCardinalIntfBucket;
+    FBuckets: array of TJclCardinalIntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1390,15 +1390,15 @@
     function Values: IJclIntfCollection;
   end;
 
-  TJclIntfCardinalHashEntry = record
+  TJclIntfCardinalHashMapEntry = record
     Key: IInterface;
     Value: Cardinal;
   end;
 
-  TJclIntfCardinalBucket = class
+  TJclIntfCardinalHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfCardinalHashEntry;
+    Entries: array of TJclIntfCardinalHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1413,7 +1413,7 @@
     function KeysEqual(const A, B: IInterface): Boolean;
     function ValuesEqual(A, B: Cardinal): Boolean;
   private
-    FBuckets: array of TJclIntfCardinalBucket;
+    FBuckets: array of TJclIntfCardinalHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1442,15 +1442,15 @@
     function Values: IJclCardinalCollection;
   end;
 
-  TJclCardinalCardinalHashEntry = record
+  TJclCardinalCardinalHashMapEntry = record
     Key: Cardinal;
     Value: Cardinal;
   end;
 
-  TJclCardinalCardinalBucket = class
+  TJclCardinalCardinalHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclCardinalCardinalHashEntry;
+    Entries: array of TJclCardinalCardinalHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1464,7 +1464,7 @@
     function KeysEqual(A, B: Cardinal): Boolean;
     function ValuesEqual(A, B: Cardinal): Boolean;
   private
-    FBuckets: array of TJclCardinalCardinalBucket;
+    FBuckets: array of TJclCardinalCardinalHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1493,15 +1493,15 @@
     function Values: IJclCardinalCollection;
   end;
 
-  TJclInt64IntfHashEntry = record
+  TJclInt64IntfHashMapEntry = record
     Key: Int64;
     Value: IInterface;
   end;
 
-  TJclInt64IntfBucket = class
+  TJclInt64IntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclInt64IntfHashEntry;
+    Entries: array of TJclInt64IntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1515,7 +1515,7 @@
     function KeysEqual(const A, B: Int64): Boolean;
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
-    FBuckets: array of TJclInt64IntfBucket;
+    FBuckets: array of TJclInt64IntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1544,15 +1544,15 @@
     function Values: IJclIntfCollection;
   end;
 
-  TJclIntfInt64HashEntry = record
+  TJclIntfInt64HashMapEntry = record
     Key: IInterface;
     Value: Int64;
   end;
 
-  TJclIntfInt64Bucket = class
+  TJclIntfInt64HashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfInt64HashEntry;
+    Entries: array of TJclIntfInt64HashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1567,7 +1567,7 @@
     function KeysEqual(const A, B: IInterface): Boolean;
     function ValuesEqual(const A, B: Int64): Boolean;
   private
-    FBuckets: array of TJclIntfInt64Bucket;
+    FBuckets: array of TJclIntfInt64HashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1596,15 +1596,15 @@
     function Values: IJclInt64Collection;
   end;
 
-  TJclInt64Int64HashEntry = record
+  TJclInt64Int64HashMapEntry = record
     Key: Int64;
     Value: Int64;
   end;
 
-  TJclInt64Int64Bucket = class
+  TJclInt64Int64HashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclInt64Int64HashEntry;
+    Entries: array of TJclInt64Int64HashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1618,7 +1618,7 @@
     function KeysEqual(const A, B: Int64): Boolean;
     function ValuesEqual(const A, B: Int64): Boolean;
   private
-    FBuckets: array of TJclInt64Int64Bucket;
+    FBuckets: array of TJclInt64Int64HashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1647,15 +1647,15 @@
     function Values: IJclInt64Collection;
   end;
 
-  TJclPtrIntfHashEntry = record
+  TJclPtrIntfHashMapEntry = record
     Key: Pointer;
     Value: IInterface;
   end;
 
-  TJclPtrIntfBucket = class
+  TJclPtrIntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclPtrIntfHashEntry;
+    Entries: array of TJclPtrIntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1669,7 +1669,7 @@
     function KeysEqual(A, B: Pointer): Boolean;
     function ValuesEqual(const A, B: IInterface): Boolean;
   private
-    FBuckets: array of TJclPtrIntfBucket;
+    FBuckets: array of TJclPtrIntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1698,15 +1698,15 @@
     function Values: IJclIntfCollection;
   end;
 
-  TJclIntfPtrHashEntry = record
+  TJclIntfPtrHashMapEntry = record
     Key: IInterface;
     Value: Pointer;
   end;
 
-  TJclIntfPtrBucket = class
+  TJclIntfPtrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfPtrHashEntry;
+    Entries: array of TJclIntfPtrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1721,7 +1721,7 @@
     function KeysEqual(const A, B: IInterface): Boolean;
     function ValuesEqual(A, B: Pointer): Boolean;
   private
-    FBuckets: array of TJclIntfPtrBucket;
+    FBuckets: array of TJclIntfPtrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1750,15 +1750,15 @@
     function Values: IJclPtrCollection;
   end;
 
-  TJclPtrPtrHashEntry = record
+  TJclPtrPtrHashMapEntry = record
     Key: Pointer;
     Value: Pointer;
   end;
 
-  TJclPtrPtrBucket = class
+  TJclPtrPtrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclPtrPtrHashEntry;
+    Entries: array of TJclPtrPtrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1772,7 +1772,7 @@
     function KeysEqual(A, B: Pointer): Boolean;
     function ValuesEqual(A, B: Pointer): Boolean;
   private
-    FBuckets: array of TJclPtrPtrBucket;
+    FBuckets: array of TJclPtrPtrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1801,15 +1801,15 @@
     function Values: IJclPtrCollection;
   end;
 
-  TJclIntfHashEntry = record
+  TJclIntfHashMapEntry = record
     Key: IInterface;
     Value: TObject;
   end;
 
-  TJclIntfBucket = class
+  TJclIntfHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntfHashEntry;
+    Entries: array of TJclIntfHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1829,7 +1829,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclIntfBucket;
+    FBuckets: array of TJclIntfHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1858,15 +1858,15 @@
     function Values: IJclCollection;
   end;
 
-  TJclAnsiStrHashEntry = record
+  TJclAnsiStrHashMapEntry = record
     Key: AnsiString;
     Value: TObject;
   end;
 
-  TJclAnsiStrBucket = class
+  TJclAnsiStrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclAnsiStrHashEntry;
+    Entries: array of TJclAnsiStrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1886,7 +1886,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclAnsiStrBucket;
+    FBuckets: array of TJclAnsiStrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1915,15 +1915,15 @@
     function Values: IJclCollection;
   end;
 
-  TJclWideStrHashEntry = record
+  TJclWideStrHashMapEntry = record
     Key: WideString;
     Value: TObject;
   end;
 
-  TJclWideStrBucket = class
+  TJclWideStrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclWideStrHashEntry;
+    Entries: array of TJclWideStrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -1943,7 +1943,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclWideStrBucket;
+    FBuckets: array of TJclWideStrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -1973,15 +1973,15 @@
   end;
 
   {$IFDEF SUPPORTS_UNICODE_STRING}
-  TJclUnicodeStrHashEntry = record
+  TJclUnicodeStrHashMapEntry = record
     Key: UnicodeString;
     Value: TObject;
   end;
 
-  TJclUnicodeStrBucket = class
+  TJclUnicodeStrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclUnicodeStrHashEntry;
+    Entries: array of TJclUnicodeStrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
   {$ENDIF SUPPORTS_UNICODE_STRING}
@@ -2003,7 +2003,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclUnicodeStrBucket;
+    FBuckets: array of TJclUnicodeStrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -2034,16 +2034,16 @@
   {$ENDIF SUPPORTS_UNICODE_STRING}
 
   {$IFDEF CONTAINER_ANSISTR}
-  TJclStrHashEntry = TJclAnsiStrHashEntry;
-  TJclStrBucket = TJclAnsiStrBucket;
+  TJclStrHashMapEntry = TJclAnsiStrHashMapEntry;
+  TJclStrHashMapBucket = TJclAnsiStrHashMapBucket;
   {$ENDIF CONTAINER_ANSISTR}
   {$IFDEF CONTAINER_WIDESTR}
-  TJclStrHashEntry = TJclWideStrHashEntry;
-  TJclStrBucket = TJclWideStrBucket;
+  TJclStrHashMapEntry = TJclWideStrHashMapEntry;
+  TJclStrHashMapBucket = TJclWideStrHashMapBucket;
   {$ENDIF CONTAINER_WIDESTR}
   {$IFDEF CONTAINER_UNICODESTR}
-  TJclStrHashEntry = TJclUnicodeStrHashEntry;
-  TJclStrBucket = TJclUnicodeStrBucket;
+  TJclStrHashMapEntry = TJclUnicodeStrHashMapEntry;
+  TJclStrHashMapBucket = TJclUnicodeStrHashMapBucket;
   {$ENDIF CONTAINER_UNICODESTR}
 
   {$IFDEF CONTAINER_ANSISTR}
@@ -2056,15 +2056,15 @@
   TJclStrHashMap = TJclUnicodeStrHashMap;
   {$ENDIF CONTAINER_UNICODESTR}
 
-  TJclSingleHashEntry = record
+  TJclSingleHashMapEntry = record
     Key: Single;
     Value: TObject;
   end;
 
-  TJclSingleBucket = class
+  TJclSingleHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclSingleHashEntry;
+    Entries: array of TJclSingleHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -2084,7 +2084,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclSingleBucket;
+    FBuckets: array of TJclSingleHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -2113,15 +2113,15 @@
     function Values: IJclCollection;
   end;
 
-  TJclDoubleHashEntry = record
+  TJclDoubleHashMapEntry = record
     Key: Double;
     Value: TObject;
   end;
 
-  TJclDoubleBucket = class
+  TJclDoubleHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclDoubleHashEntry;
+    Entries: array of TJclDoubleHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -2141,7 +2141,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclDoubleBucket;
+    FBuckets: array of TJclDoubleHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -2170,15 +2170,15 @@
     function Values: IJclCollection;
   end;
 
-  TJclExtendedHashEntry = record
+  TJclExtendedHashMapEntry = record
     Key: Extended;
     Value: TObject;
   end;
 
-  TJclExtendedBucket = class
+  TJclExtendedHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclExtendedHashEntry;
+    Entries: array of TJclExtendedHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -2198,7 +2198,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclExtendedBucket;
+    FBuckets: array of TJclExtendedHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -2228,16 +2228,16 @@
   end;
 
   {$IFDEF MATH_SINGLE_PRECISION}
-  TJclFloatHashEntry = TJclSingleHashEntry;
-  TJclFloatBucket = TJclSingleBucket;
+  TJclFloatHashMapEntry = TJclSingleHashMapEntry;
+  TJclFloatHashMapBucket = TJclSingleHashMapBucket;
   {$ENDIF MATH_SINGLE_PRECISION}
   {$IFDEF MATH_DOUBLE_PRECISION}
-  TJclFloatHashEntry = TJclDoubleHashEntry;
-  TJclFloatBucket = TJclDoubleBucket;
+  TJclFloatHashMapEntry = TJclDoubleHashMapEntry;
+  TJclFloatHashMapBucket = TJclDoubleHashMapBucket;
   {$ENDIF MATH_DOUBLE_PRECISION}
   {$IFDEF MATH_EXTENDED_PRECISION}
-  TJclFloatHashEntry = TJclExtendedHashEntry;
-  TJclFloatBucket = TJclExtendedBucket;
+  TJclFloatHashMapEntry = TJclExtendedHashMapEntry;
+  TJclFloatHashMapBucket = TJclExtendedHashMapBucket;
   {$ENDIF MATH_EXTENDED_PRECISION}
 
   {$IFDEF MATH_SINGLE_PRECISION}
@@ -2250,15 +2250,15 @@
   TJclFloatHashMap = TJclExtendedHashMap;
   {$ENDIF MATH_EXTENDED_PRECISION}
 
-  TJclIntegerHashEntry = record
+  TJclIntegerHashMapEntry = record
     Key: Integer;
     Value: TObject;
   end;
 
-  TJclIntegerBucket = class
+  TJclIntegerHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclIntegerHashEntry;
+    Entries: array of TJclIntegerHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -2278,7 +2278,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclIntegerBucket;
+    FBuckets: array of TJclIntegerHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -2307,15 +2307,15 @@
     function Values: IJclCollection;
   end;
 
-  TJclCardinalHashEntry = record
+  TJclCardinalHashMapEntry = record
     Key: Cardinal;
     Value: TObject;
   end;
 
-  TJclCardinalBucket = class
+  TJclCardinalHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclCardinalHashEntry;
+    Entries: array of TJclCardinalHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -2335,7 +2335,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclCardinalBucket;
+    FBuckets: array of TJclCardinalHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -2364,15 +2364,15 @@
     function Values: IJclCollection;
   end;
 
-  TJclInt64HashEntry = record
+  TJclInt64HashMapEntry = record
     Key: Int64;
     Value: TObject;
   end;
 
-  TJclInt64Bucket = class
+  TJclInt64HashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclInt64HashEntry;
+    Entries: array of TJclInt64HashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -2392,7 +2392,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclInt64Bucket;
+    FBuckets: array of TJclInt64HashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -2421,15 +2421,15 @@
     function Values: IJclCollection;
   end;
 
-  TJclPtrHashEntry = record
+  TJclPtrHashMapEntry = record
     Key: Pointer;
     Value: TObject;
   end;
 
-  TJclPtrBucket = class
+  TJclPtrHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclPtrHashEntry;
+    Entries: array of TJclPtrHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -2449,7 +2449,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclPtrBucket;
+    FBuckets: array of TJclPtrHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -2478,15 +2478,15 @@
     function Values: IJclCollection;
   end;
 
-  TJclHashEntry = record
+  TJclHashMapEntry = record
     Key: TObject;
     Value: TObject;
   end;
 
-  TJclBucket = class
+  TJclHashMapBucket = class
   public
     Size: Integer;
-    Entries: array of TJclHashEntry;
+    Entries: array of TJclHashMapEntry;
     procedure MoveArray(FromIndex, ToIndex, Count: Integer);
   end;
 
@@ -2511,7 +2511,7 @@
     function GetOwnsValues: Boolean;
     property OwnsValues: Boolean read FOwnsValues;
   private
-    FBuckets: array of TJclBucket;
+    FBuckets: array of TJclHashMapBucket;
     FHashFunction: TJclHashFunction;
   protected
     procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
@@ -2728,9 +2728,9 @@
   Result := Trunc(Range * (Frac(Abs(Key * A))));
 end;
 
-//=== { TJclIntfIntfBucket } ==========================================
+//=== { TJclIntfIntfHashMapBucket } ==========================================
 
-procedure TJclIntfIntfBucket.MoveArray(FromIndex, ToIndex, Count: Integer);
+procedure TJclIntfIntfHashMapBucket.MoveArray(FromIndex, ToIndex, Count: Integer);
 begin
   if Count > 0 then
   begin
@@ -2773,7 +2773,7 @@
 procedure TJclIntfIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase);
 var
   I, J: Integer;
-  SelfBucket, NewBucket: TJclIntfIntfBucket;
+  SelfBucket, NewBucket: TJclIntfIntfHashMapBucket;
   ADest: TJclIntfIntfHashMap;
   AMap: IJclIntfIntfMap;
 begin
@@ -2792,7 +2792,7 @@
         SelfBucket := FBuckets[I];
         if SelfBucket <> nil then
         begin
-          NewBucket := TJclIntfIntfBucket.Create;
+          NewBucket := TJclIntfIntfHashMapBucket.Create;
           SetLength(NewBucket.Entries, SelfBucket.Size);
           for J := 0 to SelfBucket.Size - 1 do
           begin
@@ -2828,7 +2828,7 @@
 procedure TJclIntfIntfHashMap.Clear;
 var
   I, J: Integer;
-  Bucket: TJclIntfIntfBucket;
+  Bucket: TJclIntfIntfHashMapBucket;
 begin
   if ReadOnly then
     raise EJclReadOnlyError.Create;
@@ -2862,7 +2862,7 @@
 function TJclIntfIntfHashMap.ContainsKey(const Key: IInterface): Boolean;
 var
   I: Integer;
-  Bucket: TJclIntfIntfBucket;
+  Bucket: TJclIntfIntfHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -2889,7 +2889,7 @@
 function TJclIntfIntfHashMap.ContainsValue(const Value: IInterface): Boolean;
 var
   I, J: Integer;
-  Bucket: TJclIntfIntfBucket;
+  Bucket: TJclIntfIntfHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -2918,7 +2918,7 @@
 
 function TJclIntfIntfHashMap.Extract(const Key: IInterface): IInterface;
 var
-  Bucket: TJclIntfIntfBucket;
+  Bucket: TJclIntfIntfHashMapBucket;
   I, NewCapacity: Integer;
 begin
   if ReadOnly then
@@ -2960,7 +2960,7 @@
 function TJclIntfIntfHashMap.GetValue(const Key: IInterface): IInterface;
 var
   I: Integer;
-  Bucket: TJclIntfIntfBucket;
+  Bucket: TJclIntfIntfHashMapBucket;
   Found: Boolean;
 begin
   {$IFDEF THREADSAFE}
@@ -2997,7 +2997,7 @@
 function TJclIntfIntfHashMap.KeyOfValue(const Value: IInterface): IInterface;
 var
   I, J: Integer;
-  Bucket: TJclIntfIntfBucket;
+  Bucket: TJclIntfIntfHashMapBucket;
   Found: Boolean;
 begin
   {$IFDEF THREADSAFE}
@@ -3032,7 +3032,7 @@
 function TJclIntfIntfHashMap.KeySet: IJclIntfSet;
 var
   I, J: Integer;
-  Bucket: TJclIntfIntfBucket;
+  Bucket: TJclIntfIntfHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -3058,7 +3058,7 @@
 function TJclIntfIntfHashMap.MapEquals(const AMap: IJclIntfIntfMap): Boolean;
 var
   I, J: Integer;
-  Bucket: TJclIntfIntfBucket;
+  Bucket: TJclIntfIntfHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -3095,7 +3095,7 @@
 procedure TJclIntfIntfHashMap.Pack;
 var
   I: Integer;
-  Bucket: TJclIntfIntfBucket;
+  Bucket: TJclIntfIntfHashMapBucket;
 begin
   if ReadOnly then
     raise EJclReadOnlyError.Create;
@@ -3154,7 +3154,7 @@
 procedure TJclIntfIntfHashMap.PutValue(const Key: IInterface; const Value: IInterface);
 var
   Index: Integer;
-  Bucket: TJclIntfIntfBucket;
+  Bucket: TJclIntfIntfHashMapBucket;
   I: Integer;
 begin
   if ReadOnly then
@@ -3180,7 +3180,7 @@
       end
       else
       begin
-        Bucket := TJclIntfIntfBucket.Create;
+        Bucket := TJclIntfIntfHashMapBucket.Create;
         SetLength(Bucket.Entries, 1);
         FBuckets[Index] := Bucket;
       end;
@@ -3255,7 +3255,7 @@
 function TJclIntfIntfHashMap.Values: IJclIntfCollection;
 var
   I, J: Integer;
-  Bucket: TJclIntfIntfBucket;
+  Bucket: TJclIntfIntfHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -3306,9 +3306,9 @@
   Result := ItemsEqual(A, B);
 end;
 
-//=== { TJclAnsiStrIntfBucket } ==========================================
+//=== { TJclAnsiStrIntfHashMapBucket } ==========================================
 
-procedure TJclAnsiStrIntfBucket.MoveArray(FromIndex, ToIndex, Count: Integer);
+procedure TJclAnsiStrIntfHashMapBucket.MoveArray(FromIndex, ToIndex, Count: Integer);
 begin
   if Count > 0 then
   begin
@@ -3351,7 +3351,7 @@
 procedure TJclAnsiStrIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase);
 var
   I, J: Integer;
-  SelfBucket, NewBucket: TJclAnsiStrIntfBucket;
+  SelfBucket, NewBucket: TJclAnsiStrIntfHashMapBucket;
   ADest: TJclAnsiStrIntfHashMap;
   AMap: IJclAnsiStrIntfMap;
 begin
@@ -3370,7 +3370,7 @@
         SelfBucket := FBuckets[I];
         if SelfBucket <> nil then
         begin
-          NewBucket := TJclAnsiStrIntfBucket.Create;
+          NewBucket := TJclAnsiStrIntfHashMapBucket.Create;
           SetLength(NewBucket.Entries, SelfBucket.Size);
           for J := 0 to SelfBucket.Size - 1 do
           begin
@@ -3406,7 +3406,7 @@
 procedure TJclAnsiStrIntfHashMap.Clear;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrIntfBucket;
+  Bucket: TJclAnsiStrIntfHashMapBucket;
 begin
   if ReadOnly then
     raise EJclReadOnlyError.Create;
@@ -3440,7 +3440,7 @@
 function TJclAnsiStrIntfHashMap.ContainsKey(const Key: AnsiString): Boolean;
 var
   I: Integer;
-  Bucket: TJclAnsiStrIntfBucket;
+  Bucket: TJclAnsiStrIntfHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -3467,7 +3467,7 @@
 function TJclAnsiStrIntfHashMap.ContainsValue(const Value: IInterface): Boolean;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrIntfBucket;
+  Bucket: TJclAnsiStrIntfHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -3496,7 +3496,7 @@
 
 function TJclAnsiStrIntfHashMap.Extract(const Key: AnsiString): IInterface;
 var
-  Bucket: TJclAnsiStrIntfBucket;
+  Bucket: TJclAnsiStrIntfHashMapBucket;
   I, NewCapacity: Integer;
 begin
   if ReadOnly then
@@ -3538,7 +3538,7 @@
 function TJclAnsiStrIntfHashMap.GetValue(const Key: AnsiString): IInterface;
 var
   I: Integer;
-  Bucket: TJclAnsiStrIntfBucket;
+  Bucket: TJclAnsiStrIntfHashMapBucket;
   Found: Boolean;
 begin
   {$IFDEF THREADSAFE}
@@ -3575,7 +3575,7 @@
 function TJclAnsiStrIntfHashMap.KeyOfValue(const Value: IInterface): AnsiString;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrIntfBucket;
+  Bucket: TJclAnsiStrIntfHashMapBucket;
   Found: Boolean;
 begin
   {$IFDEF THREADSAFE}
@@ -3610,7 +3610,7 @@
 function TJclAnsiStrIntfHashMap.KeySet: IJclAnsiStrSet;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrIntfBucket;
+  Bucket: TJclAnsiStrIntfHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -3636,7 +3636,7 @@
 function TJclAnsiStrIntfHashMap.MapEquals(const AMap: IJclAnsiStrIntfMap): Boolean;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrIntfBucket;
+  Bucket: TJclAnsiStrIntfHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -3673,7 +3673,7 @@
 procedure TJclAnsiStrIntfHashMap.Pack;
 var
   I: Integer;
-  Bucket: TJclAnsiStrIntfBucket;
+  Bucket: TJclAnsiStrIntfHashMapBucket;
 begin
   if ReadOnly then
     raise EJclReadOnlyError.Create;
@@ -3732,7 +3732,7 @@
 procedure TJclAnsiStrIntfHashMap.PutValue(const Key: AnsiString; const Value: IInterface);
 var
   Index: Integer;
-  Bucket: TJclAnsiStrIntfBucket;
+  Bucket: TJclAnsiStrIntfHashMapBucket;
   I: Integer;
 begin
   if ReadOnly then
@@ -3758,7 +3758,7 @@
       end
       else
       begin
-        Bucket := TJclAnsiStrIntfBucket.Create;
+        Bucket := TJclAnsiStrIntfHashMapBucket.Create;
         SetLength(Bucket.Entries, 1);
         FBuckets[Index] := Bucket;
       end;
@@ -3833,7 +3833,7 @@
 function TJclAnsiStrIntfHashMap.Values: IJclIntfCollection;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrIntfBucket;
+  Bucket: TJclAnsiStrIntfHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -3884,9 +3884,9 @@
   Result := IntfSimpleEqualityCompare(A, B);
 end;
 
-//=== { TJclIntfAnsiStrBucket } ==========================================
+//=== { TJclIntfAnsiStrHashMapBucket } ==========================================
 
-procedure TJclIntfAnsiStrBucket.MoveArray(FromIndex, ToIndex, Count: Integer);
+procedure TJclIntfAnsiStrHashMapBucket.MoveArray(FromIndex, ToIndex, Count: Integer);
 begin
   if Count > 0 then
   begin
@@ -3929,7 +3929,7 @@
 procedure TJclIntfAnsiStrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase);
 var
   I, J: Integer;
-  SelfBucket, NewBucket: TJclIntfAnsiStrBucket;
+  SelfBucket, NewBucket: TJclIntfAnsiStrHashMapBucket;
   ADest: TJclIntfAnsiStrHashMap;
   AMap: IJclIntfAnsiStrMap;
 begin
@@ -3948,7 +3948,7 @@
         SelfBucket := FBuckets[I];
         if SelfBucket <> nil then
         begin
-          NewBucket := TJclIntfAnsiStrBucket.Create;
+          NewBucket := TJclIntfAnsiStrHashMapBucket.Create;
           SetLength(NewBucket.Entries, SelfBucket.Size);
           for J := 0 to SelfBucket.Size - 1 do
           begin
@@ -3984,7 +3984,7 @@
 procedure TJclIntfAnsiStrHashMap.Clear;
 var
   I, J: Integer;
-  Bucket: TJclIntfAnsiStrBucket;
+  Bucket: TJclIntfAnsiStrHashMapBucket;
 begin
   if ReadOnly then
     raise EJclReadOnlyError.Create;
@@ -4018,7 +4018,7 @@
 function TJclIntfAnsiStrHashMap.ContainsKey(const Key: IInterface): Boolean;
 var
   I: Integer;
-  Bucket: TJclIntfAnsiStrBucket;
+  Bucket: TJclIntfAnsiStrHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -4045,7 +4045,7 @@
 function TJclIntfAnsiStrHashMap.ContainsValue(const Value: AnsiString): Boolean;
 var
   I, J: Integer;
-  Bucket: TJclIntfAnsiStrBucket;
+  Bucket: TJclIntfAnsiStrHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -4074,7 +4074,7 @@
 
 function TJclIntfAnsiStrHashMap.Extract(const Key: IInterface): AnsiString;
 var
-  Bucket: TJclIntfAnsiStrBucket;
+  Bucket: TJclIntfAnsiStrHashMapBucket;
   I, NewCapacity: Integer;
 begin
   if ReadOnly then
@@ -4116,7 +4116,7 @@
 function TJclIntfAnsiStrHashMap.GetValue(const Key: IInterface): AnsiString;
 var
   I: Integer;
-  Bucket: TJclIntfAnsiStrBucket;
+  Bucket: TJclIntfAnsiStrHashMapBucket;
   Found: Boolean;
 begin
   {$IFDEF THREADSAFE}
@@ -4153,7 +4153,7 @@
 function TJclIntfAnsiStrHashMap.KeyOfValue(const Value: AnsiString): IInterface;
 var
   I, J: Integer;
-  Bucket: TJclIntfAnsiStrBucket;
+  Bucket: TJclIntfAnsiStrHashMapBucket;
   Found: Boolean;
 begin
   {$IFDEF THREADSAFE}
@@ -4188,7 +4188,7 @@
 function TJclIntfAnsiStrHashMap.KeySet: IJclIntfSet;
 var
   I, J: Integer;
-  Bucket: TJclIntfAnsiStrBucket;
+  Bucket: TJclIntfAnsiStrHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -4214,7 +4214,7 @@
 function TJclIntfAnsiStrHashMap.MapEquals(const AMap: IJclIntfAnsiStrMap): Boolean;
 var
   I, J: Integer;
-  Bucket: TJclIntfAnsiStrBucket;
+  Bucket: TJclIntfAnsiStrHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -4251,7 +4251,7 @@
 procedure TJclIntfAnsiStrHashMap.Pack;
 var
   I: Integer;
-  Bucket: TJclIntfAnsiStrBucket;
+  Bucket: TJclIntfAnsiStrHashMapBucket;
 begin
   if ReadOnly then
     raise EJclReadOnlyError.Create;
@@ -4310,7 +4310,7 @@
 procedure TJclIntfAnsiStrHashMap.PutValue(const Key: IInterface; const Value: AnsiString);
 var
   Index: Integer;
-  Bucket: TJclIntfAnsiStrBucket;
+  Bucket: TJclIntfAnsiStrHashMapBucket;
   I: Integer;
 begin
   if ReadOnly then
@@ -4336,7 +4336,7 @@
       end
       else
       begin
-        Bucket := TJclIntfAnsiStrBucket.Create;
+        Bucket := TJclIntfAnsiStrHashMapBucket.Create;
         SetLength(Bucket.Entries, 1);
         FBuckets[Index] := Bucket;
       end;
@@ -4411,7 +4411,7 @@
 function TJclIntfAnsiStrHashMap.Values: IJclAnsiStrCollection;
 var
   I, J: Integer;
-  Bucket: TJclIntfAnsiStrBucket;
+  Bucket: TJclIntfAnsiStrHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -4467,9 +4467,9 @@
   Result := ItemsEqual(A, B);
 end;
 
-//=== { TJclAnsiStrAnsiStrBucket } ==========================================
+//=== { TJclAnsiStrAnsiStrHashMapBucket } ==========================================
 
-procedure TJclAnsiStrAnsiStrBucket.MoveArray(FromIndex, ToIndex, Count: Integer);
+procedure TJclAnsiStrAnsiStrHashMapBucket.MoveArray(FromIndex, ToIndex, Count: Integer);
 begin
   if Count > 0 then
   begin
@@ -4512,7 +4512,7 @@
 procedure TJclAnsiStrAnsiStrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase);
 var
   I, J: Integer;
-  SelfBucket, NewBucket: TJclAnsiStrAnsiStrBucket;
+  SelfBucket, NewBucket: TJclAnsiStrAnsiStrHashMapBucket;
   ADest: TJclAnsiStrAnsiStrHashMap;
   AMap: IJclAnsiStrAnsiStrMap;
 begin
@@ -4531,7 +4531,7 @@
         SelfBucket := FBuckets[I];
         if SelfBucket <> nil then
         begin
-          NewBucket := TJclAnsiStrAnsiStrBucket.Create;
+          NewBucket := TJclAnsiStrAnsiStrHashMapBucket.Create;
           SetLength(NewBucket.Entries, SelfBucket.Size);
           for J := 0 to SelfBucket.Size - 1 do
           begin
@@ -4567,7 +4567,7 @@
 procedure TJclAnsiStrAnsiStrHashMap.Clear;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrAnsiStrBucket;
+  Bucket: TJclAnsiStrAnsiStrHashMapBucket;
 begin
   if ReadOnly then
     raise EJclReadOnlyError.Create;
@@ -4601,7 +4601,7 @@
 function TJclAnsiStrAnsiStrHashMap.ContainsKey(const Key: AnsiString): Boolean;
 var
   I: Integer;
-  Bucket: TJclAnsiStrAnsiStrBucket;
+  Bucket: TJclAnsiStrAnsiStrHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -4628,7 +4628,7 @@
 function TJclAnsiStrAnsiStrHashMap.ContainsValue(const Value: AnsiString): Boolean;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrAnsiStrBucket;
+  Bucket: TJclAnsiStrAnsiStrHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -4657,7 +4657,7 @@
 
 function TJclAnsiStrAnsiStrHashMap.Extract(const Key: AnsiString): AnsiString;
 var
-  Bucket: TJclAnsiStrAnsiStrBucket;
+  Bucket: TJclAnsiStrAnsiStrHashMapBucket;
   I, NewCapacity: Integer;
 begin
   if ReadOnly then
@@ -4699,7 +4699,7 @@
 function TJclAnsiStrAnsiStrHashMap.GetValue(const Key: AnsiString): AnsiString;
 var
   I: Integer;
-  Bucket: TJclAnsiStrAnsiStrBucket;
+  Bucket: TJclAnsiStrAnsiStrHashMapBucket;
   Found: Boolean;
 begin
   {$IFDEF THREADSAFE}
@@ -4736,7 +4736,7 @@
 function TJclAnsiStrAnsiStrHashMap.KeyOfValue(const Value: AnsiString): AnsiString;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrAnsiStrBucket;
+  Bucket: TJclAnsiStrAnsiStrHashMapBucket;
   Found: Boolean;
 begin
   {$IFDEF THREADSAFE}
@@ -4771,7 +4771,7 @@
 function TJclAnsiStrAnsiStrHashMap.KeySet: IJclAnsiStrSet;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrAnsiStrBucket;
+  Bucket: TJclAnsiStrAnsiStrHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -4797,7 +4797,7 @@
 function TJclAnsiStrAnsiStrHashMap.MapEquals(const AMap: IJclAnsiStrAnsiStrMap): Boolean;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrAnsiStrBucket;
+  Bucket: TJclAnsiStrAnsiStrHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -4834,7 +4834,7 @@
 procedure TJclAnsiStrAnsiStrHashMap.Pack;
 var
   I: Integer;
-  Bucket: TJclAnsiStrAnsiStrBucket;
+  Bucket: TJclAnsiStrAnsiStrHashMapBucket;
 begin
   if ReadOnly then
     raise EJclReadOnlyError.Create;
@@ -4893,7 +4893,7 @@
 procedure TJclAnsiStrAnsiStrHashMap.PutValue(const Key: AnsiString; const Value: AnsiString);
 var
   Index: Integer;
-  Bucket: TJclAnsiStrAnsiStrBucket;
+  Bucket: TJclAnsiStrAnsiStrHashMapBucket;
   I: Integer;
 begin
   if ReadOnly then
@@ -4919,7 +4919,7 @@
       end
       else
       begin
-        Bucket := TJclAnsiStrAnsiStrBucket.Create;
+        Bucket := TJclAnsiStrAnsiStrHashMapBucket.Create;
         SetLength(Bucket.Entries, 1);
         FBuckets[Index] := Bucket;
       end;
@@ -4994,7 +4994,7 @@
 function TJclAnsiStrAnsiStrHashMap.Values: IJclAnsiStrCollection;
 var
   I, J: Integer;
-  Bucket: TJclAnsiStrAnsiStrBucket;
+  Bucket: TJclAnsiStrAnsiStrHashMapBucket;
 begin
   {$IFDEF THREADSAFE}
   if FThreadSafe then
@@ -5045,9 +5045,9 @@
   Result := ItemsEqual(A, B);
 end;
 
-//=== { TJclWideStrIntfBucket } ==========================================
+//=== { TJclWideStrIntfHashMapBucket } ==========================================
 
-procedure TJclWideStrIntfBucket.MoveArray(FromIndex, ToIndex, Count: Integer);
+procedure TJclWideStrIntfHashMapBucket.MoveArray(FromIndex, ...
 
[truncated message content]

[Jcl-checkins-diff] SF.net SVN: jcl:[3712] trunk/jcl/source/common/ JclPreProcessorContainerTemplates.pas

From: <ou...@us...> - 2012-02-03 18:25:57

Revision: 3712
          http://jcl.svn.sourceforge.net/jcl/?rev=3712&view=rev
Author:   outchy
Date:     2012-02-03 18:25:51 +0000 (Fri, 03 Feb 2012)
Log Message:
-----------
remove useless dependency on unit Forms.

Modified Paths:
--------------
    trunk/jcl/source/common/JclPreProcessorContainerTemplates.pas

Modified: trunk/jcl/source/common/JclPreProcessorContainerTemplates.pas
===================================================================
--- trunk/jcl/source/common/JclPreProcessorContainerTemplates.pas	2012-02-03 18:14:26 UTC (rev 3711)
+++ trunk/jcl/source/common/JclPreProcessorContainerTemplates.pas	2012-02-03 18:25:51 UTC (rev 3712)
@@ -35,10 +35,8 @@
 uses
   {$IFDEF HAS_UNITSCOPE}
   System.Classes,
-  Vcl.Forms,
   {$ELSE ~HAS_UNITSCOPE}
   Classes,
-  Forms,
   {$ENDIF ~HAS_UNITSCOPE}
   {$IFDEF UNITVERSIONING}
   JclUnitVersioning,

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3711] trunk/jcl/source

From: <ou...@us...> - 2012-02-03 18:14:32

Revision: 3711
          http://jcl.svn.sourceforge.net/jcl/?rev=3711&view=rev
Author:   outchy
Date:     2012-02-03 18:14:26 +0000 (Fri, 03 Feb 2012)
Log Message:
-----------
prototype update.

Modified Paths:
--------------
    trunk/jcl/source/prototypes/Hardlinks.pas
    trunk/jcl/source/windows/Hardlinks.pas

Modified: trunk/jcl/source/prototypes/Hardlinks.pas
===================================================================
--- trunk/jcl/source/prototypes/Hardlinks.pas	2012-01-31 19:03:38 UTC (rev 3710)
+++ trunk/jcl/source/prototypes/Hardlinks.pas	2012-02-03 18:14:26 UTC (rev 3711)
@@ -202,7 +202,11 @@
   {$IFDEF UNITVERSIONING}
   JclUnitVersioning,
   {$ENDIF UNITVERSIONING}
+  {$IFDEF HAS_UNITSCOPE}
+  Winapi.Windows;
+  {$ELSE ~HAS_UNITSCOPE}
   Windows;
+  {$ENDIF ~HAS_UNITSCOPE}
 
 {$IFDEF PREFERAPI}
   {$DEFINE STDCALL // For the windows API we _require_ STDCALL calling convention }

Modified: trunk/jcl/source/windows/Hardlinks.pas
===================================================================
--- trunk/jcl/source/windows/Hardlinks.pas	2012-01-31 19:03:38 UTC (rev 3710)
+++ trunk/jcl/source/windows/Hardlinks.pas	2012-02-03 18:14:26 UTC (rev 3711)
@@ -85,6 +85,7 @@
   Windows;
   {$ENDIF ~HAS_UNITSCOPE}
 
+
 {$EXTERNALSYM CreateHardLinkW}
 {$EXTERNALSYM CreateHardLinkA}
 

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3710] trunk/jcl/install/JclInstall.pas

From: <ou...@us...> - 2012-01-31 19:03:44

Revision: 3710
          http://jcl.svn.sourceforge.net/jcl/?rev=3710&view=rev
Author:   outchy
Date:     2012-01-31 19:03:38 +0000 (Tue, 31 Jan 2012)
Log Message:
-----------
style cleanup.

Modified Paths:
--------------
    trunk/jcl/install/JclInstall.pas

Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas	2012-01-31 19:02:26 UTC (rev 3709)
+++ trunk/jcl/install/JclInstall.pas	2012-01-31 19:03:38 UTC (rev 3710)
@@ -1050,7 +1050,8 @@
     if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber <= 2) then
       // design packages are not loaded by C#Builder 1 and Delphi 8
       AddOption(joJCLExpertsDLL, [goRadioButton, goChecked], joJCLExperts)
-    else if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber >= 3) then
+    else
+    if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber >= 3) then
       // expert DLLs are unstable on Delphi 2005 and BDS 2006
       // (problems while adding menu items in menu not loaded yet)
       AddOption(joJCLExpertsDsgnPackages, [goRadioButton, goChecked], joJCLExperts)
@@ -1705,9 +1706,11 @@
         MarkOptionBegin(Option);
         if Option = joJCLExpertsDsgnPackages then
           // nothing, default value
-        else if Option = joJCLExpertsDLL then
+        else
+        if Option = joJCLExpertsDLL then
           DLLExperts := OptionChecked[Option]
-        else if DLLExperts then
+        else
+        if DLLExperts then
           Result := CompileExpert(FullLibraryFileName(Target, SupportedExperts[Option]))
         else
           Result := CompilePackage(FullPackageFileName(Target, SupportedExperts[Option]));
@@ -2938,7 +2941,8 @@
       if Result and (not FirstCompilationOk) then
         // second compilation
         Result := Target.CompileProject(ProjectFileName, GetBplPath, GetDcpPath)
-      else if not Result then
+      else
+      if not Result then
         WriteLog(LoadResString(@RsLogEntryPointNotFound));
     end
     else

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3709] trunk/jcl/source/vcl/JclPrint.pas

From: <ou...@us...> - 2012-01-31 19:02:37

Revision: 3709
          http://jcl.svn.sourceforge.net/jcl/?rev=3709&view=rev
Author:   outchy
Date:     2012-01-31 19:02:26 +0000 (Tue, 31 Jan 2012)
Log Message:
-----------
cleanup: deletion of the old FDeviceMode, add Jared Davison to the author list (he is the original author of the changes in revision 3708).

Revision Links:
--------------
    http://jcl.svn.sourceforge.net/jcl/?rev=3708&view=rev

Modified Paths:
--------------
    trunk/jcl/source/vcl/JclPrint.pas

Modified: trunk/jcl/source/vcl/JclPrint.pas
===================================================================
--- trunk/jcl/source/vcl/JclPrint.pas	2012-01-30 22:20:49 UTC (rev 3708)
+++ trunk/jcl/source/vcl/JclPrint.pas	2012-01-31 19:02:26 UTC (rev 3709)
@@ -24,6 +24,7 @@
 {   Matthias Thoma (mthoma)                                                                        }
 {   Karl Ivar Hansen                                                                               }
 {   Martin Cakrt                                                                                   }
+{   Jared Davison                                                                                  }
 {                                                                                                  }
 {**************************************************************************************************}
 {                                                                                                  }
@@ -74,7 +75,6 @@
     FDriver: PChar;
     FPort: PChar;
     FHandle: THandle;
-    //FDeviceMode: PDeviceMode;
     FPrinter: Integer;
     FBinArray: PWordArray;
     FNumBins: DWord;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3708] trunk/jcl/source/vcl/JclPrint.pas

From: <ou...@us...> - 2012-01-30 22:20:56

Revision: 3708
          http://jcl.svn.sourceforge.net/jcl/?rev=3708&view=rev
Author:   outchy
Date:     2012-01-30 22:20:49 +0000 (Mon, 30 Jan 2012)
Log Message:
-----------
Mantis 5772: JclPrint settings corruption bugfixes.
(polished patch)

Modified Paths:
--------------
    trunk/jcl/source/vcl/JclPrint.pas

Modified: trunk/jcl/source/vcl/JclPrint.pas
===================================================================
--- trunk/jcl/source/vcl/JclPrint.pas	2012-01-30 21:35:12 UTC (rev 3707)
+++ trunk/jcl/source/vcl/JclPrint.pas	2012-01-30 22:20:49 UTC (rev 3708)
@@ -49,9 +49,9 @@
   JclUnitVersioning,
   {$ENDIF UNITVERSIONING}
   {$IFDEF HAS_UNITSCOPE}
-  Winapi.Windows, System.Classes, Vcl.StdCtrls, System.SysUtils,
+  Winapi.Windows, System.Classes, Vcl.StdCtrls, System.SysUtils, System.IniFiles,
   {$ELSE ~HAS_UNITSCOPE}
-  Windows, Classes, StdCtrls, SysUtils,
+  Windows, Classes, StdCtrls, SysUtils, IniFiles,
   {$ENDIF ~HAS_UNITSCOPE}
   JclBase;
 
@@ -74,18 +74,25 @@
     FDriver: PChar;
     FPort: PChar;
     FHandle: THandle;
-    FDeviceMode: PDeviceMode;
+    //FDeviceMode: PDeviceMode;
     FPrinter: Integer;
     FBinArray: PWordArray;
-    FNumBins: Byte;
+    FNumBins: DWord;
     FPaperArray: PWordArray;
-    FNumPapers: Byte;
+    FNumPapers: DWord;
     FDpiX: Integer;
     FiDpiY: Integer;
     procedure CheckPrinter;
     procedure SetBinArray;
     procedure SetPaperArray;
     function DefaultPaperName(const PaperID: Word): string;
+    function GetDevModePrinterDriverVersion: Word;
+    function GetDevModePrinterDriver: string;
+    function GetDevModePrinterDriverExtra: TDynByteArray;
+    function LockDeviceMode: PDeviceMode;
+    procedure SetDeviceMode(Creating: Boolean);
+    procedure SetPrinterName(const Value: string);
+    procedure UnlockDeviceMode;
   protected
     procedure SetOrientation(Orientation: Integer);
     function GetOrientation: Integer;
@@ -114,11 +121,15 @@
     function GetPrinterName: string;
     function GetPrinterPort: string;
     function GetPrinterDriver: string;
-    procedure SetBinFromList(BinNum: Byte);
-    function GetBinIndex: Byte;
-    procedure SetPaperFromList(PaperNum: Byte);
-    function GetPaperIndex: Byte;
+    procedure SetBinFromList(BinNum: Word);
+    function GetBinIndex: Word;
+    procedure SetPaperFromList(PaperNum: Word);
+    function GetPaperIndex: Word;
+    function ReadFromCustomIni(const PrIniFile: TCustomIniFile; const Section: string): Boolean;
+    procedure SaveToCustomIni(const PrIniFile: TCustomIniFile; const Section: string);
     procedure SetPort(Port: string);
+    procedure DevModePrinterDriverExtraReinstate(const ExtraData: TDynByteArray;
+      const ExtraDataDriverName: string; const ExtraDataDriverVersion: Word);
   public
     constructor Create; virtual;
     destructor Destroy; override;
@@ -127,8 +138,7 @@
     //function GetPaperList: TStringList; overload;
     procedure GetBinSourceList(List: TStrings); overload;
     procedure GetPaperList(List: TStrings); overload;
-    procedure SetDeviceMode(Creating: Boolean);
-    procedure UpdateDeviceMode;
+    procedure UpdateDeviceMode(const ADeviceMode: PDeviceMode);
     procedure SaveToDefaults;
     procedure SavePrinterAsDefault;
     procedure ResetPrinterDialogs;
@@ -142,8 +152,9 @@
     procedure TextOutCm(const X, Y: Double; const Text: string);
     procedure TextOutCpiLpi(const Cpi, Chars, Lpi, Lines: Double; const Text: string);
     procedure CustomPageSetup(const Width, Height: Double);
-    procedure SaveToIniFile(const IniFileName, Section: string);
-    function ReadFromIniFile(const IniFileName, Section: string): Boolean;
+    procedure DevModePrinterDriverExtraClear;
+    procedure SaveToIniFile(const IniFileName, Section: string); virtual;
+    function ReadFromIniFile(const IniFileName, Section: string): Boolean; virtual;
     property Orientation: Integer read GetOrientation write SetOrientation;
     property PaperSize: Integer read GetPaperSize write SetPaperSize;
     property PaperLength: Integer read GetPaperLength write SetPaperLength;
@@ -156,11 +167,15 @@
     property Duplex: Integer read GetDuplex write SetDuplex;
     property YResolution: Integer read GetYResolution write SetYResolution;
     property TrueTypeOption: Integer read GetTrueTypeOption write SetTrueTypeOption;
-    property PrinterName: string read GetPrinterName;
+    property PrinterName: string read GetPrinterName write SetPrinterName;
     property PrinterPort: string read GetPrinterPort write SetPort;
     property PrinterDriver: string read GetPrinterDriver;
-    property BinIndex: Byte read GetBinIndex write SetBinFromList;
-    property PaperIndex: Byte read GetPaperIndex write SetPaperFromList;
+    property BinIndex: Word read GetBinIndex write SetBinFromList;
+    property DevModePrinterDriverVersion: Word read GetDevModePrinterDriverVersion;
+    property DevModePrinterDriver: string read GetDevModePrinterDriver;
+    property DevModePrinterDriverExtra: TDynByteArray read
+        GetDevModePrinterDriverExtra;
+    property PaperIndex: Word read GetPaperIndex write SetPaperFromList;
     property DpiX: Integer read FDpiX write FDpiX;
     property DpiY: Integer read FiDpiY write FiDpiY;
   end;
@@ -195,9 +210,9 @@
 
 uses
   {$IFDEF HAS_UNITSCOPE}
-  Vcl.Graphics, System.IniFiles, Winapi.Messages, Vcl.Printers, Winapi.WinSpool,
+  Vcl.Graphics, Winapi.Messages, Vcl.Printers, Winapi.WinSpool,
   {$ELSE ~HAS_UNITSCOPE}
-  Graphics, IniFiles, Messages, Printers, WinSpool,
+  Graphics, Messages, Printers, WinSpool,
   {$ENDIF ~HAS_UNITSCOPE}
   JclSysInfo, JclVclResources;
 
@@ -217,6 +232,11 @@
   PrintIniYResolution   = 'YResolution';
   PrintIniTTOption      = 'TTOption';
 
+  PrintDriverExtraSize = 'DriverExtraSize';
+  PrintDriverExtraData = 'DriverExtraData';
+  PrintDriverVersion = 'DriverVersion';
+  PrintDriverName = 'DriverName';
+
   cWindows: PChar = 'windows';
   cDevice = 'device';
   cPrintSpool = 'winspool.drv';
@@ -529,6 +549,7 @@
   GetMem(FDevice, 255);
   GetMem(FDriver, 255);
   GetMem(FPort, 255);
+  FHandle := 0;
 end;
 
 destructor TJclPrintSet.Destroy;
@@ -547,50 +568,72 @@
 end;
 
 procedure TJclPrintSet.CheckPrinter;
+var
+  NewHandle: THandle;
+  PrinterChanged: Boolean;
+  LastDevice, LastDriver, LastPort: string;
 begin
-  if FPrinter <> Printer.PrinterIndex then
-  begin
-    Printer.GetPrinter(FDevice, FDriver, FPort, FHandle);
-    Printer.SetPrinter(FDevice, FDriver, FPort, FHandle);
+  LastDevice := FDevice;
+  LastDriver := FDriver;
+  LastPort := FPort;
+  
+  Printer.GetPrinter(FDevice, FDriver, FPort, NewHandle);
+  PrinterChanged := (FHandle <> NewHandle) or (LastDevice <> FDevice)
+    or (LastDriver <> FDriver) or (LastPort <> FPort) or (FPrinter <> Printer.PrinterIndex);
+  FHandle := NewHandle;
+  FPrinter := Printer.PrinterIndex;
+  Printer.SetPrinter(FDevice, FDriver, FPort, FHandle);
+  if PrinterChanged then
     SetDeviceMode(False);
-  end;
 end;
 
 procedure TJclPrintSet.SetBinArray;
 var
-  NumBinsRec: Integer;
+  NumBinsRec: DWord;
+  ADeviceMode: PDeviceMode;
 begin
   if FBinArray <> nil then
     FreeMem(FBinArray, FNumBins * SizeOf(Word));
   FBinArray := nil;
-  FNumBins := DeviceCapabilities(FDevice, FPort, DC_Bins, nil, FDeviceMode);
-  if FNumBins > 0 then
-  begin
-    GetMem(FBinArray, FNumBins * SizeOf(Word));
-    NumBinsRec := DeviceCapabilities(FDevice, FPort, DC_Bins,
-      PChar(FBinArray), FDeviceMode);
-    if NumBinsRec <> FNumBins then
-      raise EJclPrinterError.CreateRes(@RsRetrievingSource);
+  ADeviceMode := LockDeviceMode;
+  try
+    FNumBins := DeviceCapabilities(FDevice, FPort, DC_Bins, nil, ADeviceMode);
+    if FNumBins > 0 then
+    begin
+      GetMem(FBinArray, FNumBins * SizeOf(Word));
+      NumBinsRec := DeviceCapabilities(FDevice, FPort, DC_Bins,
+        PChar(FBinArray), ADeviceMode);
+      if NumBinsRec <> FNumBins then
+        raise EJclPrinterError.CreateRes(@RsRetrievingSource);
+    end;
+  finally
+    UnlockDeviceMode;
   end;
 end;
 
 procedure TJclPrintSet.SetPaperArray;
 var
-  NumPapersRec: Integer;
+  NumPapersRec: DWord;
+  ADeviceMode: PDeviceMode;
 begin
   if FPaperArray <> nil then
     FreeMem(FPaperArray, FNumPapers * SizeOf(Word));
-  FNumPapers := DeviceCapabilities(FDevice, FPort, DC_Papers, nil, FDeviceMode);
-  if FNumPapers > 0 then
-  begin
-    GetMem(FPaperArray, FNumPapers * SizeOf(Word));
-    NumPapersRec := DeviceCapabilities(FDevice, FPort, DC_Papers,
-      PChar(FPaperArray), FDeviceMode);
-    if NumPapersRec <> FNumPapers then
-      raise EJclPrinterError.CreateRes(@RsRetrievingPaperSource);
-  end
-  else
-    FPaperArray := nil;
+  ADeviceMode := LockDeviceMode;
+  try
+    FNumPapers := DeviceCapabilities(FDevice, FPort, DC_Papers, nil, ADeviceMode);
+    if FNumPapers > 0 then
+    begin
+      GetMem(FPaperArray, FNumPapers * SizeOf(Word));
+      NumPapersRec := DeviceCapabilities(FDevice, FPort, DC_Papers,
+        PChar(FPaperArray), ADeviceMode);
+      if NumPapersRec <> FNumPapers then
+        raise EJclPrinterError.CreateRes(@RsRetrievingPaperSource);
+    end
+    else
+      FPaperArray := nil;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 { TODO : complete this list }
@@ -664,10 +707,11 @@
   TBinArray = array [1..cBinMax] of TBinName;
   PBinArray = ^TBinArray;
 var
-  NumBinsRec: Integer;
+  NumBinsRec: DWord;
   BinArray: PBinArray;
   BinStr: string;
   Idx: Integer;
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
   BinArray := nil;
@@ -677,8 +721,13 @@
   try
     GetMem(BinArray, FNumBins * SizeOf(TBinName));
     List.Clear;
-    NumBinsRec := DeviceCapabilities(FDevice, FPort, DC_BinNames,
-      PChar(BinArray), FDeviceMode);
+    ADeviceMode := LockDeviceMode;
+    try
+      NumBinsRec := DeviceCapabilities(FDevice, FPort, DC_BinNames,
+        PChar(BinArray), ADeviceMode);
+    finally
+      UnlockDeviceMode;
+    end;
     if NumBinsRec <> FNumBins then
       raise EJclPrinterError.CreateRes(@RsRetrievingSource);
     for Idx := 1 to NumBinsRec do
@@ -699,10 +748,11 @@
   TPaperArray = array [1..cPaperNames] of TPaperName;
   PPaperArray = ^TPaperArray;
 var
-  NumPaperRec: Integer;
+  NumPaperRec: DWord;
   PaperArray: PPaperArray;
   PaperStr: string;
   Idx: Integer;
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
   PaperArray := nil;
@@ -712,8 +762,13 @@
   List.Clear;
   try
     GetMem(PaperArray, FNumPapers * SizeOf(TPaperName));
-    NumPaperRec := DeviceCapabilities(FDevice, FPort, DC_PaperNames,
-      PChar(PaperArray), FDeviceMode);
+    ADeviceMode := LockDeviceMode;
+    try
+      NumPaperRec := DeviceCapabilities(FDevice, FPort, DC_PaperNames,
+        PChar(PaperArray), ADeviceMode);
+    finally
+      UnlockDeviceMode;
+    end;
     if NumPaperRec <> FNumPapers then
     begin
       for Idx := 1 to FNumPapers do
@@ -740,31 +795,28 @@
 procedure TJclPrintSet.SetDeviceMode(Creating: Boolean);
 var
   Res: TPoint;
+  ADeviceMode: PDeviceMode;
+  NewHandle: THandle;
 begin
-  Printer.GetPrinter(FDevice, FDriver, FPort, FHandle);
-  if FHandle = 0 then
+  Printer.GetPrinter(FDevice, FDriver, FPort, NewHandle);
+  if NewHandle = 0 then
   begin
     Printer.PrinterIndex := Printer.PrinterIndex;
-    Printer.GetPrinter(FDevice, FDriver, FPort, FHandle);
+    Printer.GetPrinter(FDevice, FDriver, FPort, NewHandle);
   end;
+  FHandle := NewHandle;
   if FHandle <> 0 then
   begin
-    FDeviceMode := GlobalLock(FHandle);
+    ADeviceMode := GlobalLock(FHandle);
+
     FPrinter := Printer.PrinterIndex;
-    FDeviceMode^.dmFields := dm_Orientation or dm_PaperSize or
-      dm_PaperLength or dm_PaperWidth or
-      dm_Scale or dm_Copies or
-      dm_DefaultSource or dm_PrintQuality or
-      dm_Color or dm_Duplex or
-      dm_YResolution or dm_TTOption;
-    UpdateDeviceMode;
-    FDeviceMode^.dmFields := 0;
+    UpdateDeviceMode(ADeviceMode);
+    //FDeviceMode^.dmFields := 0;
     SetBinArray;
     SetPaperArray;
   end
   else
   begin
-    FDeviceMode := nil;
     if not Creating then
       raise EJclPrinterError.CreateRes(@RsDeviceMode);
     FPrinter := -99;
@@ -776,22 +828,24 @@
     GlobalUnLock(FHandle);
 end;
 
-procedure TJclPrintSet.UpdateDeviceMode;
+procedure TJclPrintSet.UpdateDeviceMode(const ADeviceMode: PDeviceMode);
 var
   DrvHandle: THandle;
   ExtDevCode: Integer;
 begin
-  CheckPrinter;      
+  // ONLY CALL when ADeviceMode is locked by caller!!!
+
+  //CheckPrinter;
   if OpenPrinter(FDevice, DrvHandle, nil) then
   try
-    FDeviceMode^.dmFields := dm_Orientation or dm_PaperSize or
+    ADeviceMode^.dmFields := dm_Orientation or dm_PaperSize or
       dm_PaperLength or dm_PaperWidth or
       dm_Scale or dm_Copies or
       dm_DefaultSource or dm_PrintQuality or
       dm_Color or dm_Duplex or
       dm_YResolution or dm_TTOption;
     ExtDevCode := DocumentProperties(0, DrvHandle, FDevice,
-      FDeviceMode^, FDeviceMode^,
+      ADeviceMode^, ADeviceMode^,
       DM_IN_BUFFER or DM_OUT_BUFFER);
     if ExtDevCode <> IDOK then
       raise EJclPrinterError.CreateRes(@RsUpdatingPrinter);
@@ -804,11 +858,17 @@
 var
   DrvHandle: THandle;
   ExtDevCode: Integer;
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
   OpenPrinter(FDevice, DrvHandle, nil);
-  ExtDevCode := DocumentProperties(0, DrvHandle, FDevice,
-    FDeviceMode^, FDeviceMode^, DM_IN_BUFFER or DM_UPDATE);
+  ADeviceMode := LockDeviceMode;
+  try
+    ExtDevCode := DocumentProperties(0, DrvHandle, FDevice,
+      ADeviceMode^, ADeviceMode^, DM_IN_BUFFER or DM_UPDATE);
+  finally
+    UnlockDeviceMode;
+  end;
   if ExtDevCode <> IDOK then
     raise EJclPrinterError.CreateRes(@RsUpdatingPrinter)
   else
@@ -882,233 +942,429 @@
   PaperWidth := Trunc(254 * Width);
 end;
 
+procedure TJclPrintSet.DevModePrinterDriverExtraClear;
+var
+  ADeviceMode: PDeviceMode;
+begin
+  CheckPrinter;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceMode^.dmDriverExtra := 0;
+  finally
+    UnlockDeviceMode;
+  end;
+end;
+
+procedure TJclPrintSet.DevModePrinterDriverExtraReinstate(const ExtraData: TDynByteArray;
+  const ExtraDataDriverName: string; const ExtraDataDriverVersion: Word);
+var
+  Src, Dest: PDeviceMode;
+  ADeviceModeDriverExtra: PByte;
+  NewHandle: THandle;
+begin
+  CheckPrinter;
+    { http://support.microsoft.com/kb/167345
+      Using a DEVMODE structure to modify printer settings is more difficult than just changing the fields of the structure. Specifically, a valid DEVMODE structure for a device contains private data that can only be modified by the DocumentProperties() function.
+      This article explains how to modify the contents of a DEVMODE structure with the DocumentProperties() function.}
+
+  if FHandle <> 0 then
+  begin
+    Src := GlobalLock(FHandle);
+    try
+      if not ((Src^.dmDeviceName = ExtraDataDriverName) and (Src^.dmDriverVersion = ExtraDataDriverVersion)) then
+        exit;
+        //raise Exception.Create('TJclPrintSet.DevModePrinterDriverExtraReinstate - Driver Private data does not match selected printer');
+
+      NewHandle := GlobalAlloc(GHND, sizeof(DEVMODE) + Length(ExtraData));
+      if NewHandle <> 0 then
+        try
+          Dest := GlobalLock(NewHandle);
+
+          if (Src <> nil) and (Dest <> nil) then
+          begin
+            Move(Src^, Dest^, Src^.dmSize);
+            Dest^.dmDriverExtra := 0;
+
+            Dest^.dmDriverExtra := Length(ExtraData);
+
+
+            ADeviceModeDriverExtra := PByte(Dest);
+            Inc(ADeviceModeDriverExtra, Dest^.dmSize);
+            Move(ExtraData[0], ADeviceModeDriverExtra^, dest^.dmDriverExtra);
+          end
+          else
+            raise Exception.Create('TJclPrintSet.DevModePrinterDriverExtraReinstate - GlobalLock failed');
+        finally
+          GlobalUnlock(NewHandle);
+        end;
+
+      Printer.SetPrinter(FDevice, FDriver, FPort, NewHandle);
+      FHandle := NewHandle;
+      SetDeviceMode(False);
+    finally
+      GlobalUnlock(FHandle);
+    end;
+  end
+  else
+    raise Exception.Create('TJclPrintSet.DevModePrinterDriverExtraReinstate invalid handle');
+end;
+
 procedure TJclPrintSet.SaveToIniFile(const IniFileName, Section: string);
 var
-  PrIniFile: TIniFile;
-  CurrentName: string;
+  PrIniFile: TMemIniFile;
 begin
-  PrIniFile := TIniFile.Create(IniFileName);
-  CurrentName := Printer.Printers[Printer.PrinterIndex];
-  PrIniFile.WriteString(Section, PrintIniPrinterName, CurrentName);
-  PrIniFile.WriteString(Section, PrintIniPrinterPort, PrinterPort);
-  PrIniFile.WriteInteger(Section, PrintIniOrientation, Orientation);
-  PrIniFile.WriteInteger(Section, PrintIniPaperSize, PaperSize);
-  PrIniFile.WriteInteger(Section, PrintIniPaperLength, PaperLength);
-  PrIniFile.WriteInteger(Section, PrintIniPaperWidth, PaperWidth);
-  PrIniFile.WriteInteger(Section, PrintIniScale, Scale);
-  PrIniFile.WriteInteger(Section, PrintIniCopies, Copies);
-  PrIniFile.WriteInteger(Section, PrintIniDefaultSource, DefaultSource);
-  PrIniFile.WriteInteger(Section, PrintIniPrintQuality, PrintQuality);
-  PrIniFile.WriteInteger(Section, PrintIniColor, Color);
-  PrIniFile.WriteInteger(Section, PrintIniDuplex, Duplex);
-  PrIniFile.WriteInteger(Section, PrintIniYResolution, YResolution);
-  PrIniFile.WriteInteger(Section, PrintIniTTOption, TrueTypeOption);
-  PrIniFile.Free;
+  PrIniFile := TMemIniFile.Create(IniFileName);   // use TMemIniFile as TIniFile truncats longs values
+  try
+    SaveToCustomIni(PrIniFile, Section);
+    PrIniFile.UpdateFile;
+  finally
+    PrIniFile.Free;
+  end;
 end;
 
 function TJclPrintSet.ReadFromIniFile(const IniFileName, Section: string): Boolean;
 var
-  PrIniFile: TIniFile;
-  SavedName: string;
-  NewIndex: Integer;
+  PrIniFile: TMemIniFile;
 begin
-  Result := False;
-  PrIniFile := TIniFile.Create(IniFileName);
-  SavedName := PrIniFile.ReadString(Section, PrintIniPrinterName, PrinterName);
-  if PrinterName <> SavedName then
-  begin
-    NewIndex := Printer.Printers.IndexOf(SavedName);
-    if NewIndex <> -1 then
-    begin
-      Result := True;
-      Printer.PrinterIndex := NewIndex;
-      PrinterPort := PrIniFile.ReadString(Section, PrintIniPrinterPort, PrinterPort);
-      Orientation := PrIniFile.ReadInteger(Section, PrintIniOrientation, Orientation);
-      PaperSize := PrIniFile.ReadInteger(Section, PrintIniPaperSize, PaperSize);
-      PaperLength := PrIniFile.ReadInteger(Section, PrintIniPaperLength, PaperLength);
-      PaperWidth := PrIniFile.ReadInteger(Section, PrintIniPaperWidth, PaperWidth);
-      Scale := PrIniFile.ReadInteger(Section, PrintIniScale, Scale);
-      Copies := PrIniFile.ReadInteger(Section, PrintIniCopies, Copies);
-      DefaultSource := PrIniFile.ReadInteger(Section, PrintIniDefaultSource, DefaultSource);
-      PrintQuality := PrIniFile.ReadInteger(Section, PrintIniPrintQuality, PrintQuality);
-      Color := PrIniFile.ReadInteger(Section, PrintIniColor, Color);
-      Duplex := PrIniFile.ReadInteger(Section, PrintIniDuplex, Duplex);
-      YResolution := PrIniFile.ReadInteger(Section, PrintIniYResolution, YResolution);
-      TrueTypeOption := PrIniFile.ReadInteger(Section, PrintIniTTOption, TrueTypeOption);
-    end
-    else
-      Result := False;
+  PrIniFile := TMemIniFile.Create(IniFileName);     // use TMemIniFile as TIniFile truncats longs values
+  try
+    Result := ReadFromCustomIni(PrIniFile, Section);
+  finally
+    PrIniFile.Free;
   end;
-  PrIniFile.Free;
 end;
 
 procedure TJclPrintSet.SetOrientation(Orientation: Integer);
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  FDeviceMode^.dmOrientation := Orientation;
-  Printer.Orientation := TPrinterOrientation(Orientation - 1);
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_ORIENTATION;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceMode^.dmOrientation := Orientation;
+    Printer.Orientation := TPrinterOrientation(Orientation - 1);
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_ORIENTATION;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetOrientation: Integer;
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  Result := FDeviceMode^.dmOrientation;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmOrientation;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 procedure TJclPrintSet.SetPaperSize(Size: Integer);
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  FDeviceMode^.dmPaperSize := Size;
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERSIZE;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceMode^.dmPaperSize := Size;
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PAPERSIZE;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetPaperSize: Integer;
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  Result := FDeviceMode^.dmPaperSize;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmPaperSize;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 procedure TJclPrintSet.SetPaperLength(Length: Integer);
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  FDeviceMode^.dmPaperLength := Length;
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERLENGTH;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceMode^.dmPaperLength := Length;
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PAPERLENGTH;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetPaperLength: Integer;
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  Result := FDeviceMode^.dmPaperLength;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmPaperLength;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 procedure TJclPrintSet.SetPaperWidth(Width: Integer);
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  FDeviceMode^.dmPaperWidth := Width;
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERWIDTH;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceMode^.dmPaperWidth := Width;
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PAPERWIDTH;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetPaperWidth: Integer;
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  Result := FDeviceMode^.dmPaperWidth;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmPaperWidth;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 procedure TJclPrintSet.SetScale(Scale: Integer);
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  FDeviceMode^.dmScale := Scale;
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_SCALE;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceMode^.dmScale := Scale;
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_SCALE;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetScale: Integer;
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  Result := FDeviceMode^.dmScale;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmScale;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 procedure TJclPrintSet.SetCopies(Copies: Integer);
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  FDeviceMode^.dmCopies := Copies;
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_COPIES;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceMode^.dmCopies := Copies;
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_COPIES;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetCopies: Integer;
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  Result := FDeviceMode^.dmCopies;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmCopies;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 procedure TJclPrintSet.SetBin(Bin: Integer);
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  FDeviceMode^.dmDefaultSource := Bin;
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_DEFAULTSOURCE;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceMode^.dmDefaultSource := Bin;
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_DEFAULTSOURCE;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetBin: Integer;
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  Result := FDeviceMode^.dmDefaultSource;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmDefaultSource;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 procedure TJclPrintSet.SetPrintQuality(Quality: Integer);
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  FDeviceMode^.dmPrintQuality := Quality;
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PRINTQUALITY;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceMode^.dmPrintQuality := Quality;
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PRINTQUALITY;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetPrintQuality: Integer;
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  Result := FDeviceMode^.dmPrintQuality;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmPrintQuality;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 procedure TJclPrintSet.SetColor(Color: Integer);
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  FDeviceMode^.dmColor := Color;
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_ORIENTATION;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceMode^.dmColor := Color;
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_COLOR;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetColor: Integer;
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  Result := FDeviceMode^.dmColor;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmColor;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 procedure TJclPrintSet.SetDuplex(Duplex: Integer);
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  FDeviceMode^.dmDuplex := Duplex;
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_DUPLEX;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceMode^.dmDuplex := Duplex;
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_DUPLEX;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetDuplex: Integer;
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  Result := FDeviceMode^.dmDuplex;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmDuplex;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 procedure TJclPrintSet.SetYResolution(YRes: Integer);
 var
   PrintDevMode: PDeviceModeA;
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  PrintDevMode := @FDeviceMode^;
-  PrintDevMode^.dmYResolution := YRes;
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_YRESOLUTION;
+  ADeviceMode := LockDeviceMode;
+  try
+    PrintDevMode := @ADeviceMode^;
+    PrintDevMode^.dmYResolution := YRes;
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_YRESOLUTION;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetYResolution: Integer;
 var
   PrintDevMode: PDeviceModeA;
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  PrintDevMode := @FDeviceMode^;
-  Result := PrintDevMode^.dmYResolution;
+  ADeviceMode := LockDeviceMode;
+  try
+    PrintDevMode := @ADeviceMode^;
+    Result := PrintDevMode^.dmYResolution;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 procedure TJclPrintSet.SetTrueTypeOption(Option: Integer);
 var
   PrintDevMode: PDeviceModeA;
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  PrintDevMode := @FDeviceMode^;
-  PrintDevMode^.dmTTOption := Option;
-  FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_TTOPTION;
+  ADeviceMode := LockDeviceMode;
+  try
+    PrintDevMode := @ADeviceMode^;
+    PrintDevMode^.dmTTOption := Option;
+    ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_TTOPTION;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetTrueTypeOption: Integer;
 var
   PrintDevMode: PDeviceModeA;
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
-  PrintDevMode := @FDeviceMode^;
-  Result := PrintDevMode^.dmTTOption;
+  ADeviceMode := LockDeviceMode;
+  try
+    PrintDevMode := @ADeviceMode^;
+    Result := PrintDevMode^.dmTTOption;
+  finally
+    UnlockDeviceMode;
+  end;
 end;
 
 function TJclPrintSet.GetPrinterName: string;
@@ -1129,7 +1385,7 @@
   Result := StrPas(FDriver);
 end;
 
-procedure TJclPrintSet.SetBinFromList(BinNum: Byte);
+procedure TJclPrintSet.SetBinFromList(BinNum: Word);
 begin
   CheckPrinter;
   if FNumBins = 0 then
@@ -1140,24 +1396,73 @@
     DefaultSource := FBinArray^[BinNum];
 end;
 
-function TJclPrintSet.GetBinIndex: Byte;
+function TJclPrintSet.GetBinIndex: Word;
 var
-  Idx: Byte;
+  Idx: Word;
+  ADeviceMode: PDeviceMode;
 begin
   Result := 0;
-  for Idx := 0 to FNumBins do
-  begin
-    if FBinArray^[Idx] = Word(FDeviceMode^.dmDefaultSource) then
+  ADeviceMode := LockDeviceMode;
+  try
+    for Idx := 0 to FNumBins do
     begin
-      Result := Idx;
-      Break;
+      if FBinArray^[Idx] = Word(ADeviceMode^.dmDefaultSource) then
+      begin
+        Result := Idx;
+        Break;
+      end;
     end;
+  finally
+    UnlockDeviceMode;
   end;
 end;
 
-procedure TJclPrintSet.SetPaperFromList(PaperNum: Byte);
+function TJclPrintSet.GetDevModePrinterDriverVersion: Word;
+var
+  ADeviceMode: PDeviceMode;
 begin
   CheckPrinter;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmDriverVersion;
+  finally
+    UnlockDeviceMode;
+  end;
+end;
+
+function TJclPrintSet.GetDevModePrinterDriver: string;
+var
+  ADeviceMode: PDeviceMode;
+begin
+  CheckPrinter;
+  ADeviceMode := LockDeviceMode;
+  try
+    Result := ADeviceMode^.dmDeviceName;
+  finally
+    UnlockDeviceMode;
+  end;
+end;
+
+function TJclPrintSet.GetDevModePrinterDriverExtra: TDynByteArray;
+var
+  ADeviceMode: PDeviceMode;
+  ADeviceModeDriverExtra: PByte;
+begin
+  CheckPrinter;
+  ADeviceMode := LockDeviceMode;
+  try
+    ADeviceModeDriverExtra := PByte(ADeviceMode);
+    Inc(ADeviceModeDriverExtra, ADeviceMode^.dmSize);
+    SetLength(Result, ADeviceMode^.dmDriverExtra);
+    Move(ADeviceModeDriverExtra^, Result[0], ADeviceMode^.dmDriverExtra);
+  finally
+    UnlockDeviceMode;
+  end;
+end;
+
+procedure TJclPrintSet.SetPaperFromList(PaperNum: Word);
+begin
+  CheckPrinter;
   if FNumPapers = 0 then
     Exit;
   if PaperNum > FNumPapers then
@@ -1174,21 +1479,148 @@
   Printer.SetPrinter(FDevice, FDriver, FPort, FHandle);
 end;
 
-function TJclPrintSet.GetPaperIndex: Byte;
+function TJclPrintSet.GetPaperIndex: Word;
 var
-  Idx: Byte;
+  Idx: Word;
+  ADeviceMode: PDeviceMode;
 begin
   Result := 0;
-  for Idx := 0 to FNumPapers do
+  ADeviceMode := LockDeviceMode;
+  try
+    for Idx := 0 to FNumPapers do
+    begin
+      if FPaperArray^[Idx] = Word(ADeviceMode^.dmPaperSize) then
+      begin
+        Result := Idx;
+        Break;
+      end;
+    end;
+  finally
+    UnlockDeviceMode;
+  end;
+end;
+
+function TJclPrintSet.LockDeviceMode: PDeviceMode;
+begin
+  if FHandle <> 0 then
   begin
-    if FPaperArray^[Idx] = Word(FDeviceMode^.dmPaperSize) then
+    Result := GlobalLock(FHandle);
+    if not assigned(Result) then
+      RaiseLastOSError;
+  end
+  else
+    raise Exception.Create('TJclPrintSet.LockDeviceMode invalid FHandle');
+end;
+
+function TJclPrintSet.ReadFromCustomIni(const PrIniFile: TCustomIniFile; const Section: string): Boolean;
+var
+  privData: TMemoryStream;
+  privDataExtra: TDynByteArray;
+  privDataExtraSize: Integer;
+  DevModeDriverName: string;
+  DevModeDriverVersion: Word;
+begin
+  PrinterName := PrIniFile.ReadString(Section, PrintIniPrinterName, PrinterName);
+  PrinterPort := PrIniFile.ReadString(Section, PrintIniPrinterPort, PrinterPort);
+  Orientation := PrIniFile.ReadInteger(Section, PrintIniOrientation, Orientation);
+  PaperSize := PrIniFile.ReadInteger(Section, PrintIniPaperSize, PaperSize);
+  PaperLength := PrIniFile.ReadInteger(Section, PrintIniPaperLength, PaperLength);
+  PaperWidth := PrIniFile.ReadInteger(Section, PrintIniPaperWidth, PaperWidth);
+  Scale := PrIniFile.ReadInteger(Section, PrintIniScale, Scale);
+  Copies := PrIniFile.ReadInteger(Section, PrintIniCopies, Copies);
+  DefaultSource := PrIniFile.ReadInteger(Section, PrintIniDefaultSource, DefaultSource);
+  PrintQuality := PrIniFile.ReadInteger(Section, PrintIniPrintQuality, PrintQuality);
+  Color := PrIniFile.ReadInteger(Section, PrintIniColor, Color);
+  Duplex := PrIniFile.ReadInteger(Section, PrintIniDuplex, Duplex);
+  YResolution := PrIniFile.ReadInteger(Section, PrintIniYResolution, YResolution);
+  TrueTypeOption := PrIniFile.ReadInteger(Section, PrintIniTTOption, TrueTypeOption);
+
+  DevModeDriverName := PrIniFile.ReadString(Section, PrintDriverName, '');
+  DevModeDriverVersion := Word(PrIniFile.ReadInteger(Section, PrintDriverVersion, 0));
+  if (DevModePrinterDriver = DevModeDriverName) and
+     (DevModePrinterDriverVersion = DevModeDriverVersion) then
+  begin
+    privData := TMemoryStream.Create;
+    try
+
+      PrIniFile.ReadBinaryStream(Section, PrintDriverExtraData, privData);
+      privDataExtraSize := PrIniFile.ReadInteger(Section, PrintDriverExtraSize, 0);
+      if (privData.Size = privDataExtraSize) then
+      begin
+        SetLength(privDataExtra, privDataExtraSize);
+        privdata.Read(privDataExtra[0], privDataExtraSize);
+
+        DevModePrinterDriverExtraReinstate(privDataExtra, DevModeDriverName, DevModeDriverVersion);
+      end;
+    finally
+      privData.Free;
+    end;
+  end;
+  Result := True;
+end;
+
+procedure TJclPrintSet.SaveToCustomIni(const PrIniFile: TCustomIniFile; const Section: string);
+var
+  CurrentName: string;
+  
+  privData: TMemoryStream;
+  privDataExtra: TDynByteArray;
+begin
+    PrIniFile.EraseSection(Section);
+
+    CurrentName := Printer.Printers[Printer.PrinterIndex];
+    PrIniFile.WriteString(Section, PrintIniPrinterName, CurrentName);
+    PrIniFile.WriteString(Section, PrintIniPrinterPort, PrinterPort);
+    PrIniFile.WriteInteger(Section, PrintIniOrientation, Orientation);
+    PrIniFile.WriteInteger(Section, PrintIniPaperSize, PaperSize);
+    PrIniFile.WriteInteger(Section, PrintIniPaperLength, PaperLength);
+    PrIniFile.WriteInteger(Section, PrintIniPaperWidth, PaperWidth);
+    PrIniFile.WriteInteger(Section, PrintIniScale, Scale);
+    PrIniFile.WriteInteger(Section, PrintIniCopies, Copies);
+    PrIniFile.WriteInteger(Section, PrintIniDefaultSource, DefaultSource);
+    PrIniFile.WriteInteger(Section, PrintIniPrintQuality, PrintQuality);
+    PrIniFile.WriteInteger(Section, PrintIniColor, Color);
+    PrIniFile.WriteInteger(Section, PrintIniDuplex, Duplex);
+    PrIniFile.WriteInteger(Section, PrintIniYResolution, YResolution);
+    PrIniFile.WriteInteger(Section, PrintIniTTOption, TrueTypeOption);
+
+    PrIniFile.WriteString(Section, PrintDriverName, DevModePrinterDriver);
+    PrIniFile.WriteInteger(Section, PrintDriverVersion, DevModePrinterDriverVersion);
+    PrIniFile.WriteInteger(Section, PrintDriverExtraSize, Length(DevModePrinterDriverExtra));
+
+    privDataExtra := DevModePrinterDriverExtra;
+
+    privData := TMemoryStream.Create;
+    try
+      privdata.Write(privDataExtra[0], Length(privDataExtra));
+      privData.Position := 0;
+      PrIniFile.WriteBinaryStream(Section, PrintDriverExtraData, privData);
+    finally
+      privData.Free;
+    end;
+end;
+
+procedure TJclPrintSet.SetPrinterName(const Value: string);
+var
+  NewIndex: Integer;
+begin
+  if PrinterName <> Value then
+  begin
+    NewIndex := Printer.Printers.IndexOf(Value);
+    if NewIndex <> -1 then
     begin
-      Result := Idx;
-      Break;
+      Printer.PrinterIndex := NewIndex;
     end;
   end;
+  CheckPrinter;
 end;
 
+procedure TJclPrintSet.UnlockDeviceMode;
+begin
+ if FHandle <> 0 then
+   GlobalUnLock(FHandle);
+end;
+
 {$IFDEF UNITVERSIONING}
 initialization
   RegisterUnitVersion(HInstance, UnitVersioning);

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3707] trunk/jcl/install/JclInstall.pas

From: <ou...@us...> - 2012-01-30 21:35:19

Revision: 3707
          http://jcl.svn.sourceforge.net/jcl/?rev=3707&view=rev
Author:   outchy
Date:     2012-01-30 21:35:12 +0000 (Mon, 30 Jan 2012)
Log Message:
-----------
Linking to the RTL Unicode Database at the same level as raw linking, zlib'ed linking and bzip'ed linking.

Modified Paths:
--------------
    trunk/jcl/install/JclInstall.pas

Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas	2012-01-26 04:18:43 UTC (rev 3706)
+++ trunk/jcl/install/JclInstall.pas	2012-01-30 21:35:12 UTC (rev 3707)
@@ -919,11 +919,11 @@
     AddOption(joJCLDefUnicode, [goChecked], Parent);
     if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber >= 6) then
       // Delphi 2009 and newer have unit "Character"
-      AddOption(joJCLDefUnicodeRTLDatabase, [], joJCLDefUnicode);
-    AddOption(joJCLDefUnicodeSilentFailure, [goChecked], joJCLDefUnicode);
+      AddOption(joJCLDefUnicodeRTLDatabase, [goRadioButton], joJCLDefUnicode);
     AddOption(joJCLDefUnicodeRawData, [goRadioButton, goChecked], joJCLDefUnicode);
     AddOption(joJCLDefUnicodeZLibData, [goRadioButton], joJCLDefUnicode);
     AddOption(joJCLDefUnicodeBZip2Data, [goRadioButton], joJCLDefUnicode);
+    AddOption(joJCLDefUnicodeSilentFailure, [goChecked], joJCLDefUnicode);
     {$IFDEF MSWINDOWS}
     // Sevenzip options
     AddOption(joJCLDef7z, [goChecked], Parent);

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3706] trunk/jcl/source/common/JclCompression.pas

From: <jg...@us...> - 2012-01-26 04:18:49

Revision: 3706
          http://jcl.svn.sourceforge.net/jcl/?rev=3706&view=rev
Author:   jgsoft
Date:     2012-01-26 04:18:43 +0000 (Thu, 26 Jan 2012)
Log Message:
-----------
TJclUpdateArchive.ItemAccess now returns saCreate when decompressing (just like TJclDecompressArchive) and returns saReadOnly when compressing (just like TJclCompressArchive).  This makes sure TJclUpdateArchive properly overwrites files when decompressing and that read-only files can be added to the archive without error.

Modified Paths:
--------------
    trunk/jcl/source/common/JclCompression.pas

Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas	2012-01-23 22:23:40 UTC (rev 3705)
+++ trunk/jcl/source/common/JclCompression.pas	2012-01-26 04:18:43 UTC (rev 3706)
@@ -805,7 +805,7 @@
   public
     class function MultipleItemContainer: Boolean; virtual;
     class function VolumeAccess: TJclStreamAccess; virtual;
-    class function ItemAccess: TJclStreamAccess; virtual;
+    function ItemAccess: TJclStreamAccess; virtual;
     class function ArchiveExtensions: string; virtual;
     class function ArchiveName: string; virtual;
     class function ArchiveSubExtensions: string; virtual;
@@ -1003,7 +1003,7 @@
     function AddFileCheckDuplicate(NewItem: TJclCompressionItem): Integer;
   public
     class function VolumeAccess: TJclStreamAccess; override;
-    class function ItemAccess: TJclStreamAccess; override;
+    function ItemAccess: TJclStreamAccess; override;
 
     destructor Destroy; override;
     
@@ -1052,7 +1052,7 @@
       var AOwnsStream: Boolean): Boolean; virtual;
   public
     class function VolumeAccess: TJclStreamAccess; override;
-    class function ItemAccess: TJclStreamAccess; override;
+    function ItemAccess: TJclStreamAccess; override;
 
     procedure ListFiles; virtual; abstract;
     procedure ExtractSelected(const ADestinationDir: string = '';
@@ -1094,7 +1094,7 @@
       var AOwnsStream: Boolean): Boolean; virtual;
   public
     class function VolumeAccess: TJclStreamAccess; override;
-    class function ItemAccess: TJclStreamAccess; override;
+    function ItemAccess: TJclStreamAccess; override;
 
     procedure ListFiles; virtual; abstract;
     procedure ExtractSelected(const ADestinationDir: string = '';
@@ -4886,7 +4886,7 @@
   Result := OpenFileStream(FileName, VolumeAccess);
 end;
 
-class function TJclCompressionArchive.ItemAccess: TJclStreamAccess;
+function TJclCompressionArchive.ItemAccess: TJclStreamAccess;
 begin
   Result := saReadOnly;
 end;
@@ -5267,7 +5267,7 @@
   AddFileCheckDuplicate(AItem);
 end;
 
-class function TJclCompressArchive.ItemAccess: TJclStreamAccess;
+function TJclCompressArchive.ItemAccess: TJclStreamAccess;
 begin
   Result := saReadOnly;
 end;
@@ -5325,7 +5325,7 @@
 //  ReleaseVolumes;
 end;
 
-class function TJclDecompressArchive.ItemAccess: TJclStreamAccess;
+function TJclDecompressArchive.ItemAccess: TJclStreamAccess;
 begin
   Result := saCreate;
 end;
@@ -5424,9 +5424,10 @@
   FDuplicateCheck := dcExisting;
 end;
 
-class function TJclUpdateArchive.ItemAccess: TJclStreamAccess;
+function TJclUpdateArchive.ItemAccess: TJclStreamAccess;
 begin
-  Result := saReadWrite;
+  if FDecompressing then Result := saCreate
+    else Result := saReadOnly;
 end;
 
 function TJclUpdateArchive.ValidateExtraction(Index: Integer;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3705] trunk/jcl/experts/common

From: <ou...@us...> - 2012-01-23 22:23:46

Revision: 3705
          http://jcl.svn.sourceforge.net/jcl/?rev=3705&view=rev
Author:   outchy
Date:     2012-01-23 22:23:40 +0000 (Mon, 23 Jan 2012)
Log Message:
-----------
Fix possible AV when the expert is unloaded:
- the expert reference counter could not reach 0 since each expert "holds" one reference registered into IDE environment options.
- the global FindGlobalComponentProc "FindActions" should be unconditionally unregistered when the package JclBaseExpert is unloaded.

Modified Paths:
--------------
    trunk/jcl/experts/common/JclOtaActions.pas
    trunk/jcl/experts/common/JclOtaUtils.pas

Modified: trunk/jcl/experts/common/JclOtaActions.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaActions.pas	2012-01-23 20:54:05 UTC (rev 3704)
+++ trunk/jcl/experts/common/JclOtaActions.pas	2012-01-23 22:23:40 UTC (rev 3705)
@@ -235,10 +235,7 @@
   end;
 
   if not Assigned(GlobalActionList) then
-  begin
     GlobalActionList := TList.Create;
-    RegisterFindGlobalComponentProc(FindActions);
-  end;
 
   GlobalActionList.Add(Action);
 end;
@@ -254,10 +251,7 @@
   begin
     GlobalActionList.Remove(Action);
     if (GlobalActionList.Count = 0) then
-    begin
-      UnRegisterFindGlobalComponentProc(FindActions);
       FreeAndNil(GlobalActionList);
-    end;
   end;
 
   NTAServices := GetNTAServices;
@@ -336,7 +330,9 @@
   {$IFDEF UNITVERSIONING}
   RegisterUnitVersion(HInstance, UnitVersioning);
   {$ENDIF UNITVERSIONING}
+  RegisterFindGlobalComponentProc(FindActions);
 finalization
+  UnRegisterFindGlobalComponentProc(FindActions);
   FreeAndNil(GlobalActionList);
   {$IFDEF UNITVERSIONING}
   UnregisterUnitVersion(HInstance);

Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas	2012-01-23 20:54:05 UTC (rev 3704)
+++ trunk/jcl/experts/common/JclOtaUtils.pas	2012-01-23 22:23:40 UTC (rev 3705)
@@ -98,12 +98,35 @@
     property BaseKeyName: string read FBaseKeyName;
   end;
 
-  TJclOTAExpertBase = class(TInterfacedObject{$IFDEF BDS8_UP}, INTAAddinOptions{$ENDIF})
+  {$IFDEF BDS8_UP}
+  TJclOTAExpertBase = class;
+
+  TJclOTAExpertOptions = class(TInterfacedObject, INTAAddinOptions)
   private
+    FExpert: TJclOTAExpertBase;
+  public
+    constructor Create(AExpert: TJclOTAExpertBase);
+    { INTAAddinOptions }
+    function GetArea: string;
+    function GetCaption: string;
+    function GetFrameClass: TCustomFrameClass;
+    procedure FrameCreated(AFrame: TCustomFrame);
+    procedure DialogClosed(Accepted: Boolean);
+    function ValidateContents: Boolean;
+    function GetHelpContext: Integer;
+    function IncludeInIDEInsight: Boolean;
+  end;
+  {$ENDIF BDS8_UP}
+
+  TJclOTAExpertBase = class(TInterfacedObject)
+  private
     FRootDir: string;
     FJCLRootDir: string;
     FSettings: TJclOTASettings;
     FJCLSettings: TStrings;
+    {$IFDEF BDS8_UP}
+    FOptions: INTAAddinOptions;
+    {$ENDIF BDS8_UP}
     function GetModuleHInstance: Cardinal;
     function GetRootDir: string;
     function GetJCLRootDir: string;
@@ -780,6 +803,56 @@
   {$ENDIF MSWINDOWS}
 end;
 
+//=== { TJclOTAExpertOptions } ===============================================
+
+{$IFDEF BDS8_UP}
+constructor TJclOTAExpertOptions.Create(AExpert: TJclOTAExpertBase);
+begin
+  inherited Create;
+  FExpert := AExpert;
+end;
+
+function TJclOTAExpertOptions.GetArea: string;
+begin
+  Result := FExpert.GetArea;
+end;
+
+function TJclOTAExpertOptions.GetCaption: string;
+begin
+  Result := FExpert.GetCaption;
+end;
+
+function TJclOTAExpertOptions.GetFrameClass: TCustomFrameClass;
+begin
+  Result := FExpert.GetFrameClass;
+end;
+
+procedure TJclOTAExpertOptions.FrameCreated(AFrame: TCustomFrame);
+begin
+  FExpert.FrameCreated(AFrame);
+end;
+
+procedure TJclOTAExpertOptions.DialogClosed(Accepted: Boolean);
+begin
+  FExpert.DialogClosed(Accepted);
+end;
+
+function TJclOTAExpertOptions.ValidateContents: Boolean;
+begin
+  Result := FExpert.ValidateContents;
+end;
+
+function TJclOTAExpertOptions.GetHelpContext: Integer;
+begin
+  Result := FExpert.GetHelpContext;
+end;
+
+function TJclOTAExpertOptions.IncludeInIDEInsight: Boolean;
+begin
+  Result := FExpert.IncludeInIDEInsight;
+end;
+{$ENDIF BDS8_UP}
+
 //=== { TJclOTAExpertBase } ==================================================
 
 class function TJclOTAExpertBase.ConfigurationDialog(
@@ -930,7 +1003,10 @@
   AddExpert(Self);
   {$IFDEF BDS8_UP}
   if GetFrameClass <> nil then
-    GetNTAEnvironmentOptionsServices.RegisterAddInOptions(Self);
+  begin
+    FOptions := TJclOTAExpertOptions.Create(Self);
+    GetNTAEnvironmentOptionsServices.RegisterAddInOptions(FOptions);
+  end;
   {$ENDIF BDS8_UP}
 end;
 
@@ -938,7 +1014,10 @@
 begin
   {$IFDEF BDS8_UP}
   if GetFrameClass <> nil then
-    GetNTAEnvironmentOptionsServices.UnregisterAddInOptions(Self);
+  begin
+    GetNTAEnvironmentOptionsServices.UnregisterAddInOptions(FOptions);
+    FOptions := nil;
+  end;
   {$ENDIF BDS8_UP}
   RemoveExpert(Self);
   UnregisterCommands;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3704] trunk/jcl/experts/common/JclOtaUtils.pas

From: <ou...@us...> - 2012-01-23 20:54:12

Revision: 3704
          http://jcl.svn.sourceforge.net/jcl/?rev=3704&view=rev
Author:   outchy
Date:     2012-01-23 20:54:05 +0000 (Mon, 23 Jan 2012)
Log Message:
-----------
Register the about box and splash screen entries directly during package initialization.

Modified Paths:
--------------
    trunk/jcl/experts/common/JclOtaUtils.pas

Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas	2012-01-23 20:45:41 UTC (rev 3703)
+++ trunk/jcl/experts/common/JclOtaUtils.pas	2012-01-23 20:54:05 UTC (rev 3704)
@@ -320,6 +320,10 @@
 procedure Register;
 begin
   try
+    {$IFDEF BDS}
+    RegisterSplashScreen;
+    RegisterAboutBox;
+    {$ENDIF BDS}
     RegisterPackageWizard(TJclOTAUnitVersioningExpert.Create);
     RegisterPackageWizard(TJclOTAActionExpert.Create);
   except
@@ -347,6 +351,10 @@
   try
     TerminateProc := JclWizardTerminate;
 
+    {$IFDEF BDS}
+    RegisterSplashScreen;
+    RegisterAboutBox;
+    {$ENDIF BDS}
     JCLUnitVersioningWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.AddWizard(TJclOTAUnitVersioningExpert.Create);
     JCLActionsWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.AddWizard(TJclOTAActionExpert.Create);
 
@@ -947,12 +955,6 @@
 constructor TJclOTAExpertBase.Create(AName: string);
 begin
   inherited Create;
-
-  {$IFDEF BDS}
-  RegisterSplashScreen;
-  RegisterAboutBox;
-  {$ENDIF BDS}
-
   FSettings := TJclOTASettings.Create(AName);
 end;
 

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3703] trunk/jcl/experts

From: <ou...@us...> - 2012-01-23 20:45:49

Revision: 3703
          http://jcl.svn.sourceforge.net/jcl/?rev=3703&view=rev
Author:   outchy
Date:     2012-01-23 20:45:41 +0000 (Mon, 23 Jan 2012)
Log Message:
-----------
remove code duplicates between JCL option dialog and IDE environment option dialog.

Modified Paths:
--------------
    trunk/jcl/experts/common/JclOtaActions.pas
    trunk/jcl/experts/common/JclOtaAddinOptions.pas
    trunk/jcl/experts/common/JclOtaConfigurationForm.dfm
    trunk/jcl/experts/common/JclOtaConfigurationForm.pas
    trunk/jcl/experts/common/JclOtaResources.pas
    trunk/jcl/experts/common/JclOtaUnitVersioning.pas
    trunk/jcl/experts/common/JclOtaUtils.pas
    trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
    trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas
    trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFrame.pas
    trunk/jcl/experts/useswizard/JCLUsesWizard.pas
    trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas

Modified: trunk/jcl/experts/common/JclOtaActions.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaActions.pas	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/common/JclOtaActions.pas	2012-01-23 20:45:41 UTC (rev 3703)
@@ -35,7 +35,7 @@
 
 uses
   SysUtils, Classes, Windows,
-  Controls, ComCtrls, ActnList, Menus,
+  Controls, ComCtrls, ActnList, Menus, Forms, Graphics,
   {$IFNDEF COMPILER8_UP}
   Idemenuaction, // dependency walker reports a class TPopupAction in
   // unit Idemenuaction in designide.bpl used by the IDE to display tool buttons
@@ -74,12 +74,13 @@
     constructor Create; reintroduce;
     destructor Destroy; override;
 
-    { IJclOTAOptionsCallback }
-    procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
-    procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
-
     procedure RegisterCommands; override;
     procedure UnregisterCommands; override;
+  public
+    function GetPageName: string; override;
+    function GetFrameClass: TCustomFrameClass; override;
+    procedure FrameCreated(AFrame: TCustomFrame); override;
+    procedure DialogClosed(Accepted: Boolean); override;
   end;
 
 {$IFDEF UNITVERSIONING}
@@ -97,7 +98,6 @@
 implementation
 
 uses
-  Forms, Graphics,
   JclOtaConsts, JclOtaResources,
   JclOtaActionConfigureSheet;
 
@@ -143,6 +143,18 @@
   inherited Destroy;
 end;
 
+procedure TJclOTAActionExpert.DialogClosed(Accepted: Boolean);
+begin
+  if Accepted then
+    TJclOtaActionConfigureFrame(FActionConfigureSheet).SaveChanges;
+  FActionConfigureSheet := nil;
+end;
+
+procedure TJclOTAActionExpert.FrameCreated(AFrame: TCustomFrame);
+begin
+  FActionConfigureSheet := AFrame as TJclOtaActionConfigureFrame;
+end;
+
 class function TJclOTAActionExpert.GetAction(Index: Integer): TAction;
 begin
   if Assigned(GlobalActionList) then
@@ -159,6 +171,16 @@
     Result := 0;
 end;
 
+function TJclOTAActionExpert.GetFrameClass: TCustomFrameClass;
+begin
+  Result := TJclOtaActionConfigureFrame;
+end;
+
+function TJclOTAActionExpert.GetPageName: string;
+begin
+  Result := LoadResString(@RsActionSheet);
+end;
+
 type
   TAccessToolButton = class(TToolButton);
 
@@ -203,30 +225,6 @@
   end;
 end;
 
-procedure TJclOTAActionExpert.AddConfigurationPages(
-  AddPageFunc: TJclOTAAddPageFunc);
-begin
-  if not Assigned(FActionConfigureSheet) then
-  begin
-    FActionConfigureSheet := TJclOtaActionConfigureFrame.Create(Application);
-    AddPageFunc(FActionConfigureSheet, LoadResString(@RsActionSheet), Self);
-  end;
-end;
-
-procedure TJclOTAActionExpert.ConfigurationClosed(AControl: TControl;
-  SaveChanges: Boolean);
-begin
-  if Assigned(AControl) and (AControl = FActionConfigureSheet) then
-  begin
-    if SaveChanges then
-      TJclOtaActionConfigureFrame(FActionConfigureSheet).SaveChanges;
-    FreeAndNil(FActionConfigureSheet);
-  end
-  else
-    inherited ConfigurationClosed(AControl, SaveChanges);
-  // override to customize
-end;
-
 class procedure TJclOTAActionExpert.RegisterAction(Action: TCustomAction);
 begin
   if Action.Name <> '' then

Modified: trunk/jcl/experts/common/JclOtaAddinOptions.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaAddinOptions.pas	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/common/JclOtaAddinOptions.pas	2012-01-23 20:45:41 UTC (rev 3703)
@@ -37,67 +37,16 @@
   {$IFDEF UNITVERSIONING}
   JclUnitVersioning,
   {$ENDIF UNITVERSIONING}
-  JclOtaActionConfigureSheet, JclOtaUnitVersioningSheet, JclOtaEmptyAddinOptionsFrame;
+  JclOtaUtils;
 
-function JclGetAddinOptionsCaption(const ACaption: string): string;
-procedure JclRegisterCommonAddinOptions;
-procedure JclUnregisterCommonAddinOptions;
-
-{$IFDEF UNITVERSIONING}
-const
-  UnitVersioning: TUnitVersionInfo = (
-    RCSfile: '$URL$';
-    Revision: '$Revision$';
-    Date: '$Date$';
-    LogPath: 'JCL\experts\common';
-    Extra: '';
-    Data: nil
-    );
-{$ENDIF UNITVERSIONING}
-
-implementation
-
-uses
-  JclStrings, JclOtaResources;
-
-function JclGetAddinOptionsCaption(const ACaption: string): string;
-begin
-  Result := RsProjectJEDIAddinOptionsCaptionPrefix + StrReplaceChar(ACaption, '\', '.');
-end;
-
 type
-  TJclActionAddinOptions = class(TInterfacedObject, INTAAddinOptions)
-  private
-    FFrame: TJclOtaActionConfigureFrame;
-  public
-    procedure DialogClosed(Accepted: Boolean);
-    procedure FrameCreated(AFrame: TCustomFrame);
-    function GetArea: string;
-    function GetCaption: string;
-    function GetFrameClass: TCustomFrameClass;
-    function ValidateContents: Boolean;
-    function GetHelpContext: Integer;
-    function IncludeInIDEInsight: Boolean;
-  end;
-
-  TJclUnitVersioningAddinOptions = class(TInterfacedObject, INTAAddinOptions)
-  public
-    procedure DialogClosed(Accepted: Boolean);
-    procedure FrameCreated(AFrame: TCustomFrame);
-    function GetArea: string;
-    function GetCaption: string;
-    function GetFrameClass: TCustomFrameClass;
-    function ValidateContents: Boolean;
-    function GetHelpContext: Integer;
-    function IncludeInIDEInsight: Boolean;
-  end;
-
   TJclEmptyPageAddinOptions = class(TInterfacedObject, INTAAddinOptions)
   private
     FCaption: string;
     FTitle: string;
   public
     constructor Create(const ACaption, ATitle: string);
+    { INTAAddinOptions }
     procedure DialogClosed(Accepted: Boolean);
     procedure FrameCreated(AFrame: TCustomFrame);
     function GetArea: string;
@@ -108,91 +57,23 @@
     function IncludeInIDEInsight: Boolean;
   end;
 
-//=== { TJclActionAddinOptions } =============================================
+{$IFDEF UNITVERSIONING}
+const
+  UnitVersioning: TUnitVersionInfo = (
+    RCSfile: '$URL$';
+    Revision: '$Revision$';
+    Date: '$Date$';
+    LogPath: 'JCL\experts\common';
+    Extra: '';
+    Data: nil
+    );
+{$ENDIF UNITVERSIONING}
 
-procedure TJclActionAddinOptions.DialogClosed(Accepted: Boolean);
-begin
-  if Accepted then
-    FFrame.SaveChanges;
-end;
+implementation
 
-procedure TJclActionAddinOptions.FrameCreated(AFrame: TCustomFrame);
-begin
-  FFrame := TJclOtaActionConfigureFrame(AFrame);
-end;
+uses
+  JclOtaResources, JclOtaEmptyAddinOptionsFrame;
 
-function TJclActionAddinOptions.GetArea: string;
-begin
-  Result := '';
-end;
-
-function TJclActionAddinOptions.GetCaption: string;
-begin
-  Result := JclGetAddinOptionsCaption(RsActionSheet);
-end;
-
-function TJclActionAddinOptions.GetFrameClass: TCustomFrameClass;
-begin
-  Result := TJclOtaActionConfigureFrame;
-end;
-
-function TJclActionAddinOptions.GetHelpContext: Integer;
-begin
-  Result := 0;
-end;
-
-function TJclActionAddinOptions.IncludeInIDEInsight: Boolean;
-begin
-  Result := True;
-end;
-
-function TJclActionAddinOptions.ValidateContents: Boolean;
-begin
-  Result := True;
-end;
-
-//=== { TJclUnitVersioningAddinOptions } =====================================
-
-procedure TJclUnitVersioningAddinOptions.DialogClosed(Accepted: Boolean);
-begin
-  //
-end;
-
-procedure TJclUnitVersioningAddinOptions.FrameCreated(AFrame: TCustomFrame);
-begin
-  //
-end;
-
-function TJclUnitVersioningAddinOptions.GetArea: string;
-begin
-  Result := '';
-end;
-
-function TJclUnitVersioningAddinOptions.GetCaption: string;
-begin
-  Result := JclGetAddinOptionsCaption(RsUnitVersioningSheet);
-end;
-
-function TJclUnitVersioningAddinOptions.GetFrameClass: TCustomFrameClass;
-begin
-  Result := TJclOtaUnitVersioningFrame;
-end;
-
-function TJclUnitVersioningAddinOptions.GetHelpContext: Integer;
-begin
-  Result := 0;
-end;
-
-function TJclUnitVersioningAddinOptions.IncludeInIDEInsight: Boolean;
-begin
-  Result := True;
-end;
-
-function TJclUnitVersioningAddinOptions.ValidateContents: Boolean;
-begin
-  Result := True;
-end;
-
 //=== { TJclEmptyPageAddinOptions } ==========================================
 
 constructor TJclEmptyPageAddinOptions.Create(const ACaption, ATitle: string);
@@ -243,24 +124,12 @@
 end;
 
 var
-  ActionAddinOptions: TJclActionAddinOptions = nil;
-  UnitVersioningAddinOptions: TJclUnitVersioningAddinOptions = nil;
-  ProjectJEDIEmptyAddinOptions: TJclEmptyPageAddinOptions = nil;
-  ProjectJEDIJclEmptyAddinOptions: TJclEmptyPageAddinOptions = nil;
-  ProjectJEDIJclCommonEmptyAddinOptions: TJclEmptyPageAddinOptions = nil;
+  ProjectJEDIEmptyAddinOptions: INTAAddinOptions = nil;
+  ProjectJEDIJclEmptyAddinOptions: INTAAddinOptions = nil;
+  ProjectJEDIJclCommonEmptyAddinOptions: INTAAddinOptions = nil;
 
 procedure JclRegisterCommonAddinOptions;
 begin
-  if not Assigned(ActionAddinOptions) then
-  begin
-    ActionAddinOptions := TJclActionAddinOptions.Create;
-    (BorlandIDEServices as INTAEnvironmentOptionsServices).RegisterAddInOptions(ActionAddinOptions);
-  end;
-  if not Assigned(UnitVersioningAddinOptions) then
-  begin
-    UnitVersioningAddinOptions := TJclUnitVersioningAddinOptions.Create;
-    (BorlandIDEServices as INTAEnvironmentOptionsServices).RegisterAddInOptions(UnitVersioningAddinOptions);
-  end;
   if not Assigned(ProjectJEDIEmptyAddinOptions) then
   begin
     ProjectJEDIEmptyAddinOptions := TJclEmptyPageAddinOptions.Create(RsProjectJEDIAddinOptionsCaption,
@@ -283,16 +152,6 @@
 
 procedure JclUnregisterCommonAddinOptions;
 begin
-  if Assigned(ActionAddinOptions) then
-  begin
-    (BorlandIDEServices as INTAEnvironmentOptionsServices).UnregisterAddInOptions(ActionAddinOptions);
-    ActionAddinOptions := nil;
-  end;
-  if Assigned(UnitVersioningAddinOptions) then
-  begin
-    (BorlandIDEServices as INTAEnvironmentOptionsServices).UnregisterAddInOptions(UnitVersioningAddinOptions);
-    UnitVersioningAddinOptions := nil;
-  end;
   if Assigned(ProjectJEDIEmptyAddinOptions) then
   begin
     (BorlandIDEServices as INTAEnvironmentOptionsServices).UnregisterAddInOptions(ProjectJEDIEmptyAddinOptions);
@@ -310,4 +169,33 @@
   end;
 end;
 
+initialization
+
+try
+  {$IFDEF UNITVERSIONING}
+  RegisterUnitVersion(HInstance, UnitVersioning);
+  {$ENDIF UNITVERSIONING}
+  JclRegisterCommonAddinOptions;
+except
+  on ExceptionObj: TObject do
+  begin
+    JclExpertShowExceptionDialog(ExceptionObj);
+  end;
+end;
+
+finalization
+
+try
+  {$IFDEF UNITVERSIONING}
+  UnregisterUnitVersion(HInstance);
+  {$ENDIF UNITVERSIONING}
+  JclUnregisterCommonAddinOptions;
+except
+  on ExceptionObj: TObject do
+  begin
+    JclExpertShowExceptionDialog(ExceptionObj);
+  end;
+end;
+
+
 end.

Modified: trunk/jcl/experts/common/JclOtaConfigurationForm.dfm
===================================================================
--- trunk/jcl/experts/common/JclOtaConfigurationForm.dfm	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/common/JclOtaConfigurationForm.dfm	2012-01-23 20:45:41 UTC (rev 3703)
@@ -87,6 +87,7 @@
       RightClickSelect = True
       TabOrder = 0
       OnChange = TreeViewCategoriesChange
+      OnChanging = TreeViewCategoriesChanging
     end
   end
   object PanelOptions: TPanel

Modified: trunk/jcl/experts/common/JclOtaConfigurationForm.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaConfigurationForm.pas	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/common/JclOtaConfigurationForm.pas	2012-01-23 20:45:41 UTC (rev 3703)
@@ -56,6 +56,8 @@
     procedure TreeViewCategoriesChange(Sender: TObject; Node: TTreeNode);
     procedure FormDestroy(Sender: TObject);
     procedure FormCreate(Sender: TObject);
+    procedure TreeViewCategoriesChanging(Sender: TObject; Node: TTreeNode;
+      var AllowChange: Boolean);
   private
     FSettings: TJclOTASettings;
   protected
@@ -63,8 +65,7 @@
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    procedure AddPage(AControl: TControl; PageName: string;
-      Expert: IJclOTAOptionsCallback);
+    procedure AddPage(Expert: TJclOTAExpertBase);
     function Execute(PageName: string): Boolean;
     property Settings: TJclOTASettings read FSettings;
   end;
@@ -92,22 +93,22 @@
 type
   TItemDataRec = class
   public
-    AControl: TControl;
-    Expert: IJclOTAOptionsCallback;
+    Frame: TCustomFrame;
+    Expert: TJclOTAExpertBase;
   end;
 
 //=== TJclOtaOptionsForm =====================================================
 
-procedure TJclOtaOptionsForm.AddPage(AControl: TControl; PageName: string;
-  Expert: IJclOTAOptionsCallback);
+procedure TJclOtaOptionsForm.AddPage(Expert: TJclOTAExpertBase);
 var
   ParentNode, ChildNode: TTreeNode;
-  NodeName: string;
+  PageName, NodeName: string;
   PosSeparator, Index: Integer;
   AItemDataRec: TItemDataRec;
 begin
   ParentNode := TreeViewCategories.Items.GetFirstNode;
   ChildNode := ParentNode;
+  PageName := Expert.GetPageName;
 
   repeat
     PosSeparator := Pos('\', PageName);
@@ -145,12 +146,8 @@
       ParentNode.Expand(False);
   end;
 
-  AControl.Parent := PanelOptions;
-  AControl.SetBounds(8, 8, PanelOptions.ClientWidth - 16, PanelOptions.ClientHeight - 16);
-  AControl.Visible := False;
-
   AItemDataRec := TItemDataRec.Create;
-  AItemDataRec.AControl := AControl;
+  AItemDataRec.Frame := nil;
   AItemDataRec.Expert := Expert;
   ChildNode.Data := Pointer(AItemDataRec);
 end;
@@ -221,7 +218,8 @@
     AItemDataRec := TItemDataRec(ATreeNode.Data);
     if Assigned(AItemDataRec) then
     begin
-      AItemDataRec.Expert.ConfigurationClosed(AItemDataRec.AControl, Result);
+      AItemDataRec.Expert.DialogClosed(Result);
+      AItemDataRec.Frame.Free;
       AItemDataRec.Free;
     end;
     ATreeNode := ATreeNode.GetNext;
@@ -260,17 +258,44 @@
 procedure TJclOtaOptionsForm.TreeViewCategoriesChange(Sender: TObject;
   Node: TTreeNode);
 var
+  AItemDataRec: TItemDataRec;
+  AFrame: TCustomFrame;
+  AControl: TControl;
   Index: Integer;
-  AControl: TControl;
 begin
-  if Assigned(Node.Data) then
-    AControl := TItemDataRec(Node.Data).AControl
+  AItemDataRec := TItemDataRec(Node.Data);
+  if Assigned(AItemDataRec) then
+  begin
+    AFrame := AItemDataRec.Frame;
+    if not Assigned(AFrame) then
+    begin
+      AFrame := AItemDataRec.Expert.GetFrameClass.Create(Self);
+      AFrame.Parent := PanelOptions;
+      AFrame.SetBounds(8, 8, PanelOptions.ClientWidth - 16, PanelOptions.ClientHeight - 16);
+      AFrame.Visible := False;
+      AItemDataRec.Expert.FrameCreated(AFrame);
+      AItemDataRec.Frame := AFrame;
+    end;
+    AControl := AFrame;
+  end
   else
     AControl := LabelSelectPage;
   for Index := 0 to PanelOptions.ControlCount - 1 do
     PanelOptions.Controls[Index].Visible := PanelOptions.Controls[Index] = AControl;
 end;
 
+procedure TJclOtaOptionsForm.TreeViewCategoriesChanging(Sender: TObject;
+  Node: TTreeNode; var AllowChange: Boolean);
+var
+  AItemDataRec: TItemDataRec;
+begin
+  AItemDataRec := TItemDataRec(Node.Data);
+  if Assigned(AItemDataRec) then
+    AllowChange := AItemDataRec.Expert.ValidateContents
+  else
+    AllowChange := True;
+end;
+
 {$IFDEF UNITVERSIONING}
 initialization
   RegisterUnitVersion(HInstance, UnitVersioning);

Modified: trunk/jcl/experts/common/JclOtaResources.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaResources.pas	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/common/JclOtaResources.pas	2012-01-23 20:45:41 UTC (rev 3703)
@@ -74,6 +74,7 @@
   RsELineTooLong = 'Line too long in project file';
   RsEUnterminatedComment = 'Unterminated comment in project file';
   RsBrowseToJCLRootDir = 'Browse to JCL root directory';
+  RsENoNTAEnvironmentOptionsServices = 'Unable to get IDE Environment Options Services';
 
 //=== JclExceptionForm.pas ===================================================
 resourcestring

Modified: trunk/jcl/experts/common/JclOtaUnitVersioning.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUnitVersioning.pas	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/common/JclOtaUnitVersioning.pas	2012-01-23 20:45:41 UTC (rev 3703)
@@ -35,7 +35,7 @@
 
 uses
   SysUtils, Classes, Windows,
-  Controls,
+  Controls, Forms,
   JclBase,
   {$IFDEF UNITVERSIONING}
   JclUnitVersioning,
@@ -44,13 +44,11 @@
 
 type
   TJclOTAUnitVersioningExpert = class(TJclOTAExpert)
-  private
-    FUnitVersioningSheet: TControl;
   public
     constructor Create; reintroduce;
-    { IJclOTAOptionsCallback }
-    procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
-    procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
+
+    function GetPageName: string; override;
+    function GetFrameClass: TCustomFrameClass; override;
   end;
 
 {$IFDEF UNITVERSIONING}
@@ -68,7 +66,6 @@
 implementation
 
 uses
-  Forms,
   JclOtaConsts, JclOtaResources,
   JclOtaUnitVersioningSheet;
 
@@ -79,26 +76,14 @@
   inherited Create(JclUnitVersioningExpertName);
 end;
 
-procedure TJclOTAUnitVersioningExpert.AddConfigurationPages(
-  AddPageFunc: TJclOTAAddPageFunc);
+function TJclOTAUnitVersioningExpert.GetFrameClass: TCustomFrameClass;
 begin
-  // AddPageFunc uses '\' as a separator in PageName to build a tree
-  if not Assigned(FUnitVersioningSheet) then
-  begin
-    FUnitVersioningSheet := TJclOtaUnitVersioningFrame.Create(Application);
-    AddPageFunc(FUnitVersioningSheet, LoadResString(@RsUnitVersioningSheet), Self);
-  end;
-  // override to customize
+  Result := TJclOtaUnitVersioningFrame;
 end;
 
-procedure TJclOTAUnitVersioningExpert.ConfigurationClosed(AControl: TControl;
-  SaveChanges: Boolean);
+function TJclOTAUnitVersioningExpert.GetPageName: string;
 begin
-  if Assigned(AControl) and (AControl = FUnitVersioningSheet) then
-    FreeAndNil(FUnitVersioningSheet)
-  else
-    inherited ConfigurationClosed(AControl, SaveChanges);
-  // override to customize
+  Result := LoadResString(@RsUnitVersioningSheet);
 end;
 
 {$IFDEF UNITVERSIONING}

Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/common/JclOtaUtils.pas	2012-01-23 20:45:41 UTC (rev 3703)
@@ -34,7 +34,7 @@
 
 uses
   SysUtils, Classes, Windows,
-  Controls,
+  Controls, Forms,
   JclBase,
   {$IFDEF UNITVERSIONING}
   JclUnitVersioning,
@@ -98,22 +98,7 @@
     property BaseKeyName: string read FBaseKeyName;
   end;
 
-  // Note: we MUST use an interface as the type of the Expert parameter
-  // and not an object to avoid a bug in C++ Builder 5 compiler. If we 
-  // used an object, the compiler would crash or give internal error GH4148
-  // being obviously lost trying to resolve almost circular references 
-  // between this unit and the JclOtaConfigurationForm unit.
-  IJclOTAOptionsCallback = interface;
-
-  TJclOTAAddPageFunc = procedure (AControl: TControl; PageName: string;
-    Expert: IJclOTAOptionsCallback) of object;
-
-  IJclOTAOptionsCallback = interface
-    procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc);
-    procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean);
-  end;
-
-  TJclOTAExpertBase = class(TInterfacedObject, IJclOTAOptionsCallback)
+  TJclOTAExpertBase = class(TInterfacedObject{$IFDEF BDS8_UP}, INTAAddinOptions{$ENDIF})
   private
     FRootDir: string;
     FJCLRootDir: string;
@@ -142,6 +127,9 @@
     {$ENDIF BDS4_UP}
     class function GetOTAMessageServices: IOTAMessageServices;
     class function GetOTAWizardServices: IOTAWizardServices;
+    {$IFDEF BDS8_UP}
+    class function GetNTAEnvironmentOptionsServices: INTAEnvironmentOptionsServices;
+    {$ENDIF BDS8_UP}
     class function GetActiveProject: IOTAProject;
     class function GetProjectGroup: IOTAProjectGroup;
     class function GetActiveEditBuffer: IOTAEditBuffer;
@@ -152,6 +140,17 @@
     class function GetExpert(Index: Integer): TJclOTAExpertBase;
     class function ConfigurationDialog(StartName: string = ''): Boolean;
   public
+    function GetPageName: string; virtual;
+    { INTAAddinOptions }
+    function GetArea: string; virtual;
+    function GetCaption: string; virtual;
+    function GetFrameClass: TCustomFrameClass; virtual;
+    procedure FrameCreated(AFrame: TCustomFrame); virtual;
+    procedure DialogClosed(Accepted: Boolean); virtual;
+    function ValidateContents: Boolean; virtual;
+    function GetHelpContext: Integer; virtual;
+    function IncludeInIDEInsight: Boolean; virtual;
+  public
     constructor Create(AName: string); virtual;
     destructor Destroy; override;
     procedure AfterConstruction; override;
@@ -165,10 +164,6 @@
     function IsInstalledPackage(const Project: IOTAProject): Boolean;
     function IsPackage(const Project: IOTAProject): Boolean;
 
-    { IJclOTAOptionsCallback }
-    procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); virtual;
-    procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); virtual;
-
     procedure RegisterCommands; virtual;
     procedure UnregisterCommands; virtual;
 
@@ -303,7 +298,7 @@
 
 uses
   Variants,
-  Forms, Graphics, Dialogs, ActiveX, FileCtrl, IniFiles,
+  Graphics, Dialogs, ActiveX, FileCtrl, IniFiles,
   JediRegInfo,
   {$IFDEF MSWINDOWS}
   ImageHlp, JclRegistry,
@@ -784,6 +779,8 @@
 var
   OptionsForm: TJclOtaOptionsForm;
   Index: Integer;
+  Expert: TJclOTAExpertBase;
+  FrameClass: TCustomFrameClass;
 begin
   {$IFDEF BDS8_UP}
   //no resourcestring here, because this message will be removed
@@ -802,7 +799,12 @@
   OptionsForm := TJclOtaOptionsForm.Create(nil);
   try
     for Index := 0 to GetExpertCount - 1 do
-      GetExpert(Index).AddConfigurationPages(OptionsForm.AddPage);
+    begin
+      Expert := GetExpert(Index);
+      FrameClass := Expert.GetFrameClass;
+      if Assigned(FrameClass) then
+        OptionsForm.AddPage(Expert);
+    end;
     Result := OptionsForm.Execute(StartName);
   finally
     OptionsForm.Free;
@@ -828,6 +830,18 @@
     Result := 0;
 end;
 
+function TJclOTAExpertBase.GetFrameClass: TCustomFrameClass;
+begin
+  // override to customize
+  Result := nil;
+end;
+
+function TJclOTAExpertBase.GetHelpContext: Integer;
+begin
+  // override to customize
+  Result := 0;
+end;
+
 function TJclOTAExpertBase.GetJCLRootDir: string;
 var
   IDERegKey, JclVersion, JclDcpDir, JclBplDir, PlatformStr: string;
@@ -906,10 +920,18 @@
 
   RegisterCommands;
   AddExpert(Self);
+  {$IFDEF BDS8_UP}
+  if GetFrameClass <> nil then
+    GetNTAEnvironmentOptionsServices.RegisterAddInOptions(Self);
+  {$ENDIF BDS8_UP}
 end;
 
 procedure TJclOTAExpertBase.BeforeDestruction;
 begin
+  {$IFDEF BDS8_UP}
+  if GetFrameClass <> nil then
+    GetNTAEnvironmentOptionsServices.UnregisterAddInOptions(Self);
+  {$ENDIF BDS8_UP}
   RemoveExpert(Self);
   UnregisterCommands;
 
@@ -922,20 +944,6 @@
     GlobalExpertList.Remove(AExpert);
 end;
 
-procedure TJclOTAExpertBase.AddConfigurationPages(
-  AddPageFunc: TJclOTAAddPageFunc);
-begin
-  // AddPageFunc uses '\' as a separator in PageName to build a tree
-  // override to customize
-end;
-
-procedure TJclOTAExpertBase.ConfigurationClosed(AControl: TControl;
-  SaveChanges: Boolean);
-begin
-  AControl.Free;
-  // override to customize
-end;
-
 constructor TJclOTAExpertBase.Create(AName: string);
 begin
   inherited Create;
@@ -946,24 +954,20 @@
   {$ENDIF BDS}
 
   FSettings := TJclOTASettings.Create(AName);
-  {$IFDEF BDS8_UP}
-  JclRegisterCommonAddinOptions;
-  {$ENDIF BDS8_UP}
 end;
 
 destructor TJclOTAExpertBase.Destroy;
 begin
-  { TODO -cFulcrum: Check why the class destructor isn't executed. When it gets
-    executed then use class constructor/destructor for JclRegisterCommonAddinOptions
-    and JclUnregisterCommonAddinOptions }
-  {$IFDEF BDS8_UP}
-  JclUnregisterCommonAddinOptions;
-  {$ENDIF BDS8_UP}
   FreeAndNil(FSettings);
   FreeAndNil(FJCLSettings);
   inherited Destroy;
 end;
 
+procedure TJclOTAExpertBase.DialogClosed(Accepted: Boolean);
+begin
+  // override to customize
+end;
+
 function TJclOTAExpertBase.FindExecutableName(const MapFileName: TFileName;
   const OutputDirectory: string; var ExecutableFileName: TFileName): Boolean;
 var
@@ -1018,6 +1022,11 @@
   Result := (ExecutableFileName <> '');
 end;
 
+procedure TJclOTAExpertBase.FrameCreated(AFrame: TCustomFrame);
+begin
+  // override to customize
+end;
+
 class function TJclOTAExpertBase.GetActiveEditBuffer: IOTAEditBuffer;
 var
   OTAEditorServices: IOTAEditorServices;
@@ -1044,6 +1053,18 @@
         Exit;
 end;
 
+function TJclOTAExpertBase.GetArea: string;
+begin
+  // override to customize
+  Result := '';
+end;
+
+function TJclOTAExpertBase.GetCaption: string;
+begin
+  // override to customize
+  Result := LoadResString(@RsProjectJEDIAddinOptionsCaptionPrefix) + StrReplaceChar(GetPageName, '\', '.');
+end;
+
 function TJclOTAExpertBase.GetDesigner: string;
 begin
   Result := GetOTAServices.GetActiveDesignerType;
@@ -1053,7 +1074,7 @@
 begin
   if not Assigned(Project) then
     raise EJclExpertException.CreateRes(@RsENoActiveProject);
-    
+
   Result := ChangeFileExt(Project.FileName, CompilerExtensionDRC);
 end;
 
@@ -1090,6 +1111,15 @@
     raise EJclExpertException.CreateRes(@RsBadModuleHInstance);
 end;
 
+{$IFDEF BDS8_UP}
+class function TJclOTAExpertBase.GetNTAEnvironmentOptionsServices: INTAEnvironmentOptionsServices;
+begin
+  Supports(BorlandIDEServices, INTAEnvironmentOptionsServices, Result);
+  if not Assigned(Result) then
+    raise EJclExpertException.CreateRes(@RsENoNTAEnvironmentOptionsServices);
+end;
+{$ENDIF BDS8_UP}
+
 class function TJclOTAExpertBase.GetNTAServices: INTAServices;
 begin
   Supports(BorlandIDEServices, INTAServices, Result);
@@ -1308,6 +1338,12 @@
 end;
 {$ENDIF BDS}
 
+function TJclOTAExpertBase.GetPageName: string;
+begin
+  // override to customize
+  Result := '';
+end;
+
 class function TJclOTAExpertBase.GetProjectGroup: IOTAProjectGroup;
 var
   OTAModuleServices: IOTAModuleServices;
@@ -1343,6 +1379,12 @@
   Result := FRootDir;
 end;
 
+function TJclOTAExpertBase.IncludeInIDEInsight: Boolean;
+begin
+  // override to customize
+  Result := True;
+end;
+
 function TJclOTAExpertBase.IsInstalledPackage(const Project: IOTAProject): Boolean;
 var
   PackageFileName, ExecutableNameNoExt: TFileName;
@@ -1514,6 +1556,12 @@
   // override to remove actions and menu items
 end;
 
+function TJclOTAExpertBase.ValidateContents: Boolean;
+begin
+  // override to customize
+  Result := True;
+end;
+
 //=== { TJclOTAExpert } ======================================================
 
 procedure TJclOTAExpert.AfterSave;

Modified: trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas	2012-01-23 20:45:41 UTC (rev 3703)
@@ -51,31 +51,8 @@
   TDebugExpertAction = (deGenerateJdbg, deInsertJdbg, deDeleteMapFile);
   TDebugExpertActions = set of TDebugExpertAction;
 
-  {$IFDEF BDS8_UP}
-  TJclDebugExtension = class;
-
-  TJclDebugAddinOptions = class(TInterfacedObject, INTAAddinOptions)
-  private
-    FConfigFrame: TJclDebugIdeConfigFrame;
-    FDebugExtension: TJclDebugExtension;
-  public
-    constructor Create(ADebugExtension: TJclDebugExtension);
-    procedure DialogClosed(Accepted: Boolean);
-    procedure FrameCreated(AFrame: TCustomFrame);
-    function GetArea: string;
-    function GetCaption: string;
-    function GetFrameClass: TCustomFrameClass;
-    function ValidateContents: Boolean;
-    function GetHelpContext: Integer;
-    function IncludeInIDEInsight: Boolean;
-  end;
-  {$ENDIF BDS8_UP}
-
   TJclDebugExtension = class(TJclOTAExpert)
   private
-    {$IFDEF BDS8_UP}
-    FAddinOptions: TJclDebugAddinOptions;
-    {$ENDIF BDS8_UP}
     FResultInfo: array of TJclDebugDataInfo;
     FStoreResults: Boolean;
     FBuildError: Boolean;
@@ -142,19 +119,21 @@
     procedure UpdateMenuCheckState(Sender: TMenuItem; DebugExpertAction: TDebugExpertAction);
   public
     constructor Create; reintroduce;
-    destructor Destroy; override;
     procedure AfterCompile(const Project: IOTAProject; Succeeded: Boolean);
     procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
     procedure RegisterCommands; override;
     procedure UnregisterCommands; override;
-    procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
-    procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
     procedure DisableExpert(const AProject: IOTAProject);
     property GlobalStates[Index: TDebugExpertAction]: TDebugExpertState read GetGlobalState
       write SetGlobalState;
     property ProjectStates[Index: TDebugExpertAction; const AProject: IOTAProject]: TDebugExpertState
       read GetProjectState write SetProjectState;
     property ProjectActions[const AProject: IOTAProject]: TDebugExpertActions read GetProjectActions;
+  public
+    function GetPageName: string; override;
+    function GetFrameClass: TCustomFrameClass; override;
+    procedure FrameCreated(AFrame: TCustomFrame); override;
+    procedure DialogClosed(Accepted: Boolean); override;
   end;
 
   TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier, IOTAIDENotifier50
@@ -311,112 +290,13 @@
   end;
 end;
 
-//=== { TJclDebugAddinOptions } ==============================================
-
-{$IFDEF BDS8_UP}
-constructor TJclDebugAddinOptions.Create(ADebugExtension: TJclDebugExtension);
-begin
-  inherited Create;
-  FDebugExtension := ADebugExtension;
-end;
-
-procedure TJclDebugAddinOptions.DialogClosed(Accepted: Boolean);
-begin
-  if Accepted then
-  begin
-    FDebugExtension.GlobalStates[deGenerateJdbg] := FConfigFrame.GenerateJdbgState;
-    FDebugExtension.GlobalStates[deInsertJdbg] := FConfigFrame.InsertJdbgState;
-    FDebugExtension.GlobalStates[deDeleteMapFile] := FConfigFrame.DeleteMapFileState;
-  end;
-end;
-
-procedure TJclDebugAddinOptions.FrameCreated(AFrame: TCustomFrame);
-begin
-  FConfigFrame := TJclDebugIdeConfigFrame(AFrame);
-  FConfigFrame.GenerateJdbgState := FDebugExtension.GlobalStates[deGenerateJdbg];
-  FConfigFrame.InsertJdbgState := FDebugExtension.GlobalStates[deInsertJdbg];
-  FConfigFrame.DeleteMapFileState := FDebugExtension.GlobalStates[deDeleteMapFile];
-end;
-
-function TJclDebugAddinOptions.GetArea: string;
-begin
-  Result := '';
-end;
-
-function TJclDebugAddinOptions.GetCaption: string;
-begin
-  Result := JclGetAddinOptionsCaption(RsDebugConfigPageCaption);
-end;
-
-function TJclDebugAddinOptions.GetFrameClass: TCustomFrameClass;
-begin
-  Result := TJclDebugIdeConfigFrame;
-end;
-
-function TJclDebugAddinOptions.GetHelpContext: Integer;
-begin
-  Result := 0;
-end;
-
-function TJclDebugAddinOptions.IncludeInIDEInsight: Boolean;
-begin
-  Result := True;
-end;
-
-function TJclDebugAddinOptions.ValidateContents: Boolean;
-begin
-  Result := True;
-end;
-{$ENDIF BDS8_UP}
-
 //=== { TJclDebugExtension } =================================================
 
-procedure TJclDebugExtension.ConfigurationClosed(AControl: TControl; SaveChanges: Boolean);
-begin
-  if Assigned(AControl) and (AControl = FConfigFrame) then
-  begin
-    if SaveChanges then
-    begin
-      GlobalStates[deGenerateJdbg] := FConfigFrame.GenerateJdbgState;
-      GlobalStates[deInsertJdbg] := FConfigFrame.InsertJdbgState;
-      GlobalStates[deDeleteMapFile] := FConfigFrame.DeleteMapFileState;
-      FQuiet := FConfigFrame.Quiet;
-    end;
-    FreeAndNil(FConfigFrame);
-  end
-  else
-    inherited ConfigurationClosed(AControl, SaveChanges);
-end;
-
 constructor TJclDebugExtension.Create;
 begin
   inherited Create(JclDebugExpertRegKey);
-  {$IFDEF BDS8_UP}
-  FAddinOptions := TJclDebugAddinOptions.Create(Self);
-  (BorlandIDEServices as INTAEnvironmentOptionsServices).RegisterAddInOptions(FAddinOptions);
-  {$ENDIF BDS8_UP}
 end;
 
-destructor TJclDebugExtension.Destroy;
-begin
-  {$IFDEF BDS8_UP}
-  (BorlandIDEServices as INTAEnvironmentOptionsServices).UnregisterAddInOptions(FAddinOptions);
-  FAddinOptions := nil;
-  {$ENDIF BDS8_UP}
-  inherited Destroy;
-end;
-
-procedure TJclDebugExtension.AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc);
-begin
-  inherited AddConfigurationPages(AddPageFunc);
-  FConfigFrame := TJclDebugIdeConfigFrame.Create(nil);
-  FConfigFrame.GenerateJdbgState := GlobalStates[deGenerateJdbg];
-  FConfigFrame.InsertJdbgState := GlobalStates[deInsertJdbg];
-  FConfigFrame.DeleteMapFileState := GlobalStates[deDeleteMapFile];
-  FConfigFrame.Quiet := FQuiet;
-  AddPageFunc(FConfigFrame, LoadResString(@RsDebugConfigPageCaption), Self);
-end;
-
 procedure TJclDebugExtension.AfterCompile(const Project: IOTAProject; Succeeded: Boolean);
 var
   ProjectFileName, MapFileName, DrcFileName, ExecutableFileName, JdbgFileName: TFileName;
@@ -689,6 +569,18 @@
   end;
 end;
 
+procedure TJclDebugExtension.DialogClosed(Accepted: Boolean);
+begin
+  if Accepted then
+  begin
+    GlobalStates[deGenerateJdbg] := FConfigFrame.GenerateJdbgState;
+    GlobalStates[deInsertJdbg] := FConfigFrame.InsertJdbgState;
+    GlobalStates[deDeleteMapFile] := FConfigFrame.DeleteMapFileState;
+    FQuiet := FConfigFrame.Quiet;
+  end;
+  FConfigFrame := nil;
+end;
+
 procedure TJclDebugExtension.DisableExpert(const AProject: IOTAProject);
 begin
   ProjectStates[deGenerateJdbg, AProject] := DisableDebugExpertState(ProjectStates[deGenerateJdbg, AProject]);
@@ -744,6 +636,15 @@
   FResultInfo := nil;
 end;
 
+procedure TJclDebugExtension.FrameCreated(AFrame: TCustomFrame);
+begin
+  FConfigFrame := AFrame as TJclDebugIdeConfigFrame;
+  FConfigFrame.GenerateJdbgState := GlobalStates[deGenerateJdbg];
+  FConfigFrame.InsertJdbgState := GlobalStates[deInsertJdbg];
+  FConfigFrame.DeleteMapFileState := GlobalStates[deDeleteMapFile];
+  FConfigFrame.Quiet := FQuiet;
+end;
+
 procedure TJclDebugExtension.UpdateMenuItems(const ActiveProject: IOTAProject; AMenuItem: TMenuItem; CheckTag: Integer);
 var
   Index: Integer;
@@ -1056,11 +957,21 @@
   end;
 end;
 
+function TJclDebugExtension.GetFrameClass: TCustomFrameClass;
+begin
+  Result := TJclDebugIdeConfigFrame;
+end;
+
 function TJclDebugExtension.GetGlobalState(Index: TDebugExpertAction): TDebugExpertState;
 begin
   Result := FGlobalStates[Index];
 end;
 
+function TJclDebugExtension.GetPageName: string;
+begin
+  Result := LoadResString(@RsDebugConfigPageCaption);
+end;
+
 function TJclDebugExtension.GetProjectActions(const AProject: IOTAProject): TDebugExpertActions;
 var
   PropIDs, PropValues: TDynAnsiStringArray;

Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas	2012-01-23 20:45:41 UTC (rev 3703)
@@ -51,29 +51,8 @@
   JclStackTraceViewerConfigFrame, JclStackTraceViewerOptions;
 
 type
-  {$IFDEF BDS8_UP}
-  TStackTraceViewerAddinOptions = class(TInterfacedObject, INTAAddinOptions)
-  private
-    FFrame: TJclStackTraceViewerConfigFrame;
-    FOptions: TExceptionViewerOption;
-  public
-    constructor Create(AOptions: TExceptionViewerOption);
-    procedure DialogClosed(Accepted: Boolean);
-    procedure FrameCreated(AFrame: TCustomFrame);
-    function GetArea: string;
-    function GetCaption: string;
-    function GetFrameClass: TCustomFrameClass;
-    function ValidateContents: Boolean;
-    function GetHelpContext: Integer;
-    function IncludeInIDEInsight: Boolean;
-  end;
-  {$ENDIF BDS8_UP}
-
   TJclStackTraceViewerExpert = class(TJclOTAExpert)
   private
-    {$IFDEF BDS8_UP}
-    FAddinOptions: TStackTraceViewerAddinOptions;
-    {$ENDIF BDS8_UP}
     FIcon: TIcon;
     FOptions: TExceptionViewerOption;
     FOptionsFrame: TJclStackTraceViewerConfigFrame;
@@ -87,10 +66,13 @@
     destructor Destroy; override;
     procedure RegisterCommands; override;
     procedure UnregisterCommands; override;
-    procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
-    procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
     property Icon: TIcon read FIcon;
     property Options: TExceptionViewerOption read FOptions;
+  public
+    function GetPageName: string; override;
+    function GetFrameClass: TCustomFrameClass; override;
+    procedure FrameCreated(AFrame: TCustomFrame); override;
+    procedure DialogClosed(Accepted: Boolean); override;
   end;
 
 // the expert var is required to get the icon and options in the MainForm/Frame create methods
@@ -187,81 +169,48 @@
   end;
 end;
 
-//=== { TStackTraceViewerAddinOptions } ======================================
+//=== { TJclStackTraceViewerExpert } =========================================
 
-{$IFDEF BDS8_UP}
-constructor TStackTraceViewerAddinOptions.Create(AOptions: TExceptionViewerOption);
+constructor TJclStackTraceViewerExpert.Create;
 begin
-  inherited Create;
-  FOptions := AOptions;
+  inherited Create(JclStackTraceViewerExpertName);
+  FOptions := TExceptionViewerOption.Create;
 end;
 
-procedure TStackTraceViewerAddinOptions.DialogClosed(Accepted: Boolean);
+destructor TJclStackTraceViewerExpert.Destroy;
 begin
-  if Accepted then
-    FOptions.Assign(FFrame.Options);
+  FOptions.Free;
+  FreeAndNil(frmStackView);
+  inherited Destroy;
 end;
 
-procedure TStackTraceViewerAddinOptions.FrameCreated(AFrame: TCustomFrame);
+procedure TJclStackTraceViewerExpert.DialogClosed(Accepted: Boolean);
 begin
-  FFrame := TJclStackTraceViewerConfigFrame(AFrame);
-  FFrame.Options := FOptions;
+  if Accepted then
+  begin
+    FOptions.Assign(FOptionsFrame.Options);
+    if Assigned(frmStackView) then
+      frmStackView.Options := FOptions;
+  end;
+  FOptionsFrame := nil;
 end;
 
-function TStackTraceViewerAddinOptions.GetArea: string;
+procedure TJclStackTraceViewerExpert.FrameCreated(AFrame: TCustomFrame);
 begin
-  Result := '';
+  FOptionsFrame := AFrame as TJclStackTraceViewerConfigFrame;
+  FOptionsFrame.Options := FOptions;
 end;
 
-function TStackTraceViewerAddinOptions.GetCaption: string;
+function TJclStackTraceViewerExpert.GetFrameClass: TCustomFrameClass;
 begin
-  Result := JclGetAddinOptionsCaption(RsStackTraceViewerOptionsPageName);
-end;
-
-function TStackTraceViewerAddinOptions.GetFrameClass: TCustomFrameClass;
-begin
   Result := TJclStackTraceViewerConfigFrame;
 end;
 
-function TStackTraceViewerAddinOptions.GetHelpContext: Integer;
+function TJclStackTraceViewerExpert.GetPageName: string;
 begin
-  Result := 0;
+  Result := LoadResString(@RsStackTraceViewerOptionsPageName);
 end;
 
-function TStackTraceViewerAddinOptions.IncludeInIDEInsight: Boolean;
-begin
-  Result := True;
-end;
-
-function TStackTraceViewerAddinOptions.ValidateContents: Boolean;
-begin
-  Result := True;
-end;
-{$ENDIF BDS8_UP}
-
-//=== { TJclStackTraceViewerExpert } =========================================
-
-constructor TJclStackTraceViewerExpert.Create;
-begin
-  inherited Create(JclStackTraceViewerExpertName);
-  FOptions := TExceptionViewerOption.Create;
-  {$IFDEF BDS8_UP}
-  FAddinOptions := TStackTraceViewerAddinOptions.Create(FOptions);
-  (BorlandIDEServices as INTAEnvironmentOptionsServices).RegisterAddInOptions(FAddinOptions);
-  {$ENDIF BDS8_UP}
-end;
-
-destructor TJclStackTraceViewerExpert.Destroy;
-begin
-  {$IFDEF BDS8_UP}
-  (BorlandIDEServices as INTAEnvironmentOptionsServices).UnregisterAddInOptions(FAddinOptions);
-  FAddinOptions := nil;
-  {$ENDIF BDS8_UP}
-  FOptions.Free;
-  FreeAndNil(frmStackView);
-  inherited Destroy;
-end;
-
 procedure TJclStackTraceViewerExpert.ActionExecute(Sender: TObject);
 begin
   try
@@ -280,28 +229,6 @@
   end;
 end;
 
-procedure TJclStackTraceViewerExpert.AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc);
-begin
-  inherited AddConfigurationPages(AddPageFunc);
-  FOptionsFrame := TJclStackTraceViewerConfigFrame.Create(nil);
-  FOptionsFrame.Options := FOptions;
-  AddPageFunc(FOptionsFrame, LoadResString(@RsStackTraceViewerOptionsPageName), Self);
-end;
-
-procedure TJclStackTraceViewerExpert.ConfigurationClosed(AControl: TControl; SaveChanges: Boolean);
-begin
-  if (AControl = FOptionsFrame) and Assigned(FOptionsFrame) then
-  begin
-    if SaveChanges then
-      FOptions.Assign(FOptionsFrame.Options);
-    FreeAndNil(FOptionsFrame);
-    if SaveChanges and Assigned(frmStackView) then
-      frmStackView.Options := FOptions;
-  end
-  else
-    inherited ConfigurationClosed(AControl, SaveChanges);
-end;
-
 procedure TJclStackTraceViewerExpert.LoadExpertValues;
 begin
   FOptions.ExpandTreeView := Settings.LoadBool('ExpandTreeView', FOptions.ExpandTreeView);

Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFrame.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFrame.pas	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFrame.pas	2012-01-23 20:45:41 UTC (rev 3703)
@@ -667,7 +667,7 @@
 begin
   inherited;
   {$IFDEF BDS8_UP}
-  (BorlandIDEServices as IOTAServices).GetEnvironmentOptions.EditOptions('', JclGetAddinOptionsCaption(RsStackTraceViewerOptionsPageName));
+  (BorlandIDEServices as IOTAServices).GetEnvironmentOptions.EditOptions('', StackTraceViewerExpert.GetCaption);
   {$ELSE ~BDS8_UP}
   TJclOTAExpertBase.ConfigurationDialog(LoadResString(@RsStackTraceViewerOptionsPageName));
   {$ENDIF ~BDS8_UP}

Modified: trunk/jcl/experts/useswizard/JCLUsesWizard.pas
===================================================================
--- trunk/jcl/experts/useswizard/JCLUsesWizard.pas	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/useswizard/JCLUsesWizard.pas	2012-01-23 20:45:41 UTC (rev 3703)
@@ -78,11 +78,14 @@
     procedure UnregisterCommands; override;
     procedure LoadSettings;
     procedure SaveSettings;
-    procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
-    procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
     property Active: Boolean read FActive write SetActive;
     property ConfirmChanges: Boolean read FConfirmChanges write FConfirmChanges;
     property IniFile: string read FIniFile write FIniFile;
+  public
+    function GetPageName: string; override;
+    function GetFrameClass: TCustomFrameClass; override;
+    procedure FrameCreated(AFrame: TCustomFrame); override;
+    procedure DialogClosed(Accepted: Boolean); override;
   end;
 
   TJCLUsesWizardNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier, IOTAIDENotifier50)
@@ -374,33 +377,6 @@
 
 //=== { TJCLUsesWizard } =====================================================
 
-procedure TJCLUsesWizard.AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc);
-begin
-  inherited AddConfigurationPages(AddPageFunc);
-  FFrameJclOptions := TFrameJclOptions.Create(nil);
-  FFrameJclOptions.Active := Active;
-  FFrameJclOptions.ConfirmChanges := ConfirmChanges;
-  FFrameJclOptions.ConfigFileName := IniFile;
-  AddPageFunc(FFrameJclOptions, LoadResString(@RsUsesSheet), Self);
-end;
-
-procedure TJCLUsesWizard.ConfigurationClosed(AControl: TControl;
-  SaveChanges: Boolean);
-begin
-  if Assigned(AControl) and (AControl = FFrameJclOptions) then
-  begin
-    if SaveChanges then
-    begin
-      Active := FFrameJclOptions.Active;
-      ConfirmChanges := FFrameJclOptions.ConfirmChanges;
-      IniFile := FFrameJclOptions.ConfigFileName;
-    end;
-    FreeAndNil(FFrameJclOptions);
-  end
-  else
-    inherited ConfigurationClosed(AControl, SaveChanges);
-end;
-
 procedure TJCLUsesWizard.AppIdle(Sender: TObject; var Done: Boolean);
 begin
   Application.OnIdle := FApplicationIdle;
@@ -428,7 +404,7 @@
 constructor TJCLUsesWizard.Create;
 begin
   inherited Create(JclUsesExpertName);
-  
+
   FIdentifierLists := TStringList.Create;
   FErrors := TList.Create;
   FActive := False;
@@ -442,10 +418,21 @@
   ClearErrors;
   FErrors.Free;
   FIdentifierLists.Free;
-  
+
   inherited Destroy;
 end;
 
+procedure TJCLUsesWizard.DialogClosed(Accepted: Boolean);
+begin
+  if Accepted then
+  begin
+    Active := FFrameJclOptions.Active;
+    ConfirmChanges := FFrameJclOptions.ConfirmChanges;
+    IniFile := FFrameJclOptions.ConfigFileName;
+  end;
+  FFrameJclOptions := nil;
+end;
+
 function TJCLUsesWizard.DoConfirmChanges(ChangeList: TStrings): TModalResult;
 var
   Dialog: TFormUsesConfirm;
@@ -458,6 +445,25 @@
   end;
 end;
 
+procedure TJCLUsesWizard.FrameCreated(AFrame: TCustomFrame);
+begin
+  FFrameJclOptions := AFrame as TFrameJclOptions;
+
+  FFrameJclOptions.Active := Active;
+  FFrameJclOptions.ConfirmChanges := ConfirmChanges;
+  FFrameJclOptions.ConfigFileName := IniFile;
+end;
+
+function TJCLUsesWizard.GetFrameClass: TCustomFrameClass;
+begin
+  Result := TFrameJclOptions;
+end;
+
+function TJCLUsesWizard.GetPageName: string;
+begin
+  Result := LoadResString(@RsUsesSheet);
+end;
+
 // load identifier lists
 // each line represents one JCL unit in the following format:
 // <unit_name>=<identifier0>,<identifier1>,...

Modified: trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas
===================================================================
--- trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas	2012-01-22 22:54:36 UTC (rev 3702)
+++ trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas	2012-01-23 20:45:41 UTC (rev 3703)
@@ -58,31 +58,8 @@
     property ControlAction: TJclVersionControlActionType read FControlAction write FControlAction;
   end;
 
-  {$IFDEF BDS8_UP}
-  TJclVersionControlExpert = class;
-
-  TJclVersionControlExpertOptions = class(TInterfacedObject, INTAAddinOptions)
-  private
-    FOptionsFrame: TJclVersionCtrlOptionsFrame;
-    FVersionControlExpert: TJclVersionControlExpert;
-  public
-    constructor Create(AVersionControlExpert: TJclVersionControlExpert);
-    procedure DialogClosed(Accepted: Boolean);
-    procedure FrameCreated(AFrame: TCustomFrame);
-    function GetArea: string;
-    function GetCaption: string;
-    function GetFrameClass: TCustomFrameClass;
-    function ValidateContents: Boolean;
-    function GetHelpContext: Integer;
-    function IncludeInIDEInsight: Boolean;
-  end;
-  {$ENDIF BDS8_UP}
-
   TJclVersionControlExpert = class (TJclOTAExpert)
   private
-    {$IFDEF BDS8_UP}
-    FAddinOptions: TJclVersionControlExpertOptions;
-    {$ENDIF BDS8_UP}
     FVersionCtrlMenu: TMenuItem;
     FActions: array [TJclVersionControlActionType] of TCustomAction;
     FIconIndexes: array [TJclVersionControlActionType] of Integer;
@@ -111,8 +88,6 @@
     destructor Destroy; override;
     procedure RegisterCommands; override;
     procedure UnregisterCommands; override;
-    procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
-    procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
     function SaveModules(const FileName: string;
       const IncludeSubDirectories: Boolean): Boolean;
 
@@ -124,6 +99,11 @@
     property CurrentCache: TJclVersionControlCache read GetCurrentCache;
     property CurrentPlugin: TJclVersionControlPlugin read GetCurrentPlugin;
     property CurrentFileName: string read GetCurrentFileName;
+  public
+    function GetPageName: string; override;
+    function GetFrameClass: TCustomFrameClass; override;
+    procedure FrameCreated(AFrame: TCustomFrame); override;
+    procedure DialogClosed(Accepted: Boolean); override;
   end;
 
 // design package entry point
@@ -344,73 +324,6 @@
     raise EJclExpertException.CreateRes(@RsEInvalidAction);
 end;
 
-//=== { TJclVersionControlExpertOptions } ====================================
-
-{$IFDEF BDS8_UP}
-constructor TJclVersionControlExpertOptions.Create(AVersionControlExpert: TJclVersionControlExpert);
-begin
-  inherited Create;
-  FVersionControlExpert := AVersionControlExpert;
-end;
-
-procedure TJclVersionControlExpertOptions.DialogClosed(Accepted: Boolean);
-begin
-  if Accepted then
-  begin
-    FVersionControlExpert.DisableActions := FOptionsFrame.DisableActions;
-    FVersionControlExpert.HideActions := FOptionsFrame.HideActions;
-    FVersionControlExpert.SaveConfirmation := FOptionsFrame.SaveConfirmation;
-    FVersionControlExpert.ActOnTopSandbox := FOptionsFrame.ActOnTopSandbox;
-    FVersionControlExpert.FMenuOrganization.Assign(FOptionsFrame.MenuTree);
-    FVersionControlExpert.IconType := FOptionsFrame.IconType;
-    FVersionControlExpert.RefreshMenu;
-  end;
-end;
-
-procedure TJclVersionControlExpertOptions.FrameCreated(AFrame: TCustomFrame);
-begin
-  FOptionsFrame := TJclVersionCtrlOptionsFrame(AFrame);
-  FOptionsFrame.DisableActions := FVersionControlExpert.DisableActions;
-  FOptionsFrame.HideActions := FVersionControlExpert.HideActions;
-  FOptionsFrame.SaveConfirmation := FVersionControlExpert.SaveConfirmation;
-  FOptionsFrame.ActOnTopSandbox := FVersionControlExpert.ActOnTopSandbox;
-  FOptionsFrame.SetActions(FVersionControlExpert.FActions);
-  // after SetActions
-  FOptionsFrame.MenuTree := FVersionControlExpert.FMenuOrganization;
-  FOptionsFrame.IconType := FVersionControlExpert.IconType;
-end;
-
-function TJclVersionControlExpertOptions.GetArea: string;
-begin
-  Result := '';
-end;
-
-function TJclVersionControlExpertOptions.GetCaption: string;
-begin
-  Result := JclGetAddinOptionsCaption(RsVersionControlSheet);
-end;
-
-function TJclVersionControlExpertOptions.GetFrameClass: TCustomFrameClass;
-begin
-  Result := TJclVersionCtrlOptionsFrame;
-end;
-
-function TJclVersionControlExpertOptions.GetHelpContext: Integer;
-begin
-  Result := 0;
-end;
-
-function TJclVersionControlExpertOptions.IncludeInIDEInsight: Boolean;
-begin
-  Result := True;
-end;
-
-function TJclVersionControlExpertOptions.ValidateContents: Boolean;
-begin
-  Result := True;
-end;
-{$ENDIF BDS8_UP}
-
 //=== { TJclVersionControlExpert } ===================================================
 
 procedure TJclVersionControlExpert.ActionExecute(Sender: TObject);
@@ -588,65 +501,34 @@
   end;
 end;
 
-procedure TJclVersionControlExpert.AddConfigurationPages(
-  AddPageFunc: TJclOTAAddPageFunc);
-begin
-  inherited AddConfigurationPages(AddPageFunc);
-  FOptionsFrame := TJclVersionCtrlOptionsFrame.Create(nil);
-  FOptionsFrame.DisableActions := DisableActions;
-  FOptionsFrame.HideActions := HideActions;
-  FOptionsFrame.SaveConfirmation := SaveConfirmation;
-  FOptionsFrame.ActOnTopSandbox := ActOnTopSandbox;
-  FOptionsFrame.SetActions(FActions);
-  // after SetActions
-  FOptionsFrame.MenuTree := FMenuOrganization;
-  FOptionsFrame.IconType := IconType;
-  AddPageFunc(FOptionsFrame, LoadResString(@RsVersionControlSheet), Self);
-end;
-
-procedure TJclVersionControlExpert.ConfigurationClosed(AControl: TControl;
-  SaveChanges: Boolean);
-begin
-  if (AControl = FOptionsFrame) and Assigned(FOptionsFrame) then
-  begin
-    if SaveChanges then
-    begin
-      DisableActions := FOptionsFrame.DisableActions;
-      HideActions := FOptionsFrame.HideActions;
-      SaveConfirmation := FOptionsFrame.SaveConfirmation;
-      ActOnTopSandbox := FOptionsFrame.ActOnTopSandbox;
-      FMenuOrganization.Assign(FOptionsFrame.MenuTree);
-      IconType := FOptionsFrame.IconType;
-      RefreshMenu;
-    end;
-    FreeAndNil(FOptionsFrame);
-  end
-  else
-    inherited ConfigurationClosed(AControl, SaveChanges);
-end;
-
 constructor TJclVersionControlExpert.Create;
 begin
   FMenuOrganization := TStringList.Create;
 
   inherited Create('JclVersionControlExpert');
-
-  {$IFDEF BDS8_UP}
-  FAddinOptions := TJclVersionControlExpertOptions.Create(Self);
-  (BorlandIDEServices as INTAEnvironmentOptionsServices).RegisterAddInOptions(FAddinOptions);
-  {$ENDIF BDS8_UP}
 end;
 
 destructor TJclVersionControlExpert.Destroy;
 begin
-  {$IFDEF BDS8_UP}
-  (BorlandIDEServices as INTAEnvironmentOptionsServices).UnregisterAddInOptions(FAddinOptions);
-  FAddinOptions := nil;
-  {$ENDIF BDS8_UP}
   inherited Destroy;
   FMenuOrganization.Free;
 end;
 
+procedure TJclVersionControlExpert.DialogClosed(Accepted: Boolean);
+begin
+  if Accepted then
+  begin
+    DisableActions := FOptionsFrame.DisableActions;
+    HideActions := FOptionsFrame.HideActions;
+    SaveConfirmation := FOptionsFrame.SaveConfirmation;
+    ActOnTopSandbox := FOptionsFrame.ActOnTopSandbox;
+    FMenuOrganization.Assign(FOptionsFrame.MenuTree);
+    IconType := FOptionsFrame.IconType;
+    RefreshMenu;
+  end;
+  FOptionsFrame := nil;
+end;
+
 procedure TJclVersionControlExpert.DropDownMenuPopup(Sender: TObject);
 var
   APopupMenu: TPopupMenu;
@@ -717,6 +599,20 @@
   end;
 end;
 
+procedure TJclVersionControlExpert.FrameCreated(AFrame: TCustomFrame);
+begin
+  FOptionsFrame := AFrame as TJclVersionCtrlOptionsFrame;
+
+  FOptionsFrame.DisableActions := DisableActions;
+  FOptionsFrame.HideActions := HideActions;
+  FOptionsFrame.SaveConfirmation := SaveConfirmation;
+  FOptionsFrame.ActOnTopSandbox := ActOnTopSandbox;
+  FOptionsFrame.SetActions(FActions);
+  // after SetActions
+  FOptionsFrame.MenuTree := FMenuOrganization;
+  FOptionsFrame.IconType := IconType;
+end;
+
 function TJclVersionControlExpert.GetCurrentCache: TJclVersionControlCache;
 var
   Index: Integer;
@@ -772,6 +668,16 @@
   Result := nil;
 end;
 
+function TJclVersionControlExpert.GetFrameClass: TCustomFrameClass;
+begin
+  Result := TJclVersionCtrlOptionsFrame;
+end;
+
+function TJclVersionControlExpert.GetPageName: string;
+begin
+  Result := LoadResString(@RsVersionControlSheet);
+end;
+
 procedure TJclVersionControlExpert.IDEActionMenuClick(Sender: TObject);
 var
   AMenuItem, SubMenuItem: TMenuItem;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3702] trunk/jcl

From: <ou...@us...> - 2012-01-22 22:54:45

Revision: 3702
          http://jcl.svn.sourceforge.net/jcl/?rev=3702&view=rev
Author:   outchy
Date:     2012-01-22 22:54:36 +0000 (Sun, 22 Jan 2012)
Log Message:
-----------
Refactoring of the action related stuff to a separate expert in same package JclBaseExpert.

Modified Paths:
--------------
    trunk/jcl/experts/common/JclOtaActionConfigureSheet.pas
    trunk/jcl/experts/common/JclOtaUtils.pas
    trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
    trunk/jcl/experts/debug/simdview/JclSIMDView.pas
    trunk/jcl/experts/projectanalyzer/JclProjectAnalyzerImpl.pas
    trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas
    trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas
    trunk/jcl/packages/c6/JclBaseExpert.bpk
    trunk/jcl/packages/c6/JclBaseExpert.dpk
    trunk/jcl/packages/cs1/JclBaseExpert.dpk
    trunk/jcl/packages/d10/JclBaseExpert.dpk
    trunk/jcl/packages/d11/JclBaseExpert.dpk
    trunk/jcl/packages/d11/JclBaseExpert.dproj
    trunk/jcl/packages/d12/JclBaseExpert.dpk
    trunk/jcl/packages/d12/JclBaseExpert.dproj
    trunk/jcl/packages/d14/JclBaseExpert.dpk
    trunk/jcl/packages/d14/JclBaseExpert.dproj
    trunk/jcl/packages/d15/JclBaseExpert.dpk
    trunk/jcl/packages/d15/JclBaseExpert.dproj
    trunk/jcl/packages/d16/JclBaseExpert.dpk
    trunk/jcl/packages/d16/JclBaseExpert.dproj
    trunk/jcl/packages/d6/JclBaseExpert.dpk
    trunk/jcl/packages/d7/JclBaseExpert.dpk
    trunk/jcl/packages/d8/JclBaseExpert.dpk
    trunk/jcl/packages/d9/JclBaseExpert.dpk
    trunk/jcl/packages/xml/JclBaseExpert-D.xml

Added Paths:
-----------
    trunk/jcl/experts/common/JclOtaActions.pas

Modified: trunk/jcl/experts/common/JclOtaActionConfigureSheet.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaActionConfigureSheet.pas	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/experts/common/JclOtaActionConfigureSheet.pas	2012-01-22 22:54:36 UTC (rev 3702)
@@ -75,7 +75,7 @@
 uses
   ActnList, Menus,
   ToolsApi,
-  JclOtaConsts, JclOtaResources, JclOtaUtils;
+  JclOtaConsts, JclOtaResources, JclOtaUtils, JclOtaActions;
 
 { TFrameActions }
 
@@ -87,7 +87,7 @@
   AListItem := ListViewActions.Selected;
   if Assigned(AListItem) then
   begin
-    AAction := TJclOTAExpertBase.GetAction(AListItem.Index);
+    AAction := TJclOTAActionExpert.GetAction(AListItem.Index);
     AListItem.SubItems.Strings[0] := ShortcutToText(TShortcut(AAction.Tag));
     HotKeyShortcut.HotKey := TShortcut(AAction.Tag);
   end;
@@ -114,10 +114,10 @@
 
   ListViewActions.SmallImages := ANTAServices.ImageList;
 
-  for Index := 0 to TJclOTAExpertBase.GetActionCount - 1 do
+  for Index := 0 to TJclOTAActionExpert.GetActionCount - 1 do
   begin
     AListItem := ListViewActions.Items.Add;
-    AAction := TJclOTAExpertBase.GetAction(Index);
+    AAction := TJclOTAActionExpert.GetAction(Index);
     AListItem.ImageIndex := AAction.ImageIndex;
     AListItem.Caption := AAction.Caption;
     AListItem.Data := Pointer(AAction.ShortCut);
@@ -152,10 +152,10 @@
 begin
   { (ahuser) In Delphi 7 the ListViewActions.Items.Count is 0 if the page was
     not shown. Something must delete the items that were filled in the constructor. }
-  if ListViewActions.Items.Count = TJclOTAExpertBase.GetActionCount then
+  if ListViewActions.Items.Count = TJclOTAActionExpert.GetActionCount then
   begin
-    for Index := 0 to TJclOTAExpertBase.GetActionCount - 1 do
-      TJclOTAExpertBase.GetAction(Index).ShortCut :=
+    for Index := 0 to TJclOTAActionExpert.GetActionCount - 1 do
+      TJclOTAActionExpert.GetAction(Index).ShortCut :=
         TShortcut(ListViewActions.Items.Item[Index].Data);
   end;
 end;

Copied: trunk/jcl/experts/common/JclOtaActions.pas (from rev 3701, trunk/jcl/experts/common/JclOtaUtils.pas)
===================================================================
--- trunk/jcl/experts/common/JclOtaActions.pas	                        (rev 0)
+++ trunk/jcl/experts/common/JclOtaActions.pas	2012-01-22 22:54:36 UTC (rev 3702)
@@ -0,0 +1,347 @@
+{**************************************************************************************************}
+{                                                                                                  }
+{ Project JEDI Code Library (JCL)                                                                  }
+{                                                                                                  }
+{ 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/                                                           }
+{                                                                                                  }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
+{ and limitations under the License.                                                               }
+{                                                                                                  }
+{ The Original Code is JclOtaUtils.pas.                                                            }
+{                                                                                                  }
+{ The Initial Developer of the Original Code is Petr Vones.                                        }
+{ Portions created by Petr Vones are Copyright (C) of Petr Vones.                                  }
+{                                                                                                  }
+{ Contributors:                                                                                    }
+{   Florent Ouchet (outchy)                                                                        }
+{                                                                                                  }
+{**************************************************************************************************}
+{                                                                                                  }
+{ Last modified: $Date::                                                                         $ }
+{ Revision:      $Rev::                                                                          $ }
+{ Author:        $Author::                                                                       $ }
+{                                                                                                  }
+{**************************************************************************************************}
+
+unit JclOtaActions;
+
+interface
+
+{$I jcl.inc}
+{$I crossplatform.inc}
+
+uses
+  SysUtils, Classes, Windows,
+  Controls, ComCtrls, ActnList, Menus,
+  {$IFNDEF COMPILER8_UP}
+  Idemenuaction, // dependency walker reports a class TPopupAction in
+  // unit Idemenuaction in designide.bpl used by the IDE to display tool buttons
+  // with a drop down menu, this class seems to have the same interface
+  // as TControlAction defined in Controls.pas for newer versions of Delphi
+  {$ENDIF COMPILER8_UP}
+  JclBase,
+  {$IFDEF UNITVERSIONING}
+  JclUnitVersioning,
+  {$ENDIF UNITVERSIONING}
+  ToolsAPI,
+  JclOTAUtils;
+
+type
+  // class of actions with a drop down menu on tool bars
+  {$IFDEF COMPILER8_UP}
+  TDropDownAction = TControlAction;
+  {$ELSE COMPILER8_UP}
+  TDropDownAction = TPopupAction;
+  {$ENDIF COMPILER8_UP}
+
+  TJclOTAActionExpert = class(TJclOTAExpert)
+  private
+    FConfigurationAction: TAction;
+    FConfigurationMenuItem: TMenuItem;
+    FActionConfigureSheet: TControl;
+    procedure ConfigurationActionUpdate(Sender: TObject);
+    procedure ConfigurationActionExecute(Sender: TObject);
+  public
+    class procedure CheckToolBarButton(AToolBar: TToolBar; AAction: TCustomAction);
+    class procedure RegisterAction(Action: TCustomAction);
+    class procedure UnregisterAction(Action: TCustomAction);
+    class function GetActionCount: Integer;
+    class function GetAction(Index: Integer): TAction;
+  public
+    constructor Create; reintroduce;
+    destructor Destroy; override;
+
+    { IJclOTAOptionsCallback }
+    procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
+    procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
+
+    procedure RegisterCommands; override;
+    procedure UnregisterCommands; override;
+  end;
+
+{$IFDEF UNITVERSIONING}
+const
+  UnitVersioning: TUnitVersionInfo = (
+    RCSfile: '$URL$';
+    Revision: '$Revision$';
+    Date: '$Date$';
+    LogPath: 'JCL\experts\common';
+    Extra: '';
+    Data: nil
+    );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+  Forms, Graphics,
+  JclOtaConsts, JclOtaResources,
+  JclOtaActionConfigureSheet;
+
+var
+  GlobalActionList: TList = nil;
+  GlobalActionExpert: TJclOTAActionExpert;
+
+function FindActions(const Name: string): TComponent;
+var
+  Index: Integer;
+  TestAction: TCustomAction;
+  ActionList: TList;
+begin
+  ActionList := GlobalActionList;
+  Result := nil;
+  try
+    if Assigned(ActionList) then
+      for Index := 0 to ActionList.Count-1 do
+      begin
+        TestAction := TCustomAction(ActionList.Items[Index]);
+        if (CompareText(Name,TestAction.Name) = 0) then
+          Result := TestAction;
+      end;
+  except
+    on ExceptionObj: TObject do
+    begin
+      JclExpertShowExceptionDialog(ExceptionObj);
+    end;
+  end;
+end;
+
+//=== { TJclOTAActionExpert } ================================================
+
+constructor TJclOTAActionExpert.Create;
+begin
+  inherited Create(JclActionSettings);
+  GlobalActionExpert := Self;
+end;
+
+destructor TJclOTAActionExpert.Destroy;
+begin
+  GlobalActionExpert := nil;
+  inherited Destroy;
+end;
+
+class function TJclOTAActionExpert.GetAction(Index: Integer): TAction;
+begin
+  if Assigned(GlobalActionList) then
+    Result := TAction(GlobalActionList.Items[Index])
+  else
+    Result := nil;
+end;
+
+class function TJclOTAActionExpert.GetActionCount: Integer;
+begin
+  if Assigned(GlobalActionList) then
+    Result := GlobalActionList.Count
+  else
+    Result := 0;
+end;
+
+type
+  TAccessToolButton = class(TToolButton);
+
+class procedure TJclOTAActionExpert.CheckToolBarButton(AToolBar: TToolBar; AAction: TCustomAction);
+var
+  Index: Integer;
+  AButton: TAccessToolButton;
+begin
+  if Assigned(AToolBar) then
+    for Index := AToolBar.ButtonCount - 1 downto 0 do
+    begin
+      AButton := TAccessToolButton(AToolBar.Buttons[Index]);
+      if AButton.Action = AAction then
+      begin
+        AButton.SetToolBar(nil);
+        AButton.Free;
+      end;
+    end;
+end;
+
+procedure TJclOTAActionExpert.ConfigurationActionExecute(Sender: TObject);
+begin
+  try
+    ConfigurationDialog('');
+  except
+    on ExceptionObj: TObject do
+    begin
+      JclExpertShowExceptionDialog(ExceptionObj);
+    end;
+  end;
+end;
+
+procedure TJclOTAActionExpert.ConfigurationActionUpdate(Sender: TObject);
+begin
+  try
+    (Sender as TAction).Enabled := True;
+  except
+    on ExceptionObj: TObject do
+    begin
+      JclExpertShowExceptionDialog(ExceptionObj);
+    end;
+  end;
+end;
+
+procedure TJclOTAActionExpert.AddConfigurationPages(
+  AddPageFunc: TJclOTAAddPageFunc);
+begin
+  if not Assigned(FActionConfigureSheet) then
+  begin
+    FActionConfigureSheet := TJclOtaActionConfigureFrame.Create(Application);
+    AddPageFunc(FActionConfigureSheet, LoadResString(@RsActionSheet), Self);
+  end;
+end;
+
+procedure TJclOTAActionExpert.ConfigurationClosed(AControl: TControl;
+  SaveChanges: Boolean);
+begin
+  if Assigned(AControl) and (AControl = FActionConfigureSheet) then
+  begin
+    if SaveChanges then
+      TJclOtaActionConfigureFrame(FActionConfigureSheet).SaveChanges;
+    FreeAndNil(FActionConfigureSheet);
+  end
+  else
+    inherited ConfigurationClosed(AControl, SaveChanges);
+  // override to customize
+end;
+
+class procedure TJclOTAActionExpert.RegisterAction(Action: TCustomAction);
+begin
+  if Action.Name <> '' then
+  begin
+    Action.Tag := Action.ShortCut;  // to restore settings
+    if Assigned(GlobalActionExpert) then
+      Action.ShortCut := GlobalActionExpert.Settings.LoadInteger(Action.Name, Action.ShortCut);
+  end;
+
+  if not Assigned(GlobalActionList) then
+  begin
+    GlobalActionList := TList.Create;
+    RegisterFindGlobalComponentProc(FindActions);
+  end;
+
+  GlobalActionList.Add(Action);
+end;
+
+class procedure TJclOTAActionExpert.UnregisterAction(Action: TCustomAction);
+var
+  NTAServices: INTAServices;
+begin
+  if (Action.Name <> '') and Assigned(GlobalActionExpert) then
+    GlobalActionExpert.Settings.SaveInteger(Action.Name, Action.ShortCut);
+
+  if Assigned(GlobalActionList) then
+  begin
+    GlobalActionList.Remove(Action);
+    if (GlobalActionList.Count = 0) then
+    begin
+      UnRegisterFindGlobalComponentProc(FindActions);
+      FreeAndNil(GlobalActionList);
+    end;
+  end;
+
+  NTAServices := GetNTAServices;
+  // remove action from toolbar to avoid crash when recompile package inside the IDE.
+  CheckToolBarButton(NTAServices.ToolBar[sCustomToolBar], Action);
+  CheckToolBarButton(NTAServices.ToolBar[sStandardToolBar], Action);
+  CheckToolBarButton(NTAServices.ToolBar[sDebugToolBar], Action);
+  CheckToolBarButton(NTAServices.ToolBar[sViewToolBar], Action);
+  CheckToolBarButton(NTAServices.ToolBar[sDesktopToolBar], Action);
+  {$IFDEF COMPILER7_UP}
+  CheckToolBarButton(NTAServices.ToolBar[sInternetToolBar], Action);
+  CheckToolBarButton(NTAServices.ToolBar[sCORBAToolBar], Action);
+  {$ENDIF COMPILER7_UP}
+end;
+
+procedure TJclOTAActionExpert.RegisterCommands;
+var
+  JclIcon: TIcon;
+  Category: string;
+  Index: Integer;
+  IDEMenuItem, ToolsMenuItem: TMenuItem;
+  NTAServices: INTAServices;
+begin
+  NTAServices := GetNTAServices;
+
+  Category := '';
+  for Index := 0 to NTAServices.ActionList.ActionCount - 1 do
+    if CompareText(NTAServices.ActionList.Actions[Index].Name, 'ToolsOptionsCommand') = 0 then
+      Category := NTAServices.ActionList.Actions[Index].Category;
+
+  FConfigurationAction := TAction.Create(nil);
+  JclIcon := TIcon.Create;
+  try
+    // not ModuleHInstance because the resource is in JclBaseExpert.bpl
+    JclIcon.Handle := LoadIcon(HInstance, 'JCLCONFIGURE');
+    FConfigurationAction.ImageIndex := NTAServices.ImageList.AddIcon(JclIcon);
+  finally
+    JclIcon.Free;
+  end;
+  FConfigurationAction.Caption := LoadResString(@RsJCLOptions);
+  FConfigurationAction.Name := JclConfigureActionName;
+  FConfigurationAction.Category := Category;
+  FConfigurationAction.Visible := True;
+  FConfigurationAction.OnUpdate := ConfigurationActionUpdate;
+  FConfigurationAction.OnExecute := ConfigurationActionExecute;
+
+  FConfigurationAction.ActionList := NTAServices.ActionList;
+  RegisterAction(FConfigurationAction);
+
+  IDEMenuItem := NTAServices.MainMenu.Items;
+  if not Assigned(IDEMenuItem) then
+    raise EJclExpertException.CreateRes(@RsENoIDEMenu);
+
+  ToolsMenuItem := nil;
+  for Index := 0 to IDEMenuItem.Count - 1 do
+    if CompareText(IDEMenuItem.Items[Index].Name, 'ToolsMenu') = 0 then
+      ToolsMenuItem := IDEMenuItem.Items[Index];
+  if not Assigned(ToolsMenuItem) then
+    raise EJclExpertException.CreateRes(@RsENoToolsMenu);
+
+  FConfigurationMenuItem := TMenuItem.Create(nil);
+  FConfigurationMenuItem.Name := JclConfigureMenuName;
+  FConfigurationMenuItem.Action := FConfigurationAction;
+
+  ToolsMenuItem.Insert(0, FConfigurationMenuItem);
+end;
+
+procedure TJclOTAActionExpert.UnregisterCommands;
+begin
+  UnregisterAction(FConfigurationAction);
+  FreeAndNil(FConfigurationAction);
+  FreeAndNil(FConfigurationMenuItem);
+end;
+
+initialization
+  {$IFDEF UNITVERSIONING}
+  RegisterUnitVersion(HInstance, UnitVersioning);
+  {$ENDIF UNITVERSIONING}
+finalization
+  FreeAndNil(GlobalActionList);
+  {$IFDEF UNITVERSIONING}
+  UnregisterUnitVersion(HInstance);
+  {$ENDIF UNITVERSIONING}
+
+end.

Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/experts/common/JclOtaUtils.pas	2012-01-22 22:54:36 UTC (rev 3702)
@@ -34,13 +34,7 @@
 
 uses
   SysUtils, Classes, Windows,
-  Controls, ComCtrls, ActnList, Menus,
-  {$IFNDEF COMPILER8_UP}
-  Idemenuaction, // dependency walker reports a class TPopupAction in
-  // unit Idemenuaction in designide.bpl used by the IDE to display tool buttons
-  // with a drop down menu, this class seems to have the same interface
-  // as TControlAction defined in Controls.pas for newer versions of Delphi
-  {$ENDIF COMPILER8_UP}
+  Controls,
   JclBase,
   {$IFDEF UNITVERSIONING}
   JclUnitVersioning,
@@ -52,13 +46,6 @@
   ToolsAPI;
 
 type
-  // class of actions with a drop down menu on tool bars
-  {$IFDEF COMPILER8_UP}
-  TDropDownAction = TControlAction;
-  {$ELSE COMPILER8_UP}
-  TDropDownAction = TPopupAction;
-  {$ENDIF COMPILER8_UP}
-
 // note to developers
 // to avoid JCL exceptions to be reported as Borland's exceptions in automatic
 // bug reports, all entry points should be protected with this code model:
@@ -137,8 +124,6 @@
     function GetJCLRootDir: string;
     function GetJCLSettings: TStrings;
     procedure ReadEnvVariables(EnvVariables: TStrings);
-    procedure ConfigurationActionUpdate(Sender: TObject);
-    procedure ConfigurationActionExecute(Sender: TObject);
     function GetActivePersonality: TJclBorPersonality;
     function GetDesigner: string;
   public
@@ -166,10 +151,6 @@
     class function GetExpertCount: Integer;
     class function GetExpert(Index: Integer): TJclOTAExpertBase;
     class function ConfigurationDialog(StartName: string = ''): Boolean;
-    class procedure CheckToolBarButton(AToolBar: TToolBar; AAction: TCustomAction);
-    class function GetActionCount: Integer;
-    class function GetAction(Index: Integer): TAction;
-    class function ActionSettings: TJclOtaSettings;
   public
     constructor Create(AName: string); virtual;
     destructor Destroy; override;
@@ -190,8 +171,6 @@
 
     procedure RegisterCommands; virtual;
     procedure UnregisterCommands; virtual;
-    procedure RegisterAction(Action: TCustomAction);
-    procedure UnregisterAction(Action: TCustomAction);
 
     property Settings: TJclOTASettings read FSettings;
     property JCLRootDir: string read GetJCLRootDir;
@@ -334,19 +313,20 @@
   {$ENDIF BDS8_UP}
   JclFileUtils, JclStrings, JclSysInfo, JclSimpleXml, JclCompilerUtils,
   JclOtaConsts, JclOtaResources, JclOtaExceptionForm, JclOtaConfigurationForm,
-  JclOtaActionConfigureSheet,
   JclOtaWizardForm, JclOtaWizardFrame,
-  JclOTAUnitVersioning;
+  JclOTAUnitVersioning, JclOTAActions;
 
 {$R 'JclImages.res'}
 
 var
   JCLUnitVersioningWizardIndex: Integer = -1;
+  JCLActionsWizardIndex: Integer = -1;
 
 procedure Register;
 begin
   try
     RegisterPackageWizard(TJclOTAUnitVersioningExpert.Create);
+    RegisterPackageWizard(TJclOTAActionExpert.Create);
   except
     on ExceptionObj: TObject do
       JclExpertShowExceptionDialog(ExceptionObj);
@@ -358,6 +338,8 @@
   try
     if JCLUnitVersioningWizardIndex <> -1 then
       TJclOTAExpertBase.GetOTAWizardServices.RemoveWizard(JCLUnitVersioningWizardIndex);
+    if JCLActionsWizardIndex <> -1 then
+      TJclOTAExpertBase.GetOTAWizardServices.RemoveWizard(JCLActionsWizardIndex);
   except
     on ExceptionObj: TObject do
       JclExpertShowExceptionDialog(ExceptionObj);
@@ -371,6 +353,7 @@
     TerminateProc := JclWizardTerminate;
 
     JCLUnitVersioningWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.AddWizard(TJclOTAUnitVersioningExpert.Create);
+    JCLActionsWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.AddWizard(TJclOTAActionExpert.Create);
 
     Result := True;
   except
@@ -383,35 +366,8 @@
 end;
 
 var
-  GlobalActionList: TList = nil;
-  GlobalActionSettings: TJclOtaSettings = nil;
   GlobalExpertList: TList = nil;
-  ConfigurationAction: TAction = nil;
-  ConfigurationMenuItem: TMenuItem = nil;
-  ActionConfigureSheet: TJclOtaActionConfigureFrame = nil;
 
-function FindActions(const Name: string): TComponent;
-var
-  Index: Integer;
-  TestAction: TCustomAction;
-begin
-  Result := nil;
-  try
-    if Assigned(GlobalActionList) then
-      for Index := 0 to GlobalActionList.Count-1 do
-      begin
-        TestAction := TCustomAction(GlobalActionList.Items[Index]);
-        if (CompareText(Name,TestAction.Name) = 0) then
-          Result := TestAction;
-      end;
-  except
-    on ExceptionObj: TObject do
-    begin
-      JclExpertShowExceptionDialog(ExceptionObj);
-    end;
-  end;
-end;
-
 function JclExpertShowExceptionDialog(AExceptionObj: TObject): Boolean;
 var
   AJclExpertExceptionForm: TJclExpertExceptionForm;
@@ -966,96 +922,17 @@
     GlobalExpertList.Remove(AExpert);
 end;
 
-class function TJclOTAExpertBase.GetAction(Index: Integer): TAction;
-begin
-  if Assigned(GlobalActionList) then
-    Result := TAction(GlobalActionList.Items[Index])
-  else
-    Result := nil;
-end;
-
-class function TJclOTAExpertBase.GetActionCount: Integer;
-begin
-  if Assigned(GlobalActionList) then
-    Result := GlobalActionList.Count
-  else
-    Result := 0;
-end;
-
-type
-  TAccessToolButton = class(TToolButton);
-
-class procedure TJclOTAExpertBase.CheckToolBarButton(AToolBar: TToolBar; AAction: TCustomAction);
-var
-  Index: Integer;
-  AButton: TAccessToolButton;
-begin
-  if Assigned(AToolBar) then
-    for Index := AToolBar.ButtonCount - 1 downto 0 do
-    begin
-      AButton := TAccessToolButton(AToolBar.Buttons[Index]);
-      if AButton.Action = AAction then
-      begin
-        AButton.SetToolBar(nil);
-        AButton.Free;
-      end;
-    end;
-end;
-
-class function TJclOTAExpertBase.ActionSettings: TJclOtaSettings;
-begin
-  if not Assigned(GlobalActionSettings) then
-    GlobalActionSettings := TJclOTASettings.Create(JclActionSettings);
-  Result := GlobalActionSettings;
-end;
-
-procedure TJclOTAExpertBase.ConfigurationActionExecute(Sender: TObject);
-begin
-  try
-    ConfigurationDialog('');
-  except
-    on ExceptionObj: TObject do
-    begin
-      JclExpertShowExceptionDialog(ExceptionObj);
-    end;
-  end;
-end;
-
-procedure TJclOTAExpertBase.ConfigurationActionUpdate(Sender: TObject);
-begin
-  try
-    (Sender as TAction).Enabled := True;
-  except
-    on ExceptionObj: TObject do
-    begin
-      JclExpertShowExceptionDialog(ExceptionObj);
-    end;
-  end;
-end;
-
-procedure TJclOTAExpertBase.AddConfigurationPages(  
+procedure TJclOTAExpertBase.AddConfigurationPages(
   AddPageFunc: TJclOTAAddPageFunc);
 begin
   // AddPageFunc uses '\' as a separator in PageName to build a tree
-  if not Assigned(ActionConfigureSheet) then
-  begin
-    ActionConfigureSheet := TJclOtaActionConfigureFrame.Create(Application);
-    AddPageFunc(ActionConfigureSheet, LoadResString(@RsActionSheet), Self);
-  end;
   // override to customize
 end;
 
 procedure TJclOTAExpertBase.ConfigurationClosed(AControl: TControl;
   SaveChanges: Boolean);
 begin
-  if Assigned(AControl) and (AControl = ActionConfigureSheet) then
-  begin
-    if SaveChanges then
-      ActionConfigureSheet.SaveChanges;
-    FreeAndNil(ActionConfigureSheet);
-  end
-  else
-    AControl.Free;
+  AControl.Free;
   // override to customize
 end;
 
@@ -1627,122 +1504,13 @@
   EnvVariables.Values[DelphiEnvironmentVar] := RootDir;
 end;
 
-procedure TJclOTAExpertBase.RegisterAction(Action: TCustomAction);
-begin
-  if Action.Name <> '' then
-  begin
-    Action.Tag := Action.ShortCut;  // to restore settings
-    Action.ShortCut := ActionSettings.LoadInteger(Action.Name, Action.ShortCut);
-  end;
-
-  if not Assigned(GlobalActionList) then
-  begin
-    GlobalActionList := TList.Create;
-    RegisterFindGlobalComponentProc(FindActions);
-  end;
-
-  GlobalActionList.Add(Action);
-end;
-
-procedure TJclOTAExpertBase.UnregisterAction(Action: TCustomAction);
-var
-  NTAServices: INTAServices;
-begin
-  if Action.Name <> '' then
-    ActionSettings.SaveInteger(Action.Name, Action.ShortCut);
-
-  if Assigned(GlobalActionList) then
-  begin
-    GlobalActionList.Remove(Action);
-    if (GlobalActionList.Count = 0) then
-    begin
-      FreeAndNil(GlobalActionList);
-      UnRegisterFindGlobalComponentProc(FindActions);
-    end;
-  end;
-
-  NTAServices := GetNTAServices;
-  // remove action from toolbar to avoid crash when recompile package inside the IDE.
-  CheckToolBarButton(NTAServices.ToolBar[sCustomToolBar], Action);
-  CheckToolBarButton(NTAServices.ToolBar[sStandardToolBar], Action);
-  CheckToolBarButton(NTAServices.ToolBar[sDebugToolBar], Action);
-  CheckToolBarButton(NTAServices.ToolBar[sViewToolBar], Action);
-  CheckToolBarButton(NTAServices.ToolBar[sDesktopToolBar], Action);
-  {$IFDEF COMPILER7_UP}
-  CheckToolBarButton(NTAServices.ToolBar[sInternetToolBar], Action);
-  CheckToolBarButton(NTAServices.ToolBar[sCORBAToolBar], Action);
-  {$ENDIF COMPILER7_UP}
-end;
-
 procedure TJclOTAExpertBase.RegisterCommands;
-var
-  JclIcon: TIcon;
-  Category: string;
-  Index: Integer;
-  IDEMenuItem, ToolsMenuItem: TMenuItem;
-  NTAServices: INTAServices;
 begin
-  NTAServices := GetNTAServices;
-  
-  if not Assigned(ConfigurationAction) then
-  begin
-    Category := '';
-    for Index := 0 to NTAServices.ActionList.ActionCount - 1 do
-      if CompareText(NTAServices.ActionList.Actions[Index].Name, 'ToolsOptionsCommand') = 0 then
-        Category := NTAServices.ActionList.Actions[Index].Category;
-
-    ConfigurationAction := TAction.Create(nil);
-    JclIcon := TIcon.Create;
-    try
-      // not ModuleHInstance because the resource is in JclBaseExpert.bpl                                                                  
-      JclIcon.Handle := LoadIcon(HInstance, 'JCLCONFIGURE');
-      ConfigurationAction.ImageIndex := NTAServices.ImageList.AddIcon(JclIcon);
-    finally
-      JclIcon.Free;
-    end;
-    ConfigurationAction.Caption := LoadResString(@RsJCLOptions);
-    ConfigurationAction.Name := JclConfigureActionName;
-    ConfigurationAction.Category := Category;
-    ConfigurationAction.Visible := True;
-    ConfigurationAction.OnUpdate := ConfigurationActionUpdate;
-    ConfigurationAction.OnExecute := ConfigurationActionExecute;
-
-    ConfigurationAction.ActionList := NTAServices.ActionList;
-    RegisterAction(ConfigurationAction);
-  end;
-  
-  if not Assigned(ConfigurationMenuItem) then
-  begin
-    IDEMenuItem := NTAServices.MainMenu.Items;
-    if not Assigned(IDEMenuItem) then
-      raise EJclExpertException.CreateRes(@RsENoIDEMenu);
-
-    ToolsMenuItem := nil;
-    for Index := 0 to IDEMenuItem.Count - 1 do
-      if CompareText(IDEMenuItem.Items[Index].Name, 'ToolsMenu') = 0 then
-        ToolsMenuItem := IDEMenuItem.Items[Index];
-    if not Assigned(ToolsMenuItem) then
-      raise EJclExpertException.CreateRes(@RsENoToolsMenu);
-
-    ConfigurationMenuItem := TMenuItem.Create(nil);
-    ConfigurationMenuItem.Name := JclConfigureMenuName;
-    ConfigurationMenuItem.Action := ConfigurationAction;
-
-    ToolsMenuItem.Insert(0, ConfigurationMenuItem);
-  end;
-
   // override to add actions and menu items
 end;
 
 procedure TJclOTAExpertBase.UnregisterCommands;
 begin
-  if GetExpertCount = 0 then
-  begin
-    UnregisterAction(ConfigurationAction);
-    FreeAndNil(ConfigurationAction);
-    FreeAndNil(ConfigurationMenuItem);
-  end;
-
   // override to remove actions and menu items
 end;
 
@@ -1997,8 +1765,6 @@
   {$IFDEF BDS}
   UnregisterAboutBox;
   {$ENDIF BDS}
-  FreeAndNil(GlobalActionList);
-  FreeAndNil(GlobalActionSettings);
   FreeAndNil(GlobalExpertList);
 except
   on ExceptionObj: TObject do

Modified: trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas	2012-01-22 22:54:36 UTC (rev 3702)
@@ -35,7 +35,8 @@
   JclUnitVersioning,
   {$ENDIF UNITVERSIONING}
   JclOtaUtils, JclOtaConsts,
-  JclDebugIdeConfigFrame;
+  JclDebugIdeConfigFrame,
+  JclOtaActions;
 
 type
   TJclDebugDataInfo = record
@@ -1338,7 +1339,7 @@
     FDebugExpertAction.DropdownMenu.OnPopup := DebugExpertMenuDropDown;
     FDebugExpertAction.DropdownMenu.AutoPopup := True;
     FillMenu(FDebugExpertAction.DropDownMenu.Items, DebugExpertSubMenuClick);
-    RegisterAction(FDebugExpertAction);
+    TJclOTAActionExpert.RegisterAction(FDebugExpertAction);
 
     FGenerateJdbgAction := TDropDownAction.Create(nil);
     FGenerateJdbgAction.Caption := LoadResString(@RsDebugGenerateJdbg);
@@ -1352,7 +1353,7 @@
     FGenerateJdbgAction.DropdownMenu.OnPopup := GenerateJdbgMenuDropDown;
     FGenerateJdbgAction.DropdownMenu.AutoPopup := True;
     FillMenu(FGenerateJdbgAction.DropDownMenu.Items, GenerateJdbgSubMenuClick);
-    RegisterAction(FGenerateJdbgAction);
+    TJclOTAActionExpert.RegisterAction(FGenerateJdbgAction);
 
     FInsertJdbgAction := TDropDownAction.Create(nil);
     FInsertJdbgAction.Caption := LoadResString(@RsDebugInsertJdbg);
@@ -1366,7 +1367,7 @@
     FInsertJdbgAction.DropdownMenu.OnPopup := InsertJdbgMenuDropDown;
     FInsertJdbgAction.DropdownMenu.AutoPopup := True;
     FillMenu(FInsertJdbgAction.DropDownMenu.Items, InsertJdbgSubMenuClick);
-    RegisterAction(FInsertJdbgAction);
+    TJclOTAActionExpert.RegisterAction(FInsertJdbgAction);
 
     FDeleteMapFileAction := TDropDownAction.Create(nil);
     FDeleteMapFileAction.Caption := LoadResString(@RsDeleteMapFile);
@@ -1380,7 +1381,7 @@
     FDeleteMapFileAction.DropdownMenu.OnPopup := DeleteMapFileMenuDropDown;
     FDeleteMapFileAction.DropdownMenu.AutoPopup := True;
     FillMenu(FDeleteMapFileAction.DropDownMenu.Items, DeleteMapFileSubMenuClick);
-    RegisterAction(FDeleteMapFileAction);
+    TJclOTAActionExpert.RegisterAction(FDeleteMapFileAction);
 
     // create menu items
     FDebugExpertItem := TMenuItem.Create(nil);
@@ -1524,10 +1525,10 @@
   FDebugExpertItem.Free;
 
   // remove actions
-  UnregisterAction(FDeleteMapFileAction);
-  UnregisterAction(FInsertJdbgAction);
-  UnregisterAction(FGenerateJdbgAction);
-  UnregisterAction(FDebugExpertAction);
+  TJclOTAActionExpert.UnregisterAction(FDeleteMapFileAction);
+  TJclOTAActionExpert.UnregisterAction(FInsertJdbgAction);
+  TJclOTAActionExpert.UnregisterAction(FGenerateJdbgAction);
+  TJclOTAActionExpert.UnregisterAction(FDebugExpertAction);
   FDeleteMapFileAction.Free;
   FInsertJdbgAction.Free;
   FGenerateJdbgAction.Free;

Modified: trunk/jcl/experts/debug/simdview/JclSIMDView.pas
===================================================================
--- trunk/jcl/experts/debug/simdview/JclSIMDView.pas	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/experts/debug/simdview/JclSIMDView.pas	2012-01-22 22:54:36 UTC (rev 3702)
@@ -41,7 +41,7 @@
   JclUnitVersioning,
   {$ENDIF UNITVERSIONING}
   JclSysInfo,
-  JclOtaUtils, JclSIMDViewForm;
+  JclOtaUtils, JclOtaActions, JclSIMDViewForm;
 
 {$R 'JclSIMDIcon.dcr'}
 
@@ -342,7 +342,7 @@
 
   FViewDebugMenu.Add(FSIMDMenuItem);
 
-  RegisterAction(FSIMDAction);
+  TJclOTAActionExpert.RegisterAction(FSIMDAction);
 
   FDebuggerNotifier := TJclDebuggerNotifier.Create(Self);
   FIndex := DebuggerServices.AddNotifier(FDebuggerNotifier);
@@ -352,7 +352,7 @@
 begin
   inherited UnregisterCommands;
 
-  UnregisterAction(FSIMDAction);
+  TJclOTAActionExpert.UnregisterAction(FSIMDAction);
   FreeAndNil(FIcon);
   FreeAndNil(FSIMDMenuItem);
   FreeAndNil(FSIMDAction);

Modified: trunk/jcl/experts/projectanalyzer/JclProjectAnalyzerImpl.pas
===================================================================
--- trunk/jcl/experts/projectanalyzer/JclProjectAnalyzerImpl.pas	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/experts/projectanalyzer/JclProjectAnalyzerImpl.pas	2012-01-22 22:54:36 UTC (rev 3702)
@@ -34,7 +34,7 @@
   {$IFDEF UNITVERSIONING}
   JclUnitVersioning,
   {$ENDIF UNITVERSIONING}
-  JclOtaUtils, JclProjectAnalyzerFrm;
+  JclOtaUtils, JclOtaActions, JclProjectAnalyzerFrm;
 
 type
   TJclProjectAnalyzerExpert = class(TJclOTAExpert)
@@ -378,7 +378,7 @@
         if Assigned(Items[I].Action) then
           FBuildAction.Category := TContainedAction(Items[I].Action).Category;
         FBuildAction.ActionList := IDEActionList;
-        RegisterAction(FBuildAction);
+        TJclOTAActionExpert.RegisterAction(FBuildAction);
         FBuildMenuItem := TMenuItem.Create(nil);
         FBuildMenuItem.Name := JclProjectAnalyzeMenuName;
         FBuildMenuItem.Action := FBuildAction;
@@ -407,7 +407,7 @@
   {$ENDIF BDS4_UP}
   {$ENDIF ~BDS7_UP}
 
-  UnregisterAction(FBuildAction);
+  TJclOTAActionExpert.UnregisterAction(FBuildAction);
   FreeAndNil(FBuildMenuItem);
   FreeAndNil(FBuildAction);
 end;

Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas	2012-01-22 22:54:36 UTC (rev 3702)
@@ -47,7 +47,8 @@
   {$ELSE ~BDS}
   JclStackTraceViewerMainFormDelphi,
   {$ENDIF ~BDS}
-  JclOtaUtils, JclStackTraceViewerConfigFrame, JclStackTraceViewerOptions;
+  JclOtaUtils, JclOtaActions,
+  JclStackTraceViewerConfigFrame, JclStackTraceViewerOptions;
 
 type
   {$IFDEF BDS8_UP}
@@ -367,7 +368,7 @@
 
   ViewMenu.Insert(ViewDebugMenuIdx + 1, FStackTraceViewMenuItem);
 
-  RegisterAction(FStackTraceViewAction);
+  TJclOTAActionExpert.RegisterAction(FStackTraceViewAction);
 end;
 
 procedure TJclStackTraceViewerExpert.SaveExpertValues;
@@ -380,7 +381,7 @@
 begin
   inherited UnregisterCommands;
   SaveExpertValues;
-  UnregisterAction(FStackTraceViewAction);
+  TJclOTAActionExpert.UnregisterAction(FStackTraceViewAction);
   FreeAndNil(FIcon);
   FreeAndNil(FStackTraceViewMenuItem);
   FreeAndNil(FStackTraceViewAction);

Modified: trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas
===================================================================
--- trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas	2012-01-22 22:54:36 UTC (rev 3702)
@@ -40,7 +40,8 @@
   JclUnitVersioning,
   {$ENDIF UNITVERSIONING}
   JclVersionControl,
-  JclOtaUtils, JclVersionCtrlCommonOptions;
+  JclOtaUtils, JclOtaActions,
+  JclVersionCtrlCommonOptions;
 
 type
   TJclVersionControlStandardAction = class(TCustomAction)
@@ -1160,7 +1161,7 @@
     AAction.OnExecute := ActionExecute;
     AAction.OnUpdate := ActionUpdate;
     AAction.Category := LoadResString(@RsActionCategory);
-    RegisterAction(AAction);
+    TJclOTAActionExpert.RegisterAction(AAction);
     FActions[ControlAction] := AAction;
   end;
 
@@ -1289,7 +1290,7 @@
 
   for ControlAction := Low(TJclVersionControlActionType) to High(TJclVersionControlActionType) do
   begin
-    UnregisterAction(FActions[ControlAction]);
+    TJclOTAActionExpert.UnregisterAction(FActions[ControlAction]);
     if FActions[ControlAction] is TDropDownAction then
     begin
       ADropDownAction := TDropDownAction(FActions[ControlAction]);

Modified: trunk/jcl/packages/c6/JclBaseExpert.bpk
===================================================================
--- trunk/jcl/packages/c6/JclBaseExpert.bpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/c6/JclBaseExpert.bpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -5,7 +5,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:44 UTC
+     Last generated: 22-01-2012  22:48:58 UTC
 *****************************************************************************
 -->
 <PROJECT>
@@ -21,6 +21,7 @@
       ..\..\lib\c6\JclOtaExceptionForm.obj
       ..\..\lib\c6\JclOtaConfigurationForm.obj
       ..\..\lib\c6\JclOtaActionConfigureSheet.obj
+      ..\..\lib\c6\JclOtaActions.obj
       ..\..\lib\c6\JclOtaUnitVersioningSheet.obj
       ..\..\lib\c6\JclOtaUnitVersioning.obj
       ..\..\lib\c6\JclOtaWizardForm.obj
@@ -98,6 +99,7 @@
       <FILE FILENAME="..\..\experts\common\JclOtaExceptionForm.pas" FORMNAME="JclExpertExceptionForm" UNITNAME="JclOtaExceptionForm" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
       <FILE FILENAME="..\..\experts\common\JclOtaConfigurationForm.pas" FORMNAME="JclOtaOptionsForm" UNITNAME="JclOtaConfigurationForm" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
       <FILE FILENAME="..\..\experts\common\JclOtaActionConfigureSheet.pas" FORMNAME="JclOtaActionConfigureFrame" UNITNAME="JclOtaActionConfigureSheet" CONTAINERID="PascalCompiler" DESIGNCLASS="TFrame" LOCALCOMMAND=""/>
+      <FILE FILENAME="..\..\experts\common\JclOtaActions.pas" FORMNAME="" UNITNAME="JclOtaActions" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
       <FILE FILENAME="..\..\experts\common\JclOtaUnitVersioningSheet.pas" FORMNAME="JclOtaUnitVersioningFrame" UNITNAME="JclOtaUnitVersioningSheet" CONTAINERID="PascalCompiler" DESIGNCLASS="TFrame" LOCALCOMMAND=""/>
       <FILE FILENAME="..\..\experts\common\JclOtaUnitVersioning.pas" FORMNAME="" UNITNAME="JclOtaUnitVersioning" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
       <FILE FILENAME="..\..\experts\common\JclOtaWizardForm.pas" FORMNAME="JclWizardForm" UNITNAME="JclOtaWizardForm" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>

Modified: trunk/jcl/packages/c6/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/c6/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/c6/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:44 UTC
+     Last generated: 22-01-2012  22:48:58 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -57,6 +57,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/cs1/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/cs1/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/cs1/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:44 UTC
+     Last generated: 22-01-2012  22:48:58 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -56,6 +56,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/d10/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d10/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d10/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:44 UTC
+     Last generated: 22-01-2012  22:48:59 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -58,6 +58,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/d11/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d11/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d11/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:45 UTC
+     Last generated: 22-01-2012  22:48:59 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -59,6 +59,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/d11/JclBaseExpert.dproj
===================================================================
--- trunk/jcl/packages/d11/JclBaseExpert.dproj	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d11/JclBaseExpert.dproj	2012-01-22 22:54:36 UTC (rev 3702)
@@ -98,6 +98,7 @@
     <DCCReference Include="..\..\experts\common\JclOtaExceptionForm.pas"/>
     <DCCReference Include="..\..\experts\common\JclOtaConfigurationForm.pas"/>
     <DCCReference Include="..\..\experts\common\JclOtaActionConfigureSheet.pas"/>
+    <DCCReference Include="..\..\experts\common\JclOtaActions.pas"/>
     <DCCReference Include="..\..\experts\common\JclOtaUnitVersioningSheet.pas"/>
     <DCCReference Include="..\..\experts\common\JclOtaUnitVersioning.pas"/>
     <DCCReference Include="..\..\experts\common\JclOtaWizardForm.pas"/>

Modified: trunk/jcl/packages/d12/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d12/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d12/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:45 UTC
+     Last generated: 22-01-2012  22:48:59 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -58,6 +58,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/d12/JclBaseExpert.dproj
===================================================================
--- trunk/jcl/packages/d12/JclBaseExpert.dproj	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d12/JclBaseExpert.dproj	2012-01-22 22:54:36 UTC (rev 3702)
@@ -73,6 +73,7 @@
 			<DCCReference Include="..\..\experts\common\JclOtaExceptionForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaConfigurationForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaActionConfigureSheet.pas"/>
+			<DCCReference Include="..\..\experts\common\JclOtaActions.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioningSheet.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioning.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardForm.pas"/>

Modified: trunk/jcl/packages/d14/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d14/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d14/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:45 UTC
+     Last generated: 22-01-2012  22:48:59 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -58,6 +58,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/d14/JclBaseExpert.dproj
===================================================================
--- trunk/jcl/packages/d14/JclBaseExpert.dproj	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d14/JclBaseExpert.dproj	2012-01-22 22:54:36 UTC (rev 3702)
@@ -75,6 +75,7 @@
 			<DCCReference Include="..\..\experts\common\JclOtaExceptionForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaConfigurationForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaActionConfigureSheet.pas"/>
+			<DCCReference Include="..\..\experts\common\JclOtaActions.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioningSheet.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioning.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardForm.pas"/>

Modified: trunk/jcl/packages/d15/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d15/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d15/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:45 UTC
+     Last generated: 22-01-2012  22:48:59 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -57,6 +57,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/d15/JclBaseExpert.dproj
===================================================================
--- trunk/jcl/packages/d15/JclBaseExpert.dproj	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d15/JclBaseExpert.dproj	2012-01-22 22:54:36 UTC (rev 3702)
@@ -82,6 +82,7 @@
 			<DCCReference Include="..\..\experts\common\JclOtaExceptionForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaConfigurationForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaActionConfigureSheet.pas"/>
+			<DCCReference Include="..\..\experts\common\JclOtaActions.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioningSheet.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioning.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardForm.pas"/>

Modified: trunk/jcl/packages/d16/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d16/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d16/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:45 UTC
+     Last generated: 22-01-2012  22:48:59 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -57,6 +57,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/d16/JclBaseExpert.dproj
===================================================================
--- trunk/jcl/packages/d16/JclBaseExpert.dproj	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d16/JclBaseExpert.dproj	2012-01-22 22:54:36 UTC (rev 3702)
@@ -116,6 +116,7 @@
 			<DCCReference Include="..\..\experts\common\JclOtaExceptionForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaConfigurationForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaActionConfigureSheet.pas"/>
+			<DCCReference Include="..\..\experts\common\JclOtaActions.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioningSheet.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioning.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardForm.pas"/>

Modified: trunk/jcl/packages/d6/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d6/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d6/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:44 UTC
+     Last generated: 22-01-2012  22:48:58 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -57,6 +57,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/d7/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d7/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d7/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:44 UTC
+     Last generated: 22-01-2012  22:48:58 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -57,6 +57,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/d8/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d8/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d8/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:44 UTC
+     Last generated: 22-01-2012  22:48:58 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -56,6 +56,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/d9/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d9/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/d9/JclBaseExpert.dpk	2012-01-22 22:54:36 UTC (rev 3702)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 22-01-2012  21:51:44 UTC
+     Last generated: 22-01-2012  22:48:58 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -57,6 +57,7 @@
   JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm},
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
+  JclOtaActions in '..\..\experts\common\JclOtaActions.pas' ,
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
   JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},

Modified: trunk/jcl/packages/xml/JclBaseExpert-D.xml
===================================================================
--- trunk/jcl/packages/xml/JclBaseExpert-D.xml	2012-01-22 21:54:47 UTC (rev 3701)
+++ trunk/jcl/packages/xml/JclBaseExpert-D.xml	2012-01-22 22:54:36 UTC (rev 3702)
@@ -22,6 +22,7 @@
     <File Name="..\..\experts\common\JclOtaExceptionForm.pas" Targets="designtimeIDE" Formname="JclExpertExceptionForm" Condition=""/>
     <File Name="..\..\experts\common\JclOtaConfigurationForm.pas" Targets="designtimeIDE" Formname="JclOtaOptionsForm" Condition=""/>
     <File Name="..\..\experts\common\JclOtaActionConfigureSheet.pas" Targets="designtimeIDE" Formname="JclOtaActionConfigureFrame: TFrame" Condition=""/>
+    <File Name="..\..\experts\common\JclOtaActions.pas" Targets="designtimeIDE" Formname="" Condition=""/>
     <File Name="..\..\experts\common\JclOtaUnitVersioningSheet.pas" Targets="designtimeIDE" Formname="JclOtaUnitVersioningFrame: TFrame" Condition=""/>
     <File Name="..\..\experts\common\JclOtaUnitVersioning.pas" Targets="designtimeIDE" Formname="" Condition=""/>
     <File Name="..\..\experts\common\JclOtaWizardForm.pas" Targets="designtimeIDE" Formname="JclWizardForm" Condition=""/>

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3701] trunk/jcl

From: <ou...@us...> - 2012-01-22 21:54:54

Revision: 3701
          http://jcl.svn.sourceforge.net/jcl/?rev=3701&view=rev
Author:   outchy
Date:     2012-01-22 21:54:47 +0000 (Sun, 22 Jan 2012)
Log Message:
-----------
Refactoring of the unitversioning related stuff to a separate expert in same package JclBaseExpert.

Modified Paths:
--------------
    trunk/jcl/experts/common/JclOtaConsts.pas
    trunk/jcl/experts/common/JclOtaUtils.pas
    trunk/jcl/packages/c6/JclBaseExpert.bpk
    trunk/jcl/packages/c6/JclBaseExpert.dpk
    trunk/jcl/packages/cs1/JclBaseExpert.dpk
    trunk/jcl/packages/d10/JclBaseExpert.dpk
    trunk/jcl/packages/d11/JclBaseExpert.dpk
    trunk/jcl/packages/d11/JclBaseExpert.dproj
    trunk/jcl/packages/d12/JclBaseExpert.dpk
    trunk/jcl/packages/d12/JclBaseExpert.dproj
    trunk/jcl/packages/d14/JclBaseExpert.dpk
    trunk/jcl/packages/d14/JclBaseExpert.dproj
    trunk/jcl/packages/d15/JclBaseExpert.dpk
    trunk/jcl/packages/d15/JclBaseExpert.dproj
    trunk/jcl/packages/d16/JclBaseExpert.dpk
    trunk/jcl/packages/d16/JclBaseExpert.dproj
    trunk/jcl/packages/d6/JclBaseExpert.dpk
    trunk/jcl/packages/d7/JclBaseExpert.dpk
    trunk/jcl/packages/d8/JclBaseExpert.dpk
    trunk/jcl/packages/d9/JclBaseExpert.dpk
    trunk/jcl/packages/xml/JclBaseExpert-D.xml

Added Paths:
-----------
    trunk/jcl/experts/common/JclOtaUnitVersioning.pas

Modified: trunk/jcl/experts/common/JclOtaConsts.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaConsts.pas	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/experts/common/JclOtaConsts.pas	2012-01-22 21:54:47 UTC (rev 3701)
@@ -69,6 +69,9 @@
   JclConfigureActionName = 'JCLConfigureCommand';
   JclConfigureMenuName   = 'JCLConfigureMenu';
 
+  //=== Unit Versioning Expert ===============================================
+  JclUnitVersioningExpertName   = 'JclUnitVersioningExpert';
+
   //=== Debug Expert =========================================================
   JclDebugExpertRegKey          = 'JclDebugExpert';
   JclDebugEnabledRegValue       = 'JclDebugEnabled';

Copied: trunk/jcl/experts/common/JclOtaUnitVersioning.pas (from rev 3700, trunk/jcl/experts/common/JclOtaUtils.pas)
===================================================================
--- trunk/jcl/experts/common/JclOtaUnitVersioning.pas	                        (rev 0)
+++ trunk/jcl/experts/common/JclOtaUnitVersioning.pas	2012-01-22 21:54:47 UTC (rev 3701)
@@ -0,0 +1,112 @@
+{**************************************************************************************************}
+{                                                                                                  }
+{ Project JEDI Code Library (JCL)                                                                  }
+{                                                                                                  }
+{ 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/                                                           }
+{                                                                                                  }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
+{ and limitations under the License.                                                               }
+{                                                                                                  }
+{ The Original Code is JclOtaUtils.pas.                                                            }
+{                                                                                                  }
+{ The Initial Developer of the Original Code is Petr Vones.                                        }
+{ Portions created by Petr Vones are Copyright (C) of Petr Vones.                                  }
+{                                                                                                  }
+{ Contributors:                                                                                    }
+{   Florent Ouchet (outchy)                                                                        }
+{                                                                                                  }
+{**************************************************************************************************}
+{                                                                                                  }
+{ Last modified: $Date::                                                                         $ }
+{ Revision:      $Rev::                                                                          $ }
+{ Author:        $Author::                                                                       $ }
+{                                                                                                  }
+{**************************************************************************************************}
+
+unit JclOtaUnitVersioning;
+
+interface
+
+{$I jcl.inc}
+{$I crossplatform.inc}
+
+uses
+  SysUtils, Classes, Windows,
+  Controls,
+  JclBase,
+  {$IFDEF UNITVERSIONING}
+  JclUnitVersioning,
+  {$ENDIF UNITVERSIONING}
+  JclOTAUtils;
+
+type
+  TJclOTAUnitVersioningExpert = class(TJclOTAExpert)
+  private
+    FUnitVersioningSheet: TControl;
+  public
+    constructor Create; reintroduce;
+    { IJclOTAOptionsCallback }
+    procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
+    procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
+  end;
+
+{$IFDEF UNITVERSIONING}
+const
+  UnitVersioning: TUnitVersionInfo = (
+    RCSfile: '$URL$';
+    Revision: '$Revision$';
+    Date: '$Date$';
+    LogPath: 'JCL\experts\common';
+    Extra: '';
+    Data: nil
+    );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+  Forms,
+  JclOtaConsts, JclOtaResources,
+  JclOtaUnitVersioningSheet;
+
+//=== { TJclOTAUnitVersioningExpert } ========================================
+
+constructor TJclOTAUnitVersioningExpert.Create;
+begin
+  inherited Create(JclUnitVersioningExpertName);
+end;
+
+procedure TJclOTAUnitVersioningExpert.AddConfigurationPages(
+  AddPageFunc: TJclOTAAddPageFunc);
+begin
+  // AddPageFunc uses '\' as a separator in PageName to build a tree
+  if not Assigned(FUnitVersioningSheet) then
+  begin
+    FUnitVersioningSheet := TJclOtaUnitVersioningFrame.Create(Application);
+    AddPageFunc(FUnitVersioningSheet, LoadResString(@RsUnitVersioningSheet), Self);
+  end;
+  // override to customize
+end;
+
+procedure TJclOTAUnitVersioningExpert.ConfigurationClosed(AControl: TControl;
+  SaveChanges: Boolean);
+begin
+  if Assigned(AControl) and (AControl = FUnitVersioningSheet) then
+    FreeAndNil(FUnitVersioningSheet)
+  else
+    inherited ConfigurationClosed(AControl, SaveChanges);
+  // override to customize
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+  RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+  UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.

Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/experts/common/JclOtaUtils.pas	2012-01-22 21:54:47 UTC (rev 3701)
@@ -300,6 +300,14 @@
 var
   JclDisablePostCompilationProcess: Boolean = False;
 
+// design package entry point
+procedure Register;
+
+// expert DLL entry point
+function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
+  RegisterProc: TWizardRegisterProc;
+  var TerminateProc: TWizardTerminateProc): Boolean; stdcall;
+
 {$IFDEF UNITVERSIONING}
 const
   UnitVersioning: TUnitVersionInfo = (
@@ -326,19 +334,61 @@
   {$ENDIF BDS8_UP}
   JclFileUtils, JclStrings, JclSysInfo, JclSimpleXml, JclCompilerUtils,
   JclOtaConsts, JclOtaResources, JclOtaExceptionForm, JclOtaConfigurationForm,
-  JclOtaActionConfigureSheet, JclOtaUnitVersioningSheet,
-  JclOtaWizardForm, JclOtaWizardFrame;
+  JclOtaActionConfigureSheet,
+  JclOtaWizardForm, JclOtaWizardFrame,
+  JclOTAUnitVersioning;
 
 {$R 'JclImages.res'}
 
 var
+  JCLUnitVersioningWizardIndex: Integer = -1;
+
+procedure Register;
+begin
+  try
+    RegisterPackageWizard(TJclOTAUnitVersioningExpert.Create);
+  except
+    on ExceptionObj: TObject do
+      JclExpertShowExceptionDialog(ExceptionObj);
+  end;
+end;
+
+procedure JclWizardTerminate;
+begin
+  try
+    if JCLUnitVersioningWizardIndex <> -1 then
+      TJclOTAExpertBase.GetOTAWizardServices.RemoveWizard(JCLUnitVersioningWizardIndex);
+  except
+    on ExceptionObj: TObject do
+      JclExpertShowExceptionDialog(ExceptionObj);
+  end;
+end;
+
+function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
+  RegisterProc: TWizardRegisterProc; var TerminateProc: TWizardTerminateProc): Boolean stdcall;
+begin
+  try
+    TerminateProc := JclWizardTerminate;
+
+    JCLUnitVersioningWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.AddWizard(TJclOTAUnitVersioningExpert.Create);
+
+    Result := True;
+  except
+    on ExceptionObj: TObject do
+    begin
+      JclExpertShowExceptionDialog(ExceptionObj);
+      Result := False;
+    end;
+  end;
+end;
+
+var
   GlobalActionList: TList = nil;
   GlobalActionSettings: TJclOtaSettings = nil;
   GlobalExpertList: TList = nil;
   ConfigurationAction: TAction = nil;
   ConfigurationMenuItem: TMenuItem = nil;
   ActionConfigureSheet: TJclOtaActionConfigureFrame = nil;
-  UnitVersioningSheet: TJclOtaUnitVersioningFrame = nil;
 
 function FindActions(const Name: string): TComponent;
 var
@@ -992,11 +1042,6 @@
     ActionConfigureSheet := TJclOtaActionConfigureFrame.Create(Application);
     AddPageFunc(ActionConfigureSheet, LoadResString(@RsActionSheet), Self);
   end;
-  if not Assigned(UnitVersioningSheet) then
-  begin
-    UnitVersioningSheet := TJclOtaUnitVersioningFrame.Create(Application);
-    AddPageFunc(UnitVersioningSheet, LoadResString(@RsUnitVersioningSheet), Self);
-  end;
   // override to customize
 end;
 
@@ -1010,9 +1055,6 @@
     FreeAndNil(ActionConfigureSheet);
   end
   else
-  if Assigned(AControl) and (AControl = UnitVersioningSheet) then
-    FreeAndNil(UnitVersioningSheet)
-  else
     AControl.Free;
   // override to customize
 end;

Modified: trunk/jcl/packages/c6/JclBaseExpert.bpk
===================================================================
--- trunk/jcl/packages/c6/JclBaseExpert.bpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/c6/JclBaseExpert.bpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -5,7 +5,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 07-05-2010  18:24:22 UTC
+     Last generated: 22-01-2012  21:51:44 UTC
 *****************************************************************************
 -->
 <PROJECT>
@@ -22,6 +22,7 @@
       ..\..\lib\c6\JclOtaConfigurationForm.obj
       ..\..\lib\c6\JclOtaActionConfigureSheet.obj
       ..\..\lib\c6\JclOtaUnitVersioningSheet.obj
+      ..\..\lib\c6\JclOtaUnitVersioning.obj
       ..\..\lib\c6\JclOtaWizardForm.obj
       ..\..\lib\c6\JclOtaWizardFrame.obj
     "/>
@@ -98,6 +99,7 @@
       <FILE FILENAME="..\..\experts\common\JclOtaConfigurationForm.pas" FORMNAME="JclOtaOptionsForm" UNITNAME="JclOtaConfigurationForm" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
       <FILE FILENAME="..\..\experts\common\JclOtaActionConfigureSheet.pas" FORMNAME="JclOtaActionConfigureFrame" UNITNAME="JclOtaActionConfigureSheet" CONTAINERID="PascalCompiler" DESIGNCLASS="TFrame" LOCALCOMMAND=""/>
       <FILE FILENAME="..\..\experts\common\JclOtaUnitVersioningSheet.pas" FORMNAME="JclOtaUnitVersioningFrame" UNITNAME="JclOtaUnitVersioningSheet" CONTAINERID="PascalCompiler" DESIGNCLASS="TFrame" LOCALCOMMAND=""/>
+      <FILE FILENAME="..\..\experts\common\JclOtaUnitVersioning.pas" FORMNAME="" UNITNAME="JclOtaUnitVersioning" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
       <FILE FILENAME="..\..\experts\common\JclOtaWizardForm.pas" FORMNAME="JclWizardForm" UNITNAME="JclOtaWizardForm" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
       <FILE FILENAME="..\..\experts\common\JclOtaWizardFrame.pas" FORMNAME="JclWizardFrame" UNITNAME="JclOtaWizardFrame" CONTAINERID="PascalCompiler" DESIGNCLASS="TFrame" LOCALCOMMAND=""/>
   </FILELIST>

Modified: trunk/jcl/packages/c6/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/c6/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/c6/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 07-05-2010  18:24:22 UTC
+     Last generated: 22-01-2012  21:51:44 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -58,6 +58,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame}
   ;

Modified: trunk/jcl/packages/cs1/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/cs1/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/cs1/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 07-05-2010  18:24:26 UTC
+     Last generated: 22-01-2012  21:51:44 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -57,6 +57,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame}
   ;

Modified: trunk/jcl/packages/d10/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d10/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d10/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 07-05-2010  18:24:27 UTC
+     Last generated: 22-01-2012  21:51:44 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -59,6 +59,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame}
   ;

Modified: trunk/jcl/packages/d11/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d11/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d11/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 07-05-2010  18:24:27 UTC
+     Last generated: 22-01-2012  21:51:45 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -60,6 +60,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame}
   ;

Modified: trunk/jcl/packages/d11/JclBaseExpert.dproj
===================================================================
--- trunk/jcl/packages/d11/JclBaseExpert.dproj	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d11/JclBaseExpert.dproj	2012-01-22 21:54:47 UTC (rev 3701)
@@ -99,6 +99,7 @@
     <DCCReference Include="..\..\experts\common\JclOtaConfigurationForm.pas"/>
     <DCCReference Include="..\..\experts\common\JclOtaActionConfigureSheet.pas"/>
     <DCCReference Include="..\..\experts\common\JclOtaUnitVersioningSheet.pas"/>
+    <DCCReference Include="..\..\experts\common\JclOtaUnitVersioning.pas"/>
     <DCCReference Include="..\..\experts\common\JclOtaWizardForm.pas"/>
     <DCCReference Include="..\..\experts\common\JclOtaWizardFrame.pas"/>
   </ItemGroup>

Modified: trunk/jcl/packages/d12/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d12/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d12/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 07-05-2010  18:24:28 UTC
+     Last generated: 22-01-2012  21:51:45 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -59,6 +59,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame}
   ;

Modified: trunk/jcl/packages/d12/JclBaseExpert.dproj
===================================================================
--- trunk/jcl/packages/d12/JclBaseExpert.dproj	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d12/JclBaseExpert.dproj	2012-01-22 21:54:47 UTC (rev 3701)
@@ -74,6 +74,7 @@
 			<DCCReference Include="..\..\experts\common\JclOtaConfigurationForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaActionConfigureSheet.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioningSheet.pas"/>
+			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioning.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardFrame.pas"/>
 			<BuildConfiguration Include="Base">

Modified: trunk/jcl/packages/d14/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d14/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d14/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 07-05-2010  18:24:29 UTC
+     Last generated: 22-01-2012  21:51:45 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -59,6 +59,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame}
   ;

Modified: trunk/jcl/packages/d14/JclBaseExpert.dproj
===================================================================
--- trunk/jcl/packages/d14/JclBaseExpert.dproj	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d14/JclBaseExpert.dproj	2012-01-22 21:54:47 UTC (rev 3701)
@@ -76,6 +76,7 @@
 			<DCCReference Include="..\..\experts\common\JclOtaConfigurationForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaActionConfigureSheet.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioningSheet.pas"/>
+			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioning.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardFrame.pas"/>
 			<BuildConfiguration Include="Base">

Modified: trunk/jcl/packages/d15/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d15/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d15/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 01-08-2010  21:03:32 UTC
+     Last generated: 22-01-2012  21:51:45 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -58,6 +58,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame},
   JclOtaAddinOptions in '..\..\experts\common\JclOtaAddinOptions.pas' ,

Modified: trunk/jcl/packages/d15/JclBaseExpert.dproj
===================================================================
--- trunk/jcl/packages/d15/JclBaseExpert.dproj	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d15/JclBaseExpert.dproj	2012-01-22 21:54:47 UTC (rev 3701)
@@ -83,6 +83,7 @@
 			<DCCReference Include="..\..\experts\common\JclOtaConfigurationForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaActionConfigureSheet.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioningSheet.pas"/>
+			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioning.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardFrame.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaAddinOptions.pas"/>

Modified: trunk/jcl/packages/d16/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d16/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d16/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 04-03-2011  00:53:41 UTC
+     Last generated: 22-01-2012  21:51:45 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -58,6 +58,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame},
   JclOtaAddinOptions in '..\..\experts\common\JclOtaAddinOptions.pas' ,

Modified: trunk/jcl/packages/d16/JclBaseExpert.dproj
===================================================================
--- trunk/jcl/packages/d16/JclBaseExpert.dproj	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d16/JclBaseExpert.dproj	2012-01-22 21:54:47 UTC (rev 3701)
@@ -117,6 +117,7 @@
 			<DCCReference Include="..\..\experts\common\JclOtaConfigurationForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaActionConfigureSheet.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioningSheet.pas"/>
+			<DCCReference Include="..\..\experts\common\JclOtaUnitVersioning.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardForm.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaWizardFrame.pas"/>
 			<DCCReference Include="..\..\experts\common\JclOtaAddinOptions.pas"/>

Modified: trunk/jcl/packages/d6/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d6/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d6/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 07-05-2010  18:24:24 UTC
+     Last generated: 22-01-2012  21:51:44 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -58,6 +58,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame}
   ;

Modified: trunk/jcl/packages/d7/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d7/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d7/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 07-05-2010  18:24:24 UTC
+     Last generated: 22-01-2012  21:51:44 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -58,6 +58,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame}
   ;

Modified: trunk/jcl/packages/d8/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d8/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d8/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 07-05-2010  18:24:26 UTC
+     Last generated: 22-01-2012  21:51:44 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -57,6 +57,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame}
   ;

Modified: trunk/jcl/packages/d9/JclBaseExpert.dpk
===================================================================
--- trunk/jcl/packages/d9/JclBaseExpert.dpk	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/d9/JclBaseExpert.dpk	2012-01-22 21:54:47 UTC (rev 3701)
@@ -4,7 +4,7 @@
      DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
             ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml)
 
-     Last generated: 07-05-2010  18:24:26 UTC
+     Last generated: 22-01-2012  21:51:44 UTC
 -----------------------------------------------------------------------------
 }
 
@@ -58,6 +58,7 @@
   JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm},
   JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame: TFrame},
   JclOtaUnitVersioningSheet in '..\..\experts\common\JclOtaUnitVersioningSheet.pas' {JclOtaUnitVersioningFrame: TFrame},
+  JclOtaUnitVersioning in '..\..\experts\common\JclOtaUnitVersioning.pas' ,
   JclOtaWizardForm in '..\..\experts\common\JclOtaWizardForm.pas' {JclWizardForm},
   JclOtaWizardFrame in '..\..\experts\common\JclOtaWizardFrame.pas' {JclWizardFrame: TFrame}
   ;

Modified: trunk/jcl/packages/xml/JclBaseExpert-D.xml
===================================================================
--- trunk/jcl/packages/xml/JclBaseExpert-D.xml	2012-01-22 14:45:29 UTC (rev 3700)
+++ trunk/jcl/packages/xml/JclBaseExpert-D.xml	2012-01-22 21:54:47 UTC (rev 3701)
@@ -23,6 +23,7 @@
     <File Name="..\..\experts\common\JclOtaConfigurationForm.pas" Targets="designtimeIDE" Formname="JclOtaOptionsForm" Condition=""/>
     <File Name="..\..\experts\common\JclOtaActionConfigureSheet.pas" Targets="designtimeIDE" Formname="JclOtaActionConfigureFrame: TFrame" Condition=""/>
     <File Name="..\..\experts\common\JclOtaUnitVersioningSheet.pas" Targets="designtimeIDE" Formname="JclOtaUnitVersioningFrame: TFrame" Condition=""/>
+    <File Name="..\..\experts\common\JclOtaUnitVersioning.pas" Targets="designtimeIDE" Formname="" Condition=""/>
     <File Name="..\..\experts\common\JclOtaWizardForm.pas" Targets="designtimeIDE" Formname="JclWizardForm" Condition=""/>
     <File Name="..\..\experts\common\JclOtaWizardFrame.pas" Targets="designtimeIDE" Formname="JclWizardFrame: TFrame" Condition=""/>
     <File Name="..\..\experts\common\JclOtaAddinOptions.pas" Targets="d15,d16" Formname="" Condition=""/>

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3700] trunk/jcl/source/vcl/JclVersionCtrlSVNImpl.pas

From: <ou...@us...> - 2012-01-22 14:45:36

Revision: 3700
          http://jcl.svn.sourceforge.net/jcl/?rev=3700&view=rev
Author:   outchy
Date:     2012-01-22 14:45:29 +0000 (Sun, 22 Jan 2012)
Log Message:
-----------
Mantis 5701: JCL Version Control Integration doesn't work with SVN 1.7 anymore.

Modified Paths:
--------------
    trunk/jcl/source/vcl/JclVersionCtrlSVNImpl.pas

Modified: trunk/jcl/source/vcl/JclVersionCtrlSVNImpl.pas
===================================================================
--- trunk/jcl/source/vcl/JclVersionCtrlSVNImpl.pas	2012-01-22 12:19:57 UTC (rev 3699)
+++ trunk/jcl/source/vcl/JclVersionCtrlSVNImpl.pas	2012-01-22 14:45:29 UTC (rev 3700)
@@ -46,6 +46,7 @@
   TSvnDirVersion = (sdvNone, sdv10, sdv17);
   TJclVersionControlSVN = class (TJclVersionControlPlugin)
   private
+    FSVNStatusCmd: string;
     FTortoiseSVNProc: string;
   protected
     function GetSupportedActionTypes: TJclVersionControlActionTypes; override;
@@ -79,11 +80,13 @@
 
 uses
   JclVclResources,
-  JclFileUtils, JclSysInfo, JclSysUtils, JclRegistry, JclStrings;
+  JclFileUtils, JclSysInfo, JclSysUtils, JclRegistry, JclStrings, JclSimpleXml;
 
 const
   JclVersionCtrlRegKeyName = 'SOFTWARE\TortoiseSVN';
   JclVersionCtrlRegValueName = 'ProcPath';
+  JclVersionCtrlSVNExeName = 'svn.exe';
+  
   JclVersionCtrlSVNAddVerb = 'add';
   JclVersionCtrlSVNBlameVerb = 'blame';
   JclVersionCtrlSVNBranchVerb = 'copy';
@@ -102,12 +105,22 @@
   JclVersionCtrlSVNUpdateVerb = 'update';
   JclVersionCtrlSVNUpdateToParam = '/rev';
   JclVersionCtrlSVNUnlockVerb = 'unlock';
+
 //  JclVersionCtrlSVNTortoiseDLL = 'TortoiseSVN.dll';
   JclVersionCtrlSVNDirectory1 = '.svn\';
   JclVersionCtrlSVNDirectory2 = '_svn\';
   JclVersionCtrlSVNEntryFile = 'entries';
   JclVersionCtrlSVNDbFile = 'wc.db';
 
+  JclVersionCtrlSVNStatusElementName = 'status';
+  JclVersionCtrlSVNTargetElementName = 'target';
+  JclVersionCtrlSVNEntryElementName = 'entry';
+  JclVersionCtrlSVNWCStatusElementName = 'wc-status';
+  //JclVersionCtrlSVNPropsPropertyName = 'props';
+  JclVersionCtrlSVNItemPropertyName = 'item';
+  JclVersionCtrlSVNPathPropertyName = 'path';
+  JclVersionCtrlSVNUnversionedPropertyValue = 'unversioned';
+
   JclVersionCtrlSVNDirectories: array [0..1] of string =
    ( JclVersionCtrlSVNDirectory1, JclVersionCtrlSVNDirectory2 );
 
@@ -134,6 +147,12 @@
   end
   else
     FTortoiseSVNProc := RegReadStringDef(HKLM, JclVersionCtrlRegKeyName, JclVersionCtrlRegValueName, '');
+
+  FSVNStatusCmd := PathAddSeparator(ExtractFilePath(FTortoiseSVNProc)) + JclVersionCtrlSVNExeName;
+  if FileExists(FSVNStatusCmd) then
+    FSVNStatusCmd := FSVNStatusCmd + ' status --xml --non-interactive --depth=empty --verbose '
+  else
+    FSVNStatusCmd := '';
 end;
 
 destructor TJclVersionControlSVN.Destroy;
@@ -238,33 +257,23 @@
   Result := FTortoiseSVNProc <> '';
 end;
 
-function TJclVersionControlSVN.GetFileActions(
-  const FileName: TFileName): TJclVersionControlActionTypes;
-var
-  EntryLine: string;
-  EntryFileName, UpperCaseFileName, XmlFileNameValue: TFileName;
-  Entries: TJclAnsiMappedTextReader;
-  IndexDir: Integer;
-  SupportedDirVersion: TSvnDirVersion;
-begin
-  Result := inherited GetFileActions(FileName);
+function TJclVersionControlSVN.GetFileActions(const FileName: TFileName): TJclVersionControlActionTypes;
 
-  if Enabled then
+  // internal method to get file actions (not complete and not compatible with SVN 1.7 wc
+  function GetSVNInternalFileActions(const FileName: TFileName; var Actions: TJclVersionControlActionTypes): Boolean;
+  var
+    EntryLine: string;
+    EntryFileName, UpperCaseFileName, XmlFileNameValue: TFileName;
+    Entries: TJclAnsiMappedTextReader;
+    IndexDir: Integer;
   begin
-    SupportedDirVersion := SVNSupportedDirVersion(ExtractFilePath(FileName));
-    if SupportedDirVersion = sdv17 then
-    begin
-      Result := GetSupportedActionTypes;
-      Exit;
-    end
-    else if SupportedDirVersion = sdvNone then
-      Exit;
-
     UpperCaseFileName := StrUpper(ExtractFileName(FileName));
     XmlFileNameValue := Format('NAME="%s"', [UpperCaseFileName]);
 
     for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do
     begin
+      Result := False;
+
       EntryFileName := PathAddSeparator(ExtractFilePath(FileName))
         + JclVersionCtrlSVNDirectories[IndexDir] + JclVersionCtrlSVNEntryFile;
 
@@ -278,8 +287,9 @@
             // old SVN entries file (xml-like)
             if Pos(XmlFileNameValue, StrUpper(EntryLine)) > 0 then
             begin
+              Result := True;
               // TODO: check modifications
-              Result := Result + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph,
+              Actions := Actions + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph,
                 vcaLog, vcaLock, vcaMerge, vcaRename, vcaRevert, vcaRepoBrowser,
                 vcaStatus, vcaTag, vcaUpdate, vcaUpdateTo, vcaUnlock];
               FreeAndNil(Entries);
@@ -291,8 +301,9 @@
               EntryLine := string(Entries.ReadLn);
               if StrSame(UpperCaseFileName, StrUpper(EntryLine)) then
               begin
+                Result := True;
                 // TODO: check modifications
-                Result := Result + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph,
+                Actions := Actions + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph,
                   vcaLog, vcaLock, vcaMerge, vcaRename, vcaRevert, vcaRepoBrowser,
                   vcaStatus, vcaTag, vcaUpdate, vcaUpdateTo, vcaUnlock];
                 FreeAndNil(Entries);
@@ -303,10 +314,87 @@
         finally
           Entries.Free;
         end;
-        Result := Result + [vcaAdd];
+        Actions := Actions + [vcaAdd];
       end;
     end;
   end;
+
+  // external method: rely on svn.exe to get file actions
+  function GetSVNExecutableFileActions(const FileName: TFileName; var Actions: TJclVersionControlActionTypes): Boolean;
+  var
+    SVNOutput, SVNError: string;
+    XML: TJclSimpleXML;
+    TargetElement, EntryElement, WcStatusElement: TJclSimpleXMLElem;
+    ItemProp: TJclSimpleXMLProp;
+  begin
+    Result := False;
+    if Execute(FSVNStatusCmd + FileName, SVNOutput, SVNError) <> 0 then
+      Exit;
+
+    XML := TJclSimpleXML.Create;
+    try
+      XML.LoadFromString(SVNOutput);
+      XML.Options := XML.Options - [sxoAutoCreate];
+      if XML.Root.Name <> JclVersionCtrlSVNStatusElementName then
+        Exit;
+
+      TargetElement := XML.Root.Items.ItemNamed[JclVersionCtrlSVNTargetElementName];
+      if not Assigned(TargetElement) then
+        Exit;
+
+      EntryElement := TargetElement.Items.ItemNamed[JclVersionCtrlSVNEntryElementName];
+      if not Assigned(EntryElement) then
+        Exit;
+
+      WcStatusElement := EntryElement.Items.ItemNamed[JclVersionCtrlSVNWcStatusElementName];
+      if not Assigned(WcStatusElement) then
+        Exit;
+
+      ItemProp := WcStatusElement.Properties.ItemNamed[JclVersionCtrlSVNItemPropertyName];
+      if not Assigned(ItemProp) then
+        Exit;
+
+      Result := True;
+
+      if ItemProp.Value = JclVersionCtrlSVNUnversionedPropertyValue then
+        Actions := Actions + [vcaAdd, vcaRepoBrowser, vcaStatus]
+      else
+        // TODO: check modifications
+        Actions := Actions + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph,
+          vcaLog, vcaLock, vcaMerge, vcaRename, vcaRevert, vcaRepoBrowser,
+          vcaStatus, vcaTag, vcaUpdate, vcaUpdateTo, vcaUnlock];
+    finally
+      XML.Free;
+    end;
+  end;
+
+var
+  Found: Boolean;
+  SupportedDirVersion: TSvnDirVersion;
+begin
+  Result := inherited GetFileActions(FileName);
+
+  Found := not Enabled;
+
+  // SVN 1.7 repos: invoke SVN to query the working copy
+  if (not Found) and (FSVNStatusCmd <> '') then
+    Found := GetSVNExecutableFileActions(FileName, Result);
+
+  // SVN 1.6 repos: direct queries on the working copy
+  if not Found then
+  begin
+    SupportedDirVersion := SVNSupportedDirVersion(ExtractFilePath(FileName));
+    if SupportedDirVersion = sdv17 then
+    begin
+      Result := GetSupportedActionTypes;
+      Exit;
+    end
+    else if SupportedDirVersion = sdvNone then
+      Exit;
+
+    //Found := GetSVNInternalFileActions(FileName, Result);
+    GetSVNInternalFileActions(FileName, Result);
+  end;
 end;
 
 function TJclVersionControlSVN.GetSVNBaseDir(const FileName: TFileName): string;
@@ -349,59 +437,206 @@
 
 function TJclVersionControlSVN.GetSandboxActions(
   const SdBxName: TFileName): TJclVersionControlActionTypes;
-var
-  SvnDirectory: string;
-  IndexDir: Integer;
-begin
-  Result := inherited GetSandboxActions(SdBxName);
 
-  if Enabled then
+  function GetSVNInternalSandboxActions(const SdBxName: TFileName; out Actions: TJclVersionControlActionTypes): Boolean;
+  var
+    SvnDirectory: string;
+    IndexDir: Integer;
   begin
+    Result := False;
+    // not in a sandbox
+    Actions := Actions + [vcaCheckOutSandbox];
+
     for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do
     begin
       SvnDirectory := sdBxName + JclVersionCtrlSVNDirectories[IndexDir];
 
       if DirectoryExists(SvnDirectory) then
       begin
-        Result := Result + [vcaAddSandbox, vcaBranchSandbox, vcaCommitSandbox,
+        Result := True;
+        Actions := Actions + [vcaAddSandbox, vcaBranchSandbox, vcaCommitSandbox,
           vcaLogSandbox, vcaLockSandbox, vcaMergeSandbox, vcaRevertSandbox,
           vcaStatusSandbox, vcaTagSandBox, vcaUpdateSandbox, vcaUpdateSandboxTo,
-          vcaUnlockSandbox];
+          vcaUnlockSandbox] - [vcaCheckOutSandbox];
         Exit;
       end;
     end;
+  end;
+
+  function GetSVNExecutableSandboxActions(const SdBxName: TFileName; out Actions: TJclVersionControlActionTypes): Boolean;
+  var
+    SVNOutput, SVNError: string;
+    XML: TJclSimpleXML;
+    TargetElement, EntryElement, WcStatusElement: TJclSimpleXMLElem;
+    ItemProp: TJclSimpleXMLProp;
+  begin
+    Result := False;
     // not in a sandbox
-    Result := Result + [vcaCheckOutSandbox];
+    Actions := Actions + [vcaCheckOutSandbox];
+
+    if Execute(FSVNStatusCmd + SdBxName, SVNOutput, SVNError) <> 0 then
+      Exit;
+
+    XML := TJclSimpleXML.Create;
+    try
+      XML.LoadFromString(SVNOutput);
+      XML.Options := XML.Options - [sxoAutoCreate];
+      if XML.Root.Name <> JclVersionCtrlSVNStatusElementName then
+        Exit;
+
+      TargetElement := XML.Root.Items.ItemNamed[JclVersionCtrlSVNTargetElementName];
+      if not Assigned(TargetElement) then
+        Exit;
+
+      EntryElement := TargetElement.Items.ItemNamed[JclVersionCtrlSVNEntryElementName];
+      if not Assigned(EntryElement) then
+        Exit;
+
+      WcStatusElement := EntryElement.Items.ItemNamed[JclVersionCtrlSVNWcStatusElementName];
+      if not Assigned(WcStatusElement) then
+        Exit;
+
+      ItemProp := WcStatusElement.Properties.ItemNamed[JclVersionCtrlSVNItemPropertyName];
+      if not Assigned(ItemProp) then
+        Exit;
+
+      if ItemProp.Value <> JclVersionCtrlSVNUnversionedPropertyValue then
+      begin
+        Result := True;
+        Actions := Actions + [vcaAddSandbox, vcaBranchSandbox, vcaCommitSandbox,
+          vcaLogSandbox, vcaLockSandbox, vcaMergeSandbox, vcaRevertSandbox,
+          vcaStatusSandbox, vcaTagSandBox, vcaUpdateSandbox, vcaUpdateSandboxTo,
+          vcaUnlockSandbox] - [vcaCheckOutSandbox];
+      end;
+    finally
+      XML.Free;
+    end;
   end;
+
+var
+  Found: Boolean;
+begin
+  Result := inherited GetSandboxActions(SdBxName);
+
+  Found := not Enabled;
+  if (not Found) and (FSVNStatusCmd <> '') then
+    Found := GetSVNExecutableSandboxActions(SdBxName, Result);
+  if not Found then
+    // Found := GetSVNInternalSandboxActions(SdBxName, Result);
+    GetSVNInternalSandboxActions(SdBxName, Result);
 end;
 
 function TJclVersionControlSVN.GetSandboxNames(const FileName: TFileName;
   SdBxNames: TStrings): Boolean;
-var
-  DirectoryName: string;
-  IndexDir, IndexFileName: Integer;
-begin
-  Result := True;
 
-  SdBxNames.BeginUpdate;
-  try
-    SdBxNames.Clear;
+  // internal method, not complete, not compatible with SVN 1.7
+  function GetSVNInternalSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean;
+  var
+    DirectoryName: string;
+    IndexDir, IndexFileName: Integer;
+  begin
+    SdBxNames.BeginUpdate;
+    try
+      SdBxNames.Clear;
 
-    if Enabled then
       for IndexFileName := Length(FileName) downto 1 do
         if FileName[IndexFileName] = DirDelimiter then
-    begin
-      DirectoryName := Copy(FileName, 1, IndexFileName);
-      for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do
       begin
-        if DirectoryExists(DirectoryName + JclVersionCtrlSVNDirectories[IndexDir]) then
-          SdBxNames.Add(DirectoryName);
+        DirectoryName := Copy(FileName, 1, IndexFileName);
+        for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do
+        begin
+          if DirectoryExists(DirectoryName + JclVersionCtrlSVNDirectories[IndexDir]) then
+            SdBxNames.Add(DirectoryName);
+        end;
       end;
+    finally
+      SdBxNames.EndUpdate;
     end;
-  finally
-    SdBxNames.EndUpdate;
+
+    Result := SdBxNames.Count > 0;
   end;
 
+  function GetSVNExecutableSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean;
+  var
+    ParentDirectories: TStrings;
+    Index: Integer;
+    SVNOutput, SVNError: string;
+    XML: TJclSimpleXML;
+    TargetElements: TJclSimpleXMLNamedElems;
+    TargetElement, EntryElement, WcStatusElement: TJclSimpleXMLElem;
+    PathProp, ItemProp: TJclSimpleXMLProp;
+  begin
+    Result := False;
+
+    ParentDirectories := TStringList.Create;
+    try
+      for Index := Length(FileName) downto 1 do
+        if FileName[Index] = DirDelimiter then
+          ParentDirectories.Add(Copy('"' + FileName, 1, Index) + '"');
+
+      if Execute(FSVNStatusCmd + StringsToStr(ParentDirectories, NativeSpace, False), SVNOutput, SVNError) <> 0 then
+        Exit;
+    finally
+      ParentDirectories.Free;
+    end;
+
+    XML := TJclSimpleXML.Create;
+    try
+      XML.LoadFromString(SVNOutput);
+      XML.Options := XML.Options - [sxoAutoCreate];
+      if XML.Root.Name <> JclVersionCtrlSVNStatusElementName then
+        Exit;
+
+      TargetElements := XML.Root.Items.NamedElems[JclVersionCtrlSVNTargetElementName];
+
+      SdBxNames.BeginUpdate;
+      try
+        SdBxNames.Clear;
+
+        for Index := 0 to TargetElements.Count - 1 do
+        begin
+          TargetElement := TargetElements.Item[Index];
+          if not Assigned(TargetElement) then
+            Continue;
+
+          EntryElement := TargetElement.Items.ItemNamed[JclVersionCtrlSVNEntryElementName];
+          if not Assigned(EntryElement) then
+            Continue;
+
+          PathProp := EntryElement.Properties.ItemNamed[JclVersionCtrlSVNPathPropertyName];
+          if not Assigned(PathProp) then
+            Continue;
+
+          WcStatusElement := EntryElement.Items.ItemNamed[JclVersionCtrlSVNWcStatusElementName];
+          if not Assigned(WcStatusElement) then
+            Continue;
+
+          ItemProp := WcStatusElement.Properties.ItemNamed[JclVersionCtrlSVNItemPropertyName];
+          if not Assigned(ItemProp) then
+            Continue;
+
+          if ItemProp.Value <> JclVersionCtrlSVNUnversionedPropertyValue then
+            SdBxNames.Add(PathProp.Value);
+        end;
+      finally
+        SdBxNames.EndUpdate;
+      end;
+    finally
+      XML.Free;
+    end;
+
+    Result := SdBxNames.Count > 0;
+  end;
+
+begin
+  Result := not Enabled;
+
+  if (not Result) and (FSVNStatusCmd <> '') then
+    Result := GetSVNExecutableSandboxNames(FileName, SdBxNames);
+
+  if not Result then
+    Result := GetSVNInternalSandboxNames(FileName, SdBxNames);
+
   if SdBxNames.Count = 0 then
     Result := inherited GetSandboxNames(FileName, SdBxNames);
 end;

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3699] trunk/jcl/source/common/JclSysUtils.pas

From: <ou...@us...> - 2012-01-22 12:20:04

Revision: 3699
          http://jcl.svn.sourceforge.net/jcl/?rev=3699&view=rev
Author:   outchy
Date:     2012-01-22 12:19:57 +0000 (Sun, 22 Jan 2012)
Log Message:
-----------
Fix a bug when the error and output pipes were incorrectly merged together.

Modified Paths:
--------------
    trunk/jcl/source/common/JclSysUtils.pas

Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas	2012-01-22 11:17:51 UTC (rev 3698)
+++ trunk/jcl/source/common/JclSysUtils.pas	2012-01-22 12:19:57 UTC (rev 3699)
@@ -3069,13 +3069,13 @@
 function Execute(const CommandLine: string; var Output, Error: string; RawOutput, RawError: Boolean;
   AbortPtr: PBoolean): Cardinal;
 begin
-  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, nil, RawOutput, True, Error, nil, RawError);
+  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, nil, RawOutput, False, Error, nil, RawError);
 end;
 
 function Execute(const CommandLine: string; AbortEvent: TJclEvent; var Output, Error: string;
   RawOutput, RawError: Boolean): Cardinal;
 begin
-  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, nil, RawOutput, True, Error, nil, RawError);
+  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, nil, RawOutput, False, Error, nil, RawError);
 end;
 
 { TODO -cHelp :
@@ -3089,7 +3089,7 @@
 begin
   Output := '';
   Error := '';
-  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, OutputLineCallback, RawOutput, True, Error, ErrorLineCallback, RawError);
+  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, OutputLineCallback, RawOutput, False, Error, ErrorLineCallback, RawError);
 end;
 
 function Execute(const CommandLine: string; AbortEvent: TJclEvent; OutputLineCallback, ErrorLineCallback: TTextHandler;
@@ -3099,7 +3099,7 @@
 begin
   Output := '';
   Error := '';
-  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, OutputLineCallback, RawOutput, True, Error, ErrorLineCallback, RawError);
+  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, OutputLineCallback, RawOutput, False, Error, ErrorLineCallback, RawError);
 end;
 
 //=== { TJclCommandLineTool } ================================================

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3698] trunk/jcl/source/common/JclBase.pas

From: <ou...@us...> - 2012-01-22 11:17:58

Revision: 3698
          http://jcl.svn.sourceforge.net/jcl/?rev=3698&view=rev
Author:   outchy
Date:     2012-01-22 11:17:51 +0000 (Sun, 22 Jan 2012)
Log Message:
-----------
Mantis 5770: Install does not compile with Delphi 7.

Modified Paths:
--------------
    trunk/jcl/source/common/JclBase.pas

Modified: trunk/jcl/source/common/JclBase.pas
===================================================================
--- trunk/jcl/source/common/JclBase.pas	2012-01-21 20:06:50 UTC (rev 3697)
+++ trunk/jcl/source/common/JclBase.pas	2012-01-22 11:17:51 UTC (rev 3698)
@@ -530,7 +530,11 @@
 procedure CheckOSError(ErrorCode: Cardinal);
 begin
   if ErrorCode <> ERROR_SUCCESS then
+    {$IFDEF RTL170_UP}
     RaiseLastOSError(ErrorCode);
+    {$ELSE ~RTL170_UP}
+    RaiseLastOSError;
+    {$ENDIF ~RTL170_UP}
 end;
 {$ENDIF RTL230_UP}
 

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3697] trunk/help/pcre.dtx

From: <ou...@us...> - 2012-01-21 20:06:56

Revision: 3697
          http://jcl.svn.sourceforge.net/jcl/?rev=3697&view=rev
Author:   outchy
Date:     2012-01-21 20:06:50 +0000 (Sat, 21 Jan 2012)
Log Message:
-----------
help update.

Modified Paths:
--------------
    trunk/help/pcre.dtx

Modified: trunk/help/pcre.dtx
===================================================================
--- trunk/help/pcre.dtx	2012-01-21 17:22:58 UTC (rev 3696)
+++ trunk/help/pcre.dtx	2012-01-21 20:06:50 UTC (rev 3697)
@@ -160,115 +160,120 @@
   Options
   JclPCRE_Using
 --------------------------------------------------------------------------------
-@@TJclRegEx.Compile@string@Boolean@Boolean
-Summary:
-  Converts a regular expression into the form required for the PCRE.DLL library.
-Description:
-  Compile is a method used to convert a regular expression into the form
-  required for the PCRE.DLL library, and to optionally perform
-  optimization and localization for the regular expression.
+@@TJclRegEx.Compile@string@Boolean@Boolean@Boolean
+Summary
+Converts a regular expression into the form required for the
+PCRE.DLL library.
+Description
+Compile is a method used to convert a regular expression into
+the form required for the PCRE.DLL library, and to optionally
+perform optimization and localization for the regular
+expression.
 
-  Pattern indicates the regular expression to be compiled. Pattern must
-  contain a string that meets the syntax and semantics of the regular
-  expressions supported by PCRE.  The power of regular expressions comes
-  from the ability to include alternatives and repetitions in the
-  pattern. These are encoded in the pattern by the use of metacharacters,
-  which do not stand for themselves but instead are interpreted in some
-  special way.
+Pattern indicates the regular expression to be compiled.
+Pattern must contain a string that meets the syntax and
+semantics of the regular expressions supported by PCRE. The
+power of regular expressions comes from the ability to
+include alternatives and repetitions in the pattern. These
+are encoded in the pattern by the use of metacharacters,
+which do not stand for themselves but instead are interpreted
+in some special way.
 
-  There are two different sets of metacharacters: those that are
-  recognized anywhere in the pattern except within square brackets, and
-  those that are recognized in square brackets. Outside square brackets,
-  the metacharacters are as follows:
+There are two different sets of metacharacters: those that
+are recognized anywhere in the pattern except within square
+brackets, and those that are recognized in square brackets.
+Outside square brackets, the metacharacters are as follows:
 
 <table>
-Metacharacter   Description
---------------  ------------------------------------------------------
+Metacharacter   \Description
+--------------  -----------------------------------------------------
 \\              general escape character with several uses
-\^              assert start of string (or line, in multiline mode)
-\$              assert end of string (or line, in multiline mode)
-\.              match any character except newline (by default)
-\[              start character class definition
-\|              start of alternative branch
-\(              start subpattern
-\)              end subpattern
-\?              extends the meaning of ( also 0 or 1 quantifier
-                  also quantifier minimizer
+^               assert start of string (or line, in multiline mode)
+$               assert end of string (or line, in multiline mode)
+.               match any character except newline (by default)
+[               start character class definition
+|               start of alternative branch
+(               start subpattern
+)               end subpattern
+?               extends the meaning of ( also 0 or 1 quantifier also
+                 quantifier minimizer
 \*              0 or more quantifier
-\+              1 or more quantifier
-                  also "possessive quantifier"
-\{              start min/max quantifier
+\+              1 or more quantifier also "possessive quantifier"
+{               start min/max quantifier
 </table>
 
-  Part of a pattern that is in square brackets is called a "character
-  class". In a character class the only metacharacters are:
+Part of a pattern that is in square brackets is called a
+"character class". In a character class the only
+metacharacters are:
 
 <table>
-Metacharacter   Description
---------------  ------------------------------------------------------
+Metacharacter   \Description
+--------------  --------------------------------------------------
 \\              general escape character
-\^              negate the class, but only if the first character
+^               negate the class, but only if the first character
 \-              indicates character range
-\[              POSIX character class (followed by POSIX syntax)
-\]              terminates the character class
+[               POSIX character class (followed by POSIX syntax)
+]               terminates the character class
 </table>
 
-  Please refer to the documentation in PCRE Patterns for a more
-  detailed description of regular expressions and metacharacters.
+Please refer to the documentation in PCRE Patterns for a more
+detailed description of regular expressions and
+metacharacters.
 
-  Study indicates if the regular expression should be inspected for
-  additional information that can be extracted to speed up matching
-  performance. Set Study to True if the same compiled regular expression
-  will be used in multiple calls to the Match method.
+Study indicates if the regular expression should be inspected
+for additional information that can be extracted to speed up
+matching performance. Set Study to True if the same compiled
+regular expression will be used in multiple calls to the
+Match method.
 
-  UserLocale indicates that a non-standard locale is in use on the local
-  machine, and show be used to override the character tables built into
-  the PCRE library. Set UserLocale to True to force the users' locale to
-  be used instead of the default encodings in the PCRE library.
+UserLocale indicates that a non-standard locale is in use on
+the local machine, and show be used to override the character
+tables built into the PCRE library. Set UserLocale to True to
+force the users' locale to be used instead of the default
+encodings in the PCRE library.
 
-  Values in the Options property are used to configure the regular
-  expression engine in the PCRE library, and to alter the run-time
-  behavior of pattern matching. Set values in the Options property prior
-  to calling Compile or Match to control the configuration and behavior
-  of the PCRE library.
+Values in the Options property are used to configure the
+regular expression engine in the PCRE library, and to alter
+the run-time behavior of pattern matching. Set values in the
+Options property prior to calling Compile or Match to control
+the configuration and behavior of the PCRE library.
 
-  Refer to the documentation for TJclRegExOption for a description of
-  the values used in the Options property.
+Refer to the documentation for TJclRegExOption for a
+\description of the values used in the Options property.
 
-  The compiled regular expression representing Pattern is stored
-  internally in TJclRegEx for subsequent use in the Match method. An
-  EPCREError exception is raised if Pattern contains an empty string ('').
+The compiled regular expression representing Pattern is
+stored internally in TJclRegEx for subsequent use in the
+Match method. An EPCREError exception is raised if Pattern
+contains an empty string ('').
 
-  Compile returns a Boolean value that indicates if the regular
-  expression in Pattern is successfully compiled (and optionally
-  optimized).
+Compile returns a Boolean value that indicates if the regular
+expression in Pattern is successfully compiled (and
+\optionally optimized).
 
-  Use the ErrorMessage and ErrorOffset properties to determine the type
-  and location of a syntax error detected in the Pattern argument.
+Use the ErrorMessage and ErrorOffset properties to determine
+the type and location of a syntax error detected in the
+Pattern argument.
 
-  Use the Match method to comapre a text subject using the compiled
-  regular expression.
-Parameters:
-  Pattern    - Regular expression to use when comparing a text subject using
-               the regular expression engine.
-  Study      - Indicates if optimization is required for the regular
-               expression.
-  UserLocale - Indicates if non-standard localization is required for the
-               regular expression.
-Result:
-  Boolean - True indicates successful completion of the method.
-Exceptions:
-  EPCREError - Exception raised when the regular expression in Pattern
-               contains an empty string ('').
-See also:
-  Options
-  Match
-  ErrorMessage
-  ErrorOffset
-  TJclRegExOption
-  TJclRegExOptions
-  EPCREError
---------------------------------------------------------------------------------
+Use the Match method to comapre a text subject using the
+compiled regular expression.
+Parameters
+Pattern :     Regular expression to use when comparing a text
+              subject using the regular expression engine.
+Study :       Indicates if optimization is required for the
+              regular expression.
+UserLocale :  Indicates if non\-standard localization is
+              required for the regular expression.
+JITCompile :  Enable the Just-In-Time compilation of this
+              regular expression.
+Returns
+Boolean - True indicates successful completion of the method.
+Exceptions
+EPCREError - Exception raised when the regular expression in
+Pattern contains an empty string ('').
+See Also
+Options Match ErrorMessage ErrorOffset TJclRegExOption
+TJclRegExOptions EPCREError
+
 @@TJclRegEx.Destroy
 Summary:
   Destructor for object instance.

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3696] trunk/jcl

From: <ou...@us...> - 2012-01-21 17:23:05

Revision: 3696
          http://jcl.svn.sourceforge.net/jcl/?rev=3696&view=rev
Author:   outchy
Date:     2012-01-21 17:22:58 +0000 (Sat, 21 Jan 2012)
Log Message:
-----------
New compile-time option to make JclPCRE.pas relying on RTL's RegularExpressionsAPI.pas instead of JCL's pcre.pas (Delphi XE and newer only).

Modified Paths:
--------------
    trunk/jcl/install/JclInstall.pas
    trunk/jcl/install/JclInstallResources.pas
    trunk/jcl/source/common/JclPCRE.pas
    trunk/jcl/source/common/pcre.pas
    trunk/jcl/source/include/jcl.inc
    trunk/jcl/source/include/jcl.template.inc

Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas	2012-01-21 16:08:11 UTC (rev 3695)
+++ trunk/jcl/install/JclInstall.pas	2012-01-21 17:22:58 UTC (rev 3696)
@@ -68,6 +68,7 @@
         joJCLDefPCREStaticLink,
         joJCLDefPCRELinkDLL,
         joJCLDefPCRELinkOnRequest,
+        joJCLDefPCRERTL,
         joJCLDefBZip2StaticLink,
         joJCLDefBZip2LinkDLL,
         joJCLDefBZip2LinkOnRequest,
@@ -132,7 +133,7 @@
       'MATH_EXT_EXTREMEVALUES',  'HOOK_DLL_EXCEPTIONS',
       'DEBUG_NO_BINARY', 'DEBUG_NO_TD32', 'DEBUG_NO_MAP', 'DEBUG_NO_EXPORTS',
       'DEBUG_NO_SYMBOLS', 'PCRE_STATICLINK',
-      'PCRE_LINKDLL', 'PCRE_LINKONREQUEST', 'BZIP2_STATICLINK',
+      'PCRE_LINKDLL', 'PCRE_LINKONREQUEST', 'PCRE_RTL', 'BZIP2_STATICLINK',
       'BZIP2_LINKDLL', 'BZIP2_LINKONREQUEST', 'ZLIB_STATICLINK',
       'ZLIB_LINKDLL', 'ZLIB_LINKONREQUEST', 'ZLIB_RTL', 'UNICODE_RTL_DATABASE',
       'UNICODE_SILENT_FAILURE', 'UNICODE_RAW_DATA', 'UNICODE_ZLIB_DATA',
@@ -405,6 +406,7 @@
       (Id: -1; Caption: @RsCaptionDefPCREStaticLink;       Hint: @RsHintDefPCREStaticLink), // joDefPCREStaticLink
       (Id: -1; Caption: @RsCaptionDefPCRELinkDLL;          Hint: @RsHintDefPCRELinkDLL), // joDefPCRELinkDLL
       (Id: -1; Caption: @RsCaptionDefPCRELinkOnRequest;    Hint: @RsHintDefPCRELinkOnRequest), // joDefPCRELinkOnRequest
+      (Id: -1; Caption: @RsCaptionDefPCRERTL;              Hint: @RsHintDefPCRERTL), // joDefPCRERTL
       (Id: -1; Caption: @RsCaptionDefBZip2StaticLink;      Hint: @RsHintDefBZip2StaticLink), // joDefBZip2StaticLink
       (Id: -1; Caption: @RsCaptionDefBZip2LinkDLL;         Hint: @RsHintDefBZip2LinkDLL), // joDefBZip2LinkDLL
       (Id: -1; Caption: @RsCaptionDefBZip2LinkOnRequest;   Hint: @RsHintDefBZip2LinkOnRequest), // joDefBZip2LinkOnRequest
@@ -897,6 +899,9 @@
     else
       AddOption(joJCLDefPCRELinkOnRequest, [goRadioButton, goChecked], joJCLDefPCRE);
     AddOption(joJCLDefPCRELinkDLL, [goRadioButton], joJCLDefPCRE);
+    if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber >= 8) then
+      // Delphi XE and newer have a licensed version of JCL's pcre.pas named RegularExpressionsAPI
+      AddOption(joJCLDefPCRERTL, [goRadioButton], joJCLDefPCRE);
     // BZip2 options
     AddOption(joJCLDefBZip2, [goChecked], Parent);
     AddOption(joJCLDefBZip2StaticLink, [goRadioButton, goChecked], joJCLDefBZip2);

Modified: trunk/jcl/install/JclInstallResources.pas
===================================================================
--- trunk/jcl/install/JclInstallResources.pas	2012-01-21 16:08:11 UTC (rev 3695)
+++ trunk/jcl/install/JclInstallResources.pas	2012-01-21 17:22:58 UTC (rev 3696)
@@ -77,6 +77,7 @@
   RsCaptionDefPCREStaticLink    = 'Static link to PCRE code';
   RsCaptionDefPCRELinkDLL       = 'Static bind to pcre.dll';
   RsCaptionDefPCRELinkOnRequest = 'Late bind to pcre.dll';
+  RsCaptionDefPCRERTL           = 'Use RTL''s RegularExpressionAPI';
   // BZip2 options
   RsCaptionDefBZip2              = 'BZip2 options';
   RsCaptionDefBZip2StaticLink    = 'Static link to BZip2 code';
@@ -190,6 +191,7 @@
   RsHintDefPCREStaticLink    = 'Code from PCRE is linked into JCL binaries';
   RsHintDefPCRELinkDLL       = 'JCL binaries require pcre.dll to be present';
   RsHintDefPCRELinkOnRequest = 'JCL binaries require pcre.dll when calling PCRE functions';
+  RsHintDefPCRERTL           = 'JCL relies on RTL''s RegularExpressionsAPI functions and declarations';
   // BZip2 options
   RsHintDefBZip2              = 'BZip2 specific options (bzip2.pas)';
   RsHintDefBZip2StaticLink    = 'Code from BZip2 is linked into JCL binaries';

Modified: trunk/jcl/source/common/JclPCRE.pas
===================================================================
--- trunk/jcl/source/common/JclPCRE.pas	2012-01-21 16:08:11 UTC (rev 3695)
+++ trunk/jcl/source/common/JclPCRE.pas	2012-01-21 17:22:58 UTC (rev 3696)
@@ -50,8 +50,14 @@
   {$ENDIF HAS_UNIT_LIBC}
   {$IFDEF HAS_UNITSCOPE}
   System.Classes, System.SysUtils,
+  {$IFDEF PCRE_RTL}
+  System.RegularExpressionsAPI,
+  {$ENDIF PCRE_RTL}
   {$ELSE ~HAS_UNITSCOPE}
   Classes, SysUtils,
+  {$IFDEF PCRE_RTL}
+  RegularExpressionsAPI,
+  {$ENDIF PCRE_RTL}
   {$ENDIF ~HAS_UNITSCOPE}
   JclBase, JclStringConversions;
 
@@ -244,7 +250,13 @@
 var
   GTables: PAnsiChar;
 
-function JclPCREGetMem(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL}
+{$IFDEF RTL230_UP}
+  {$IFDEF PCRE_RTL}
+    {$DEFINE PCRE_EXPORT_CDECL}
+  {$ENDIF PCRE_RTL}
+{$ENDIF RTL230_UP}
+
+function JclPCREGetMem(Size: {$IFDEF PCRE_RTL}Integer{$ELSE}SizeInt{$ENDIF}): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL}
 begin
   GetMem(Result, Size);
 end;
@@ -313,6 +325,7 @@
       PErr := @RsErrNullWsLimit;
     PCRE_ERROR_BADNEWLINE:
       PErr := @RsErrBadNewLine;
+    {$IFNDEF PCRE_RTL}
     PCRE_ERROR_BADOFFSET:
       PErr := @RsErrBadOffset;
     PCRE_ERROR_SHORTUTF8:
@@ -321,6 +334,7 @@
       PErr := @RsErrRecurseLoop;
     PCRE_ERROR_JITSTACKLIMIT:
       PErr := @RsErrJITStackLimit;
+    {$ENDIF ~PCRE_RTL}
     JCL_PCRE_ERROR_STUDYFAILED:
       PErr := @RsErrStudyFailed;
     JCL_PCRE_ERROR_CALLOUTERROR:
@@ -339,7 +353,11 @@
   if Assigned(FCode) then
     CallPCREFree(FCode);
   if Assigned(FExtra) then
+    {$IFDEF PCRE_RTL}
+    CallPCREFree(FExtra);
+    {$ELSE ~PCRE_RTL}
     pcre_free_study(FExtra);
+    {$ENDIF ~PCRE_RTL}
   if Assigned(FVector) then
     FreeMem(FVector);
   if Assigned(FChangedCaptures) then
@@ -352,7 +370,10 @@
 var
   ErrMsgPtr: PAnsiChar;
   Tables: PAnsiChar;
-  StudyOptions, ConfigJIT: Integer;
+  StudyOptions: Integer;
+  {$IFNDEF PCRE_RTL}
+  ConfigJIT: Integer;
+  {$ENDIF ~PCRE_RTL}
 begin
   if UserLocale then
   begin
@@ -380,7 +401,14 @@
   begin
     if Study then
     begin
+      {$IFDEF PCRE_RTL}
       if Assigned(FExtra) then
+        CallPCREFree(FExtra);
+      if JITCompile then
+        raise EPCREError.CreateRes(@RsErrNoJITSupport, 0);
+      StudyOptions := 0;
+      {$ELSE ~PCRE_RTL}
+      if Assigned(FExtra) then
         pcre_free_study(FExtra);
       if JITCompile then
       begin
@@ -391,6 +419,7 @@
       end
       else
         StudyOptions := 0;
+      {$ENDIF ~PCRE_RTL}
       FExtra := pcre_study(FCode, StudyOptions, @ErrMsgPtr);
       Result := Assigned(FExtra) or (not Assigned(ErrMsgPtr));
       if not Result then
@@ -413,6 +442,11 @@
 
 function TJclRegEx.GetAPIOptions(RunTime, DFA: Boolean): Integer;
 const
+  {$IFDEF PCRE_RTL}
+  PCRE_PARTIAL_HARD     = $08000000;
+  PCRE_NOTEMPTY_ATSTART = $10000000;
+  PCRE_UCP              = $20000000;
+  {$ENDIF PCRE_RTL}
   { roIgnoreCase, roMultiLine, roDotAll, roExtended,
     roAnchored, roDollarEndOnly, roExtra, roNotBOL, roNotEOL, roUnGreedy,
     roNotEmpty, roUTF8, roNoAutoCapture, roNoUTF8Check, roAutoCallout,
@@ -776,7 +810,9 @@
 end;
 
 initialization
+  {$IFNDEF PCRE_RTL}
   pcre.LibNotLoadedHandler := LibNotLoadedHandler;
+  {$ENDIF ~PCRE_RTL}
   if LoadPCRE then
   begin
     SetPCREMallocCallback(JclPCREGetMem);

Modified: trunk/jcl/source/common/pcre.pas
===================================================================
--- trunk/jcl/source/common/pcre.pas	2012-01-21 16:08:11 UTC (rev 3695)
+++ trunk/jcl/source/common/pcre.pas	2012-01-21 17:22:58 UTC (rev 3696)
@@ -52,6 +52,8 @@
 
 //DOM-IGNORE-BEGIN
 
+{$IFNDEF PCRE_RTL}
+
 (*************************************************
 *       Perl-Compatible Regular Expressions      *
 *************************************************)
@@ -668,6 +670,7 @@
 
 {$ENDIF PCRE_LINKONREQUEST}
 
+{$ENDIF ~PCRE_RTL}
 //DOM-IGNORE-END
 
 function IsPCRELoaded: Boolean;
@@ -704,6 +707,7 @@
   Types, SysUtils;
   {$ENDIF ~HAS_UNITSCOPE}
 
+{$IFNDEF PCRE_RTL}
 {$IFDEF PCRE_STATICLINK}
 
 // make the linker happy with PCRE 8.00
@@ -1231,17 +1235,27 @@
   pcre_callout_func := nil;
 end;
 {$ENDIF ~PCRE_STATICLINK}
+{$ENDIF ~PCRE_RTL}
 
 function IsPCRELoaded: Boolean;
 begin
+  {$IFDEF PCRE_RTL}
+  Result := True;
+  {$ELSE ~PCRE_RTL}
   {$IFDEF PCRE_STATICLINK}
   Result := True;
   {$ELSE ~PCRE_STATICLINK}
   Result := PCRELib <> INVALID_MODULEHANDLE_VALUE;
   {$ENDIF ~PCRE_STATICLINK}
+  {$ENDIF ~PCRE_RTL}
 end;
 
 function LoadPCRE: Boolean;
+{$IFDEF PCRE_RTL}
+begin
+  Result := True;
+end;
+{$ELSE ~PCRE_RTL}
 {$IFDEF PCRE_STATICLINK}
 begin
   Result := True;
@@ -1308,9 +1322,11 @@
     InitPCREFuncPtrs(@LibNotLoadedHandler);
 end;
 {$ENDIF ~PCRE_STATICLINK}
+{$ENDIF ~PCRE_RTL}
 
 procedure UnloadPCRE;
 begin
+  {$IFNDEF PCRE_RTL}
   {$IFNDEF PCRE_STATICLINK}
   if PCRELib <> INVALID_MODULEHANDLE_VALUE then
     {$IFDEF MSWINDOWS}
@@ -1322,6 +1338,7 @@
   PCRELib := INVALID_MODULEHANDLE_VALUE;
   InitPCREFuncPtrs(@LibNotLoadedHandler);
   {$ENDIF ~PCRE_STATICLINK}
+  {$ENDIF ~PCRE_RTL}
 end;
 
 {$IFDEF PCRE_LINKDLL}

Modified: trunk/jcl/source/include/jcl.inc
===================================================================
--- trunk/jcl/source/include/jcl.inc	2012-01-21 16:08:11 UTC (rev 3695)
+++ trunk/jcl/source/include/jcl.inc	2012-01-21 17:22:58 UTC (rev 3696)
@@ -269,21 +269,30 @@
 {$IFDEF PCRE_STATICLINK}
   {$UNDEF PCRE_LINKDLL}
   {$UNDEF PCRE_LINKONREQUEST}
+  {$UNDEF PCRE_RTL}
 {$ENDIF PCRE_STATICLINK}
 {$IFDEF PCRE_LINKDLL}
   {$UNDEF PCRE_LINKONREQUEST}
+  {$UNDEF PCRE_RTL}
 {$ENDIF PCRE_LINKDLL}
+{$IFDEF PCRE_LINKONREQUEST}
+  {$UNDEF PCRE_RTL}
+{$ENDIF PCRE_LINKONREQUEST}
 
 {$IFNDEF PCRE_STATICLINK}
   {$IFNDEF PCRE_LINKDLL}
     {$IFNDEF PCRE_LINKONREQUEST}
-      {$DEFINE PCRE_LINKONREQUEST}
+      {$IFNDEF PCRE_RTL}
+        {$DEFINE PCRE_LINKONREQUEST}
+      {$ENDIF ~PCRE_RTL}
     {$ENDIF ~PCRE_LINKONREQUEST}
   {$ENDIF ~PCRE_LINKDLL}
 {$ENDIF ~PCRE_STATICLINK}
 
 {$IFNDEF PCRE_STATICLINK}
-  {$DEFINE PCRE_EXPORT_CDECL}
+  {$IFNDEF PCRE_RTL}
+    {$DEFINE PCRE_EXPORT_CDECL}
+  {$ENDIF ~PCRE_RTL}
 {$ENDIF ~PCRE_STATICLINK}
 
 // BZip2 options

Modified: trunk/jcl/source/include/jcl.template.inc
===================================================================
--- trunk/jcl/source/include/jcl.template.inc	2012-01-21 16:08:11 UTC (rev 3695)
+++ trunk/jcl/source/include/jcl.template.inc	2012-01-21 17:22:58 UTC (rev 3696)
@@ -81,10 +81,12 @@
 //   static link: PCRE_STATICLINK
 //   static dll import: PCRE_LINKDLL
 //   dynamic dll import: PCRE_LINKONREQUEST
+//   RTL's RegularExpressionsAPI: PCRE_RTL
 
 {.$DEFINE PCRE_STATICLINK}
 {.$DEFINE PCRE_LINKDLL}
 {.$DEFINE PCRE_LINKONREQUEST} // default
+{.$DEFINE PCRE_RTL} // DXE and newer
 
 
 // BZIP2 options, mutually exclusive

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3695] trunk/jcl

From: <ou...@us...> - 2012-01-21 16:08:17

Revision: 3695
          http://jcl.svn.sourceforge.net/jcl/?rev=3695&view=rev
Author:   outchy
Date:     2012-01-21 16:08:11 +0000 (Sat, 21 Jan 2012)
Log Message:
-----------
Mantis 5690: Add option to use Delphi zlib.

Modified Paths:
--------------
    trunk/jcl/install/JclInstall.pas
    trunk/jcl/install/JclInstallResources.pas
    trunk/jcl/source/common/JclCompression.pas
    trunk/jcl/source/common/zlibh.pas
    trunk/jcl/source/include/jcl.inc
    trunk/jcl/source/include/jcl.template.inc

Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas	2012-01-21 15:07:37 UTC (rev 3694)
+++ trunk/jcl/install/JclInstall.pas	2012-01-21 16:08:11 UTC (rev 3695)
@@ -74,6 +74,7 @@
         joJCLDefZLibStaticLink,
         joJCLDefZLibLinkDLL,
         joJCLDefZLibLinkOnRequest,
+        joJCLDefZLibRTL,
         joJCLDefUnicodeRTLDatabase,
         joJCLDefUnicodeSilentFailure,
         joJCLDefUnicodeRawData,
@@ -133,11 +134,11 @@
       'DEBUG_NO_SYMBOLS', 'PCRE_STATICLINK',
       'PCRE_LINKDLL', 'PCRE_LINKONREQUEST', 'BZIP2_STATICLINK',
       'BZIP2_LINKDLL', 'BZIP2_LINKONREQUEST', 'ZLIB_STATICLINK',
-      'ZLIB_LINKDLL', 'ZLIB_LINKONREQUEST', 'UNICODE_RTL_DATABASE', 'UNICODE_SILENT_FAILURE',
-      'UNICODE_RAW_DATA', 'UNICODE_ZLIB_DATA', 'UNICODE_BZIP2_DATA',
-      'CONTAINER_ANSISTR', 'CONTAINER_WIDESTR', 'CONTAINER_UNICODESTR',
-      'CONTAINER_NOSTR', {'7ZIP_STATICLINK',} '7ZIP_LINKDLL',
-      '7ZIP_LINKONREQUEST' );
+      'ZLIB_LINKDLL', 'ZLIB_LINKONREQUEST', 'ZLIB_RTL', 'UNICODE_RTL_DATABASE',
+      'UNICODE_SILENT_FAILURE', 'UNICODE_RAW_DATA', 'UNICODE_ZLIB_DATA',
+      'UNICODE_BZIP2_DATA', 'CONTAINER_ANSISTR', 'CONTAINER_WIDESTR',
+      'CONTAINER_UNICODESTR', 'CONTAINER_NOSTR', {'7ZIP_STATICLINK',}
+      '7ZIP_LINKDLL', '7ZIP_LINKONREQUEST' );
 
 type
   TJclDistribution = class;
@@ -410,6 +411,7 @@
       (Id: -1; Caption: @RsCaptionDefZLibStaticLink;       Hint: @RsHintDefZLibStaticLink), // joDefZLibStaticLink
       (Id: -1; Caption: @RsCaptionDefZLibLinkDLL;          Hint: @RsHintDefZLibLinkDLL), // joDefZLibLinkDLL
       (Id: -1; Caption: @RsCaptionDefZLibLinkOnRequest;    Hint: @RsHintDefZLibLinkOnRequest), // joDefZLibLinkOnRequest
+      (Id: -1; Caption: @RsCaptionDefZLibRTL;              Hint: @RsHintDefZLibRTL), // joDefZLibRTL
       (Id: -1; Caption: @RsCaptionDefUnicodeRTLDatabase;   Hint: @RsHintDefUnicodeRTLDatabase), // joDefUnicodeSilentFailure
       (Id: -1; Caption: @RsCaptionDefUnicodeSilentFailure; Hint: @RsHintDefUnicodeSilentFailure), // joDefUnicodeSilentFailure
       (Id: -1; Caption: @RsCaptionDefUnicodeRawData;       Hint: @RsHintDefUnicodeRawData), // joDefUnicodeRawData
@@ -905,6 +907,9 @@
     AddOption(joJCLDefZLibStaticLink, [goRadioButton, goChecked], joJCLDefZLib);
     AddOption(joJCLDefZLibLinkOnRequest, [goRadioButton], joJCLDefZLib);
     AddOption(joJCLDefZLibLinkDLL, [goRadioButton], joJCLDefZLib);
+    if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber >= 9) then
+      // Delphi XE2 ZLib is up-to-date and can directly be used by the JCL
+      AddOption(joJCLDefZLibRTL, [goRadioButton], joJCLDefZLib);
     // Unicode options
     AddOption(joJCLDefUnicode, [goChecked], Parent);
     if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber >= 6) then

Modified: trunk/jcl/install/JclInstallResources.pas
===================================================================
--- trunk/jcl/install/JclInstallResources.pas	2012-01-21 15:07:37 UTC (rev 3694)
+++ trunk/jcl/install/JclInstallResources.pas	2012-01-21 16:08:11 UTC (rev 3695)
@@ -87,6 +87,7 @@
   RsCaptionDefZLibStaticLink    = 'Static link to ZLib code';
   RsCaptionDefZLibLinkDLL       = 'Static bind to zlib1.dll';
   RsCaptionDefZLibLinkOnRequest = 'Late bind to zlib1.dll';
+  RsCaptionDefZLibRTL           = 'Use RTL''s ZLib';
   // Unicode options
   RsCaptionDefUnicode              = 'Unicode options';
   RsCaptionDefUnicodeRTLDatabase   = 'Prefer RTL database';
@@ -199,6 +200,7 @@
   RsHintDefZLibStaticLink    = 'Code from ZLib is linked into JCL binaries';
   RsHintDefZLibLinkDLL       = 'JCL binaries require zlib1.dll to be present';
   RsHintDefZLibLinkOnRequest = 'JCL binaries require zlib1.dll when calling ZLib functions';
+  RsHintDefZLibRTL           = 'JCL relies on RTL''s ZLib functions and declarations';
   // Unicode options
   RsHintDefUnicode              = 'Unicode specific option (JclUnicode.pas)';
   RsHintDefUnicodeRTLDatabase   = 'Prefer RTL Character Database over JCL one, less accurate but reduce executable sizes';

Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas	2012-01-21 15:07:37 UTC (rev 3694)
+++ trunk/jcl/source/common/JclCompression.pas	2012-01-21 16:08:11 UTC (rev 3695)
@@ -62,12 +62,18 @@
   {$ENDIF MSWINDOWS}
   System.Types,
   System.SysUtils, System.Classes, System.Contnrs,
+  {$IFDEF ZLIB_RTL}
+  System.ZLib,
+  {$ENDIF ZLIB_RTL}
   {$ELSE ~HAS_UNITSCOPE}
   {$IFDEF MSWINDOWS}
   Windows, Sevenzip, ActiveX,
   {$ENDIF MSWINDOWS}
   Types,
   SysUtils, Classes, Contnrs,
+  {$IFDEF ZLIB_RTL}
+  ZLib,
+  {$ENDIF ZLIB_RTL}
   {$ENDIF ~HAS_UNITSCOPE}
   zlibh, bzip2, JclWideStrings, JclBase, JclStreams;
 
@@ -286,6 +292,19 @@
     property CompressionLevel: Integer read FCompressionLevel write SetCompressionLevel;
   end;
 
+{$IFDEF ZLIB_RTL}
+const
+  DEF_WBITS = 15;
+  {$EXTERNALSYM DEF_WBITS}
+  DEF_MEM_LEVEL = 8;
+  {$EXTERNALSYM DEF_MEM_LEVEL}
+
+type
+  PBytef = PByte;
+  {$EXTERNALSYM PBytef}
+{$ENDIF ZLIB_RTL}
+
+type
   TJclZLibDecompressStream = class(TJclDecompressStream)
   private
     FWindowBits: Integer;

Modified: trunk/jcl/source/common/zlibh.pas
===================================================================
--- trunk/jcl/source/common/zlibh.pas	2012-01-21 15:07:37 UTC (rev 3694)
+++ trunk/jcl/source/common/zlibh.pas	2012-01-21 16:08:11 UTC (rev 3695)
@@ -74,6 +74,8 @@
 
 //DOM-IGNORE-BEGIN
 
+{$IFNDEF ZLIB_RTL}
+
 {$IFNDEF FPC}
 type
   {$IFDEF UNIX}
@@ -2021,6 +2023,7 @@
   {$EXTERNALSYM DEF_MEM_LEVEL}
 
 //DOM-IGNORE-END
+{$ENDIF ~ZLIB_RTL}
 
 function IsZLibLoaded: Boolean;
 function LoadZLib: Boolean;
@@ -2040,6 +2043,8 @@
 
 implementation
 
+{$IFNDEF ZLIB_RTL}
+
 uses
   {$IFDEF HAS_UNITSCOPE}
   System.SysUtils;
@@ -2305,6 +2310,7 @@
 var
   ZLibModuleHandle: TModuleHandle = INVALID_MODULEHANDLE_VALUE;
 {$ENDIF ~ZLIB_STATICLINK}
+{$ENDIF ~ZLIB_RTL}
 
 function IsZLibLoaded: Boolean;
 begin
@@ -2395,6 +2401,7 @@
   {$ENDIF ZLIB_LINKONREQUEST}
 end;
 
+{$IFNDEF ZLIB_RTL}
 {$IFDEF ZLIB_LINKDLL}
 // Core functions
 function zlibVersion;          external szZLIB name ZLIBzlibVersionExportName;
@@ -2435,6 +2442,8 @@
 function get_crc_table;        external szZLIB name ZLIBget_crc_tableExportName;
 {$ENDIF ZLIB_LINKDLL}
 
+{$ENDIF ~ZLIB_RTL}
+
 {$IFDEF UNITVERSIONING}
 initialization
   RegisterUnitVersion(HInstance, UnitVersioning);

Modified: trunk/jcl/source/include/jcl.inc
===================================================================
--- trunk/jcl/source/include/jcl.inc	2012-01-21 15:07:37 UTC (rev 3694)
+++ trunk/jcl/source/include/jcl.inc	2012-01-21 16:08:11 UTC (rev 3695)
@@ -320,15 +320,22 @@
 {$IFDEF ZLIB_STATICLINK}
   {$UNDEF ZLIB_LINKDLL}
   {$UNDEF ZLIB_LINKONREQUEST}
+  {$UNDEF ZLIB_RTL}
 {$ENDIF ZLIB_STATICLINK}
 {$IFDEF ZLIB_LINKDLL}
   {$UNDEF ZLIB_LINKONREQUEST}
+  {$UNDEF ZLIB_RTL}
 {$ENDIF ZLIB_LINKDLL}
+{$IFDEF ZLIB_LINKONREQUEST}
+  {$UNDEF ZLIB_RTL}
+{$ENDIF ZLIB_LINKONREQUEST}
 
 {$IFNDEF ZLIB_STATICLINK}
   {$IFNDEF ZLIB_LINKDLL}
     {$IFNDEF ZLIB_LINKONREQUEST}
-      {$DEFINE ZLIB_STATICLINK}
+      {$IFNDEF ZLIB_RTL}
+        {$DEFINE ZLIB_STATICLINK}
+      {$ENDIF ~ZLIB_RTL}
     {$ENDIF ~ZLIB_LINKONREQUEST}
   {$ENDIF ~ZLIB_LINKDLL}
 {$ENDIF ~ZLIB_STATICLINK}

Modified: trunk/jcl/source/include/jcl.template.inc
===================================================================
--- trunk/jcl/source/include/jcl.template.inc	2012-01-21 15:07:37 UTC (rev 3694)
+++ trunk/jcl/source/include/jcl.template.inc	2012-01-21 16:08:11 UTC (rev 3695)
@@ -99,6 +99,7 @@
 {.$DEFINE ZLIB_STATICLINK} // default
 {.$DEFINE ZLIB_LINKDLL}
 {.$DEFINE ZLIB_LINKONREQUEST}
+{.$DEFINE ZLIB_RTL} // DXE2 and newer only
 
 
 // Unicode options

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3694] trunk/jcl/source

From: <ou...@us...> - 2012-01-21 15:07:45

Revision: 3694
          http://jcl.svn.sourceforge.net/jcl/?rev=3694&view=rev
Author:   outchy
Date:     2012-01-21 15:07:37 +0000 (Sat, 21 Jan 2012)
Log Message:
-----------
JCL option "UNICODE_RTL_DATABASE" now completely disables the database in JclUnicode.pas.

Modified Paths:
--------------
    trunk/jcl/source/common/JclAlgorithms.pas
    trunk/jcl/source/common/JclCompression.pas
    trunk/jcl/source/common/JclStrings.pas
    trunk/jcl/source/common/JclUnicode.pas
    trunk/jcl/source/common/JclWideStrings.pas
    trunk/jcl/source/prototypes/JclAlgorithms.pas

Modified: trunk/jcl/source/common/JclAlgorithms.pas
===================================================================
--- trunk/jcl/source/common/JclAlgorithms.pas	2012-01-20 22:42:06 UTC (rev 3693)
+++ trunk/jcl/source/common/JclAlgorithms.pas	2012-01-21 15:07:37 UTC (rev 3694)
@@ -492,6 +492,9 @@
   {$IFDEF HAS_UNIT_ANSISTRINGS}
   System.AnsiStrings,
   {$ENDIF HAS_UNIT_ANSISTRINGS}
+  {$IFDEF UNICODE_RTL_DATABASE}
+  System.Character,
+  {$ENDIF UNICODE_RTL_DATABASE}
   System.SysUtils,
   {$ELSE ~HAS_UNITSCOPE}
   {$IFDEF COMPILER11_UP}
@@ -500,6 +503,9 @@
   {$IFDEF HAS_UNIT_ANSISTRINGS}
   AnsiStrings,
   {$ENDIF HAS_UNIT_ANSISTRINGS}
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Character,
+  {$ENDIF UNICODE_RTL_DATABASE}
   SysUtils,
   {$ENDIF ~HAS_UNITSCOPE}
   JclAnsiStrings, JclStringConversions, JclUnicode;
@@ -879,11 +885,19 @@
   IntegerHash.H3 := 2;
   IntegerHash.H4 := 3;
   I := 1;
+  {$IFDEF UNICODE_RTL_DATABASE}
+  SetLength(CA, 1);
+  {$ELSE ~UNICODE_RTL_DATABASE}
   SetLength(CA, 0);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
   while I < Length(AString) do
   begin
     C.C := UTF8GetNextChar(AString, I);
+    {$IFDEF UNICODE_RTL_DATABASE}
+    CA[0] := Ord(TCharacter.ToLower(Chr(C.C)));
+    {$ELSE ~UNICODE_RTL_DATABASE}
     CA := UnicodeCaseFold(C.C);
+    {$ENDIF ~UNICODE_RTL_DATABASE}
     for J := Low(CA) to High(CA) do
     begin
       C.C := CA[J];
@@ -934,12 +948,20 @@
   IntegerHash.H2 := 1;
   IntegerHash.H3 := 2;
   IntegerHash.H4 := 3;
+  {$IFDEF UNICODE_RTL_DATABASE}
+  SetLength(CA, 1);
+  {$ELSE ~UNICODE_RTL_DATABASE}
   SetLength(CA, 0);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
   I := 1;
   while I < Length(AString) do
   begin
     C.C := UTF16GetNextChar(AString, I);
+    {$IFDEF UNICODE_RTL_DATABASE}
+    CA[0] := Ord(TCharacter.ToLower(Chr(C.C)));
+    {$ELSE ~UNICODE_RTL_DATABASE}
     CA := UnicodeCaseFold(C.C);
+    {$ENDIF ~UNICODE_RTL_DATABASE}
     for J := Low(CA) to High(CA) do
     begin
       C.C := CA[J];
@@ -991,12 +1013,20 @@
   IntegerHash.H2 := 1;
   IntegerHash.H3 := 2;
   IntegerHash.H4 := 3;
+  {$IFDEF UNICODE_RTL_DATABASE}
+  SetLength(CA, 1);
+  {$ELSE ~UNICODE_RTL_DATABASE}
   SetLength(CA, 0);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
   I := 1;
   while I < Length(AString) do
   begin
     C.C := UTF16GetNextChar(AString, I);
+    {$IFDEF UNICODE_RTL_DATABASE}
+    CA[0] := Ord(TCharacter.ToLower(Chr(C.C)));
+    {$ELSE ~UNICODE_RTL_DATABASE}
     CA := UnicodeCaseFold(C.C);
+    {$ENDIF ~UNICODE_RTL_DATABASE}
     for J := Low(CA) to High(CA) do
     begin
       C.C := CA[J];

Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas	2012-01-20 22:42:06 UTC (rev 3693)
+++ trunk/jcl/source/common/JclCompression.pas	2012-01-21 15:07:37 UTC (rev 3694)
@@ -2185,9 +2185,7 @@
 implementation
 
 uses
-  {$IFNDEF UNICODE_RTL_DATABASE}
   JclUnicode, // WideSameText
-  {$ENDIF ~UNICODE_RTL_DATABASE}
   JclDateTime, JclFileUtils, JclResources, JclStrings, JclSysUtils;
 
 const

Modified: trunk/jcl/source/common/JclStrings.pas
===================================================================
--- trunk/jcl/source/common/JclStrings.pas	2012-01-20 22:42:06 UTC (rev 3693)
+++ trunk/jcl/source/common/JclStrings.pas	2012-01-21 15:07:37 UTC (rev 3694)
@@ -1214,7 +1214,7 @@
     P := PChar(S);
     for I := 1 to L do
     begin
-      P^ := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.ToLower(P^);
+      P^ := TCharacter.ToLower(P^);
       Inc(P);
     end;
   end;
@@ -1231,7 +1231,7 @@
   if S <> nil then
   begin
     repeat
-      S^ := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.ToLower(S^);
+      S^ := TCharacter.ToLower(S^);
       Inc(S);
     until S^ = #0;
   end;
@@ -1970,7 +1970,7 @@
     P := PChar(S);
     for I := 1 to L do
     begin
-      P^ := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.ToUpper(P^);
+      P^ := TCharacter.ToUpper(P^);
       Inc(P);
     end;
   end;
@@ -1987,7 +1987,7 @@
   if S <> nil then
   begin
     repeat
-      S^ := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.ToUpper(S^);
+      S^ := TCharacter.ToUpper(S^);
       Inc(S);
     until S^ = #0;
   end;
@@ -2799,7 +2799,7 @@
 function CharIsAlpha(const C: Char): Boolean;
 begin
   {$IFDEF UNICODE_RTL_DATABASE}
-  Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.IsLetter(C);
+  Result := TCharacter.IsLetter(C);
   {$ELSE ~UNICODE_RTL_DATABASE}
   Result := (StrCharTypes[C] and C1_ALPHA) <> 0;
   {$ENDIF ~UNICODE_RTL_DATABASE}
@@ -2808,7 +2808,7 @@
 function CharIsAlphaNum(const C: Char): Boolean;
 begin
   {$IFDEF UNICODE_RTL_DATABASE}
-  Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.IsLetterOrDigit(C);
+  Result := TCharacter.IsLetterOrDigit(C);
   {$ELSE ~UNICODE_RTL_DATABASE}
   Result := ((StrCharTypes[C] and C1_ALPHA) <> 0) or ((StrCharTypes[C] and C1_DIGIT) <> 0);
   {$ENDIF ~UNICODE_RTL_DATABASE}
@@ -2827,7 +2827,7 @@
 function CharIsControl(const C: Char): Boolean;
 begin
   {$IFDEF UNICODE_RTL_DATABASE}
-  Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.IsControl(C);
+  Result := TCharacter.IsControl(C);
   {$ELSE ~UNICODE_RTL_DATABASE}
   Result := (StrCharTypes[C] and C1_CNTRL) <> 0;
   {$ENDIF ~UNICODE_RTL_DATABASE}
@@ -2841,7 +2841,7 @@
 function CharIsDigit(const C: Char): Boolean;
 begin
   {$IFDEF UNICODE_RTL_DATABASE}
-  Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.IsDigit(C);
+  Result := TCharacter.IsDigit(C);
   {$ELSE ~UNICODE_RTL_DATABASE}
   Result := (StrCharTypes[C] and C1_DIGIT) <> 0;
   {$ENDIF ~UNICODE_RTL_DATABASE}
@@ -2866,7 +2866,7 @@
 function CharIsLower(const C: Char): Boolean;
 begin
   {$IFDEF UNICODE_RTL_DATABASE}
-  Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.IsLower(C);
+  Result := TCharacter.IsLower(C);
   {$ELSE ~UNICODE_RTL_DATABASE}
   Result := (StrCharTypes[C] and C1_LOWER) <> 0;
   {$ENDIF ~UNICODE_RTL_DATABASE}
@@ -2890,7 +2890,7 @@
 function CharIsPunctuation(const C: Char): Boolean;
 begin
   {$IFDEF UNICODE_RTL_DATABASE}
-  Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.IsPunctuation(C);
+  Result := TCharacter.IsPunctuation(C);
   {$ELSE ~UNICODE_RTL_DATABASE}
   Result := ((StrCharTypes[C] and C1_PUNCT) <> 0);
   {$ENDIF ~UNICODE_RTL_DATABASE}
@@ -2904,7 +2904,7 @@
 function CharIsSpace(const C: Char): Boolean;
 begin
   {$IFDEF UNICODE_RTL_DATABASE}
-  Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.IsWhiteSpace(C);
+  Result := TCharacter.IsWhiteSpace(C);
   {$ELSE ~UNICODE_RTL_DATABASE}
   Result := (StrCharTypes[C] and C1_SPACE) <> 0;
   {$ENDIF ~UNICODE_RTL_DATABASE}
@@ -2913,7 +2913,7 @@
 function CharIsUpper(const C: Char): Boolean;
 begin
   {$IFDEF UNICODE_RTL_DATABASE}
-  Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.IsUpper(C);
+  Result := TCharacter.IsUpper(C);
   {$ELSE ~UNICODE_RTL_DATABASE}
   Result := (StrCharTypes[C] and C1_UPPER) <> 0;
   {$ENDIF ~UNICODE_RTL_DATABASE}
@@ -3063,7 +3063,7 @@
 function CharLower(const C: Char): Char;
 begin
   {$IFDEF UNICODE_RTL_DATABASE}
-  Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.ToLower(C);
+  Result := TCharacter.ToLower(C);
   {$ELSE ~UNICODE_RTL_DATABASE}
   Result := StrCaseMap[Ord(C) + StrLoOffset];
   {$ENDIF ~UNICODE_RTL_DATABASE}
@@ -3086,7 +3086,7 @@
 function CharUpper(const C: Char): Char;
 begin
   {$IFDEF UNICODE_RTL_DATABASE}
-  Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Character.ToUpper(C);
+  Result := TCharacter.ToUpper(C);
   {$ELSE ~UNICODE_RTL_DATABASE}
   Result := StrCaseMap[Ord(C) + StrUpOffset];
   {$ENDIF ~UNICODE_RTL_DATABASE}

Modified: trunk/jcl/source/common/JclUnicode.pas
===================================================================
--- trunk/jcl/source/common/JclUnicode.pas	2012-01-20 22:42:06 UTC (rev 3693)
+++ trunk/jcl/source/common/JclUnicode.pas	2012-01-21 15:07:37 UTC (rev 3694)
@@ -177,11 +177,17 @@
   Winapi.Windows,
   {$ENDIF MSWINDOWS}
   System.SysUtils, System.Classes,
+  {$IFDEF HAS_UNIT_CHARACTER}
+  System.Character,
+  {$ENDIF HAS_UNIT_CHARACTER}
   {$ELSE ~HAS_UNITSCOPE}
   {$IFDEF MSWINDOWS}
   Windows,
   {$ENDIF MSWINDOWS}
   SysUtils, Classes,
+  {$IFDEF HAS_UNIT_CHARACTER}
+  Character,
+  {$ENDIF HAS_UNIT_CHARACTER}
   {$ENDIF ~HAS_UNITSCOPE}
   JclBase;
 
@@ -319,6 +325,80 @@
   );
   TCharacterCategories = set of TCharacterCategory;
 
+{$IFDEF HAS_UNIT_CHARACTER}
+type
+  TCharacterUnicodeCategory = ccLetterUppercase..ccSymbolOther;
+
+const
+  CharacterCategoryToUnicodeCategory: array [TCharacterUnicodeCategory] of TUnicodeCategory =
+    ( TUnicodeCategory.ucUppercaseLetter,    // ccLetterUppercase
+      TUnicodeCategory.ucLowercaseLetter,    // ccLetterLowercase
+      TUnicodeCategory.ucTitlecaseLetter,    // ccLetterTitlecase
+      TUnicodeCategory.ucNonSpacingMark,     // ccMarkNonSpacing
+      TUnicodeCategory.ucCombiningMark,      // ccMarkSpacingCombining
+      TUnicodeCategory.ucEnclosingMark,      // ccMarkEnclosing
+      TUnicodeCategory.ucDecimalNumber,      // ccNumberDecimalDigit
+      TUnicodeCategory.ucLetterNumber,       // ccNumberLetter
+      TUnicodeCategory.ucOtherNumber,        // ccNumberOther
+      TUnicodeCategory.ucSpaceSeparator,     // ccSeparatorSpace
+      TUnicodeCategory.ucLineSeparator,      // ccSeparatorLine
+      TUnicodeCategory.ucParagraphSeparator, // ccSeparatorParagraph
+      TUnicodeCategory.ucControl,            // ccOtherControl
+      TUnicodeCategory.ucFormat,             // ccOtherFormat
+      TUnicodeCategory.ucSurrogate,          // ccOtherSurrogate
+      TUnicodeCategory.ucPrivateUse,         // ccOtherPrivate
+      TUnicodeCategory.ucUnassigned,         // ccOtherUnassigned
+      TUnicodeCategory.ucModifierLetter,     // ccLetterModifier
+      TUnicodeCategory.ucOtherLetter,        // ccLetterOther
+      TUnicodeCategory.ucConnectPunctuation, // ccPunctuationConnector
+      TUnicodeCategory.ucDashPunctuation,    // ccPunctuationDash
+      TUnicodeCategory.ucOpenPunctuation,    // ccPunctuationOpen
+      TUnicodeCategory.ucClosePunctuation,   // ccPunctuationClose
+      TUnicodeCategory.ucInitialPunctuation, // ccPunctuationInitialQuote
+      TUnicodeCategory.ucFinalPunctuation,   // ccPunctuationFinalQuote
+      TUnicodeCategory.ucOtherPunctuation,   // ccPunctuationOther
+      TUnicodeCategory.ucMathSymbol,         // ccSymbolMath
+      TUnicodeCategory.ucCurrencySymbol,     // ccSymbolCurrency
+      TUnicodeCategory.ucModifierSymbol,     // ccSymbolModifier
+      TUnicodeCategory.ucOtherSymbol );      // ccSymbolOther
+
+  UnicodeCategoryToCharacterCategory: array [TUnicodeCategory] of TCharacterCategory =
+    ( ccOtherControl,            // ucControl
+      ccOtherFormat,             // ucFormat
+      ccOtherUnassigned,         // ucUnassigned
+      ccOtherPrivate,            // ucPrivateUse
+      ccOtherSurrogate,          // ucSurrogate
+      ccLetterLowercase,         // ucLowercaseLetter
+      ccLetterModifier,          // ucModifierLetter
+      ccLetterOther,             // ucOtherLetter
+      ccLetterTitlecase,         // ucTitlecaseLetter
+      ccLetterUppercase,         // ucUppercaseLetter
+      ccMarkSpacingCombining,    // ucCombiningMark
+      ccMarkEnclosing,           // ucEnclosingMark
+      ccMarkNonSpacing,          // ucNonSpacingMark
+      ccNumberDecimalDigit,      // ucDecimalNumber
+      ccNumberLetter,            // ucLetterNumber
+      ccNumberOther,             // ucOtherNumber
+      ccPunctuationConnector,    // ucConnectPunctuation
+      ccPunctuationDash,         // ucDashPunctuation
+      ccPunctuationClose,        // ucClosePunctuation
+      ccPunctuationFinalQuote,   // ucFinalPunctuation
+      ccPunctuationInitialQuote, // ucInitialPunctuation
+      ccPunctuationOther,        // ucOtherPunctuation
+      ccPunctuationOpen,         // ucOpenPunctuation
+      ccSymbolCurrency,          // ucCurrencySymbol
+      ccSymbolModifier,          // ucModifierSymbol
+      ccSymbolMath,              // ucMathSymbol
+      ccSymbolOther,             // ucOtherSymbol
+      ccSeparatorLine,           // ucLineSeparator
+      ccSeparatorParagraph,      // ucParagraphSeparator
+      ccSeparatorSpace );        // ucSpaceSeparator
+
+function CharacterCategoriesToUnicodeCategory(const Categories: TCharacterCategories): TUnicodeCategory;
+function UnicodeCategoryToCharacterCategories(Category: TUnicodeCategory): TCharacterCategories;
+{$ENDIF HAS_UNIT_CHARACTER}
+
+type
   // four forms of normalization are defined:
   TNormalizationForm = (
     nfNone, // do not normalize
@@ -792,6 +872,8 @@
     (Range:(RangeStart: $F0000; RangeEnd: $FFFFF); Name: 'Supplementary Private Use Area-A'),
     (Range:(RangeStart: $100000; RangeEnd: $10FFFF); Name: 'Supplementary Private Use Area-B'));
 
+{$IFNDEF UNICODE_RTL_DATABASE}
+
 type
   TWideStrings = class;
 
@@ -1255,6 +1337,8 @@
     property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
   end;
 
+{$ENDIF ~UNICODE_RTL_DATABASE}
+
 {
 // all these functions are now in JclWideStrings.pas
 function StrLenW(Str: PWideChar): SizeInt;
@@ -1291,10 +1375,12 @@
 // functions involving Delphi wide strings
 function WideAdjustLineBreaks(const S: WideString): WideString;
 function WideCharPos(const S: WideString; const Ch: WideChar; const Index: SizeInt): SizeInt;  //az
+{$IFNDEF UNICODE_RTL_DATABASE}
 function WideCompose(const S: WideString; Compatible: Boolean = True): WideString; overload;
 function WideCompose(const S: WideString; Tags: TCompatibilityFormattingTags): WideString; overload;
 function WideDecompose(const S: WideString; Compatible: Boolean = True): WideString; overload;
 function WideDecompose(const S: WideString; Tags: TCompatibilityFormattingTags): WideString; overload;
+{$ENDIF ~UNICODE_RTL_DATABASE}
 function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString;
 function WideQuotedStr(const S: WideString; Quote: WideChar): WideString;
 function WideStringOfChar(C: WideChar; Count: SizeInt): WideString;
@@ -1303,18 +1389,21 @@
 type
   TCaseType = (ctFold, ctLower, ctTitle, ctUpper);
 
+{$IFNDEF UNICODE_RTL_DATABASE}
+function WideNormalize(const S: WideString; Form: TNormalizationForm): WideString;
+
 function WideCaseConvert(C: WideChar; CaseType: TCaseType): WideString; overload;
 function WideCaseConvert(const S: WideString; CaseType: TCaseType): WideString; overload;
 function WideCaseFolding(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
 function WideCaseFolding(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
+function WideTitleCase(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
+function WideTitleCase(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
+{$ENDIF ~UNICODE_RTL_DATABASE}
 function WideLowerCase(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
 function WideLowerCase(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
-function WideTitleCase(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
-function WideTitleCase(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
 function WideUpperCase(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
 function WideUpperCase(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
 
-function WideNormalize(const S: WideString; Form: TNormalizationForm): WideString;
 function WideSameText(const Str1, Str2: WideString): Boolean;
 function WideTrim(const S: WideString): WideString;
 function WideTrimLeft(const S: WideString): WideString;
@@ -1328,15 +1417,17 @@
   end;
 
 // Low level character routines
+{$IFNDEF UNICODE_RTL_DATABASE}
 function UnicodeNumberLookup(Code: UCS4; var Number: TUcNumber): Boolean;
 function UnicodeCompose(const Codes: array of UCS4; out Composite: UCS4; Compatible: Boolean = True): Integer; overload;
 function UnicodeCompose(const Codes: array of UCS4; out Composite: UCS4; Tags: TCompatibilityFormattingTags): Integer; overload;
 function UnicodeCaseFold(Code: UCS4): TUCS4Array;
 function UnicodeDecompose(Code: UCS4; Compatible: Boolean = True): TUCS4Array; overload;
 function UnicodeDecompose(Code: UCS4; Tags: TCompatibilityFormattingTags): TUCS4Array; overload;
+function UnicodeToTitle(Code: UCS4): TUCS4Array;
+{$ENDIF ~UNICODE_RTL_DATABASE}
 function UnicodeToUpper(Code: UCS4): TUCS4Array;
 function UnicodeToLower(Code: UCS4): TUCS4Array;
-function UnicodeToTitle(Code: UCS4): TUCS4Array;
 
 // Character test routines
 function UnicodeIsAlpha(C: UCS4): Boolean;
@@ -1354,7 +1445,9 @@
 function UnicodeIsUpper(C: UCS4): Boolean;
 function UnicodeIsLower(C: UCS4): Boolean;
 function UnicodeIsTitle(C: UCS4): Boolean;
+{$IFNDEF UNICODE_RTL_DATABASE}
 function UnicodeIsHexDigit(C: UCS4): Boolean;
+{$ENDIF ~UNICODE_RTL_DATABASE}
 function UnicodeIsIsoControl(C: UCS4): Boolean;
 function UnicodeIsFormatControl(C: UCS4): Boolean;
 function UnicodeIsSymbol(C: UCS4): Boolean;
@@ -1364,6 +1457,7 @@
 function UnicodeIsClosePunctuation(C: UCS4): Boolean;
 function UnicodeIsInitialPunctuation(C: UCS4): Boolean;
 function UnicodeIsFinalPunctuation(C: UCS4): Boolean;
+{$IFNDEF UNICODE_RTL_DATABASE}
 function UnicodeIsComposed(C: UCS4): Boolean;
 function UnicodeIsQuotationMark(C: UCS4): Boolean;
 function UnicodeIsSymmetric(C: UCS4): Boolean;
@@ -1381,6 +1475,7 @@
 // Other character test functions
 function UnicodeIsMark(C: UCS4): Boolean;
 function UnicodeIsModifier(C: UCS4): Boolean;
+{$ENDIF ~UNICODE_RTL_DATABASE}
 function UnicodeIsLetterNumber(C: UCS4): Boolean;
 function UnicodeIsConnectionPunctuation(C: UCS4): Boolean;
 function UnicodeIsDash(C: UCS4): Boolean;
@@ -1405,6 +1500,7 @@
 function UnicodeIsConnector(C: UCS4): Boolean;
 function UnicodeIsPunctuationOther(C: UCS4): Boolean;
 function UnicodeIsSymbolOther(C: UCS4): Boolean;
+{$IFNDEF UNICODE_RTL_DATABASE}
 function UnicodeIsLeftToRightEmbedding(C: UCS4): Boolean;
 function UnicodeIsLeftToRightOverride(C: UCS4): Boolean;
 function UnicodeIsRightToLeftArabic(C: UCS4): Boolean;
@@ -1447,6 +1543,7 @@
 function UnicodeIsTerminalPunctuation(C: UCS4): Boolean;
 function UnicodeIsUnifiedIdeograph(C: UCS4): Boolean;
 function UnicodeIsVariationSelector(C: UCS4): Boolean;
+{$ENDIF ~UNICODE_RTL_DATABASE}
 
 // Utility functions
 function CharSetFromLocale(Language: LCID): Byte;
@@ -1509,6 +1606,7 @@
 //       the Unicode database file which can be compiled to the needed res file.
 //       This tool, including its source code, can be downloaded from www.lischke-online.de/Unicode.html.
 
+{$IFNDEF UNICODE_RTL_DATABASE}
 {$IFDEF UNICODE_RAW_DATA}
 {$R JclUnicode.res}
 {$ENDIF UNICODE_RAW_DATA}
@@ -1518,6 +1616,7 @@
 {$IFDEF UNICODE_ZLIB_DATA}
 {$R JclUnicodeZLib.res}
 {$ENDIF UNICODE_ZLIB_DATA}
+{$ENDIF ~UNICODE_RTL_DATABASE}
 
 uses
   {$IFDEF HAS_UNIT_RTLCONSTS}
@@ -1527,6 +1626,7 @@
   RtlConsts,
   {$ENDIF ~HAS_UNITSCOPE}
   {$ENDIF HAS_UNIT_RTLCONSTS}
+  {$IFNDEF UNICODE_RTL_DATABASE}
   {$IFDEF UNICODE_BZIP2_DATA}
   BZip2,
   {$ENDIF UNICODE_BZIP2_DATA}
@@ -1537,6 +1637,7 @@
   {$IFNDEF UNICODE_RAW_DATA}
   JclCompression,
   {$ENDIF ~UNICODE_RAW_DATA}
+  {$ENDIF ~UNICODE_RTL_DATABASE}
   JclResources, JclSynch, JclSysUtils, JclSysInfo, JclStringConversions, JclWideStrings;
 
 const
@@ -1558,7 +1659,59 @@
   // used to negate a set of categories
   ClassAll = [Low(TCharacterCategory)..High(TCharacterCategory)];
 
+{$IFDEF HAS_UNIT_CHARACTER}
+function CharacterCategoriesToUnicodeCategory(const Categories: TCharacterCategories): TUnicodeCategory;
 var
+  Category: TCharacterUnicodeCategory;
+begin
+  for Category := Low(TCharacterUnicodeCategory) to High(TCharacterUnicodeCategory) do
+    if Category in Categories then
+  begin
+    Result := CharacterCategoryToUnicodeCategory[Category];
+    Exit;
+  end;
+  Result := TUnicodeCategory.ucUnassigned;
+end;
+
+function UnicodeCategoryToCharacterCategories(Category: TUnicodeCategory): TCharacterCategories;
+begin
+  Result := [];
+  Include(Result, UnicodeCategoryToCharacterCategory[Category]);
+end;
+{$ENDIF HAS_UNIT_CHARACTER}
+
+{$IFDEF UNICODE_RTL_DATABASE}
+procedure LoadCharacterCategories;
+begin
+  // do nothing, the RTL database is already loaded
+end;
+
+procedure LoadCaseMappingData;
+begin
+  // do nothing, the RTL database is already loaded
+end;
+
+procedure LoadDecompositionData;
+begin
+  // do nothing, the RTL database is already loaded
+end;
+
+procedure LoadCombiningClassData;
+begin
+  // do nothing, the RTL database is already loaded
+end;
+
+procedure LoadNumberData;
+begin
+  // do nothing, the RTL database is already loaded
+end;
+
+procedure LoadCompositionData;
+begin
+  // do nothing, the RTL database is already loaded
+end;
+{$ELSE ~UNICODE_RTL_DATABASE}
+var
   // As the global data can be accessed by several threads it should be guarded
   // while the data is loaded.
   LoadInProgress: TJclCriticalSection;
@@ -1867,26 +2020,40 @@
   end;
 end;
 
+{$ENDIF ~UNICODE_RTL_DATABASE}
+
 function UnicodeToUpper(Code: UCS4): TUCS4Array;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  SetLength(Result, 1);
+  Result[0] := Ord(TCharacter.ToUpper(Chr(Code)));
+  {$ELSE ~UNICODE_RTL_DATABASE}
   SetLength(Result, 0);
   if not CaseLookup(Code, ctUpper, Result) then
   begin
     SetLength(Result, 1);
     Result[0] := Code;
   end;
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeToLower(Code: UCS4): TUCS4Array;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  SetLength(Result, 1);
+  Result[0] := Ord(TCharacter.ToLower(Chr(Code)));
+  {$ELSE ~UNICODE_RTL_DATABASE}
   SetLength(Result, 0);
   if not CaseLookup(Code, ctLower, Result) then
   begin
     SetLength(Result, 1);
     Result[0] := Code;
   end;
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
+{$IFNDEF UNICODE_RTL_DATABASE}
+
 function UnicodeToTitle(Code: UCS4): TUCS4Array;
 begin
   SetLength(Result, 0);
@@ -6103,6 +6270,8 @@
     Sort;
 end;
 
+{$ENDIF ~UNICODE_RTL_DATABASE}
+
 // exchanges in each character of the given string the low order and high order
 // byte to go from LSB to MSB and vice versa.
 // EAX contains address of string
@@ -6314,6 +6483,8 @@
     Result := 0;
 end;
 
+{$IFNDEF UNICODE_RTL_DATABASE}
+
 function WideComposeHangul(const Source: WideString): WideString;
 var
   Len: SizeInt;
@@ -6594,6 +6765,8 @@
   end;
 end;
 
+{$ENDIF ~UNICODE_RTL_DATABASE}
+
 function WideSameText(const Str1, Str2: WideString): Boolean;
 // Compares both strings case-insensitively and returns True if both are equal, otherwise False is returned.
 begin
@@ -6604,6 +6777,8 @@
 
 //----------------- general purpose case mapping ---------------------------------------------------
 
+{$IFNDEF UNICODE_RTL_DATABASE}
+
 function WideCaseConvert(C: WideChar; CaseType: TCaseType): WideString;
 var
   I, RPos: SizeInt;
@@ -6694,16 +6869,28 @@
   Result:= WideCaseConvert(S, ctFold);
 end;
 
+{$ENDIF ~UNICODE_RTL_DATABASE}
+
 function WideLowerCase(C: WideChar): WideString;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.ToLower(C);
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result:= WideCaseConvert(C, ctLower);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function WideLowerCase(const S: WideString): WideString;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.ToLower(S);
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result:= WideCaseConvert(S, ctLower);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
+{$IFNDEF UNICODE_RTL_DATABASE}
+
 function WideTitleCase(C: WideChar): WideString;
 begin
   Result:= WideCaseConvert(C, ctTitle);
@@ -6714,166 +6901,312 @@
   Result:= WideCaseConvert(S, ctTitle);
 end;
 
+{$ENDIF ~UNICODE_RTL_DATABASE}
+
 function WideUpperCase(C: WideChar): WideString;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.ToUpper(C);
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result:= WideCaseConvert(C, ctUpper);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function WideUpperCase(const S: WideString): WideString;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.ToUpper(S);
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result:= WideCaseConvert(S, ctUpper);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 //----------------- character test routines --------------------------------------------------------
 
 function UnicodeIsAlpha(C: UCS4): Boolean; // Is the character alphabetic?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.IsLetter(Chr(C));
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, ClassLetter);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsDigit(C: UCS4): Boolean; // Is the character a digit?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.IsDigit(Chr(C));
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccNumberDecimalDigit]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsAlphaNum(C: UCS4): Boolean; // Is the character alphabetic or a number?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.IsLetterOrDigit(Chr(C));
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, ClassLetter + [ccNumberDecimalDigit]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsNumberOther(C: UCS4): Boolean;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherNumber;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccNumberOther]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsCased(C: UCS4): Boolean;
 // Is the character a "cased" character, i.e. either lower case, title case or upper case
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) in
+    [TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucTitlecaseLetter, TUnicodeCategory.ucUppercaseLetter];
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccLetterLowercase, ccLetterTitleCase, ccLetterUppercase]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsControl(C: UCS4): Boolean;
 // Is the character a control character?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) in
+    [TUnicodeCategory.ucControl, TUnicodeCategory.ucFormat];
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccOtherControl, ccOtherFormat]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsSpace(C: UCS4): Boolean;
 // Is the character a spacing character?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucSpaceSeparator;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, ClassSpace);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsWhiteSpace(C: UCS4): Boolean;
 // Is the character a white space character (same as UnicodeIsSpace plus
 // tabulator, new line etc.)?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucSpaceSeparator;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, ClassSpace + [ccWhiteSpace, ccSegmentSeparator]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsBlank(C: UCS4): Boolean;
 // Is the character a space separator?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucSpaceSeparator;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccSeparatorSpace]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsPunctuation(C: UCS4): Boolean;
 // Is the character a punctuation mark?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) in
+    [TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation,
+     TUnicodeCategory.ucClosePunctuation, TUnicodeCategory.ucFinalPunctuation,
+     TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucOtherPunctuation,
+     TUnicodeCategory.ucOpenPunctuation];
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, ClassPunctuation);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsGraph(C: UCS4): Boolean;
 // Is the character graphical?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) in
+    [TUnicodeCategory.ucCombiningMark, TUnicodeCategory.ucEnclosingMark,
+     TUnicodeCategory.ucNonSpacingMark,
+     TUnicodeCategory.ucDecimalNumber, TUnicodeCategory.ucLetterNumber,
+     TUnicodeCategory.ucOtherNumber,
+     TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter,
+     TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter,
+     TUnicodeCategory.ucUppercaseLetter,
+     TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation,
+     TUnicodeCategory.ucClosePunctuation, TUnicodeCategory.ucFinalPunctuation,
+     TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucOtherPunctuation,
+     TUnicodeCategory.ucOpenPunctuation,
+     TUnicodeCategory.ucCurrencySymbol, TUnicodeCategory.ucModifierSymbol,
+     TUnicodeCategory.ucMathSymbol, TUnicodeCategory.ucOtherSymbol];
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, ClassMark + ClassNumber + ClassLetter + ClassPunctuation + ClassSymbol);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsPrintable(C: UCS4): Boolean;
 // Is the character printable?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) in
+    [TUnicodeCategory.ucCombiningMark, TUnicodeCategory.ucEnclosingMark,
+     TUnicodeCategory.ucNonSpacingMark,
+     TUnicodeCategory.ucDecimalNumber, TUnicodeCategory.ucLetterNumber,
+     TUnicodeCategory.ucOtherNumber,
+     TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter,
+     TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter,
+     TUnicodeCategory.ucUppercaseLetter,
+     TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation,
+     TUnicodeCategory.ucClosePunctuation, TUnicodeCategory.ucFinalPunctuation,
+     TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucOtherPunctuation,
+     TUnicodeCategory.ucOpenPunctuation,
+     TUnicodeCategory.ucCurrencySymbol, TUnicodeCategory.ucModifierSymbol,
+     TUnicodeCategory.ucMathSymbol, TUnicodeCategory.ucOtherSymbol,
+     TUnicodeCategory.ucSpaceSeparator];
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, ClassMark + ClassNumber + ClassLetter + ClassPunctuation + ClassSymbol +
     [ccSeparatorSpace]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsUpper(C: UCS4): Boolean;
 // Is the character already upper case?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucUppercaseLetter;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccLetterUppercase]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsLower(C: UCS4): Boolean;
 // Is the character already lower case?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucLowercaseLetter;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccLetterLowercase]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsTitle(C: UCS4): Boolean;
 // Is the character already title case?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucTitlecaseLetter;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccLetterTitlecase]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
+{$IFNDEF UNICODE_RTL_DATABASE}
 function UnicodeIsHexDigit(C: UCS4): Boolean;
 // Is the character a hex digit?
 begin
   Result := CategoryLookup(C, [ccHexDigit]);
 end;
+{$ENDIF ~UNICODE_RTL_DATABASE}
 
 function UnicodeIsIsoControl(C: UCS4): Boolean;
 // Is the character a C0 control character (< 32)?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucControl;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccOtherControl]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsFormatControl(C: UCS4): Boolean;
 // Is the character a format control character?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucFormat;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccOtherFormat]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsSymbol(C: UCS4): Boolean;
 // Is the character a symbol?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) in
+    [TUnicodeCategory.ucCurrencySymbol, TUnicodeCategory.ucModifierSymbol,
+     TUnicodeCategory.ucMathSymbol, TUnicodeCategory.ucOtherSymbol];
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, ClassSymbol);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsNumber(C: UCS4): Boolean;
 // Is the character a number or digit?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) in
+    [TUnicodeCategory.ucDecimalNumber, TUnicodeCategory.ucLetterNumber,
+     TUnicodeCategory.ucOtherNumber];
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, ClassNumber);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsNonSpacing(C: UCS4): Boolean;
 // Is the character non-spacing?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucNonSpacingMark;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccMarkNonSpacing]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsOpenPunctuation(C: UCS4): Boolean;
 // Is the character an open/left punctuation (e.g. '[')?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOpenPunctuation;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccPunctuationOpen]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsClosePunctuation(C: UCS4): Boolean;
 // Is the character an close/right punctuation (e.g. ']')?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucClosePunctuation;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccPunctuationClose]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsInitialPunctuation(C: UCS4): Boolean;
 // Is the character an initial punctuation (e.g. U+2018 LEFT SINGLE QUOTATION MARK)?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucInitialPunctuation;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccPunctuationInitialQuote]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsFinalPunctuation(C: UCS4): Boolean;
 // Is the character a final punctuation (e.g. U+2019 RIGHT SINGLE QUOTATION MARK)?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucFinalPunctuation;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccPunctuationFinalQuote]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
+{$IFNDEF UNICODE_RTL_DATABASE}
 function UnicodeIsComposed(C: UCS4): Boolean;
 // Can the character be decomposed into a set of other characters?
 begin
@@ -6951,102 +7284,180 @@
 begin
   Result := CategoryLookup(C, [ccLetterModifier]);
 end;
+{$ENDIF ~UNICODE_RTL_DATABASE}
 
 function UnicodeIsLetterNumber(C: UCS4): Boolean;
 // Is the character a number represented by a letter?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucLetterNumber;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccNumberLetter]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsConnectionPunctuation(C: UCS4): Boolean;
 // Is the character connecting punctuation?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucConnectPunctuation;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccPunctuationConnector]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsDash(C: UCS4): Boolean;
 // Is the character a dash punctuation?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucDashPunctuation;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccPunctuationDash]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsMath(C: UCS4): Boolean;
 // Is the character a math character?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucMathSymbol;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccSymbolMath]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsCurrency(C: UCS4): Boolean;
 // Is the character a currency character?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucCurrencySymbol;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccSymbolCurrency]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsModifierSymbol(C: UCS4): Boolean;
 // Is the character a modifier symbol?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucModifierSymbol;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccSymbolModifier]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsSpacingMark(C: UCS4): Boolean;
 // Is the character a spacing mark?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) in
+    [TUnicodeCategory.ucLineSeparator, TUnicodeCategory.ucParagraphSeparator,
+     TUnicodeCategory.ucSpaceSeparator];
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccMarkSpacingCombining]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsEnclosing(C: UCS4): Boolean;
 // Is the character enclosing (i.e. enclosing box)?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucEnclosingMark;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccMarkEnclosing]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsPrivate(C: UCS4): Boolean;
 // Is the character from the Private Use Area?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucPrivateUse;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccOtherPrivate]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsSurrogate(C: UCS4): Boolean;
 // Is the character one of the surrogate codes?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucSurrogate;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccOtherSurrogate]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsLineSeparator(C: UCS4): Boolean;
 // Is the character a line separator?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucLineSeparator;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccSeparatorLine]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsParagraphSeparator(C: UCS4): Boolean;
 // Is th character a paragraph separator;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucParagraphSeparator;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccSeparatorParagraph]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsIdentifierStart(C: UCS4): Boolean;
 // Can the character begin an identifier?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) in
+    [TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter,
+     TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter,
+     TUnicodeCategory.ucUppercaseLetter,
+     TUnicodeCategory.ucLetterNumber];
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, ClassLetter + [ccNumberLetter]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsIdentifierPart(C: UCS4): Boolean;
 // Can the character appear in an identifier?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) in
+    [TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter,
+     TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter,
+     TUnicodeCategory.ucUppercaseLetter,
+     TUnicodeCategory.ucLetterNumber, TUnicodeCategory.ucDecimalNumber,
+     TUnicodeCategory.ucNonSpacingMark, TUnicodeCategory.ucCombiningMark,
+     TUnicodeCategory.ucConnectPunctuation,
+     TUnicodeCategory.ucFormat];
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, ClassLetter + [ccNumberLetter, ccMarkNonSpacing, ccMarkSpacingCombining,
     ccNumberDecimalDigit, ccPunctuationConnector, ccOtherFormat]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsDefined(C: UCS4): Boolean;
 // Is the character defined (appears in one of the data files)?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) <> TUnicodeCategory.ucUnassigned;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccAssigned]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsUndefined(C: UCS4): Boolean;
 // Is the character undefined (not assigned in the Unicode database)?
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucUnassigned;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := not CategoryLookup(C, [ccAssigned]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsHan(C: UCS4): Boolean;
@@ -7063,29 +7474,50 @@
 
 function UnicodeIsUnassigned(C: UCS4): Boolean;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucUnassigned;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccOtherUnassigned]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsLetterOther(C: UCS4): Boolean;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherLetter;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccLetterOther]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsConnector(C: UCS4): Boolean;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucConnectPunctuation;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccPunctuationConnector]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsPunctuationOther(C: UCS4): Boolean;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherPunctuation;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccPunctuationOther]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 function UnicodeIsSymbolOther(C: UCS4): Boolean;
 begin
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherSymbol;
+  {$ELSE ~UNICODE_RTL_DATABASE}
   Result := CategoryLookup(C, [ccSymbolOther]);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
+{$IFNDEF UNICODE_RTL_DATABASE}
 function UnicodeIsLeftToRightEmbedding(C: UCS4): Boolean;
 begin
   Result := CategoryLookup(C, [ccLeftToRightEmbedding]);
@@ -7295,6 +7727,7 @@
 begin
   Result := CategoryLookup(C, [ccVariationSelector]);
 end;
+{$ENDIF ~UNICODE_RTL_DATABASE}
 
 // I need to fix a problem (introduced by MS) here. The first parameter can be a pointer
 // (and is so defined) or can be a normal DWORD, depending on the dwFlags parameter.
@@ -7529,7 +7962,9 @@
 procedure PrepareUnicodeData;
 // Prepares structures which are globally needed.
 begin
+  {$IFNDEF UNICODE_RTL_DATABASE}
   LoadInProgress := TJclCriticalSection.Create;
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 
   if (Win32Platform and VER_PLATFORM_WIN32_NT) <> 0 then
     @WideCompareText := @CompareTextWinNT
@@ -7540,7 +7975,9 @@
 procedure FreeUnicodeData;
 // Frees all data which has been allocated and which is not automatically freed by Delphi.
 begin
+  {$IFNDEF UNICODE_RTL_DATABASE}
   FreeAndNil(LoadInProgress);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
 end;
 
 initialization

Modified: trunk/jcl/source/common/JclWideStrings.pas
===================================================================
--- trunk/jcl/source/common/JclWideStrings.pas	2012-01-20 22:42:06 UTC (rev 3693)
+++ trunk/jcl/source/common/JclWideStrings.pas	2012-01-21 15:07:37 UTC (rev 3694)
@@ -371,9 +371,7 @@
   {$ENDIF MSWINDOWS}
   Math,
   {$ENDIF ~HAS_UNITSCOPE}
-  {$IFNDEF UNICODE_RTL_DATABASE}
   JclUnicode,
-  {$ENDIF ~UNICODE_RTL_DATABASE}
   JclResources;
 
 procedure SwapWordByteOrder(P: PWideChar; Len: SizeInt);

Modified: trunk/jcl/source/prototypes/JclAlgorithms.pas
===================================================================
--- trunk/jcl/source/prototypes/JclAlgorithms.pas	2012-01-20 22:42:06 UTC (rev 3693)
+++ trunk/jcl/source/prototypes/JclAlgorithms.pas	2012-01-21 15:07:37 UTC (rev 3694)
@@ -225,6 +225,9 @@
   {$IFDEF HAS_UNIT_ANSISTRINGS}
   System.AnsiStrings,
   {$ENDIF HAS_UNIT_ANSISTRINGS}
+  {$IFDEF UNICODE_RTL_DATABASE}
+  System.Character,
+  {$ENDIF UNICODE_RTL_DATABASE}
   System.SysUtils,
   {$ELSE ~HAS_UNITSCOPE}
   {$IFDEF COMPILER11_UP}
@@ -233,6 +236,9 @@
   {$IFDEF HAS_UNIT_ANSISTRINGS}
   AnsiStrings,
   {$ENDIF HAS_UNIT_ANSISTRINGS}
+  {$IFDEF UNICODE_RTL_DATABASE}
+  Character,
+  {$ENDIF UNICODE_RTL_DATABASE}
   SysUtils,
   {$ENDIF ~HAS_UNITSCOPE}
   JclAnsiStrings, JclStringConversions, JclUnicode;
@@ -612,11 +618,19 @@
   IntegerHash.H3 := 2;
   IntegerHash.H4 := 3;
   I := 1;
+  {$IFDEF UNICODE_RTL_DATABASE}
+  SetLength(CA, 1);
+  {$ELSE ~UNICODE_RTL_DATABASE}
   SetLength(CA, 0);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
   while I < Length(AString) do
   begin
     C.C := UTF8GetNextChar(AString, I);
+    {$IFDEF UNICODE_RTL_DATABASE}
+    CA[0] := Ord(TCharacter.ToLower(Chr(C.C)));
+    {$ELSE ~UNICODE_RTL_DATABASE}
     CA := UnicodeCaseFold(C.C);
+    {$ENDIF ~UNICODE_RTL_DATABASE}
     for J := Low(CA) to High(CA) do
     begin
       C.C := CA[J];
@@ -667,12 +681,20 @@
   IntegerHash.H2 := 1;
   IntegerHash.H3 := 2;
   IntegerHash.H4 := 3;
+  {$IFDEF UNICODE_RTL_DATABASE}
+  SetLength(CA, 1);
+  {$ELSE ~UNICODE_RTL_DATABASE}
   SetLength(CA, 0);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
   I := 1;
   while I < Length(AString) do
   begin
     C.C := UTF16GetNextChar(AString, I);
+    {$IFDEF UNICODE_RTL_DATABASE}
+    CA[0] := Ord(TCharacter.ToLower(Chr(C.C)));
+    {$ELSE ~UNICODE_RTL_DATABASE}
     CA := UnicodeCaseFold(C.C);
+    {$ENDIF ~UNICODE_RTL_DATABASE}
     for J := Low(CA) to High(CA) do
     begin
       C.C := CA[J];
@@ -724,12 +746,20 @@
   IntegerHash.H2 := 1;
   IntegerHash.H3 := 2;
   IntegerHash.H4 := 3;
+  {$IFDEF UNICODE_RTL_DATABASE}
+  SetLength(CA, 1);
+  {$ELSE ~UNICODE_RTL_DATABASE}
   SetLength(CA, 0);
+  {$ENDIF ~UNICODE_RTL_DATABASE}
   I := 1;
   while I < Length(AString) do
   begin
     C.C := UTF16GetNextChar(AString, I);
+    {$IFDEF UNICODE_RTL_DATABASE}
+    CA[0] := Ord(TCharacter.ToLower(Chr(C.C)));
+    {$ELSE ~UNICODE_RTL_DATABASE}
     CA := UnicodeCaseFold(C.C);
+    {$ENDIF ~UNICODE_RTL_DATABASE}
     for J := Low(CA) to High(CA) do
     begin
       C.C := CA[J];

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

[Jcl-checkins-diff] SF.net SVN: jcl:[3693] trunk/website/sourceforge/daily/index.php

From: <ou...@us...> - 2012-01-20 22:42:13

Revision: 3693
          http://jcl.svn.sourceforge.net/jcl/?rev=3693&view=rev
Author:   outchy
Date:     2012-01-20 22:42:06 +0000 (Fri, 20 Jan 2012)
Log Message:
-----------
Add sourceforge logo.

Modified Paths:
--------------
    trunk/website/sourceforge/daily/index.php

Modified: trunk/website/sourceforge/daily/index.php
===================================================================
--- trunk/website/sourceforge/daily/index.php	2012-01-19 18:41:57 UTC (rev 3692)
+++ trunk/website/sourceforge/daily/index.php	2012-01-20 22:42:06 UTC (rev 3693)
@@ -160,5 +160,5 @@
 <br>
 Thank you for considering the JCL.<br>
 <br>
-</body>
+<a href="http://sourceforge.net/projects/jcl"><img src="http://sflogo.sourceforge.net/sflogo.php?group_id=47514&amp;type=15" width="150" height="40" alt="Get JEDI Code Library at SourceForge.net. Fast, secure and Free Open Source software downloads" /></a></body>
 </html>

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

49 messages has been excluded from this view by a project administrator.

Flat | Threaded

<< < 1 .. 6 7 8 9 10 .. 92 > >> (Page 8 of 92)