Menu
▾
▴
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
|
|
From: <ou...@us...> - 2007-11-11 15:50:16
|
Revision: 2212
http://jcl.svn.sourceforge.net/jcl/?rev=2212&view=rev
Author: outchy
Date: 2007-11-11 07:50:03 -0800 (Sun, 11 Nov 2007)
Log Message:
-----------
Delphi.net 2007 doesn't support Copy function.
Added parameterized types support for sorted maps.
Modified Paths:
--------------
trunk/jcl/source/common/JclSortedMaps.pas
trunk/jcl/source/prototypes/JclSortedMaps.pas
trunk/jcl/source/prototypes/containers/JclSortedMaps.imp
Modified: trunk/jcl/source/common/JclSortedMaps.pas
===================================================================
--- trunk/jcl/source/common/JclSortedMaps.pas 2007-11-11 07:11:50 UTC (rev 2211)
+++ trunk/jcl/source/common/JclSortedMaps.pas 2007-11-11 15:50:03 UTC (rev 2212)
@@ -653,7 +653,7 @@
property OwnsValues: Boolean read FOwnsValues;
end;
- {$IFDEF SUPPORTS_GENERICS_DISABLED}
+ {$IFDEF SUPPORTS_GENERICS}
TJclEntry<TKey,TValue> = record
Key: TKey;
@@ -719,6 +719,7 @@
private
FKeyComparer: IComparer<TKey>;
FValueComparer: IComparer<TValue>;
+ FValueEqualityComparer: IEqualityComparer<TValue>;
protected
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
function KeysCompare(const A, B: TKey): Integer; override;
@@ -730,10 +731,12 @@
function IJclIntfCloneable.Clone = IntfClone;
public
constructor Create(const AKeyComparer: IComparer<TKey>; const AValueComparer: IComparer<TValue>;
- ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
+ const AValueEqualityComparer: IEqualityComparer<TValue>; ACapacity: Integer; AOwnsValues: Boolean;
+ AOwnsKeys: Boolean);
property KeyComparer: IComparer<TKey> read FKeyComparer write FKeyComparer;
property ValueComparer: IComparer<TValue> read FValueComparer write FValueComparer;
+ property ValueEqualityComparer: IEqualityComparer<TValue> read FValueEqualityComparer write FValueEqualityComparer;
end;
// F = Functions to compare items
@@ -742,6 +745,7 @@
private
FKeyCompare: TCompare<TKey>;
FValueCompare: TCompare<TValue>;
+ FValueEqualityCompare: TEqualityCompare<TValue>;
protected
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
function KeysCompare(const A, B: TKey): Integer; override;
@@ -753,14 +757,15 @@
function IJclIntfCloneable.Clone = IntfClone;
public
constructor Create(AKeyCompare: TCompare<TKey>; AValueCompare: TCompare<TValue>;
- ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
+ AValueEqualityCompare: TEqualityCompare<TValue>; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
property KeyCompare: TCompare<TKey> read FKeyCompare write FKeyCompare;
property ValueCompare: TCompare<TValue> read FValueCompare write FValueCompare;
+ property ValueEqualityCompare: TEqualityCompare<TValue> read FValueEqualityCompare write FValueEqualityCompare;
end;
// I = items can compare themselves to an other
- TJclSortedMapI<TKey: IComparable<TKey>; TValue: IComparable<TValue>> = class(TJclSortedMap<TKey, TValue>,
+ TJclSortedMapI<TKey: IComparable<TKey>; TValue: IComparable<TValue>, IEquatable<TValue>> = class(TJclSortedMap<TKey, TValue>,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclContainer,
IJclMap<TKey,TValue>, IJclSortedMap<TKey,TValue>, IJclPairOwner<TKey, TValue>)
protected
@@ -1022,8 +1027,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -1319,8 +1328,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -1332,7 +1345,7 @@
function TJclIntfIntfSortedMap.TailMap(const FromKey: IInterface): IJclIntfIntfSortedMap;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclIntfIntfSortedMap;
begin
{$IFDEF THREADSAFE}
@@ -1346,8 +1359,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -1612,8 +1630,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -1909,8 +1931,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -1922,7 +1948,7 @@
function TJclAnsiStrIntfSortedMap.TailMap(const FromKey: AnsiString): IJclAnsiStrIntfSortedMap;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclAnsiStrIntfSortedMap;
begin
{$IFDEF THREADSAFE}
@@ -1936,8 +1962,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -2202,8 +2233,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -2499,8 +2534,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -2512,7 +2551,7 @@
function TJclIntfAnsiStrSortedMap.TailMap(const FromKey: IInterface): IJclIntfAnsiStrSortedMap;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclIntfAnsiStrSortedMap;
begin
{$IFDEF THREADSAFE}
@@ -2526,8 +2565,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -2794,8 +2838,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -3091,8 +3139,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -3104,7 +3156,7 @@
function TJclAnsiStrAnsiStrSortedMap.TailMap(const FromKey: AnsiString): IJclAnsiStrAnsiStrSortedMap;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclAnsiStrAnsiStrSortedMap;
begin
{$IFDEF THREADSAFE}
@@ -3118,8 +3170,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -3386,8 +3443,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -3683,8 +3744,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -3696,7 +3761,7 @@
function TJclWideStrIntfSortedMap.TailMap(const FromKey: WideString): IJclWideStrIntfSortedMap;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclWideStrIntfSortedMap;
begin
{$IFDEF THREADSAFE}
@@ -3710,8 +3775,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -3976,8 +4046,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -4273,8 +4347,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -4286,7 +4364,7 @@
function TJclIntfWideStrSortedMap.TailMap(const FromKey: IInterface): IJclIntfWideStrSortedMap;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclIntfWideStrSortedMap;
begin
{$IFDEF THREADSAFE}
@@ -4300,8 +4378,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -4568,8 +4651,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -4865,8 +4952,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -4878,7 +4969,7 @@
function TJclWideStrWideStrSortedMap.TailMap(const FromKey: WideString): IJclWideStrWideStrSortedMap;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclWideStrWideStrSortedMap;
begin
{$IFDEF THREADSAFE}
@@ -4892,8 +4983,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -5173,8 +5269,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -5470,8 +5570,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -5483,7 +5587,7 @@
function TJclIntfSortedMap.TailMap(const FromKey: IInterface): IJclIntfSortedMap;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclIntfSortedMap;
begin
{$IFDEF THREADSAFE}
@@ -5497,8 +5601,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -5778,8 +5887,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -6075,8 +6188,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -6088,7 +6205,7 @@
function TJclAnsiStrSortedMap.TailMap(const FromKey: AnsiString): IJclAnsiStrSortedMap;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclAnsiStrSortedMap;
begin
{$IFDEF THREADSAFE}
@@ -6102,8 +6219,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -6383,8 +6505,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -6680,8 +6806,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -6693,7 +6823,7 @@
function TJclWideStrSortedMap.TailMap(const FromKey: WideString): IJclWideStrSortedMap;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclWideStrSortedMap;
begin
{$IFDEF THREADSAFE}
@@ -6707,8 +6837,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -7001,8 +7136,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -7298,8 +7437,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -7311,7 +7454,7 @@
function TJclSortedMap.TailMap(FromKey: TObject): IJclSortedMap;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclSortedMap;
begin
{$IFDEF THREADSAFE}
@@ -7325,8 +7468,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -7360,7 +7508,7 @@
end;
-{$IFDEF SUPPORTS_GENERICS_DISABLED}
+{$IFDEF SUPPORTS_GENERICS}
//=== { TJclSortedMap<TKey,TValue> } ==============================================
@@ -7616,8 +7764,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -7678,7 +7830,7 @@
ReadLock;
try
{$ENDIF THREADSAFE}
- Result := TJclArraySet<TKey>.Create(FSize, False);
+ Result := CreateEmptyArraySet(FSize, False);
for Index := 0 to FSize - 1 do
Result.Add(FEntries[Index].Key);
{$IFDEF THREADSAFE}
@@ -7909,8 +8061,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -7922,7 +8078,7 @@
function TJclSortedMap<TKey,TValue>.TailMap(const FromKey: TKey): IJclSortedMap<TKey,TValue>;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: TJclSortedMap<TKey,TValue>;
begin
{$IFDEF THREADSAFE}
@@ -7936,8 +8092,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -7955,7 +8116,7 @@
ReadLock;
try
{$ENDIF THREADSAFE}
- Result := TJclArrayList<TValue>.Create(FSize, False);
+ Result := CreateEmptyArrayList(FSize, False);
for Index := 0 to FSize - 1 do
Result.Add(FEntries[Index].Value);
{$IFDEF THREADSAFE}
@@ -7967,12 +8128,152 @@
-{function TJclSortedMap<TKey,TValue>.CreateEmptyContainer: TJclAbstractContainerBase;
+//=== { TJclSortedMapE<TKey, TValue> } =======================================
+
+constructor TJclSortedMapE<TKey, TValue>.Create(const AKeyComparer: IComparer<TKey>;
+ const AValueComparer: IComparer<TValue>; const AValueEqualityComparer: IEqualityComparer<TValue>; ACapacity: Integer;
+ AOwnsValues: Boolean; AOwnsKeys: Boolean);
begin
- Result := TJclSortedMap<TKey,TValue>.Create(FSize, False, False);
+ inherited Create(ACapacity, AOwnsValues, AOwnsKeys);
+ FKeyComparer := AKeyComparer;
+ FValueComparer := AValueComparer;
+ FValueEqualityComparer := AValueEqualityComparer;
+end;
+
+procedure TJclSortedMapE<TKey, TValue>.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
+var
+ ADest: TJclSortedMapE<TKey, TValue>;
+begin
+ inherited AssignPropertiesTo(Dest);
+ if Dest is TJclSortedMapE<TKey, TValue> then
+ begin
+ ADest := TJclSortedMapE<TKey, TValue>(Dest);
+ ADest.FKeyComparer := FKeyComparer;
+ ADest.FValueComparer := FValueComparer;
+ end;
+end;
+
+function TJclSortedMapE<TKey, TValue>.CreateEmptyArrayList(ACapacity: Integer;
+ AOwnsObjects: Boolean): IJclCollection<TValue>;
+begin
+ if FValueEqualityComparer = nil then
+ raise EJclNoEqualityComparerError.Create;
+ Result := TJclArrayListE<TValue>.Create(FValueEqualityComparer, ACapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapE<TKey, TValue>.CreateEmptyContainer: TJclAbstractContainerBase;
+begin
+ Result := TJclSortedMapE<TKey, TValue>.Create(FKeyComparer, FValueComparer, FValueEqualityComparer, FCapacity,
+ FOwnsValues, FOwnsKeys);
AssignPropertiesTo(Result);
-end;}
+end;
+function TJclSortedMapE<TKey, TValue>.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet<TKey>;
+begin
+ Result := TJclArraySetE<TKey>.Create(FKeyComparer, FCapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapE<TKey, TValue>.KeysCompare(const A, B: TKey): Integer;
+begin
+ if KeyComparer = nil then
+ raise EJclNoComparerError.Create;
+ Result := KeyComparer.Compare(A, B);
+end;
+
+function TJclSortedMapE<TKey, TValue>.ValuesCompare(const A, B: TValue): Integer;
+begin
+ if ValueComparer = nil then
+ raise EJclNoComparerError.Create;
+ Result := ValueComparer.Compare(A, B);
+end;
+
+//=== { TJclSortedMapF<TKey, TValue> } =======================================
+
+constructor TJclSortedMapF<TKey, TValue>.Create(AKeyCompare: TCompare<TKey>; AValueCompare: TCompare<TValue>;
+ AValueEqualityCompare: TEqualityCompare<TValue>; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
+begin
+ inherited Create(ACapacity, AOwnsValues, AOwnsKeys);
+ FKeyCompare := AKeyCompare;
+ FValueCompare := AValueCompare;
+ FValueEqualityCompare := AValueEqualityCompare;
+end;
+
+procedure TJclSortedMapF<TKey, TValue>.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
+var
+ ADest: TJclSortedMapF<TKey, TValue>;
+begin
+ inherited AssignPropertiesTo(Dest);
+ if Dest is TJclSortedMapF<TKey, TValue> then
+ begin
+ ADest := TJclSortedMapF<TKey, TValue>(Dest);
+ ADest.FKeyCompare := FKeyCompare;
+ ADest.FValueCompare := FValueCompare;
+ end;
+end;
+
+function TJclSortedMapF<TKey, TValue>.CreateEmptyArrayList(ACapacity: Integer;
+ AOwnsObjects: Boolean): IJclCollection<TValue>;
+begin
+ if not Assigned(FValueEqualityCompare) then
+ raise EJclNoEqualityComparerError.Create;
+ Result := TJclArrayListF<TValue>.Create(FValueEqualityCompare, ACapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapF<TKey, TValue>.CreateEmptyContainer: TJclAbstractContainerBase;
+begin
+ Result := TJclSortedMapF<TKey, TValue>.Create(FKeyCompare, FValueCompare, FValueEqualityCompare, FCapacity,
+ FOwnsValues, FOwnsKeys);
+ AssignPropertiesTo(Result);
+end;
+
+function TJclSortedMapF<TKey, TValue>.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet<TKey>;
+begin
+ Result := TJclArraySetF<TKey>.Create(FKeyCompare, FCapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapF<TKey, TValue>.KeysCompare(const A, B: TKey): Integer;
+begin
+ if not Assigned(KeyCompare) then
+ raise EJclNoComparerError.Create;
+ Result := KeyCompare(A, B);
+end;
+
+function TJclSortedMapF<TKey, TValue>.ValuesCompare(const A, B: TValue): Integer;
+begin
+ if not Assigned(ValueCompare) then
+ raise EJclNoComparerError.Create;
+ Result := ValueCompare(A, B);
+end;
+
+//=== { TJclSortedMapI<TKey, TValue> } =======================================
+
+function TJclSortedMapI<TKey, TValue>.CreateEmptyArrayList(ACapacity: Integer;
+ AOwnsObjects: Boolean): IJclCollection<TValue>;
+begin
+ Result := TJclArrayListI<TValue>.Create(ACapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapI<TKey, TValue>.CreateEmptyContainer: TJclAbstractContainerBase;
+begin
+ Result := TJclSortedMapI<TKey, TValue>.Create(FCapacity, FOwnsValues, FOwnsKeys);
+ AssignPropertiesTo(Result);
+end;
+
+function TJclSortedMapI<TKey, TValue>.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet<TKey>;
+begin
+ Result := TJclArraySetI<TKey>.Create(FCapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapI<TKey, TValue>.KeysCompare(const A, B: TKey): Integer;
+begin
+ Result := A.CompareTo(B);
+end;
+
+function TJclSortedMapI<TKey, TValue>.ValuesCompare(const A, B: TValue): Integer;
+begin
+ Result := A.CompareTo(B);
+end;
+
{$ENDIF SUPPORTS_GENERICS}
{$IFDEF UNITVERSIONING}
Modified: trunk/jcl/source/prototypes/JclSortedMaps.pas
===================================================================
--- trunk/jcl/source/prototypes/JclSortedMaps.pas 2007-11-11 07:11:50 UTC (rev 2211)
+++ trunk/jcl/source/prototypes/JclSortedMaps.pas 2007-11-11 15:50:03 UTC (rev 2212)
@@ -166,7 +166,7 @@
property OwnsKeys: Boolean read FOwnsKeys;
property OwnsValues: Boolean read FOwnsValues;,; AOwnsKeys: Boolean,; AOwnsValues: Boolean,Key: TObject,Value: TObject,ToKey: TObject,FromKey\, ToKey: TObject,FromKey: TObject)*)
- {$IFDEF SUPPORTS_GENERICS_DISABLED}
+ {$IFDEF SUPPORTS_GENERICS}
(*$JPPEXPANDMACRO JCLSORTEDMAPINT(TKey,TValue,TJclEntry<TKey\,TValue>,TJclEntryArray<TKey\,TValue>,TJclSortedMap<TKey\,TValue>,TJclAbstractContainerBase,IJclMap<TKey\,TValue>,IJclSortedMap<TKey\,TValue>,IJclSet<TKey>,IJclCollection<TValue>, IJclPairOwner<TKey\,TValue>\,,
FOwnsKeys: Boolean;
FOwnsValues: Boolean;,
@@ -188,6 +188,7 @@
private
FKeyComparer: IComparer<TKey>;
FValueComparer: IComparer<TValue>;
+ FValueEqualityComparer: IEqualityComparer<TValue>;
protected
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
function KeysCompare(const A, B: TKey): Integer; override;
@@ -199,10 +200,12 @@
function IJclIntfCloneable.Clone = IntfClone;
public
constructor Create(const AKeyComparer: IComparer<TKey>; const AValueComparer: IComparer<TValue>;
- ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
+ const AValueEqualityComparer: IEqualityComparer<TValue>; ACapacity: Integer; AOwnsValues: Boolean;
+ AOwnsKeys: Boolean);
property KeyComparer: IComparer<TKey> read FKeyComparer write FKeyComparer;
property ValueComparer: IComparer<TValue> read FValueComparer write FValueComparer;
+ property ValueEqualityComparer: IEqualityComparer<TValue> read FValueEqualityComparer write FValueEqualityComparer;
end;
// F = Functions to compare items
@@ -211,6 +214,7 @@
private
FKeyCompare: TCompare<TKey>;
FValueCompare: TCompare<TValue>;
+ FValueEqualityCompare: TEqualityCompare<TValue>;
protected
procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
function KeysCompare(const A, B: TKey): Integer; override;
@@ -222,14 +226,15 @@
function IJclIntfCloneable.Clone = IntfClone;
public
constructor Create(AKeyCompare: TCompare<TKey>; AValueCompare: TCompare<TValue>;
- ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
+ AValueEqualityCompare: TEqualityCompare<TValue>; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
property KeyCompare: TCompare<TKey> read FKeyCompare write FKeyCompare;
property ValueCompare: TCompare<TValue> read FValueCompare write FValueCompare;
+ property ValueEqualityCompare: TEqualityCompare<TValue> read FValueEqualityCompare write FValueEqualityCompare;
end;
// I = items can compare themselves to an other
- TJclSortedMapI<TKey: IComparable<TKey>; TValue: IComparable<TValue>> = class(TJclSortedMap<TKey, TValue>,
+ TJclSortedMapI<TKey: IComparable<TKey>; TValue: IComparable<TValue>, IEquatable<TValue>> = class(TJclSortedMap<TKey, TValue>,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclContainer,
IJclMap<TKey,TValue>, IJclSortedMap<TKey,TValue>, IJclPairOwner<TKey, TValue>)
protected
@@ -858,11 +863,11 @@
{$JPPUNDEFMACRO KEYSCOMPARE}
{$JPPUNDEFMACRO VALUESCOMPARE}
-{$IFDEF SUPPORTS_GENERICS_DISABLED}
+{$IFDEF SUPPORTS_GENERICS}
{$JPPDEFINEMACRO CREATEEMPTYCONTAINER}
-{$JPPDEFINEMACRO CREATEEMPTYARRAYSET(Param)TJclArraySet<TKey>.Create(Param, False)}
-{$JPPDEFINEMACRO CREATEEMPTYARRAYLIST(Param)TJclArrayList<TValue>.Create(Param, False)}
+{$JPPDEFINEMACRO CREATEEMPTYARRAYSET(Param)CreateEmptyArraySet(Param, False)}
+{$JPPDEFINEMACRO CREATEEMPTYARRAYLIST(Param)CreateEmptyArrayList(Param, False)}
{$JPPDEFINEMACRO FREEKEY
function TJclSortedMap<TKey,TValue>.FreeKey(var Key: TKey): TKey;
begin
@@ -920,12 +925,152 @@
{$JPPUNDEFMACRO KEYSCOMPARE}
{$JPPUNDEFMACRO VALUESCOMPARE}
-{function TJclSortedMap<TKey,TValue>.CreateEmptyContainer: TJclAbstractContainerBase;
+//=== { TJclSortedMapE<TKey, TValue> } =======================================
+
+constructor TJclSortedMapE<TKey, TValue>.Create(const AKeyComparer: IComparer<TKey>;
+ const AValueComparer: IComparer<TValue>; const AValueEqualityComparer: IEqualityComparer<TValue>; ACapacity: Integer;
+ AOwnsValues: Boolean; AOwnsKeys: Boolean);
begin
- Result := TJclSortedMap<TKey,TValue>.Create(FSize, False, False);
+ inherited Create(ACapacity, AOwnsValues, AOwnsKeys);
+ FKeyComparer := AKeyComparer;
+ FValueComparer := AValueComparer;
+ FValueEqualityComparer := AValueEqualityComparer;
+end;
+
+procedure TJclSortedMapE<TKey, TValue>.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
+var
+ ADest: TJclSortedMapE<TKey, TValue>;
+begin
+ inherited AssignPropertiesTo(Dest);
+ if Dest is TJclSortedMapE<TKey, TValue> then
+ begin
+ ADest := TJclSortedMapE<TKey, TValue>(Dest);
+ ADest.FKeyComparer := FKeyComparer;
+ ADest.FValueComparer := FValueComparer;
+ end;
+end;
+
+function TJclSortedMapE<TKey, TValue>.CreateEmptyArrayList(ACapacity: Integer;
+ AOwnsObjects: Boolean): IJclCollection<TValue>;
+begin
+ if FValueEqualityComparer = nil then
+ raise EJclNoEqualityComparerError.Create;
+ Result := TJclArrayListE<TValue>.Create(FValueEqualityComparer, ACapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapE<TKey, TValue>.CreateEmptyContainer: TJclAbstractContainerBase;
+begin
+ Result := TJclSortedMapE<TKey, TValue>.Create(FKeyComparer, FValueComparer, FValueEqualityComparer, FCapacity,
+ FOwnsValues, FOwnsKeys);
AssignPropertiesTo(Result);
-end;}
+end;
+function TJclSortedMapE<TKey, TValue>.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet<TKey>;
+begin
+ Result := TJclArraySetE<TKey>.Create(FKeyComparer, FCapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapE<TKey, TValue>.KeysCompare(const A, B: TKey): Integer;
+begin
+ if KeyComparer = nil then
+ raise EJclNoComparerError.Create;
+ Result := KeyComparer.Compare(A, B);
+end;
+
+function TJclSortedMapE<TKey, TValue>.ValuesCompare(const A, B: TValue): Integer;
+begin
+ if ValueComparer = nil then
+ raise EJclNoComparerError.Create;
+ Result := ValueComparer.Compare(A, B);
+end;
+
+//=== { TJclSortedMapF<TKey, TValue> } =======================================
+
+constructor TJclSortedMapF<TKey, TValue>.Create(AKeyCompare: TCompare<TKey>; AValueCompare: TCompare<TValue>;
+ AValueEqualityCompare: TEqualityCompare<TValue>; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
+begin
+ inherited Create(ACapacity, AOwnsValues, AOwnsKeys);
+ FKeyCompare := AKeyCompare;
+ FValueCompare := AValueCompare;
+ FValueEqualityCompare := AValueEqualityCompare;
+end;
+
+procedure TJclSortedMapF<TKey, TValue>.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
+var
+ ADest: TJclSortedMapF<TKey, TValue>;
+begin
+ inherited AssignPropertiesTo(Dest);
+ if Dest is TJclSortedMapF<TKey, TValue> then
+ begin
+ ADest := TJclSortedMapF<TKey, TValue>(Dest);
+ ADest.FKeyCompare := FKeyCompare;
+ ADest.FValueCompare := FValueCompare;
+ end;
+end;
+
+function TJclSortedMapF<TKey, TValue>.CreateEmptyArrayList(ACapacity: Integer;
+ AOwnsObjects: Boolean): IJclCollection<TValue>;
+begin
+ if not Assigned(FValueEqualityCompare) then
+ raise EJclNoEqualityComparerError.Create;
+ Result := TJclArrayListF<TValue>.Create(FValueEqualityCompare, ACapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapF<TKey, TValue>.CreateEmptyContainer: TJclAbstractContainerBase;
+begin
+ Result := TJclSortedMapF<TKey, TValue>.Create(FKeyCompare, FValueCompare, FValueEqualityCompare, FCapacity,
+ FOwnsValues, FOwnsKeys);
+ AssignPropertiesTo(Result);
+end;
+
+function TJclSortedMapF<TKey, TValue>.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet<TKey>;
+begin
+ Result := TJclArraySetF<TKey>.Create(FKeyCompare, FCapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapF<TKey, TValue>.KeysCompare(const A, B: TKey): Integer;
+begin
+ if not Assigned(KeyCompare) then
+ raise EJclNoComparerError.Create;
+ Result := KeyCompare(A, B);
+end;
+
+function TJclSortedMapF<TKey, TValue>.ValuesCompare(const A, B: TValue): Integer;
+begin
+ if not Assigned(ValueCompare) then
+ raise EJclNoComparerError.Create;
+ Result := ValueCompare(A, B);
+end;
+
+//=== { TJclSortedMapI<TKey, TValue> } =======================================
+
+function TJclSortedMapI<TKey, TValue>.CreateEmptyArrayList(ACapacity: Integer;
+ AOwnsObjects: Boolean): IJclCollection<TValue>;
+begin
+ Result := TJclArrayListI<TValue>.Create(ACapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapI<TKey, TValue>.CreateEmptyContainer: TJclAbstractContainerBase;
+begin
+ Result := TJclSortedMapI<TKey, TValue>.Create(FCapacity, FOwnsValues, FOwnsKeys);
+ AssignPropertiesTo(Result);
+end;
+
+function TJclSortedMapI<TKey, TValue>.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet<TKey>;
+begin
+ Result := TJclArraySetI<TKey>.Create(FCapacity, AOwnsObjects);
+end;
+
+function TJclSortedMapI<TKey, TValue>.KeysCompare(const A, B: TKey): Integer;
+begin
+ Result := A.CompareTo(B);
+end;
+
+function TJclSortedMapI<TKey, TValue>.ValuesCompare(const A, B: TValue): Integer;
+begin
+ Result := A.CompareTo(B);
+end;
+
{$ENDIF SUPPORTS_GENERICS}
{$IFDEF UNITVERSIONING}
Modified: trunk/jcl/source/prototypes/containers/JclSortedMaps.imp
===================================================================
--- trunk/jcl/source/prototypes/containers/JclSortedMaps.imp 2007-11-11 07:11:50 UTC (rev 2211)
+++ trunk/jcl/source/prototypes/containers/JclSortedMaps.imp 2007-11-11 15:50:03 UTC (rev 2212)
@@ -268,8 +268,12 @@
if ToIndex >= 0 then
begin
NewMap.SetCapacity(ToIndex + 1);
- NewMap.FEntries := Copy(FEntries, 0, ToIndex + 1);
NewMap.FSize := ToIndex + 1;
+ while ToIndex >= 0 do
+ begin
+ NewMap.FEntries[ToIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -561,8 +565,12 @@
if (FromIndex >= 0) and (FromIndex <= ToIndex) then
begin
NewMap.SetCapacity(ToIndex - FromIndex + 1);
- NewMap.FEntries := Copy(FEntries, FromIndex, ToIndex - FromIndex + 1);
NewMap.FSize := ToIndex - FromIndex + 1;
+ while ToIndex >= FromIndex do
+ begin
+ NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex];
+ Dec(ToIndex);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
@@ -574,7 +582,7 @@
function SELFCLASSNAME.TailMap(TAILMAPPARAMETERDECLARATION): SORTEDMAPINTERFACENAME;
var
- FromIndex: Integer;
+ FromIndex, Index: Integer;
NewMap: SELFCLASSNAME;
begin
{$IFDEF THREADSAFE}
@@ -588,8 +596,13 @@
if (FromIndex >= 0) and (FromIndex < FSize) then
begin
NewMap.SetCapacity(FSize - FromIndex);
- NewMap.FEntries := Copy(FEntries, FromIndex, FSize - FromIndex);
NewMap.FSize := FSize - FromIndex;
+ Index := FromIndex;
+ while Index < FSize do
+ begin
+ NewMap.FEntries[Index - FromIndex] := FEntries[Index];
+ Inc(Index);
+ end;
end;
Result := NewMap;
{$IFDEF THREADSAFE}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-11-11 07:12:05
|
Revision: 2211
http://jcl.svn.sourceforge.net/jcl/?rev=2211&view=rev
Author: outchy
Date: 2007-11-10 23:11:50 -0800 (Sat, 10 Nov 2007)
Log Message:
-----------
fixed compilation error.
Modified Paths:
--------------
trunk/jcl/source/common/JclQueues.pas
trunk/jcl/source/prototypes/JclQueues.pas
Modified: trunk/jcl/source/common/JclQueues.pas
===================================================================
--- trunk/jcl/source/common/JclQueues.pas 2007-11-10 23:34:01 UTC (rev 2210)
+++ trunk/jcl/source/common/JclQueues.pas 2007-11-11 07:11:50 UTC (rev 2211)
@@ -208,7 +208,7 @@
end;
// E = external helper to compare items for equality (GetHashCode is not used)
- TJclQueueE<T> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE},
+ TJclQueueE<T> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclContainer, IJclQueue<T>, IJclItemOwner<T>)
private
FEqualityComparer: IEqualityComparer<T>;
@@ -225,7 +225,7 @@
end;
// F = function to compare items for equality
- TJclQueueF<T> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE},
+ TJclQueueF<T> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclContainer, IJclQueue<T>, IJclItemOwner<T>)
private
FEqualityCompare: TEqualityCompare<T>;
@@ -242,7 +242,7 @@
end;
// I = items can compare themselves to an other
- TJclQueueI<T: IEquatable<T>> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE},
+ TJclQueueI<T: IEquatable<T>> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclContainer, IJclQueue<T>, IJclItemOwner<T>)
protected
function CreateEmptyContainer: TJclAbstractContainerBase; override;
Modified: trunk/jcl/source/prototypes/JclQueues.pas
===================================================================
--- trunk/jcl/source/prototypes/JclQueues.pas 2007-11-10 23:34:01 UTC (rev 2210)
+++ trunk/jcl/source/prototypes/JclQueues.pas 2007-11-11 07:11:50 UTC (rev 2211)
@@ -74,7 +74,7 @@
(*$JPPEXPANDMACRO JCLQUEUEINT(TJclQueue<T>,IJclQueue<T>,TJclAbstractContainer<T>,T,TJclBase<T>.TDynArray, IJclEqualityComparer<T>\, IJclItemOwner<T>\,,,,,; AOwnsItems: Boolean,const AItem: T)*)
// E = external helper to compare items for equality (GetHashCode is not used)
- TJclQueueE<T> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE},
+ TJclQueueE<T> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclContainer, IJclQueue<T>, IJclItemOwner<T>)
private
FEqualityComparer: IEqualityComparer<T>;
@@ -91,7 +91,7 @@
end;
// F = function to compare items for equality
- TJclQueueF<T> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE},
+ TJclQueueF<T> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclContainer, IJclQueue<T>, IJclItemOwner<T>)
private
FEqualityCompare: TEqualityCompare<T>;
@@ -108,7 +108,7 @@
end;
// I = items can compare themselves to an other
- TJclQueueI<T: IEquatable<T>> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE},
+ TJclQueueI<T: IEquatable<T>> = class(TJclQueue<T>, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclContainer, IJclQueue<T>, IJclItemOwner<T>)
protected
function CreateEmptyContainer: TJclAbstractContainerBase; override;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-11-10 23:34:05
|
Revision: 2210
http://jcl.svn.sourceforge.net/jcl/?rev=2210&view=rev
Author: outchy
Date: 2007-11-10 15:34:01 -0800 (Sat, 10 Nov 2007)
Log Message:
-----------
Mantis 3495: IJclSortedMap not implemented
introducing JclSortedMaps.pas to expose all classes implementing IJcl*SortedMap
generic support is still disabled (to be tested).
Modified Paths:
--------------
trunk/jcl/packages/c5/JclC50.bpk
trunk/jcl/packages/c5/JclC50.cpp
trunk/jcl/packages/c5/JclC50.dpk
trunk/jcl/packages/c6/Jcl.bpk
trunk/jcl/packages/c6/Jcl.dpk
trunk/jcl/packages/cs1/Jcl.dpk
trunk/jcl/packages/d10/Jcl.dpk
trunk/jcl/packages/d10.net/Jedi.Jcl.bdsproj
trunk/jcl/packages/d10.net/Jedi.Jcl.dpr
trunk/jcl/packages/d11/Jcl.dpk
trunk/jcl/packages/d11.net/Jedi.Jcl.dpr
trunk/jcl/packages/d11.net/Jedi.Jcl.dproj
trunk/jcl/packages/d5/JclD50.dpk
trunk/jcl/packages/d6/Jcl.dpk
trunk/jcl/packages/d7/Jcl.dpk
trunk/jcl/packages/d8/Jcl.dpk
trunk/jcl/packages/d9/Jcl.dpk
trunk/jcl/packages/d9.net/Jedi.Jcl.bdsproj
trunk/jcl/packages/d9.net/Jedi.Jcl.dpr
trunk/jcl/packages/k3/Jcl.bpk
trunk/jcl/packages/k3/Jcl.dpk
trunk/jcl/packages/xml/Jcl-L.xml
trunk/jcl/packages/xml/Jcl-R.xml
trunk/jcl/source/common/JclContainerIntf.pas
trunk/jcl/source/prototypes/Makefile.mak
Added Paths:
-----------
trunk/jcl/source/common/JclSortedMaps.pas
trunk/jcl/source/prototypes/JclSortedMaps.pas
trunk/jcl/source/prototypes/containers/JclSortedMaps.imp
Modified: trunk/jcl/packages/c5/JclC50.bpk
===================================================================
--- trunk/jcl/packages/c5/JclC50.bpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/c5/JclC50.bpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -5,7 +5,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 06-08-2007 11:54:51 UTC
+ Last generated: 10-11-2007 23:18:36 UTC
*****************************************************************************
-->
<PROJECT>
@@ -53,6 +53,7 @@
..\..\lib\c5\JclRTTI.obj
..\..\lib\c5\JclSimpleXml.obj
..\..\lib\c5\JclSchedule.obj
+ ..\..\lib\c5\JclSortedMaps.obj
..\..\lib\c5\JclStacks.obj
..\..\lib\c5\JclStatistics.obj
..\..\lib\c5\JclStreams.obj
Modified: trunk/jcl/packages/c5/JclC50.cpp
===================================================================
--- trunk/jcl/packages/c5/JclC50.cpp 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/c5/JclC50.cpp 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 09-06-2007 20:44:07 UTC
+ Last generated: 10-11-2007 23:18:36 UTC
-----------------------------------------------------------------------------
*/
@@ -50,6 +50,7 @@
USEUNIT("..\..\source\common\JclRTTI.pas");
USEUNIT("..\..\source\common\JclSimpleXml.pas");
USEUNIT("..\..\source\common\JclSchedule.pas");
+USEUNIT("..\..\source\common\JclSortedMaps.pas");
USEUNIT("..\..\source\common\JclStacks.pas");
USEUNIT("..\..\source\common\JclStatistics.pas");
USEUNIT("..\..\source\common\JclStreams.pas");
Modified: trunk/jcl/packages/c5/JclC50.dpk
===================================================================
--- trunk/jcl/packages/c5/JclC50.dpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/c5/JclC50.dpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 09-06-2007 20:44:07 UTC
+ Last generated: 10-11-2007 23:18:36 UTC
-----------------------------------------------------------------------------
}
@@ -79,6 +79,7 @@
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
JclSimpleXml in '..\..\source\common\JclSimpleXml.pas' ,
JclSchedule in '..\..\source\common\JclSchedule.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/c6/Jcl.bpk
===================================================================
--- trunk/jcl/packages/c6/Jcl.bpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/c6/Jcl.bpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -5,7 +5,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 06-08-2007 11:54:52 UTC
+ Last generated: 10-11-2007 23:18:36 UTC
*****************************************************************************
-->
<PROJECT>
@@ -53,6 +53,7 @@
..\..\lib\c6\JclRTTI.obj
..\..\lib\c6\JclSimpleXml.obj
..\..\lib\c6\JclSchedule.obj
+ ..\..\lib\c6\JclSortedMaps.obj
..\..\lib\c6\JclStacks.obj
..\..\lib\c6\JclStatistics.obj
..\..\lib\c6\JclStreams.obj
@@ -190,6 +191,7 @@
<FILE FILENAME="..\..\source\common\JclRTTI.pas" FORMNAME="" UNITNAME="JclRTTI" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\common\JclSimpleXml.pas" FORMNAME="" UNITNAME="JclSimpleXml" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\common\JclSchedule.pas" FORMNAME="" UNITNAME="JclSchedule" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\..\source\common\JclSortedMaps.pas" FORMNAME="" UNITNAME="JclSortedMaps" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\common\JclStacks.pas" FORMNAME="" UNITNAME="JclStacks" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\common\JclStatistics.pas" FORMNAME="" UNITNAME="JclStatistics" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\common\JclStreams.pas" FORMNAME="" UNITNAME="JclStreams" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
Modified: trunk/jcl/packages/c6/Jcl.dpk
===================================================================
--- trunk/jcl/packages/c6/Jcl.dpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/c6/Jcl.dpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 20-04-2007 16:14:43 UTC
+ Last generated: 10-11-2007 23:18:37 UTC
-----------------------------------------------------------------------------
}
@@ -78,6 +78,7 @@
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
JclSimpleXml in '..\..\source\common\JclSimpleXml.pas' ,
JclSchedule in '..\..\source\common\JclSchedule.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/cs1/Jcl.dpk
===================================================================
--- trunk/jcl/packages/cs1/Jcl.dpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/cs1/Jcl.dpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 20-04-2007 16:14:46 UTC
+ Last generated: 10-11-2007 23:18:39 UTC
-----------------------------------------------------------------------------
}
@@ -79,6 +79,7 @@
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
JclSimpleXml in '..\..\source\common\JclSimpleXml.pas' ,
JclSchedule in '..\..\source\common\JclSchedule.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/d10/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d10/Jcl.dpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d10/Jcl.dpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 20-04-2007 16:14:48 UTC
+ Last generated: 10-11-2007 23:18:40 UTC
-----------------------------------------------------------------------------
}
@@ -79,6 +79,7 @@
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
JclSimpleXml in '..\..\source\common\JclSimpleXml.pas' ,
JclSchedule in '..\..\source\common\JclSchedule.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/d10.net/Jedi.Jcl.bdsproj
===================================================================
--- trunk/jcl/packages/d10.net/Jedi.Jcl.bdsproj 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d10.net/Jedi.Jcl.bdsproj 2007-11-10 23:34:01 UTC (rev 2210)
@@ -200,6 +200,7 @@
<File FileName="..\..\source\common\JclQueues.pas" ContainerId="" ModuleName="JclQueues"/>
<File FileName="..\..\source\common\JclResources.pas" ContainerId="" ModuleName="JclResources"/>
<File FileName="..\..\source\common\JclRTTI.pas" ContainerId="" ModuleName="JclRTTI"/>
+ <File FileName="..\..\source\common\JclSortedMaps.pas" ContainerId="" ModuleName="JclSortedMaps"/>
<File FileName="..\..\source\common\JclStacks.pas" ContainerId="" ModuleName="JclStacks"/>
<File FileName="..\..\source\common\JclStatistics.pas" ContainerId="" ModuleName="JclStatistics"/>
<File FileName="..\..\source\common\JclStreams.pas" ContainerId="" ModuleName="JclStreams"/>
Modified: trunk/jcl/packages/d10.net/Jedi.Jcl.dpr
===================================================================
--- trunk/jcl/packages/d10.net/Jedi.Jcl.dpr 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d10.net/Jedi.Jcl.dpr 2007-11-10 23:34:01 UTC (rev 2210)
@@ -25,6 +25,7 @@
JclQueues in '..\..\source\common\JclQueues.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/d11/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d11/Jcl.dpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d11/Jcl.dpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 20-04-2007 16:14:49 UTC
+ Last generated: 10-11-2007 23:18:41 UTC
-----------------------------------------------------------------------------
}
@@ -79,6 +79,7 @@
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
JclSimpleXml in '..\..\source\common\JclSimpleXml.pas' ,
JclSchedule in '..\..\source\common\JclSchedule.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/d11.net/Jedi.Jcl.dpr
===================================================================
--- trunk/jcl/packages/d11.net/Jedi.Jcl.dpr 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d11.net/Jedi.Jcl.dpr 2007-11-10 23:34:01 UTC (rev 2210)
@@ -25,6 +25,7 @@
JclQueues in '..\..\source\common\JclQueues.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/d11.net/Jedi.Jcl.dproj
===================================================================
--- trunk/jcl/packages/d11.net/Jedi.Jcl.dproj 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d11.net/Jedi.Jcl.dproj 2007-11-10 23:34:01 UTC (rev 2210)
@@ -108,6 +108,7 @@
<DCCReference Include="..\..\source\common\JclQueues.pas"/>
<DCCReference Include="..\..\source\common\JclResources.pas"/>
<DCCReference Include="..\..\source\common\JclRTTI.pas"/>
+ <DCCReference Include="..\..\source\common\JclSortedMaps.pas"/>
<DCCReference Include="..\..\source\common\JclStacks.pas"/>
<DCCReference Include="..\..\source\common\JclStatistics.pas"/>
<DCCReference Include="..\..\source\common\JclStreams.pas"/>
Modified: trunk/jcl/packages/d5/JclD50.dpk
===================================================================
--- trunk/jcl/packages/d5/JclD50.dpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d5/JclD50.dpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 09-06-2007 20:44:07 UTC
+ Last generated: 10-11-2007 23:18:37 UTC
-----------------------------------------------------------------------------
}
@@ -79,6 +79,7 @@
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
JclSimpleXml in '..\..\source\common\JclSimpleXml.pas' ,
JclSchedule in '..\..\source\common\JclSchedule.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/d6/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d6/Jcl.dpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d6/Jcl.dpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 20-04-2007 16:14:44 UTC
+ Last generated: 10-11-2007 23:18:38 UTC
-----------------------------------------------------------------------------
}
@@ -79,6 +79,7 @@
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
JclSimpleXml in '..\..\source\common\JclSimpleXml.pas' ,
JclSchedule in '..\..\source\common\JclSchedule.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/d7/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d7/Jcl.dpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d7/Jcl.dpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 20-04-2007 16:14:45 UTC
+ Last generated: 10-11-2007 23:18:38 UTC
-----------------------------------------------------------------------------
}
@@ -79,6 +79,7 @@
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
JclSimpleXml in '..\..\source\common\JclSimpleXml.pas' ,
JclSchedule in '..\..\source\common\JclSchedule.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/d8/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d8/Jcl.dpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d8/Jcl.dpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 20-04-2007 16:14:46 UTC
+ Last generated: 10-11-2007 23:18:39 UTC
-----------------------------------------------------------------------------
}
@@ -79,6 +79,7 @@
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
JclSimpleXml in '..\..\source\common\JclSimpleXml.pas' ,
JclSchedule in '..\..\source\common\JclSchedule.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/d9/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d9/Jcl.dpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d9/Jcl.dpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 20-04-2007 16:14:47 UTC
+ Last generated: 10-11-2007 23:18:40 UTC
-----------------------------------------------------------------------------
}
@@ -79,6 +79,7 @@
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
JclSimpleXml in '..\..\source\common\JclSimpleXml.pas' ,
JclSchedule in '..\..\source\common\JclSchedule.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/d9.net/Jedi.Jcl.bdsproj
===================================================================
--- trunk/jcl/packages/d9.net/Jedi.Jcl.bdsproj 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d9.net/Jedi.Jcl.bdsproj 2007-11-10 23:34:01 UTC (rev 2210)
@@ -200,6 +200,7 @@
<File FileName="..\..\source\common\JclQueues.pas" ContainerId="" ModuleName="JclQueues"/>
<File FileName="..\..\source\common\JclResources.pas" ContainerId="" ModuleName="JclResources"/>
<File FileName="..\..\source\common\JclRTTI.pas" ContainerId="" ModuleName="JclRTTI"/>
+ <File FileName="..\..\source\common\JclSortedMaps.pas" ContainerId="" ModuleName="JclSortedMaps"/>
<File FileName="..\..\source\common\JclStacks.pas" ContainerId="" ModuleName="JclStacks"/>
<File FileName="..\..\source\common\JclStatistics.pas" ContainerId="" ModuleName="JclStatistics"/>
<File FileName="..\..\source\common\JclStreams.pas" ContainerId="" ModuleName="JclStreams"/>
Modified: trunk/jcl/packages/d9.net/Jedi.Jcl.dpr
===================================================================
--- trunk/jcl/packages/d9.net/Jedi.Jcl.dpr 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/d9.net/Jedi.Jcl.dpr 2007-11-10 23:34:01 UTC (rev 2210)
@@ -25,6 +25,7 @@
JclQueues in '..\..\source\common\JclQueues.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
+ JclSortedMaps in '..\..\source\common\JclSortedMaps.pas' ,
JclStacks in '..\..\source\common\JclStacks.pas' ,
JclStatistics in '..\..\source\common\JclStatistics.pas' ,
JclStreams in '..\..\source\common\JclStreams.pas' ,
Modified: trunk/jcl/packages/k3/Jcl.bpk
===================================================================
--- trunk/jcl/packages/k3/Jcl.bpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/k3/Jcl.bpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -44,6 +44,7 @@
..\..\lib\k3\JclRTTI.obj
..\..\lib\k3\JclSimpleXml.obj
..\..\lib\k3\JclSchedule.obj
+ ..\..\lib\k3\JclSortedMaps.obj
..\..\lib\k3\JclStacks.obj
..\..\lib\k3\JclStatistics.obj
..\..\lib\k3\JclStreams.obj
@@ -144,6 +145,7 @@
<FILE FILENAME="../../source/common/JclRTTI.pas" FORMNAME="" UNITNAME="JclRTTI" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="../../source/common/JclSimpleXml.pas" FORMNAME="" UNITNAME="JclSimpleXml" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="../../source/common/JclSchedule.pas" FORMNAME="" UNITNAME="JclSchedule" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="../../source/common/JclSortedMaps.pas" FORMNAME="" UNITNAME="JclSortedMaps" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="../../source/common/JclStacks.pas" FORMNAME="" UNITNAME="JclStacks" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="../../source/common/JclStatistics.pas" FORMNAME="" UNITNAME="JclStatistics" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="../../source/common/JclStreams.pas" FORMNAME="" UNITNAME="JclStreams" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
Modified: trunk/jcl/packages/k3/Jcl.dpk
===================================================================
--- trunk/jcl/packages/k3/Jcl.dpk 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/k3/Jcl.dpk 2007-11-10 23:34:01 UTC (rev 2210)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml)
- Last generated: 13-09-2007 10:08:46 UTC
+ Last generated: 10-11-2007 23:18:41 UTC
-----------------------------------------------------------------------------
}
@@ -80,6 +80,7 @@
JclRTTI in '../../source/common/JclRTTI.pas' ,
JclSimpleXml in '../../source/common/JclSimpleXml.pas' ,
JclSchedule in '../../source/common/JclSchedule.pas' ,
+ JclSortedMaps in '../../source/common/JclSortedMaps.pas' ,
JclStacks in '../../source/common/JclStacks.pas' ,
JclStatistics in '../../source/common/JclStatistics.pas' ,
JclStreams in '../../source/common/JclStreams.pas' ,
Modified: trunk/jcl/packages/xml/Jcl-L.xml
===================================================================
--- trunk/jcl/packages/xml/Jcl-L.xml 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/xml/Jcl-L.xml 2007-11-10 23:34:01 UTC (rev 2210)
@@ -37,6 +37,7 @@
<File Name="..\..\source\common\JclQueues.pas" Targets="JclDotNet" Formname="" Condition=""/>
<File Name="..\..\source\common\JclResources.pas" Targets="JclDotNet" Formname="" Condition=""/>
<File Name="..\..\source\common\JclRTTI.pas" Targets="JclDotNet" Formname="" Condition=""/>
+ <File Name="..\..\source\common\JclSortedMaps.pas" Targets="JclDotNet" Formname="" Condition=""/>
<File Name="..\..\source\common\JclStacks.pas" Targets="JclDotNet" Formname="" Condition=""/>
<File Name="..\..\source\common\JclStatistics.pas" Targets="JclDotNet" Formname="" Condition=""/>
<File Name="..\..\source\common\JclStreams.pas" Targets="JclDotNet" Formname="" Condition=""/>
Modified: trunk/jcl/packages/xml/Jcl-R.xml
===================================================================
--- trunk/jcl/packages/xml/Jcl-R.xml 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/packages/xml/Jcl-R.xml 2007-11-10 23:34:01 UTC (rev 2210)
@@ -56,6 +56,7 @@
<File Name="..\..\source\common\JclRTTI.pas" Targets="JclDev" Formname="" Condition=""/>
<File Name="..\..\source\common\JclSimpleXml.pas" Targets="JclDev" Formname="" Condition=""/>
<File Name="..\..\source\common\JclSchedule.pas" Targets="JclDev" Formname="" Condition=""/>
+ <File Name="..\..\source\common\JclSortedMaps.pas" Targets="JclDev" Formname="" Condition=""/>
<File Name="..\..\source\common\JclStacks.pas" Targets="JclDev" Formname="" Condition=""/>
<File Name="..\..\source\common\JclStatistics.pas" Targets="JclDev" Formname="" Condition=""/>
<File Name="..\..\source\common\JclStreams.pas" Targets="JclDev" Formname="" Condition=""/>
Modified: trunk/jcl/source/common/JclContainerIntf.pas
===================================================================
--- trunk/jcl/source/common/JclContainerIntf.pas 2007-11-10 23:32:26 UTC (rev 2209)
+++ trunk/jcl/source/common/JclContainerIntf.pas 2007-11-10 23:34:01 UTC (rev 2210)
@@ -749,11 +749,11 @@
property Items[const Key: IInterface]: IInterface read GetValue write PutValue;
end;
- IJclMultiIntfIntfMap = interface(IJclIntfIntfMap)
+ (*IJclMultiIntfIntfMap = interface(IJclIntfIntfMap)
['{497775A5-D3F1-49FC-A641-15CC9E77F3D0}']
function GetValues(const Key: IInterface): IJclIntfIterator;
function Count(const Key: IInterface): Integer;
- end;
+ end;*)
IJclAnsiStrIntfMap = interface(IJclAnsiStrContainer)
['{A4788A96-281A-4924-AA24-03776DDAAD8A}']
@@ -1060,6 +1060,65 @@
end;
{$ENDIF SUPPORTS_GENERICS}
+ IJclIntfIntfSortedMap = interface(IJclIntfIntfMap)
+ ['{265A6EB2-4BB3-459F-8813-360FD32A4971}']
+ function FirstKey: IInterface;
+ function HeadMap(const ToKey: IInterface): IJclIntfIntfSortedMap;
+ function LastKey: IInterface;
+ function SubMap(const FromKey, ToKey: IInterface): IJclIntfIntfSortedMap;
+ function TailMap(const FromKey: IInterface): IJclIntfIntfSortedMap;
+ end;
+
+ IJclAnsiStrIntfSortedMap = interface(IJclAnsiStrIntfMap)
+ ['{706D1C91-5416-4FDC-B6B1-F4C1E8CFCD38}']
+ function FirstKey: AnsiString;
+ function HeadMap(const ToKey: AnsiString): IJclAnsiStrIntfSortedMap;
+ function LastKey: AnsiString;
+ function SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrIntfSortedMap;
+ function TailMap(const FromKey: AnsiString): IJclAnsiStrIntfSortedMap;
+ end;
+
+ IJclWideStrIntfSortedMap = interface(IJclWideStrIntfMap)
+ ['{299FDCFD-2DB7-4D64-BF18-EE3668316430}']
+ function FirstKey: WideString;
+ function HeadMap(const ToKey: WideString): IJclWideStrIntfSortedMap;
+ function LastKey: WideString;
+ function SubMap(const FromKey, ToKey: WideString): IJclWideStrIntfSortedMap;
+ function TailMap(const FromKey: WideString): IJclWideStrIntfSortedMap;
+ end;
+
+ {$IFDEF CONTAINER_ANSISTR}
+ IJclStrIntfSortedMap = IJclAnsiStrIntfSortedMap;
+ {$ENDIF CONTAINER_ANSISTR}
+ {$IFDEF CONTAINER_WIDESTR}
+ IJclStrIntfSortedMap = IJclWideStrIntfSortedMap;
+ {$ENDIF CONTAINER_WIDESTR}
+
+ IJclIntfAnsiStrSortedMap = interface(IJclIntfAnsiStrMap)
+ ['{96E6AC5E-8C40-4795-9C8A-CFD098B58680}']
+ function FirstKey: IInterface;
+ function HeadMap(const ToKey: IInterface): IJclIntfAnsiStrSortedMap;
+ function LastKey: IInterface;
+ function SubMap(const FromKey, ToKey: IInterface): IJclIntfAnsiStrSortedMap;
+ function TailMap(const FromKey: IInterface): IJclIntfAnsiStrSortedMap;
+ end;
+
+ IJclIntfWideStrSortedMap = interface(IJclIntfWideStrMap)
+ ['{FBE3AD2E-2781-4DC0-9E80-027027380E21}']
+ function FirstKey: IInterface;
+ function HeadMap(const ToKey: IInterface): IJclIntfWideStrSortedMap;
+ function LastKey: IInterface;
+ function SubMap(const FromKey, ToKey: IInterface): IJclIntfWideStrSortedMap;
+ function TailMap(const FromKey: IInterface): IJclIntfWideStrSortedMap;
+ end;
+
+ {$IFDEF CONTAINER_ANSISTR}
+ IJclIntfStrSortedMap = IJclIntfAnsiStrSortedMap;
+ {$ENDIF CONTAINER_ANSISTR}
+ {$IFDEF CONTAINER_WIDESTR}
+ IJclIntfStrSortedMap = IJclIntfWideStrSortedMap;
+ {$ENDIF CONTAINER_WIDESTR}
+
IJclAnsiStrAnsiStrSortedMap = interface(IJclAnsiStrAnsiStrMap)
['{4F457799-5D03-413D-A46C-067DC4200CC3}']
function FirstKey: AnsiString;
@@ -1085,6 +1144,40 @@
IJclStrStrSortedMap = IJclWideStrWideStrSortedMap;
{$ENDIF CONTAINER_WIDESTR}
+ IJclIntfSortedMap = interface(IJclIntfMap)
+ ['{3CED1477-B958-4109-9BDA-7C84B9E063B2}']
+ function FirstKey: IInterface;
+ function HeadMap(const ToKey: IInterface): IJclIntfSortedMap;
+ function LastKey: IInterface;
+ function SubMap(const FromKey, ToKey: IInterface): IJclIntfSortedMap;
+ function TailMap(const FromKey: IInterface): IJclIntfSortedMap;
+ end;
+
+ IJclAnsiStrSortedMap = interface(IJclAnsiStrMap)
+ ['{573F98E3-EBCD-4F28-8F35-96A7366CBF47}']
+ function FirstKey: AnsiString;
+ function HeadMap(const ToKey: AnsiString): IJclAnsiStrSortedMap;
+ function LastKey: AnsiString;
+ function SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrSortedMap;
+ function TailMap(const FromKey: AnsiString): IJclAnsiStrSortedMap;
+ end;
+
+ IJclWideStrSortedMap = interface(IJclWideStrMap)
+ ['{B3021EFC-DE25-4B4B-A896-ACE823CD5C01}']
+ function FirstKey: WideString;
+ function HeadMap(const ToKey: WideString): IJclWideStrSortedMap;
+ function LastKey: WideString;
+ function SubMap(const FromKey, ToKey: WideString): IJclWideStrSortedMap;
+ function TailMap(const FromKey: WideString): IJclWideStrSortedMap;
+ end;
+
+ {$IFDEF CONTAINER_ANSISTR}
+ IJclStrSortedMap = IJclAnsiStrSortedMap;
+ {$ENDIF CONTAINER_ANSISTR}
+ {$IFDEF CONTAINER_WIDESTR}
+ IJclStrSortedMap = IJclWideStrSortedMap;
+ {$ENDIF CONTAINER_WIDESTR}
+
IJclSortedMap = interface(IJclMap)
['{F317A70F-7851-49C2-9DCF-092D8F4D4F98}']
function FirstKey: TObject;
@@ -1112,6 +1205,27 @@
function TailSet(const AStartObject: IInterface): IJclIntfSortedSet;
end;
+ IJclAnsiStrSortedSet = interface(IJclAnsiStrSet)
+ ['{03198146-F967-4310-868B-7AD3D52D5CBE}']
+ function HeadSet(const AEndObject: AnsiString): IJclAnsiStrSortedSet;
+ function SubSet(const Start, Finish: AnsiString): IJclAnsiStrSortedSet;
+ function TailSet(const AStartObject: AnsiString): IJclAnsiStrSortedSet;
+ end;
+
+ IJclWideStrSortedSet = interface(IJclWideStrSet)
+ ['{ED9567E2-C1D3-4C00-A1D4-90D5C7E27C2D}']
+ function HeadSet(const AEndObject: WideString): IJclWideStrSortedSet;
+ function SubSet(const Start, Finish: WideString): IJclWideStrSortedSet;
+ function TailSet(const AStartObject: WideString): IJclWideStrSortedSet;
+ end;
+
+ {$IFDEF CONTAINER_ANSISTR}
+ IJclStrSortedSet = IJclAnsiStrSortedSet;
+ {$ENDIF CONTAINER_ANSISTR}
+ {$IFDEF CONTAINER_WIDESTR}
+ IJclStrSortedSet = IJclWideStrSortedSet;
+ {$ENDIF CONTAINER_WIDESTR}
+
IJclSortedSet = interface(IJclSet)
['{A3D23E76-ADE9-446C-9B97-F49FCE895D9F}']
function HeadSet(AEndObject: TObject): IJclSortedSet;
Added: trunk/jcl/source/common/JclSortedMaps.pas
===================================================================
--- trunk/jcl/source/common/JclSortedMaps.pas (rev 0)
+++ trunk/jcl/source/common/JclSortedMaps.pas 2007-11-10 23:34:01 UTC (rev 2210)
@@ -0,0 +1,7986 @@
+{**************************************************************************************************}
+{ WARNING: JEDI preprocessor generated unit. Do not edit. }
+{**************************************************************************************************}
+
+{**************************************************************************************************}
+{ }
+{ 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 JclSortedMaps.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by }
+{ Florent Ouchet are Copyright (C) Florent Ouchet <outchy att users dott sourceforge dott net }
+{ All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ The Delphi Container Library }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: $ }
+{ Revision: $Rev:: $ }
+{ Author: $Author:: $ }
+{ }
+{**************************************************************************************************}
+
+unit JclSortedMaps;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Classes,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ {$IFDEF SUPPORTS_GENERICS}
+ {$IFDEF CLR}
+ System.Collections.Generic,
+ {$ENDIF CLR}
+ JclAlgorithms,
+ {$ENDIF SUPPORTS_GENERICS}
+ JclBase, JclAbstractContainers, JclContainerIntf;
+
+type
+
+ TJclIntfIntfEntry = record
+ Key: IInterface;
+ Value: IInterface;
+ end;
+
+ TJclIntfIntfEntryArray = array of TJclIntfIntfEntry;
+
+ TJclIntfIntfSortedMap = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer,
+ IJclIntfIntfMap, IJclIntfIntfSortedMap)
+ private
+ FEntries: TJclIntfIntfEntryArray;
+ function BinarySearch(const Key: IInterface): Integer;
+ protected
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
+ procedure MoveArray(FromIndex, ToIndex, Count: Integer);
+ { IJclPackable }
+ procedure SetCapacity(Value: Integer); override;
+ { IJclIntfIntfMap }
+ procedure Clear;
+ function ContainsKey(const Key: IInterface): Boolean;
+ function ContainsValue(const Value: IInterface): Boolean;
+ function Equals(const AMap: IJclIntfIntfMap): Boolean;
+ function GetValue(const Key: IInterface): IInterface;
+ function IsEmpty: Boolean;
+ function KeyOfValue(const Value: IInterface): IInterface;
+ function KeySet: IJclIntfSet;
+ procedure PutAll(const AMap: IJclIntfIntfMap);
+ procedure PutValue(const Key: IInterface; const Value: IInterface);
+ function Remove(const Key: IInterface): IInterface;
+ function Size: Integer;
+ function Values: IJclIntfCollection;
+ { IJclIntfIntfSortedMap }
+ function FirstKey: IInterface;
+ function HeadMap(const ToKey: IInterface): IJclIntfIntfSortedMap;
+ function LastKey: IInterface;
+ function SubMap(const FromKey, ToKey: IInterface): IJclIntfIntfSortedMap;
+ function TailMap(const FromKey: IInterface): IJclIntfIntfSortedMap;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ function CreateEmptyContainer: TJclAbstractContainerBase; override;
+ function FreeKey(var Key: IInterface): IInterface;
+ function FreeValue(var Value: IInterface): IInterface;
+ function KeysCompare(const A, B: IInterface): Integer;
+ function ValuesCompare(const A, B: IInterface): Integer;
+ public
+ constructor Create(ACapacity: Integer);
+ destructor Destroy; override;
+ end;
+
+
+ TJclAnsiStrIntfEntry = record
+ Key: AnsiString;
+ Value: IInterface;
+ end;
+
+ TJclAnsiStrIntfEntryArray = array of TJclAnsiStrIntfEntry;
+
+ TJclAnsiStrIntfSortedMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer,
+ IJclAnsiStrIntfMap, IJclAnsiStrIntfSortedMap)
+ private
+ FEntries: TJclAnsiStrIntfEntryArray;
+ function BinarySearch(const Key: AnsiString): Integer;
+ protected
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
+ procedure MoveArray(FromIndex, ToIndex, Count: Integer);
+ { IJclPackable }
+ procedure SetCapacity(Value: Integer); override;
+ { IJclAnsiStrIntfMap }
+ procedure Clear;
+ function ContainsKey(const Key: AnsiString): Boolean;
+ function ContainsValue(const Value: IInterface): Boolean;
+ function Equals(const AMap: IJclAnsiStrIntfMap): Boolean;
+ function GetValue(const Key: AnsiString): IInterface;
+ function IsEmpty: Boolean;
+ function KeyOfValue(const Value: IInterface): AnsiString;
+ function KeySet: IJclAnsiStrSet;
+ procedure PutAll(const AMap: IJclAnsiStrIntfMap);
+ procedure PutValue(const Key: AnsiString; const Value: IInterface);
+ function Remove(const Key: AnsiString): IInterface;
+ function Size: Integer;
+ function Values: IJclIntfCollection;
+ { IJclAnsiStrIntfSortedMap }
+ function FirstKey: AnsiString;
+ function HeadMap(const ToKey: AnsiString): IJclAnsiStrIntfSortedMap;
+ function LastKey: AnsiString;
+ function SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrIntfSortedMap;
+ function TailMap(const FromKey: AnsiString): IJclAnsiStrIntfSortedMap;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ function CreateEmptyContainer: TJclAbstractContainerBase; override;
+ function FreeKey(var Key: AnsiString): AnsiString;
+ function FreeValue(var Value: IInterface): IInterface;
+ function KeysCompare(const A, B: AnsiString): Integer;
+ function ValuesCompare(const A, B: IInterface): Integer;
+ public
+ constructor Create(ACapacity: Integer);
+ destructor Destroy; override;
+ end;
+
+
+ TJclIntfAnsiStrEntry = record
+ Key: IInterface;
+ Value: AnsiString;
+ end;
+
+ TJclIntfAnsiStrEntryArray = array of TJclIntfAnsiStrEntry;
+
+ TJclIntfAnsiStrSortedMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer,
+ IJclIntfAnsiStrMap, IJclIntfAnsiStrSortedMap)
+ private
+ FEntries: TJclIntfAnsiStrEntryArray;
+ function BinarySearch(const Key: IInterface): Integer;
+ protected
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
+ procedure MoveArray(FromIndex, ToIndex, Count: Integer);
+ { IJclPackable }
+ procedure SetCapacity(Value: Integer); override;
+ { IJclIntfAnsiStrMap }
+ procedure Clear;
+ function ContainsKey(const Key: IInterface): Boolean;
+ function ContainsValue(const Value: AnsiString): Boolean;
+ function Equals(const AMap: IJclIntfAnsiStrMap): Boolean;
+ function GetValue(const Key: IInterface): AnsiString;
+ function IsEmpty: Boolean;
+ function KeyOfValue(const Value: AnsiString): IInterface;
+ function KeySet: IJclIntfSet;
+ procedure PutAll(const AMap: IJclIntfAnsiStrMap);
+ procedure PutValue(const Key: IInterface; const Value: AnsiString);
+ function Remove(const Key: IInterface): AnsiString;
+ function Size: Integer;
+ function Values: IJclAnsiStrCollection;
+ { IJclIntfAnsiStrSortedMap }
+ function FirstKey: IInterface;
+ function HeadMap(const ToKey: IInterface): IJclIntfAnsiStrSortedMap;
+ function LastKey: IInterface;
+ function SubMap(const FromKey, ToKey: IInterface): IJclIntfAnsiStrSortedMap;
+ function TailMap(const FromKey: IInterface): IJclIntfAnsiStrSortedMap;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ function CreateEmptyContainer: TJclAbstractContainerBase; override;
+ function FreeKey(var Key: IInterface): IInterface;
+ function FreeValue(var Value: AnsiString): AnsiString;
+ function KeysCompare(const A, B: IInterface): Integer;
+ function ValuesCompare(const A, B: AnsiString): Integer;
+ public
+ constructor Create(ACapacity: Integer);
+ destructor Destroy; override;
+ end;
+
+
+ TJclAnsiStrAnsiStrEntry = record
+ Key: AnsiString;
+ Value: AnsiString;
+ end;
+
+ TJclAnsiStrAnsiStrEntryArray = array of TJclAnsiStrAnsiStrEntry;
+
+ TJclAnsiStrAnsiStrSortedMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer,
+ IJclAnsiStrAnsiStrMap, IJclAnsiStrAnsiStrSortedMap)
+ private
+ FEntries: TJclAnsiStrAnsiStrEntryArray;
+ function BinarySearch(const Key: AnsiString): Integer;
+ protected
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
+ procedure MoveArray(FromIndex, ToIndex, Count: Integer);
+ { IJclPackable }
+ procedure SetCapacity(Value: Integer); override;
+ { IJclAnsiStrAnsiStrMap }
+ procedure Clear;
+ function ContainsKey(const Key: AnsiString): Boolean;
+ function ContainsValue(const Value: AnsiString): Boolean;
+ function Equals(const AMap: IJclAnsiStrAnsiStrMap): Boolean;
+ function GetValue(const Key: AnsiString): AnsiString;
+ function IsEmpty: Boolean;
+ function KeyOfValue(const Value: AnsiString): AnsiString;
+ function KeySet: IJclAnsiStrSet;
+ procedure PutAll(const AMap: IJclAnsiStrAnsiStrMap);
+ procedure PutValue(const Key: AnsiString; const Value: AnsiString);
+ function Remove(const Key: AnsiString): AnsiString;
+ function Size: Integer;
+ function Values: IJclAnsiStrCollection;
+ { IJclAnsiStrAnsiStrSortedMap }
+ function FirstKey: AnsiString;
+ function HeadMap(const ToKey: AnsiString): IJclAnsiStrAnsiStrSortedMap;
+ function LastKey: AnsiString;
+ function SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrAnsiStrSortedMap;
+ function TailMap(const FromKey: AnsiString): IJclAnsiStrAnsiStrSortedMap;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ function CreateEmptyContainer: TJclAbstractContainerBase; override;
+ function FreeKey(var Key: AnsiString): AnsiString;
+ function FreeValue(var Value: AnsiString): AnsiString;
+ function KeysCompare(const A, B: AnsiString): Integer;
+ function ValuesCompare(const A, B: AnsiString): Integer;
+ public
+ constructor Create(ACapacity: Integer);
+ destructor Destroy; override;
+ end;
+
+
+ TJclWideStrIntfEntry = record
+ Key: WideString;
+ Value: IInterface;
+ end;
+
+ TJclWideStrIntfEntryArray = array of TJclWideStrIntfEntry;
+
+ TJclWideStrIntfSortedMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer,
+ IJclWideStrIntfMap, IJclWideStrIntfSortedMap)
+ private
+ FEntries: TJclWideStrIntfEntryArray;
+ function BinarySearch(const Key: WideString): Integer;
+ protected
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
+ procedure MoveArray(FromIndex, ToIndex, Count: Integer);
+ { IJclPackable }
+ procedure SetCapacity(Value: Integer); override;
+ { IJclWideStrIntfMap }
+ procedure Clear;
+ function ContainsKey(const Key: WideString): Boolean;
+ function ContainsValue(const Value: IInterface): Boolean;
+ function Equals(const AMap: IJclWideStrIntfMap): Boolean;
+ function GetValue(const Key: WideString): IInterface;
+ function IsEmpty: Boolean;
+ function KeyOfValue(const Value: IInterface): WideString;
+ function KeySet: IJclWideStrSet;
+ procedure PutAll(const AMap: IJclWideStrIntfMap);
+ procedure PutValue(const Key: WideString; const Value: IInterface);
+ function Remove(const Key: WideString): IInterface;
+ function Size: Integer;
+ function Values: IJclIntfCollection;
+ { IJclWideStrIntfSortedMap }
+ function FirstKey: WideString;
+ function HeadMap(const ToKey: WideString): IJclWideStrIntfSortedMap;
+ function LastKey: WideString;
+ function SubMap(const FromKey, ToKey: WideString): IJclWideStrIntfSortedMap;
+ function TailMap(const FromKey: WideString): IJclWideStrIntfSortedMap;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ function CreateEmptyContainer: TJclAbstractContainerBase; override;
+ function FreeKey(var Key: WideString): WideString;
+ function FreeValue(var Value: IInterface): IInterface;
+ function KeysCompare(const A, B: WideString): Integer;
+ function ValuesCompare(const A, B: IInterface): Integer;
+ public
+ constructor Create(ACapacity: Integer);
+ destructor Destroy; override;
+ end;
+
+
+ TJclIntfWideStrEntry = record
+ Key: IInterface;
+ Value: WideString;
+ end;
+
+ TJclIntfWideStrEntryArray = array of TJclIntfWideStrEntry;
+
+ TJclIntfWideStrSortedMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer,
+ IJclIntfWideStrMap, IJclIntfWideStrSortedMap)
+ private
+ FEntries: TJclIntfWideStrEntryArray;
+ function BinarySearch(const Key: IInterface): Integer;
+ protected
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
+ procedure MoveArray(FromIndex, ToIndex, Count: Integer);
+ { IJclPackable }
+ procedure SetCapacity(Value: Integer); override;
+ { IJclIntfWideStrMap }
+ procedure Clear;
+ function ContainsKey(const Key: IInterface): Boolean;
+ function ContainsValue(const Value: WideString): Boolean;
+ function Equals(const AMap: IJclIntfWideStrMap): Boolean;
+ function GetValue(const Key: IInterface): WideString;
+ function IsEmpty: Boolean;
+ function KeyOfValue(const Value: WideString): IInterface;
+ function KeySet: IJclIntfSet;
+ procedure PutAll(const AMap: IJclIntfWideStrMap);
+ procedure PutValue(const Key: IInterface; const Value: WideString);
+ function Remove(const Key: IInterface): WideString;
+ function Size: Integer;
+ function Values: IJclWideStrCollection;
+ { IJclIntfWideStrSortedMap }
+ function FirstKey: IInterface;
+ function HeadMap(const ToKey: IInterface): IJclIntfWideStrSortedMap;
+ function LastKey: IInterface;
+ function SubMap(const FromKey, ToKey: IInterface): IJclIntfWideStrSortedMap;
+ function TailMap(const FromKey: IInterface): IJclIntfWideStrSortedMap;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ function CreateEmptyContainer: TJclAbstractContainerBase; override;
+ function FreeKey(var Key: IInterface): IInterface;
+ function FreeValue(var Value: WideString): WideString;
+ function KeysCompare(const A, B: IInterface): Integer;
+ function ValuesCompare(const A, B: WideString): Integer;
+ public
+ constructor Create(ACapacity: Integer);
+ destructor Destroy; override;
+ end;
+
+
+ TJclWideStrWideStrEntry = record
+ Key: WideString;
+ Value: WideString;
+ end;
+
+ TJclWideStrWideStrEntryArray = array of TJclWideStrWideStrEntry;
+
+ TJclWideStrWideStrSortedMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer,
+ IJclWideStrWideStrMap, IJclWideStrWideStrSortedMap)
+ private
+ FEntries: TJclWideStrWideStrEntryArray;
+ function BinarySearch(const Key: WideString): Integer;
+ protected
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
+ procedure MoveArray(FromIndex, ToIndex, Count: Integer);
+ { IJclPackable }
+ procedure SetCapacity(Value: Integer); override;
+ { IJclWideStrWideStrMap }
+ procedure Clear;
+ function ContainsKey(const Key: WideString): Boolean;
+ function ContainsValue(const Value: WideString): Boolean;
+ function Equals(const AMap: IJclWideStrWideStrMap): Boolean;
+ function GetValue(const Key: WideString): WideString;
+ function IsEmpty: Boolean;
+ function KeyOfValue(const Value: WideString): WideString;
+ function KeySet: IJclWideStrSet;
+ procedure PutAll(const AMap: IJclWideStrWideStrMap);
+ procedure PutValue(const Key: WideString; const Value: WideString);
+ function Remove(const Key: WideString): WideString;
+ function Size: Integer;
+ function Values: IJclWideStrCollection;
+ { IJclWideStrWideStrSortedMap }
+ function FirstKey: WideString;
+ function HeadMap(const ToKey: WideString): IJclWideStrWideStrSortedMap;
+ function LastKey: WideString;
+ function SubMap(const FromKey, ToKey: WideString): IJclWideStrWideStrSortedMap;
+ function TailMap(const FromKey: WideString): IJclWideStrWideStrSortedMap;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ function CreateEmptyContainer: TJclAbstractContainerBase; override;
+ function FreeKey(var Key: WideString): WideString;
+ function FreeValue(var Value: WideString): WideString;
+ function KeysCompare(const A, B: WideString): Integer;
+ function ValuesCompare(const A, B: WideString): Integer;
+ public
+ constructor Create(ACapacity: Integer);
+ destructor Destroy; override;
+ end;
+
+ {$IFDEF CONTAINER_ANSISTR}
+ TJclStrIntfSortedMap = TJclAnsiStrIntfSortedMap;
+ TJclIntfStrSortedMap = TJclIntfAnsiStrSortedMap;
+ TJclStrStrSortedMap = TJclAnsiStrAnsiStrSortedMap;
+ {$ENDIF CONTAINER_ANSISTR}
+ {$IFDEF CONTAINER_WIDESTR}
+ TJclStrIntfSortedMap = TJclWideStrIntfSortedMap;
+ TJclIntfStrSortedMap = TJclIntfWideStrSortedMap;
+ TJclStrStrSortedMap = TJclWideStrWideStrSortedMap;
+ {$ENDIF CONTAINER_WIDESTR}
+
+
+ TJclIntfEntry = record
+ Key: IInterface;
+ Value: TObject;
+ end;
+
+ TJclIntfEntryArray = array of TJclIntfEntry;
+
+ TJclIntfSortedMap = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclValueOwner,
+ IJclIntfMap, IJclIntfSortedMap)
+ private
+ FEntries: TJclIntfEntryArray;
+ FOwnsValues: Boolean;
+ function BinarySearch(const Key: IInterface): Integer;
+ protected
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
+ procedure MoveArray(FromIndex, ToIndex, Count: Integer);
+ { IJclPackable }
+ procedure SetCapacity(Value: Integer); override;
+ { IJclIntfMap }
+ procedure Clear;
+ function ContainsKey(const Key: IInterface): Boolean;
+ function ContainsValue(Value: TObject): Boolean;
+ function Equals(const AMap: IJclIntfMap): Boolean;
+ function GetValue(const Key: IInterface): TObject;
+ function IsEmpty: Boolean;
+ function KeyOfValue(Value: TObject): IInterface;
+ function KeySet: IJclIntfSet;
+ procedure PutAll(const AMap: IJclIntfMap);
+ procedure PutValue(const Key: IInterface; Value: TObject);
+ function Remove(const Key: IInterface): TObject;
+ function Size: Integer;
+ function Values: IJclCollection;
+ { IJclIntfSortedMap }
+ function FirstKey: IInterface;
+ function HeadMap(const ToKey: IInterface): IJclIntfSortedMap;
+ function LastKey: IInterface;
+ function SubMap(const FromKey, ToKey: IInterface): IJclIntfSortedMap;
+ function TailMap(const FromKey: IInterface): IJclIntfSortedMap;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ { IJclValueOwner }
+ function FreeValue(var Value: TObject): TObject;
+ function GetOwnsValues: Boolean;
+ function CreateEmptyContainer: TJclAbstractContainerBase; override;
+ function FreeKey(var Key: IInterface): IInterface;
+ function KeysCompare(const A, B: IInterface): Integer;
+ function ValuesCompare(A, B: TObject): Integer;
+ public
+ constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
+ destructor Destroy; override;
+ property OwnsValues: Boolean read FOwnsValues;
+ end;
+
+
+ TJclAnsiStrEntry = record
+ Key: AnsiString;
+ Value: TObject;
+ end;
+
+ TJclAnsiStrEntryArray = array of TJclAnsiStrEntry;
+
+ TJclAnsiStrSortedMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer, IJclValueOwner,
+ IJclAnsiStrMap, IJclAnsiStrSortedMap)
+ private
+ FEntries: TJclAnsiStrEntryArray;
+ FOwnsValues: Boolean;
+ function BinarySearch(const Key: AnsiString): Integer;
+ protected
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
+ procedure MoveArray(FromIndex, ToIndex, Count: Integer);
+ { IJclPackable }
+ procedure SetCapacity(Value: Integer); override;
+ { IJclAnsiStrMap }
+ procedure Clear;
+ function ContainsKey(const Key: AnsiString): Boolean;
+ function ContainsValue(Value: TObject): Boolean;
+ function Equals(const AMap: IJclAnsiStrMap): Boolean;
+ function GetValue(const Key: AnsiString): TObject;
+ function IsEmpty: Boolean;
+ function KeyOfValue(Value: TObject): AnsiString;
+ function KeySet: IJclAnsiStrSet;
+ procedure PutAll(const AMap: IJclAnsiStrMap);
+ procedure PutValue(const Key: AnsiString; Value: TObject);
+ function Remove(const Key: AnsiString): TObject;
+ function Size: Integer;
+ function Values: IJclCollection;
+ { IJclAnsiStrSortedMap }
+ function FirstKey: AnsiString;
+ function HeadMap(const ToKey: AnsiString): IJclAnsiStrSortedMap;
+ function LastKey: AnsiString;
+ function SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrSortedMap;
+ function TailMap(const FromKey: AnsiString): IJclAnsiStrSortedMap;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ { IJclValueOwner }
+ function FreeValue(var Value: TObject): TObject;
+ function GetOwnsValues: Boolean;
+ function CreateEmptyContainer: TJclAbstractContainerBase; override;
+ function FreeKey(var Key: AnsiString): AnsiString;
+ function KeysCompare(const A, B: AnsiString): Integer;
+ function ValuesCompare(A, B: TObject): Integer;
+ public
+ constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
+ destructor Destroy; override;
+ property OwnsValues: Boolean read FOwnsValues;
+ end;
+
+
+ TJclWideStrEntry = record
+ Key: WideString;
+ Value: TObject;
+ end;
+
+ TJclWideStrEntryArray = array of TJclWideStrEntry;
+
+ TJclWideStrSortedMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer, IJclValueOwner,
+ IJclWideStrMap, IJclWideStrSortedMap)
+ private
+ FEntries: TJclWideStrEntryArray;
+ FOwnsValues: Boolean;
+ function BinarySearch(const Key: WideString): Integer;
+ protected
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
+ procedure MoveArray(FromIndex, ToIndex, Count: Integer);
+ { IJclPackable }
+ procedure SetCapacity(Value: Integer); override;
+ { IJclWideStrMap }
+ procedure Clear;
+ function ContainsKey(const Key: WideString): Boolean;
+ function ContainsValue(Value: TObject): Boolean;
+ function Equals(const AMap: IJclWideStrMap): Boolean;
+ function GetValue(const Key: WideString): TObject;
+ function IsEmpty: Boolean;
+ function KeyOfValue(Value: TObject): WideString;
+ function KeySet: IJclWideStrSet;
+ procedure PutAll(const AMap: IJclWideStrMap);
+ procedure PutValue(const Key: WideString; Value: TObject);
+ function Remove(const Key: WideString): TObject;
+ function Size: Integer;
+ function Values: IJclCollection;
+ { IJclWideStrSortedMap }
+ function FirstKey: WideString;
+ function HeadMap(const ToKey: WideString): IJclWideStrSortedMap;
+ function LastKey: WideString;
+ function SubMap(const FromKey, ToKey: WideString): IJclWideStrSortedMap;
+ function TailMap(const FromKey: WideString): IJclWideStrSortedMap;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ { IJclValueOwner }
+ function FreeValue(var Value: TObject): TObject;
+ function GetOwnsValues: Boolean;
+ function CreateEmptyContainer: TJclAbstractContainerBase; override;
+ function FreeKey(var Key: WideString): WideString;
+ function KeysCompare(const A, B: WideString): Integer;
+ function ValuesCompare(A, B: TObject): Integer;
+ public
+ constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
+ destructor Destroy; override;
+ property OwnsValues: Boolean read FOwnsValues;
+ end;
+
+ {$IFDEF CONTAINER_ANSISTR}
+ TJclStrSortedMap = TJclAnsiStrSortedMap;
+ {$ENDIF CONTAINER_ANSISTR}
+ {$IFDEF CONTAINER_WIDESTR}
+ TJclStrSortedMap = TJclWideStrSortedMap;
+ {$ENDIF CONTAINER_WIDESTR}
+
+
+ TJclEntry = record
+ Key: TObject;
+ Value: TObject;
+ end;
+
+ TJclEntryArray = array of TJclEntry;
+
+ TJclSortedMap = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclKeyOwner, IJclValueOwner,
+ IJclMap, IJclSortedMap)
+ private
+ FEntries: TJclEntryArray;
+ FOwnsKeys: Boolean;
+ FOwnsValues: Boolean;
+ function BinarySearch(Key: TObject): Integer;
+ protected
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); override;
+ procedure MoveArray(FromIndex, ToIndex, Count: Integer);
+ { IJclPackable }
+ procedure SetCapacity(Value: Integer); override;
+ { IJclMap }
+ procedure Clear;
+ function ContainsKey(Key: TObject): Boolean;
+ function ContainsValue(Value: TObject): Boolean;
+ function Equals(const AMap: IJclMap): Boolean;
+ function GetValue(Key: TObject): TObject;
+ function IsEmpty: Boolean;
+ function KeyOfValue(Value: TObject): TObject;
+ function KeySet: IJclSet;
+ procedure PutAll(const AMap: IJclMap);
+ procedure PutValue(Key: TObject; Value: TObject);
+ function Remove(Key: TObject): TObject;
+ function Size: Integer;
+ function Values: IJclCollection;
+ { IJclSortedMap }
+ function FirstKey: TObject;
+ function HeadMap(ToKey: TObject): IJclSortedMap;
+ function LastKey: TObject;
+ function SubMap(FromKey, ToKey: TObject): IJclSortedMap;
+ function TailMap(FromKey: TObject): IJclSortedMap;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ { IJclKeyOwner }
+ function FreeKey(var Key: TObject): TObject;
+ function GetOwnsKeys: Boolean;
+ { IJclValueOwner }
+ function FreeValue(var Value: TObject): TObject;
+ function GetOwnsValues: Boolean;
+ function CreateEmpty...
[truncated message content] |
|
From: <ou...@us...> - 2007-11-10 23:32:29
|
Revision: 2209
http://jcl.svn.sourceforge.net/jcl/?rev=2209&view=rev
Author: outchy
Date: 2007-11-10 15:32:26 -0800 (Sat, 10 Nov 2007)
Log Message:
-----------
minor style cleaning
Modified Paths:
--------------
trunk/jcl/source/common/JclHashMaps.pas
trunk/jcl/source/prototypes/containers/JclHashMaps.imp
Modified: trunk/jcl/source/common/JclHashMaps.pas
===================================================================
--- trunk/jcl/source/common/JclHashMaps.pas 2007-11-10 18:02:00 UTC (rev 2208)
+++ trunk/jcl/source/common/JclHashMaps.pas 2007-11-10 23:32:26 UTC (rev 2209)
@@ -76,7 +76,7 @@
TJclIntfIntfBucketArray = array of TJclIntfIntfBucket;
TJclIntfIntfHashMap = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer,
IJclIntfIntfMap)
private
FBuckets: TJclIntfIntfBucketArray;
@@ -135,7 +135,7 @@
TJclAnsiStrIntfBucketArray = array of TJclAnsiStrIntfBucket;
TJclAnsiStrIntfHashMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer,
IJclAnsiStrIntfMap)
private
FBuckets: TJclAnsiStrIntfBucketArray;
@@ -193,7 +193,7 @@
TJclIntfAnsiStrBucketArray = array of TJclIntfAnsiStrBucket;
TJclIntfAnsiStrHashMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer,
IJclIntfAnsiStrMap)
private
FBuckets: TJclIntfAnsiStrBucketArray;
@@ -252,7 +252,7 @@
TJclAnsiStrAnsiStrBucketArray = array of TJclAnsiStrAnsiStrBucket;
TJclAnsiStrAnsiStrHashMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer,
IJclAnsiStrAnsiStrMap)
private
FBuckets: TJclAnsiStrAnsiStrBucketArray;
@@ -310,7 +310,7 @@
TJclWideStrIntfBucketArray = array of TJclWideStrIntfBucket;
TJclWideStrIntfHashMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer,
IJclWideStrIntfMap)
private
FBuckets: TJclWideStrIntfBucketArray;
@@ -368,7 +368,7 @@
TJclIntfWideStrBucketArray = array of TJclIntfWideStrBucket;
TJclIntfWideStrHashMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer,
IJclIntfWideStrMap)
private
FBuckets: TJclIntfWideStrBucketArray;
@@ -427,7 +427,7 @@
TJclWideStrWideStrBucketArray = array of TJclWideStrWideStrBucket;
TJclWideStrWideStrHashMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer,
IJclWideStrWideStrMap)
private
FBuckets: TJclWideStrWideStrBucketArray;
@@ -496,7 +496,7 @@
TJclIntfBucketArray = array of TJclIntfBucket;
TJclIntfHashMap = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclValueOwner,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclValueOwner,
IJclIntfMap)
private
FBuckets: TJclIntfBucketArray;
@@ -559,7 +559,7 @@
TJclAnsiStrBucketArray = array of TJclAnsiStrBucket;
TJclAnsiStrHashMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer, IJclValueOwner,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer, IJclValueOwner,
IJclAnsiStrMap)
private
FBuckets: TJclAnsiStrBucketArray;
@@ -621,7 +621,7 @@
TJclWideStrBucketArray = array of TJclWideStrBucket;
TJclWideStrHashMap = class(TJclwideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer, IJclValueOwner,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclStrContainer, IJclWideStrContainer, IJclValueOwner,
IJclWideStrMap)
private
FBuckets: TJclWideStrBucketArray;
@@ -690,7 +690,7 @@
TJclBucketArray = array of TJclBucket;
TJclHashMap = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclKeyOwner, IJclValueOwner,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclKeyOwner, IJclValueOwner,
IJclMap)
private
FBuckets: TJclBucketArray;
@@ -758,7 +758,7 @@
TJclBucketArray<TKey,TValue> = array of TJclBucket<TKey,TValue>;
TJclHashMap<TKey,TValue> = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclPairOwner<TKey, TValue>,
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, IJclPairOwner<TKey, TValue>,
IJclMap<TKey,TValue>)
private
FBuckets: TJclBucketArray<TKey,TValue>;
Modified: trunk/jcl/source/prototypes/containers/JclHashMaps.imp
===================================================================
--- trunk/jcl/source/prototypes/containers/JclHashMaps.imp 2007-11-10 18:02:00 UTC (rev 2208)
+++ trunk/jcl/source/prototypes/containers/JclHashMaps.imp 2007-11-10 23:32:26 UTC (rev 2209)
@@ -18,7 +18,7 @@
BUCKETARRAYTYPENAME = array of BUCKETTYPENAME;
SELFCLASSNAME = class(ANCESTORNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
- IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer, INTERFACEADDITIONAL
+ IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclContainer,INTERFACEADDITIONAL
MAPINTERFACENAME)
private
FBuckets: BUCKETARRAYTYPENAME;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-11-10 18:02:04
|
Revision: 2208
http://jcl.svn.sourceforge.net/jcl/?rev=2208&view=rev
Author: outchy
Date: 2007-11-10 10:02:00 -0800 (Sat, 10 Nov 2007)
Log Message:
-----------
eliminating function inlining (source of compiler internal errors)
Modified Paths:
--------------
trunk/jcl/source/common/JclBinaryTrees.pas
trunk/jcl/source/common/JclHashMaps.pas
trunk/jcl/source/prototypes/JclBinaryTrees.pas
trunk/jcl/source/prototypes/JclHashMaps.pas
Modified: trunk/jcl/source/common/JclBinaryTrees.pas
===================================================================
--- trunk/jcl/source/common/JclBinaryTrees.pas 2007-11-03 16:15:43 UTC (rev 2207)
+++ trunk/jcl/source/common/JclBinaryTrees.pas 2007-11-10 18:02:00 UTC (rev 2208)
@@ -97,9 +97,9 @@
function GetTraverseOrder: TJclTraverseOrder;
procedure SetTraverseOrder(Value: TJclTraverseOrder);
{ IJclIntfComparer }
- function ItemsCompare(const A, B: IInterface): Integer;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsCompare(const A, B: IInterface): Integer;
{ IJclIntfEqualityComparer }
- function ItemsEqual(const A, B: IInterface): Boolean;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsEqual(const A, B: IInterface): Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
public
constructor Create(ACompare: TIntfCompare);
@@ -151,9 +151,9 @@
function GetTraverseOrder: TJclTraverseOrder;
procedure SetTraverseOrder(Value: TJclTraverseOrder);
{ IJclAnsiStrComparer }
- function ItemsCompare(const A, B: AnsiString): Integer;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsCompare(const A, B: AnsiString): Integer;
{ IJclAnsiStrEqualityComparer }
- function ItemsEqual(const A, B: AnsiString): Boolean;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsEqual(const A, B: AnsiString): Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
public
constructor Create(ACompare: TAnsiStrCompare);
@@ -205,9 +205,9 @@
function GetTraverseOrder: TJclTraverseOrder;
procedure SetTraverseOrder(Value: TJclTraverseOrder);
{ IJclWideStrComparer }
- function ItemsCompare(const A, B: WideString): Integer;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsCompare(const A, B: WideString): Integer;
{ IJclWideStrEqualityComparer }
- function ItemsEqual(const A, B: WideString): Boolean;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsEqual(const A, B: WideString): Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
public
constructor Create(ACompare: TWideStrCompare);
@@ -266,9 +266,9 @@
function GetTraverseOrder: TJclTraverseOrder;
procedure SetTraverseOrder(Value: TJclTraverseOrder);
{ IJclComparer }
- function ItemsCompare(A, B: TObject): Integer;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsCompare(A, B: TObject): Integer;
{ IJclEqualityComparer }
- function ItemsEqual(A, B: TObject): Boolean;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsEqual(A, B: TObject): Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
public
constructor Create(ACompare: TCompare; AOwnsObjects: Boolean);
Modified: trunk/jcl/source/common/JclHashMaps.pas
===================================================================
--- trunk/jcl/source/common/JclHashMaps.pas 2007-11-03 16:15:43 UTC (rev 2207)
+++ trunk/jcl/source/common/JclHashMaps.pas 2007-11-10 18:02:00 UTC (rev 2208)
@@ -107,11 +107,11 @@
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function Hash(const AInterface: IInterface): Integer; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
+ function FreeKey(var Key: IInterface): IInterface;
+ function FreeValue(var Value: IInterface): IInterface;
+ function Hash(const AInterface: IInterface): Integer;
+ function KeysEqual(const A, B: IInterface): Boolean;
+ function ValuesEqual(const A, B: IInterface): Boolean;
public
constructor Create(ACapacity: Integer);
destructor Destroy; override;
@@ -166,10 +166,10 @@
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: AnsiString): AnsiString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A, B: AnsiString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
+ function FreeKey(var Key: AnsiString): AnsiString;
+ function FreeValue(var Value: IInterface): IInterface;
+ function KeysEqual(const A, B: AnsiString): Boolean;
+ function ValuesEqual(const A, B: IInterface): Boolean;
public
constructor Create(ACapacity: Integer);
destructor Destroy; override;
@@ -224,11 +224,11 @@
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: AnsiString): AnsiString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function Hash(const AInterface: IInterface): Integer; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A, B: AnsiString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
+ function FreeKey(var Key: IInterface): IInterface;
+ function FreeValue(var Value: AnsiString): AnsiString;
+ function Hash(const AInterface: IInterface): Integer;
+ function KeysEqual(const A, B: IInterface): Boolean;
+ function ValuesEqual(const A, B: AnsiString): Boolean;
public
constructor Create(ACapacity: Integer);
destructor Destroy; override;
@@ -283,10 +283,10 @@
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: AnsiString): AnsiString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: AnsiString): AnsiString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A, B: AnsiString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A, B: AnsiString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
+ function FreeKey(var Key: AnsiString): AnsiString;
+ function FreeValue(var Value: AnsiString): AnsiString;
+ function KeysEqual(const A, B: AnsiString): Boolean;
+ function ValuesEqual(const A, B: AnsiString): Boolean;
public
constructor Create(ACapacity: Integer);
destructor Destroy; override;
@@ -341,10 +341,10 @@
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: WideString): WideString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A, B: WideString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
+ function FreeKey(var Key: WideString): WideString;
+ function FreeValue(var Value: IInterface): IInterface;
+ function KeysEqual(const A, B: WideString): Boolean;
+ function ValuesEqual(const A, B: IInterface): Boolean;
public
constructor Create(ACapacity: Integer);
destructor Destroy; override;
@@ -399,11 +399,11 @@
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: WideString): WideString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function Hash(const AInterface: IInterface): Integer; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A, B: WideString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
+ function FreeKey(var Key: IInterface): IInterface;
+ function FreeValue(var Value: WideString): WideString;
+ function Hash(const AInterface: IInterface): Integer;
+ function KeysEqual(const A, B: IInterface): Boolean;
+ function ValuesEqual(const A, B: WideString): Boolean;
public
constructor Create(ACapacity: Integer);
destructor Destroy; override;
@@ -458,10 +458,10 @@
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: WideString): WideString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: WideString): WideString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A, B: WideString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A, B: WideString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
+ function FreeKey(var Key: WideString): WideString;
+ function FreeValue(var Value: WideString): WideString;
+ function KeysEqual(const A, B: WideString): Boolean;
+ function ValuesEqual(const A, B: WideString): Boolean;
public
constructor Create(ACapacity: Integer);
destructor Destroy; override;
@@ -531,10 +531,10 @@
function FreeValue(var Value: TObject): TObject;
function GetOwnsValues: Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function Hash(const AInterface: IInterface): Integer; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(A, B: TObject): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
+ function FreeKey(var Key: IInterface): IInterface;
+ function Hash(const AInterface: IInterface): Integer;
+ function KeysEqual(const A, B: IInterface): Boolean;
+ function ValuesEqual(A, B: TObject): Boolean;
public
constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
destructor Destroy; override;
@@ -594,9 +594,9 @@
function FreeValue(var Value: TObject): TObject;
function GetOwnsValues: Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: AnsiString): AnsiString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A, B: AnsiString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(A, B: TObject): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
+ function FreeKey(var Key: AnsiString): AnsiString;
+ function KeysEqual(const A, B: AnsiString): Boolean;
+ function ValuesEqual(A, B: TObject): Boolean;
public
constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
destructor Destroy; override;
@@ -656,9 +656,9 @@
function FreeValue(var Value: TObject): TObject;
function GetOwnsValues: Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: WideString): WideString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A, B: WideString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(A, B: TObject): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
+ function FreeKey(var Key: WideString): WideString;
+ function KeysEqual(const A, B: WideString): Boolean;
+ function ValuesEqual(A, B: TObject): Boolean;
public
constructor Create(ACapacity: Integer; AOwnsValues: Boolean);
destructor Destroy; override;
@@ -729,9 +729,9 @@
function FreeValue(var Value: TObject): TObject;
function GetOwnsValues: Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function Hash(AObject: TObject): Integer; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(A, B: TObject): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(A, B: TObject): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
+ function Hash(AObject: TObject): Integer;
+ function KeysEqual(A, B: TObject): Boolean;
+ function ValuesEqual(A, B: TObject): Boolean;
public
constructor Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean);
destructor Destroy; override;
Modified: trunk/jcl/source/prototypes/JclBinaryTrees.pas
===================================================================
--- trunk/jcl/source/prototypes/JclBinaryTrees.pas 2007-11-03 16:15:43 UTC (rev 2207)
+++ trunk/jcl/source/prototypes/JclBinaryTrees.pas 2007-11-10 18:02:00 UTC (rev 2208)
@@ -53,27 +53,27 @@
(*$JPPEXPANDMACRO JCLBINARYTREEINT(TJclIntfBinaryNode,TJclIntfBinaryTree,TJclIntfAbstractContainer,IJclIntfCollection,IJclIntfTree,IJclIntfIterator, IJclIntfEqualityComparer\, IJclIntfComparer\,,
FCompare: TIntfCompare;,
{ IJclIntfComparer }
- function ItemsCompare(const A, B: IInterface): Integer;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsCompare(const A, B: IInterface): Integer;
{ IJclIntfEqualityComparer }
- function ItemsEqual(const A, B: IInterface): Boolean;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsEqual(const A, B: IInterface): Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;,
property Compare: TIntfCompare read FCompare write FCompare;,ACompare: TIntfCompare,,const AInterface: IInterface,IInterface)*)
(*$JPPEXPANDMACRO JCLBINARYTREEINT(TJclAnsiStrBinaryNode,TJclAnsiStrBinaryTree,TJclAnsiStrAbstractCollection,IJclAnsiStrCollection,IJclAnsiStrTree,IJclAnsiStrIterator, IJclStrContainer\, IJclAnsiStrContainer\, IJclAnsiStrFlatContainer\, IJclAnsiStrEqualityComparer\, IJclAnsiStrComparer\,,
FCompare: TAnsiStrCompare;,
{ IJclAnsiStrComparer }
- function ItemsCompare(const A, B: AnsiString): Integer;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsCompare(const A, B: AnsiString): Integer;
{ IJclAnsiStrEqualityComparer }
- function ItemsEqual(const A, B: AnsiString): Boolean;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsEqual(const A, B: AnsiString): Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;,
property Compare: TAnsiStrCompare read FCompare write FCompare;,ACompare: TAnsiStrCompare, override;,const AString: AnsiString,AnsiString)*)
(*$JPPEXPANDMACRO JCLBINARYTREEINT(TJclWideStrBinaryNode,TJclWideStrBinaryTree,TJclWideStrAbstractCollection,IJclWideStrCollection,IJclWideStrTree,IJclWideStrIterator, IJclStrContainer\, IJclWideStrContainer\, IJclWideStrFlatContainer\, IJclWideStrEqualityComparer\, IJclWideStrComparer\,,
FCompare: TWideStrCompare;,
{ IJclWideStrComparer }
- function ItemsCompare(const A, B: WideString): Integer;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsCompare(const A, B: WideString): Integer;
{ IJclWideStrEqualityComparer }
- function ItemsEqual(const A, B: WideString): Boolean;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsEqual(const A, B: WideString): Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;,
property Compare: TWideStrCompare read FCompare write FCompare;,ACompare: TWideStrCompare, override;,const AString: WideString,WideString)*)
@@ -87,9 +87,9 @@
(*$JPPEXPANDMACRO JCLBINARYTREEINT(TJclBinaryNode,TJclBinaryTree,TJclAbstractContainer,IJclCollection,IJclTree,IJclIterator, IJclObjectOwner\, IJclEqualityComparer\, IJclComparer\,,
FCompare: TCompare;,
{ IJclComparer }
- function ItemsCompare(A, B: TObject): Integer;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsCompare(A, B: TObject): Integer;
{ IJclEqualityComparer }
- function ItemsEqual(A, B: TObject): Boolean;{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF SUPPORTS_INLINE}
+ function ItemsEqual(A, B: TObject): Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;,
property Compare: TCompare read FCompare write FCompare;,ACompare: TCompare; AOwnsObjects: Boolean,,AObject: TObject,TObject)*)
Modified: trunk/jcl/source/prototypes/JclHashMaps.pas
===================================================================
--- trunk/jcl/source/prototypes/JclHashMaps.pas 2007-11-03 16:15:43 UTC (rev 2207)
+++ trunk/jcl/source/prototypes/JclHashMaps.pas 2007-11-10 18:02:00 UTC (rev 2208)
@@ -58,55 +58,55 @@
(*$JPPEXPANDMACRO JCLHASHMAPINT(IInterface,IInterface,TJclIntfIntfEntry,TJclIntfIntfEntryArray,TJclIntfIntfBucket,TJclIntfIntfBucketArray,TJclIntfIntfHashMap,TJclAbstractContainerBase,IJclIntfIntfMap,IJclIntfSet,IJclIntfCollection,,,
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function Hash(const AInterface: IInterface): Integer; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A\, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A\, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS},,,,const Key: IInterface,const Value: IInterface)*)
+ function FreeKey(var Key: IInterface): IInterface;
+ function FreeValue(var Value: IInterface): IInterface;
+ function Hash(const AInterface: IInterface): Integer;
+ function KeysEqual(const A\, B: IInterface): Boolean;
+ function ValuesEqual(const A\, B: IInterface): Boolean;,,,,const Key: IInterface,const Value: IInterface)*)
(*$JPPEXPANDMACRO JCLHASHMAPINT(AnsiString,IInterface,TJclAnsiStrIntfEntry,TJclAnsiStrIntfEntryArray,TJclAnsiStrIntfBucket,TJclAnsiStrIntfBucketArray,TJclAnsiStrIntfHashMap,TJclAnsiStrAbstractContainer,IJclAnsiStrIntfMap,IJclAnsiStrSet,IJclIntfCollection, IJclStrContainer\, IJclAnsiStrContainer\,,,
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: AnsiString): AnsiString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A\, B: AnsiString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A\, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS},,,,const Key: AnsiString,const Value: IInterface)*)
+ function FreeKey(var Key: AnsiString): AnsiString;
+ function FreeValue(var Value: IInterface): IInterface;
+ function KeysEqual(const A\, B: AnsiString): Boolean;
+ function ValuesEqual(const A\, B: IInterface): Boolean;,,,,const Key: AnsiString,const Value: IInterface)*)
(*$JPPEXPANDMACRO JCLHASHMAPINT(IInterface,AnsiString,TJclIntfAnsiStrEntry,TJclIntfAnsiStrEntryArray,TJclIntfAnsiStrBucket,TJclIntfAnsiStrBucketArray,TJclIntfAnsiStrHashMap,TJclAnsiStrAbstractContainer,IJclIntfAnsiStrMap,IJclIntfSet,IJclAnsiStrCollection, IJclStrContainer\, IJclAnsiStrContainer\,,,
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: AnsiString): AnsiString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function Hash(const AInterface: IInterface): Integer; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A\, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A\, B: AnsiString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS},,,,const Key: IInterface,const Value: AnsiString)*)
+ function FreeKey(var Key: IInterface): IInterface;
+ function FreeValue(var Value: AnsiString): AnsiString;
+ function Hash(const AInterface: IInterface): Integer;
+ function KeysEqual(const A\, B: IInterface): Boolean;
+ function ValuesEqual(const A\, B: AnsiString): Boolean;,,,,const Key: IInterface,const Value: AnsiString)*)
(*$JPPEXPANDMACRO JCLHASHMAPINT(AnsiString,AnsiString,TJclAnsiStrAnsiStrEntry,TJclAnsiStrAnsiStrEntryArray,TJclAnsiStrAnsiStrBucket,TJclAnsiStrAnsiStrBucketArray,TJclAnsiStrAnsiStrHashMap,TJclAnsiStrAbstractContainer,IJclAnsiStrAnsiStrMap,IJclAnsiStrSet,IJclAnsiStrCollection, IJclStrContainer\, IJclAnsiStrContainer\,,,
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: AnsiString): AnsiString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: AnsiString): AnsiString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A\, B: AnsiString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A\, B: AnsiString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS},,,,const Key: AnsiString,const Value: AnsiString)*)
+ function FreeKey(var Key: AnsiString): AnsiString;
+ function FreeValue(var Value: AnsiString): AnsiString;
+ function KeysEqual(const A\, B: AnsiString): Boolean;
+ function ValuesEqual(const A\, B: AnsiString): Boolean;,,,,const Key: AnsiString,const Value: AnsiString)*)
(*$JPPEXPANDMACRO JCLHASHMAPINT(WideString,IInterface,TJclWideStrIntfEntry,TJclWideStrIntfEntryArray,TJclWideStrIntfBucket,TJclWideStrIntfBucketArray,TJclWideStrIntfHashMap,TJclWideStrAbstractContainer,IJclWideStrIntfMap,IJclWideStrSet,IJclIntfCollection, IJclStrContainer\, IJclWideStrContainer\,,,
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: WideString): WideString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A\, B: WideString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A\, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS},,,,const Key: WideString,const Value: IInterface)*)
+ function FreeKey(var Key: WideString): WideString;
+ function FreeValue(var Value: IInterface): IInterface;
+ function KeysEqual(const A\, B: WideString): Boolean;
+ function ValuesEqual(const A\, B: IInterface): Boolean;,,,,const Key: WideString,const Value: IInterface)*)
(*$JPPEXPANDMACRO JCLHASHMAPINT(IInterface,WideString,TJclIntfWideStrEntry,TJclIntfWideStrEntryArray,TJclIntfWideStrBucket,TJclIntfWideStrBucketArray,TJclIntfWideStrHashMap,TJclWideStrAbstractContainer,IJclIntfWideStrMap,IJclIntfSet,IJclWideStrCollection, IJclStrContainer\, IJclWideStrContainer\,,,
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: WideString): WideString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function Hash(const AInterface: IInterface): Integer; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A\, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A\, B: WideString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS},,,,const Key: IInterface,const Value: WideString)*)
+ function FreeKey(var Key: IInterface): IInterface;
+ function FreeValue(var Value: WideString): WideString;
+ function Hash(const AInterface: IInterface): Integer;
+ function KeysEqual(const A\, B: IInterface): Boolean;
+ function ValuesEqual(const A\, B: WideString): Boolean;,,,,const Key: IInterface,const Value: WideString)*)
(*$JPPEXPANDMACRO JCLHASHMAPINT(WideString,WideString,TJclWideStrWideStrEntry,TJclWideStrWideStrEntryArray,TJclWideStrWideStrBucket,TJclWideStrWideStrBucketArray,TJclWideStrWideStrHashMap,TJclWideStrAbstractContainer,IJclWideStrWideStrMap,IJclWideStrSet,IJclWideStrCollection, IJclStrContainer\, IJclWideStrContainer\,,,
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: WideString): WideString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function FreeValue(var Value: WideString): WideString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A\, B: WideString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(const A\, B: WideString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS},,,,const Key: WideString,const Value: WideString)*)
+ function FreeKey(var Key: WideString): WideString;
+ function FreeValue(var Value: WideString): WideString;
+ function KeysEqual(const A\, B: WideString): Boolean;
+ function ValuesEqual(const A\, B: WideString): Boolean;,,,,const Key: WideString,const Value: WideString)*)
{$IFDEF CONTAINER_ANSISTR}
TJclStrIntfHashMap = TJclAnsiStrIntfHashMap;
@@ -125,10 +125,10 @@
function FreeValue(var Value: TObject): TObject;
function GetOwnsValues: Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: IInterface): IInterface; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function Hash(const AInterface: IInterface): Integer; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A\, B: IInterface): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(A\, B: TObject): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS},
+ function FreeKey(var Key: IInterface): IInterface;
+ function Hash(const AInterface: IInterface): Integer;
+ function KeysEqual(const A\, B: IInterface): Boolean;
+ function ValuesEqual(A\, B: TObject): Boolean;,
property OwnsValues: Boolean read FOwnsValues;,,; AOwnsValues: Boolean,const Key: IInterface,Value: TObject)*)
(*$JPPEXPANDMACRO JCLHASHMAPINT(AnsiString,TObject,TJclAnsiStrEntry,TJclAnsiStrEntryArray,TJclAnsiStrBucket,TJclAnsiStrBucketArray,TJclAnsiStrHashMap,TJclAnsiStrAbstractContainer,IJclAnsiStrMap,IJclAnsiStrSet,IJclCollection, IJclStrContainer\, IJclAnsiStrContainer\, IJclValueOwner\,,
@@ -137,9 +137,9 @@
function FreeValue(var Value: TObject): TObject;
function GetOwnsValues: Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: AnsiString): AnsiString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A\, B: AnsiString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(A\, B: TObject): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS},
+ function FreeKey(var Key: AnsiString): AnsiString;
+ function KeysEqual(const A\, B: AnsiString): Boolean;
+ function ValuesEqual(A\, B: TObject): Boolean;,
property OwnsValues: Boolean read FOwnsValues;,,; AOwnsValues: Boolean,const Key: AnsiString,Value: TObject)*)
(*$JPPEXPANDMACRO JCLHASHMAPINT(WideString,TObject,TJclWideStrEntry,TJclWideStrEntryArray,TJclWideStrBucket,TJclWideStrBucketArray,TJclWideStrHashMap,TJclwideStrAbstractContainer,IJclWideStrMap,IJclWideStrSet,IJclCollection, IJclStrContainer\, IJclWideStrContainer\, IJclValueOwner\,,
@@ -148,9 +148,9 @@
function FreeValue(var Value: TObject): TObject;
function GetOwnsValues: Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function FreeKey(var Key: WideString): WideString; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(const A\, B: WideString): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(A\, B: TObject): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS},
+ function FreeKey(var Key: WideString): WideString;
+ function KeysEqual(const A\, B: WideString): Boolean;
+ function ValuesEqual(A\, B: TObject): Boolean;,
property OwnsValues: Boolean read FOwnsValues;,,; AOwnsValues: Boolean,const Key: WideString,Value: TObject)*)
{$IFDEF CONTAINER_ANSISTR}
@@ -170,9 +170,9 @@
function FreeValue(var Value: TObject): TObject;
function GetOwnsValues: Boolean;
function CreateEmptyContainer: TJclAbstractContainerBase; override;
- function Hash(AObject: TObject): Integer; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function KeysEqual(A\, B: TObject): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS}
- function ValuesEqual(A\, B: TObject): Boolean; {$IFDEF SUPPORTS_GENERICS}inline;{$ENDIF SUPPORTS_GENERICS},
+ function Hash(AObject: TObject): Integer;
+ function KeysEqual(A\, B: TObject): Boolean;
+ function ValuesEqual(A\, B: TObject): Boolean;,
property OwnsKeys: Boolean read FOwnsKeys;
property OwnsValues: Boolean read FOwnsValues;,; AOwnsKeys: Boolean,; AOwnsValues: Boolean,Key: TObject,Value: TObject)*)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-11-03 16:15:50
|
Revision: 2207
http://jcl.svn.sourceforge.net/jcl/?rev=2207&view=rev
Author: outchy
Date: 2007-11-03 09:15:43 -0700 (Sat, 03 Nov 2007)
Log Message:
-----------
Updated CPU detection to latest specifications of AMD and Intel
Improved Streaming SIMD Extension detection.
Modified Paths:
--------------
trunk/jcl/experts/common/JclOtaResources.pas
trunk/jcl/experts/debug/simdview/JclSIMDCpuInfo.dfm
trunk/jcl/experts/debug/simdview/JclSIMDCpuInfo.pas
trunk/jcl/experts/debug/simdview/JclSIMDView.pas
trunk/jcl/experts/debug/simdview/JclSIMDViewForm.pas
trunk/jcl/source/common/JclResources.pas
trunk/jcl/source/common/JclSysInfo.pas
Modified: trunk/jcl/experts/common/JclOtaResources.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaResources.pas 2007-11-02 16:18:06 UTC (rev 2206)
+++ trunk/jcl/experts/common/JclOtaResources.pas 2007-11-03 16:15:43 UTC (rev 2207)
@@ -258,9 +258,6 @@
RsExMMX = 'Ex MMX';
Rs3DNow = '3DNow!';
RsEx3DNow = 'Ex 3DNow!';
- RsSSE1 = 'SSE1';
- RsSSE2 = 'SSE2';
- RsSSE3 = 'SSE3';
RsLong = '64-bit Core';
RsTrademarks =
Modified: trunk/jcl/experts/debug/simdview/JclSIMDCpuInfo.dfm
===================================================================
--- trunk/jcl/experts/debug/simdview/JclSIMDCpuInfo.dfm 2007-11-02 16:18:06 UTC (rev 2206)
+++ trunk/jcl/experts/debug/simdview/JclSIMDCpuInfo.dfm 2007-11-03 16:15:43 UTC (rev 2207)
@@ -3,7 +3,7 @@
Top = 438
BorderStyle = bsDialog
Caption = 'Local CPU Informations'
- ClientHeight = 208
+ ClientHeight = 264
ClientWidth = 322
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@@ -78,7 +78,7 @@
end
object CheckBoxExMMX: TCheckBox
Left = 8
- Top = 96
+ Top = 95
Width = 137
Height = 17
Alignment = taLeftJustify
@@ -88,7 +88,7 @@
end
object CheckBox3DNow: TCheckBox
Left = 8
- Top = 120
+ Top = 118
Width = 137
Height = 17
Alignment = taLeftJustify
@@ -98,7 +98,7 @@
end
object CheckBoxEx3DNow: TCheckBox
Left = 8
- Top = 144
+ Top = 141
Width = 137
Height = 17
Alignment = taLeftJustify
@@ -107,9 +107,9 @@
TabOrder = 6
end
object CheckBox64Bits: TCheckBox
- Left = 160
- Top = 144
- Width = 153
+ Left = 8
+ Top = 164
+ Width = 137
Height = 17
Alignment = taLeftJustify
Caption = '64 bits'
@@ -117,7 +117,7 @@
TabOrder = 7
end
object CheckBoxSSE1: TCheckBox
- Left = 160
+ Left = 161
Top = 72
Width = 153
Height = 17
@@ -127,8 +127,8 @@
TabOrder = 8
end
object CheckBoxSSE2: TCheckBox
- Left = 160
- Top = 96
+ Left = 161
+ Top = 95
Width = 153
Height = 17
Alignment = taLeftJustify
@@ -137,8 +137,8 @@
TabOrder = 9
end
object CheckBoxSSE3: TCheckBox
- Left = 160
- Top = 120
+ Left = 161
+ Top = 118
Width = 153
Height = 17
Alignment = taLeftJustify
@@ -148,11 +148,51 @@
end
object ButtonClose: TButton
Left = 128
- Top = 176
+ Top = 233
Width = 83
Height = 25
Caption = 'Close'
ModalResult = 2
TabOrder = 11
end
+ object CheckBoxSSSE3: TCheckBox
+ Left = 161
+ Top = 141
+ Width = 153
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'Suppl. SSE Version 3'
+ Enabled = False
+ TabOrder = 12
+ end
+ object CheckBoxSSE4A: TCheckBox
+ Left = 161
+ Top = 164
+ Width = 153
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'SSE Version 4 A'
+ Enabled = False
+ TabOrder = 13
+ end
+ object CheckBoxSSE5: TCheckBox
+ Left = 161
+ Top = 210
+ Width = 153
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'SSE Version 5'
+ Enabled = False
+ TabOrder = 14
+ end
+ object CheckBoxSSE4B: TCheckBox
+ Left = 161
+ Top = 187
+ Width = 153
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'SSE Version 4 B'
+ Enabled = False
+ TabOrder = 15
+ end
end
Modified: trunk/jcl/experts/debug/simdview/JclSIMDCpuInfo.pas
===================================================================
--- trunk/jcl/experts/debug/simdview/JclSIMDCpuInfo.pas 2007-11-02 16:18:06 UTC (rev 2206)
+++ trunk/jcl/experts/debug/simdview/JclSIMDCpuInfo.pas 2007-11-03 16:15:43 UTC (rev 2207)
@@ -56,6 +56,10 @@
CheckBoxSSE2: TCheckBox;
CheckBoxSSE3: TCheckBox;
ButtonClose: TButton;
+ CheckBoxSSSE3: TCheckBox;
+ CheckBoxSSE4A: TCheckBox;
+ CheckBoxSSE5: TCheckBox;
+ CheckBoxSSE4B: TCheckBox;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
@@ -92,9 +96,13 @@
CheckBox3DNow.Checked := CpuInfo._3DNow;
CheckBoxEx3DNow.Checked := CpuInfo.Ex3DNow;
CheckBox64Bits.Checked := CpuInfo.Is64Bits;
- CheckBoxSSE1.Checked := CpuInfo.SSE >= 1;
- CheckBoxSSE2.Checked := CpuInfo.SSE >= 2;
- CheckBoxSSE3.Checked := CpuInfo.SSE >= 3;
+ CheckBoxSSE1.Checked := sse in CpuInfo.SSE;
+ CheckBoxSSE2.Checked := sse2 in CpuInfo.SSE;
+ CheckBoxSSE3.Checked := sse3 in CpuInfo.SSE;
+ CheckBoxSSSE3.Checked := ssse3 in CpuInfo.SSE;
+ CheckBoxSSE4A.Checked := sse4A in CpuInfo.SSE;
+ CheckBoxSSE4B.Checked := sse4B in CpuInfo.SSE;
+ CheckBoxSSE5.Checked := sse5 in CpuInfo.SSE;
ShowModal;
end;
Modified: trunk/jcl/experts/debug/simdview/JclSIMDView.pas
===================================================================
--- trunk/jcl/experts/debug/simdview/JclSIMDView.pas 2007-11-02 16:18:06 UTC (rev 2206)
+++ trunk/jcl/experts/debug/simdview/JclSIMDView.pas 2007-11-03 16:15:43 UTC (rev 2207)
@@ -125,6 +125,7 @@
implementation
uses
+ TypInfo,
JclOtaConsts, JclOtaResources,
JclSIMDUtils;
@@ -212,7 +213,7 @@
procedure TJclSIMDWizard.SIMDActionExecute(Sender: TObject);
begin
try
- if CpuInfo.SSE = 0 then
+ if CpuInfo.SSE = [] then
raise EJclExpertException.CreateTrace(RsNoSSE);
if not Assigned(FForm) then
@@ -245,7 +246,7 @@
try
AAction := Sender as TAction;
- if (CpuInfo.SSE <> 0) or CPUInfo.MMX or CPUInfo._3DNow then
+ if (CpuInfo.SSE <> []) or CPUInfo.MMX or CPUInfo._3DNow then
begin
AThread := nil;
AProcess := nil;
@@ -373,6 +374,8 @@
Result := LeftValue + ',' + RightValue;
end;
+var
+ SSESupport: TSSESupport;
begin
Result := '';
with CpuInfo do
@@ -385,12 +388,9 @@
Result := Concat(Result, Rs3DNow);
if Ex3DNow then
Result := Concat(Result, RsEx3DNow);
- if SSE >= 1 then
- Result := Concat(Result, RsSSE1);
- if SSE >= 2 then
- Result := Concat(Result, RsSSE2);
- if SSE >= 3 then
- Result := Concat(Result, RsSSE3);
+ for SSESupport := Low(TSSESupport) to High(TSSESupport) do
+ if SSESupport in SSE then
+ Result := Concat(Result, GetEnumName(TypeInfo(TSSESupport), Integer(SSESupport)));
if Is64Bits then
Result := Result + ',' + RsLong;
end;
Modified: trunk/jcl/experts/debug/simdview/JclSIMDViewForm.pas
===================================================================
--- trunk/jcl/experts/debug/simdview/JclSIMDViewForm.pas 2007-11-02 16:18:06 UTC (rev 2206)
+++ trunk/jcl/experts/debug/simdview/JclSIMDViewForm.pas 2007-11-03 16:15:43 UTC (rev 2207)
@@ -170,7 +170,7 @@
FNbMMRegister := 0;
- if CpuInfo.SSE = 0 then
+ if CpuInfo.SSE = [] then
FNbXMMRegister := 0
else
if CpuInfo.Is64Bits then
Modified: trunk/jcl/source/common/JclResources.pas
===================================================================
--- trunk/jcl/source/common/JclResources.pas 2007-11-02 16:18:06 UTC (rev 2206)
+++ trunk/jcl/source/common/JclResources.pas 2007-11-03 16:15:43 UTC (rev 2207)
@@ -1728,7 +1728,12 @@
RsIntelCacheDescr45 = '2nd-level cache: 2 MBytes, 4-way set associative, 32 byte line size';
RsIntelCacheDescr46 = '3rd-level cache: 4 MBytes, 4-way set associative, 64 byte line size';
RsIntelCacheDescr47 = '3rd-level cache: 8 MBytes, 4-way set associative, 64 byte line size';
+ RsIntelCacheDescr48 = '3rd-level cache: 8 MByte, 8-way set associative, 64 byte line size';
RsIntelCacheDescr49 = '2nd-level cache: 4 MBytes, 16-way set associative, 64 byte line size';
+ RsIntelCacheDescr4A = '3rd-level cache: 6MByte, 12-way set associative, 64 byte line size';
+ RsIntelCacheDescr4B = '3rd-level cache: 8MByte, 16-way set associative, 64 byte line size';
+ RsIntelCacheDescr4D = '3rd-level cache: 16MByte, 16-way set associative, 64 byte line size';
+ RsIntelCacheDescr4E = '2nd-level cache: 6MByte, 24-way set associative, 64 byte line size';
RsIntelCacheDescr50 = 'Instruction TLB: 4 KByte and 2 MByte or 4 MByte pages, 64 Entries';
RsIntelCacheDescr51 = 'Instruction TLB: 4 KByte and 2 MByte or 4 MByte pages, 128 Entries';
RsIntelCacheDescr52 = 'Instruction TLB: 4 KByte and 2 MByte or 4 MByte pages, 256 Entries';
Modified: trunk/jcl/source/common/JclSysInfo.pas
===================================================================
--- trunk/jcl/source/common/JclSysInfo.pas 2007-11-02 16:18:06 UTC (rev 2206)
+++ trunk/jcl/source/common/JclSysInfo.pas 2007-11-03 16:15:43 UTC (rev 2207)
@@ -377,6 +377,7 @@
L2KByteDataTLB: array [TTLBInformation] of Byte; // L2 TLB for 4-KByte pages
L2KByteInstructionTLB: array [TTLBInformation] of Byte; // L2 TLB for 4-KByte pages
L2Cache: Cardinal;
+ L3Cache: Cardinal;
AdvancedPowerManagement: Cardinal;
PhysicalAddressSize: Byte;
VirtualAddressSize: Byte;
@@ -441,13 +442,16 @@
CPU_TYPE_VIA = 5;
type
+ TSSESupport = (sse, sse2, sse3, ssse3, sse4A, sse4B, sse5);
+ TSSESupports = set of TSSESupport;
+
TCpuInfo = record
HasInstruction: Boolean;
MMX: Boolean;
ExMMX: Boolean;
_3DNow: Boolean;
Ex3DNow: Boolean;
- SSE: Byte; // SSE version 0 = no SSE, 1 = SSE, 2 = SSE2, 3 = SSE3
+ SSE: TSSESupports;
IsFDIVOK: Boolean;
Is64Bits: Boolean;
DEPCapable: Boolean;
@@ -622,15 +626,15 @@
EINTEL_BIT_12 = BIT_12; // Reserved, do not count on value
EINTEL_CMPXCHG16B = BIT_13; // CMPXCHG16B instruction
EINTEL_XTPR = BIT_14; // Send Task Priority messages
- EINTEL_BIT_15 = BIT_15; // Reserved, do not count on value
+ EINTEL_PDCM = BIT_15; // Perf/Debug Capability MSR
EINTEL_BIT_16 = BIT_16; // Reserved, do not count on value
EINTEL_BIT_17 = BIT_17; // Reserved, do not count on value
EINTEL_BIT_18 = BIT_18; // Reserved, do not count on value
- EINTEL_BIT_19 = BIT_19; // Reserved, do not count on value
- EINTEL_BIT_20 = BIT_20; // Reserved, do not count on value
+ EINTEL_SSE4_1 = BIT_19; // Streaming SIMD Extensions 4.1
+ EINTEL_SSE4_2 = BIT_20; // Streaming SIMD Extensions 4.2
EINTEL_BIT_21 = BIT_21; // Reserved, do not count on value
EINTEL_BIT_22 = BIT_22; // Reserved, do not count on value
- EINTEL_BIT_23 = BIT_23; // Reserved, do not count on value
+ EINTEL_POPCNT = BIT_23; // A value of 1 indicates the processor supports the POPCNT instruction.
EINTEL_BIT_24 = BIT_24; // Reserved, do not count on value
EINTEL_BIT_25 = BIT_25; // Reserved, do not count on value
EINTEL_BIT_26 = BIT_26; // Reserved, do not count on value
@@ -743,38 +747,38 @@
AMD_BIT_31 = BIT_31; // Reserved, do not count on value
{ AMD Standard Feature Flags continued }
- AMD2_SSE3 = BIT_0; // SSE3 extensions
- AMD2_BIT_1 = BIT_1; // Reserved, do not count on value
- AMD2_BIT_2 = BIT_2; // Reserved, do not count on value
- AMD2_BIT_3 = BIT_3; // Reserved, do not count on value
- AMD2_BIT_4 = BIT_4; // Reserved, do not count on value
- AMD2_BIT_5 = BIT_5; // Reserved, do not count on value
- AMD2_BIT_6 = BIT_6; // Reserved, do not count on value
- AMD2_BIT_7 = BIT_7; // Reserved, do not count on value
- AMD2_BIT_8 = BIT_8; // Reserved, do not count on value
- AMD2_BIT_9 = BIT_9; // Reserved, do not count on value
- AMD2_BIT_10 = BIT_10; // Reserved, do not count on value
- AMD2_BIT_11 = BIT_11; // Reserved, do not count on value
- AMD2_BIT_12 = BIT_12; // Reserved, do not count on value
+ AMD2_SSE3 = BIT_0; // SSE3 extensions
+ AMD2_BIT_1 = BIT_1; // Reserved, do not count on value
+ AMD2_BIT_2 = BIT_2; // Reserved, do not count on value
+ AMD2_MONITOR = BIT_3; // MONITOR/MWAIT instructions. See "MONITOR" and "MWAIT" in APM3.
+ AMD2_BIT_4 = BIT_4; // Reserved, do not count on value
+ AMD2_BIT_5 = BIT_5; // Reserved, do not count on value
+ AMD2_BIT_6 = BIT_6; // Reserved, do not count on value
+ AMD2_BIT_7 = BIT_7; // Reserved, do not count on value
+ AMD2_BIT_8 = BIT_8; // Reserved, do not count on value
+ AMD2_BIT_9 = BIT_9; // Reserved, do not count on value
+ AMD2_BIT_10 = BIT_10; // Reserved, do not count on value
+ AMD2_BIT_11 = BIT_11; // Reserved, do not count on value
+ AMD2_BIT_12 = BIT_12; // Reserved, do not count on value
AMD2_CMPXCHG16B = BIT_13; // CMPXCHG16B available
- AMD2_BIT_14 = BIT_14; // Reserved, do not count on value
- AMD2_BIT_15 = BIT_15; // Reserved, do not count on value
- AMD2_BIT_16 = BIT_16; // Reserved, do not count on value
- AMD2_BIT_17 = BIT_17; // Reserved, do not count on value
- AMD2_BIT_18 = BIT_18; // Reserved, do not count on value
- AMD2_BIT_19 = BIT_19; // Reserved, do not count on value
- AMD2_BIT_20 = BIT_20; // Reserved, do not count on value
- AMD2_BIT_21 = BIT_21; // Reserved, do not count on value
- AMD2_BIT_22 = BIT_22; // Reserved, do not count on value
- AMD2_BIT_23 = BIT_23; // Reserved, do not count on value
- AMD2_BIT_24 = BIT_24; // Reserved, do not count on value
- AMD2_BIT_25 = BIT_25; // Reserved, do not count on value
- AMD2_BIT_26 = BIT_26; // Reserved, do not count on value
- AMD2_BIT_27 = BIT_27; // Reserved, do not count on value
- AMD2_BIT_28 = BIT_28; // Reserved, do not count on value
- AMD2_BIT_29 = BIT_29; // Reserved, do not count on value
- AMD2_BIT_30 = BIT_30; // Reserved, do not count on value
- AMD2_RAZ = BIT_31; // RAZ
+ AMD2_BIT_14 = BIT_14; // Reserved, do not count on value
+ AMD2_BIT_15 = BIT_15; // Reserved, do not count on value
+ AMD2_BIT_16 = BIT_16; // Reserved, do not count on value
+ AMD2_BIT_17 = BIT_17; // Reserved, do not count on value
+ AMD2_BIT_18 = BIT_18; // Reserved, do not count on value
+ AMD2_BIT_19 = BIT_19; // Reserved, do not count on value
+ AMD2_BIT_20 = BIT_20; // Reserved, do not count on value
+ AMD2_BIT_21 = BIT_21; // Reserved, do not count on value
+ AMD2_BIT_22 = BIT_22; // Reserved, do not count on value
+ AMD2_POPCNT = BIT_23; // POPCNT instruction. See "POPCNT" in APM3.
+ AMD2_BIT_24 = BIT_24; // Reserved, do not count on value
+ AMD2_BIT_25 = BIT_25; // Reserved, do not count on value
+ AMD2_BIT_26 = BIT_26; // Reserved, do not count on value
+ AMD2_BIT_27 = BIT_27; // Reserved, do not count on value
+ AMD2_BIT_28 = BIT_28; // Reserved, do not count on value
+ AMD2_BIT_29 = BIT_29; // Reserved, do not count on value
+ AMD2_BIT_30 = BIT_30; // Reserved, do not count on value
+ AMD2_RAZ = BIT_31; // RAZ
{ AMD Enhanced Feature Flags }
EAMD_FPU = BIT_0; // Floating-Point unit on chip
@@ -803,46 +807,46 @@
EAMD_MMX = BIT_23; // MMX technology
EAMD_FX = BIT_24; // FXSAVE and FXSTORE instructions
EAMD_FFX = BIT_25; // Fast FXSAVE and FXSTORE instructions
- EAMD_BIT_26 = BIT_26; // Reserved, do not count on value
- EAMD_BIT_27 = BIT_27; // Reserved, do not count on value
+ EAMD_1GBPAGE = BIT_26; // 1-GB large page support.
+ EAMD_RDTSCP = BIT_27; // RDTSCP instruction.
EAMD_BIT_28 = BIT_28; // Reserved, do not count on value
EAMD_LONG = BIT_29; // Long Mode (64-bit Core)
EAMD_EX3DNOW = BIT_30; // AMD Extensions to 3DNow! intructions
EAMD_3DNOW = BIT_31; // AMD 3DNOW! Technology
{ AMD Extended Feature Flags continued }
- EAMD2_LAHF = BIT_0; // LAHF/SAHF available in 64-bit mode
- EAMD2_CMPLEGACY = BIT_1; // core multi-processing legacy mode
- EAMD2_SVM = BIT_2; // Secure Virtual Machine
- EAMD2_BIT_3 = BIT_3; // Reserved, do not count on value
- EAMD2_ALTMOVCR8 = BIT_4; // LOCK MOV CR0 means MOV CR8
- EAMD2_BIT_5 = BIT_5; // Reserved, do not count on value
- EAMD2_BIT_6 = BIT_6; // Reserved, do not count on value
- EAMD2_BIT_7 = BIT_7; // Reserved, do not count on value
- EAMD2_BIT_8 = BIT_8; // Reserved, do not count on value
- EAMD2_BIT_9 = BIT_9; // Reserved, do not count on value
- EAMD2_BIT_10 = BIT_10; // Reserved, do not count on value
- EAMD2_BIT_11 = BIT_11; // Reserved, do not count on value
- EAMD2_BIT_12 = BIT_12; // Reserved, do not count on value
- EAMD2_BIT_13 = BIT_13; // Reserved, do not count on value
- EAMD2_BIT_14 = BIT_14; // Reserved, do not count on value
- EAMD2_BIT_15 = BIT_15; // Reserved, do not count on value
- EAMD2_BIT_16 = BIT_16; // Reserved, do not count on value
- EAMD2_BIT_17 = BIT_17; // Reserved, do not count on value
- EAMD2_BIT_18 = BIT_18; // Reserved, do not count on value
- EAMD2_BIT_19 = BIT_19; // Reserved, do not count on value
- EAMD2_BIT_20 = BIT_20; // Reserved, do not count on value
- EAMD2_BIT_21 = BIT_21; // Reserved, do not count on value
- EAMD2_BIT_22 = BIT_22; // Reserved, do not count on value
- EAMD2_BIT_23 = BIT_23; // Reserved, do not count on value
- EAMD2_BIT_24 = BIT_24; // Reserved, do not count on value
- EAMD2_BIT_25 = BIT_25; // Reserved, do not count on value
- EAMD2_BIT_26 = BIT_26; // Reserved, do not count on value
- EAMD2_BIT_27 = BIT_27; // Reserved, do not count on value
- EAMD2_BIT_28 = BIT_28; // Reserved, do not count on value
- EAMD2_BIT_29 = BIT_29; // Reserved, do not count on value
- EAMD2_BIT_30 = BIT_30; // Reserved, do not count on value
- EAMD2_BIT_31 = BIT_31; // Reserved, do not count on value
+ EAMD2_LAHF = BIT_0; // LAHF/SAHF available in 64-bit mode
+ EAMD2_CMPLEGACY = BIT_1; // core multi-processing legacy mode
+ EAMD2_SVM = BIT_2; // Secure Virtual Machine
+ EAMD2_EXTAPICSPACE = BIT_3; // This bit indicates the presence of extended APIC register space starting at offset 400h from the \x93APIC Base Address Register,\x94 as specified in the BKDG.
+ EAMD2_ALTMOVCR8 = BIT_4; // LOCK MOV CR0 means MOV CR8
+ EAMD2_ABM = BIT_5; // ABM: Advanced bit manipulation. LZCNT instruction support.
+ EAMD2_SSE4A = BIT_6; // EXTRQ, INSERTQ, MOVNTSS, and MOVNTSD instruction support.
+ EAMD2_MISALIGNSSE = BIT_7; // Misaligned SSE mode.
+ EAMD2_3DNOWPREFETCH = BIT_8; // PREFETCH and PREFETCHW instruction support.
+ EAMD2_OSVW = BIT_9; // OS visible workaround.
+ EAMD2_BIT_10 = BIT_10; // Reserved, do not count on value
+ EAMD2_SSE5 = BIT_11; // Streaming SIMD Extensions 5
+ EAMD2_SKINIT = BIT_12; // SKINIT, STGI, and DEV support.
+ EAMD2_WDT = BIT_13; // Watchdog timer support.
+ EAMD2_BIT_14 = BIT_14; // Reserved, do not count on value
+ EAMD2_BIT_15 = BIT_15; // Reserved, do not count on value
+ EAMD2_BIT_16 = BIT_16; // Reserved, do not count on value
+ EAMD2_BIT_17 = BIT_17; // Reserved, do not count on value
+ EAMD2_BIT_18 = BIT_18; // Reserved, do not count on value
+ EAMD2_BIT_19 = BIT_19; // Reserved, do not count on value
+ EAMD2_BIT_20 = BIT_20; // Reserved, do not count on value
+ EAMD2_BIT_21 = BIT_21; // Reserved, do not count on value
+ EAMD2_BIT_22 = BIT_22; // Reserved, do not count on value
+ EAMD2_BIT_23 = BIT_23; // Reserved, do not count on value
+ EAMD2_BIT_24 = BIT_24; // Reserved, do not count on value
+ EAMD2_BIT_25 = BIT_25; // Reserved, do not count on value
+ EAMD2_BIT_26 = BIT_26; // Reserved, do not count on value
+ EAMD2_BIT_27 = BIT_27; // Reserved, do not count on value
+ EAMD2_BIT_28 = BIT_28; // Reserved, do not count on value
+ EAMD2_BIT_29 = BIT_29; // Reserved, do not count on value
+ EAMD2_BIT_30 = BIT_30; // Reserved, do not count on value
+ EAMD2_BIT_31 = BIT_31; // Reserved, do not count on value
{ AMD Power Management Features Flags }
PAMD_TEMPSENSOR = BIT_0; // Temperature Sensor
@@ -851,8 +855,8 @@
PAMD_THERMALTRIP = BIT_3; // Thermal Trip
PAMD_THERMALMONITOR = BIT_4; // Thermal Monitoring
PAMD_SOFTTHERMCONTROL = BIT_5; // Software Thermal Control
- PAMD_BIT_6 = BIT_6; // Reserved, do not count on value
- PAMD_BIT_7 = BIT_7; // Reserved, do not count on value
+ PAMD_100MHZSTEP = BIT_6; // 100 Mhz multiplier control.
+ PAMD_HWPSTATE = BIT_7; // Hardware P-State control.
PAMD_TSC_INVARIANT = BIT_8; // TSC rate is invariant
PAMD_BIT_9 = BIT_9; // Reserved, do not count on value
PAMD_BIT_10 = BIT_10; // Reserved, do not count on value
@@ -1151,66 +1155,71 @@
MXCSR_FZ = BIT_15; // Flush to Zero
const
- IntelCacheDescription: array [0..58] of TCacheInfo = (
+ IntelCacheDescription: array [0..63] of TCacheInfo = (
(D: $00; Family: cfOther; I: RsIntelCacheDescr00),
- (D: $01; Family: cfInstructionTLB; Size: 4; WaysOfAssoc: 4; Entries: 32; I: RsIntelCacheDescr01),
- (D: $02; Family: cfInstructionTLB; Size: 4096; WaysOfAssoc: 4; Entries: 2; I: RsIntelCacheDescr02),
- (D: $03; Family: cfDataTLB; Size: 4; WaysOfAssoc: 4; Entries: 64; I: RsIntelCacheDescr03),
- (D: $04; Family: cfDataTLB; Size: 4096; WaysOfAssoc: 4; Entries: 8; I: RsIntelCacheDescr04),
- (D: $05; Family: cfDataTLB; Size: 4096; WaysOfAssoc: 4; Entries: 32; I: RsIntelCacheDescr05),
- (D: $06; Family: cfL1InstructionCache; Size: 8; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr06),
- (D: $08; Family: cfL1InstructionCache; Size: 16; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr08),
- (D: $0A; Family: cfL1DataCache; Size: 8; WaysOfAssoc: 2; LineSize: 32; I: RsIntelCacheDescr0A),
- (D: $0B; Family: cfInstructionTLB; Size: 4; WaysOfAssoc: 4; Entries: 4; I: RsIntelCacheDescr0B),
- (D: $0C; Family: cfL1DataCache; Size: 16; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr0C),
- (D: $22; Family: cfL3Cache; Size: 512; WaysOfAssoc: 4; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr22),
- (D: $23; Family: cfL3Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr23),
- (D: $25; Family: cfL3Cache; Size: 2048; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr25),
- (D: $29; Family: cfL3Cache; Size: 4096; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr29),
- (D: $2C; Family: cfL1DataCache; Size: 32; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr2C),
- (D: $30; Family: cfL1InstructionCache; Size: 32; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr30),
- (D: $40; Family: cfOther; I: RsIntelCacheDescr40),
- (D: $41; Family: cfL2Cache; Size: 128; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr41),
- (D: $42; Family: cfL2Cache; Size: 256; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr42),
- (D: $43; Family: cfL2Cache; Size: 512; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr43),
- (D: $44; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr44),
- (D: $45; Family: cfL2Cache; Size: 2048; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr45),
- (D: $46; Family: cfL3Cache; Size: 4096; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr46),
- (D: $47; Family: cfL3Cache; Size: 8192; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr47),
- (D: $49; Family: cfL2Cache; Size: 4096; WaysOfAssoc: 16; LineSize: 64; I: RsIntelCacheDescr49),
- (D: $50; Family: cfInstructionTLB; Size: 4; Entries: 64; I: RsIntelCacheDescr50),
- (D: $51; Family: cfInstructionTLB; Size: 4; Entries: 128; I: RsIntelCacheDescr51),
- (D: $52; Family: cfInstructionTLB; Size: 4; Entries: 256; I: RsIntelCacheDescr52),
- (D: $56; Family: cfDataTLB; Size: 4096; WaysOfAssoc: 4; Entries: 16; I: RsIntelCacheDescr56),
- (D: $57; Family: cfDataTLB; Size: 4; WaysOfAssoc: 4; Entries: 16; I: RsIntelCacheDescr57),
- (D: $5B; Family: cfDataTLB; Size: 4096; Entries: 64; I: RsIntelCacheDescr5B),
- (D: $5C; Family: cfDataTLB; Size: 4096; Entries: 128; I: RsIntelCacheDescr5C),
- (D: $5D; Family: cfDataTLB; Size: 4096; Entries: 256; I: RsIntelCacheDescr5D),
- (D: $60; Family: cfL1DataCache; Size: 16; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr60),
- (D: $66; Family: cfL1DataCache; Size: 8; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr66),
- (D: $67; Family: cfL1DataCache; Size: 16; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr67),
- (D: $68; Family: cfL1DataCache; Size: 32; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr68),
- (D: $70; Family: cfTrace; Size: 12; WaysOfAssoc: 8; I: RsIntelCacheDescr70),
- (D: $71; Family: cfTrace; Size: 16; WaysOfAssoc: 8; I: RsIntelCacheDescr71),
- (D: $72; Family: cfTrace; Size: 32; WaysOfAssoc: 8; I: RsIntelCacheDescr72),
- (D: $78; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr78),
- (D: $79; Family: cfL2Cache; Size: 128; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr79),
- (D: $7A; Family: cfL2Cache; Size: 256; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr7A),
- (D: $7B; Family: cfL2Cache; Size: 512; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr7B),
- (D: $7C; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr7C),
- (D: $7D; Family: cfL2Cache; Size: 2048; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr7D),
- (D: $7F; Family: cfL2Cache; Size: 512; WaysOfAssoc: 2; LineSize: 64; I: RsIntelCacheDescr7F),
- (D: $82; Family: cfL2Cache; Size: 256; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr82),
- (D: $83; Family: cfL2Cache; Size: 512; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr83),
- (D: $84; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr84),
- (D: $85; Family: cfL2Cache; Size: 2048; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr85),
- (D: $86; Family: cfL2Cache; Size: 512; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr86),
- (D: $87; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr87),
- (D: $B0; Family: cfInstructionTLB; Size: 4; WaysOfAssoc: 4; Entries: 128; I: RsIntelCacheDescrB0),
- (D: $B3; Family: cfDataTLB; Size: 4; WaysOfAssoc: 4; Entries: 128; I: RsIntelCacheDescrB3),
- (D: $B4; Family: cfDataTLB; Size: 4; WaysOfAssoc: 4; Entries: 256; I: RsIntelCacheDescrB4),
- (D: $F0; Family: cfOther; I: RsIntelCacheDescrF0),
- (D: $F1; Family: cfOther; I: RsIntelCacheDescrF1)
+ (D: $01; Family: cfInstructionTLB; Size: 4; WaysOfAssoc: 4; Entries: 32; I: RsIntelCacheDescr01),
+ (D: $02; Family: cfInstructionTLB; Size: 4096; WaysOfAssoc: 4; Entries: 2; I: RsIntelCacheDescr02),
+ (D: $03; Family: cfDataTLB; Size: 4; WaysOfAssoc: 4; Entries: 64; I: RsIntelCacheDescr03),
+ (D: $04; Family: cfDataTLB; Size: 4096; WaysOfAssoc: 4; Entries: 8; I: RsIntelCacheDescr04),
+ (D: $05; Family: cfDataTLB; Size: 4096; WaysOfAssoc: 4; Entries: 32; I: RsIntelCacheDescr05),
+ (D: $06; Family: cfL1InstructionCache; Size: 8; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr06),
+ (D: $08; Family: cfL1InstructionCache; Size: 16; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr08),
+ (D: $0A; Family: cfL1DataCache; Size: 8; WaysOfAssoc: 2; LineSize: 32; I: RsIntelCacheDescr0A),
+ (D: $0B; Family: cfInstructionTLB; Size: 4; WaysOfAssoc: 4; Entries: 4; I: RsIntelCacheDescr0B),
+ (D: $0C; Family: cfL1DataCache; Size: 16; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr0C),
+ (D: $22; Family: cfL3Cache; Size: 512; WaysOfAssoc: 4; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr22),
+ (D: $23; Family: cfL3Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr23),
+ (D: $25; Family: cfL3Cache; Size: 2048; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr25),
+ (D: $29; Family: cfL3Cache; Size: 4096; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr29),
+ (D: $2C; Family: cfL1DataCache; Size: 32; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr2C),
+ (D: $30; Family: cfL1InstructionCache; Size: 32; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr30),
+ (D: $40; Family: cfOther; I: RsIntelCacheDescr40),
+ (D: $41; Family: cfL2Cache; Size: 128; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr41),
+ (D: $42; Family: cfL2Cache; Size: 256; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr42),
+ (D: $43; Family: cfL2Cache; Size: 512; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr43),
+ (D: $44; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr44),
+ (D: $45; Family: cfL2Cache; Size: 2048; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr45),
+ (D: $46; Family: cfL3Cache; Size: 4096; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr46),
+ (D: $47; Family: cfL3Cache; Size: 8192; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr47),
+ (D: $48; Family: cfL2Cache; Size: 3072; WaysOfAssoc: 12; LineSize: 64; I: RsIntelCacheDescr48),
+ (D: $49; Family: cfL2Cache; Size: 4096; WaysOfAssoc: 16; LineSize: 64; I: RsIntelCacheDescr49),
+ (D: $4A; Family: cfL3Cache; Size: 6144; WaysOfAssoc: 12; LineSize: 64; I: RsIntelCacheDescr4A),
+ (D: $4B; Family: cfL3Cache; Size: 8192; WaysOfAssoc: 16; LineSize: 64; I: RsIntelCacheDescr4B),
+ (D: $4D; Family: cfL3Cache; Size: 16384; WaysOfAssoc: 16; LineSize: 64; I: RsIntelCacheDescr4D),
+ (D: $4E; Family: cfL3Cache; Size: 6144; WaysOfAssoc: 24; LineSize: 64; I: RsIntelCacheDescr4E),
+ (D: $50; Family: cfInstructionTLB; Size: 4; Entries: 64; I: RsIntelCacheDescr50),
+ (D: $51; Family: cfInstructionTLB; Size: 4; Entries: 128; I: RsIntelCacheDescr51),
+ (D: $52; Family: cfInstructionTLB; Size: 4; Entries: 256; I: RsIntelCacheDescr52),
+ (D: $56; Family: cfDataTLB; Size: 4096; WaysOfAssoc: 4; Entries: 16; I: RsIntelCacheDescr56),
+ (D: $57; Family: cfDataTLB; Size: 4; WaysOfAssoc: 4; Entries: 16; I: RsIntelCacheDescr57),
+ (D: $5B; Family: cfDataTLB; Size: 4096; Entries: 64; I: RsIntelCacheDescr5B),
+ (D: $5C; Family: cfDataTLB; Size: 4096; Entries: 128; I: RsIntelCacheDescr5C),
+ (D: $5D; Family: cfDataTLB; Size: 4096; Entries: 256; I: RsIntelCacheDescr5D),
+ (D: $60; Family: cfL1DataCache; Size: 16; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr60),
+ (D: $66; Family: cfL1DataCache; Size: 8; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr66),
+ (D: $67; Family: cfL1DataCache; Size: 16; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr67),
+ (D: $68; Family: cfL1DataCache; Size: 32; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr68),
+ (D: $70; Family: cfTrace; Size: 12; WaysOfAssoc: 8; I: RsIntelCacheDescr70),
+ (D: $71; Family: cfTrace; Size: 16; WaysOfAssoc: 8; I: RsIntelCacheDescr71),
+ (D: $72; Family: cfTrace; Size: 32; WaysOfAssoc: 8; I: RsIntelCacheDescr72),
+ (D: $78; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr78),
+ (D: $79; Family: cfL2Cache; Size: 128; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr79),
+ (D: $7A; Family: cfL2Cache; Size: 256; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr7A),
+ (D: $7B; Family: cfL2Cache; Size: 512; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr7B),
+ (D: $7C; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr7C),
+ (D: $7D; Family: cfL2Cache; Size: 2048; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr7D),
+ (D: $7F; Family: cfL2Cache; Size: 512; WaysOfAssoc: 2; LineSize: 64; I: RsIntelCacheDescr7F),
+ (D: $82; Family: cfL2Cache; Size: 256; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr82),
+ (D: $83; Family: cfL2Cache; Size: 512; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr83),
+ (D: $84; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr84),
+ (D: $85; Family: cfL2Cache; Size: 2048; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr85),
+ (D: $86; Family: cfL2Cache; Size: 512; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr86),
+ (D: $87; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr87),
+ (D: $B0; Family: cfInstructionTLB; Size: 4; WaysOfAssoc: 4; Entries: 128; I: RsIntelCacheDescrB0),
+ (D: $B3; Family: cfDataTLB; Size: 4; WaysOfAssoc: 4; Entries: 128; I: RsIntelCacheDescrB3),
+ (D: $B4; Family: cfDataTLB; Size: 4; WaysOfAssoc: 4; Entries: 256; I: RsIntelCacheDescrB4),
+ (D: $F0; Family: cfOther; I: RsIntelCacheDescrF0),
+ (D: $F1; Family: cfOther; I: RsIntelCacheDescrF1)
);
procedure GetCpuInfo(var CpuInfo: TCpuInfo);
@@ -4336,16 +4345,19 @@
end;
CPUInfo.MMX := (CPUInfo.Features and MMX_FLAG) <> 0;
+ CPUInfo.SSE := [];
if (CPUInfo.Features and SSE_FLAG) <> 0 then
- if (CPUInfo.Features and SSE2_FLAG) <> 0 then
- if (CPUInfo.IntelSpecific.ExFeatures and EINTEL_SSE3) <> 0 then
- CPUInfo.SSE := 3
- else
- CPUInfo.SSE := 2
- else
- CPUInfo.SSE := 1
- else
- CPUInfo.SSE := 0;
+ Include(CPUInfo.SSE, sse);
+ if (CPUInfo.Features and SSE2_FLAG) <> 0 then
+ Include(CPUInfo.SSE, sse2);
+ if (CPUInfo.IntelSpecific.ExFeatures and EINTEL_SSE3) <> 0 then
+ Include(CPUInfo.SSE, sse3);
+ if (CPUInfo.IntelSpecific.ExFeatures and EINTEL_SSSE3) <> 0 then
+ Include(CPUInfo.SSE, ssse3);
+ if (CPUInfo.IntelSpecific.ExFeatures and EINTEL_SSE4_1) <> 0 then
+ Include(CPUInfo.SSE, sse4A);
+ if (CPUInfo.IntelSpecific.ExFeatures and EINTEL_SSE4_2) <> 0 then
+ Include(CPUInfo.SSE, sse4B);
CPUInfo.Is64Bits := CPUInfo.HasExtendedInfo and ((CPUInfo.IntelSpecific.Ex64Features and EINTEL64_EM64T)<>0);
CPUInfo.DepCapable := CPUInfo.HasExtendedInfo and ((CPUInfo.IntelSpecific.Ex64Features and EINTEL64_EDB) <> 0);
end;
@@ -4404,7 +4416,7 @@
end;
if ExHiVal >= $80000006 then
CallCPUID($80000006, 0, CPUInfo.AMDSpecific.L2MByteInstructionTLB, CPUInfo.AMDSpecific.L2KByteInstructionTLB,
- CPUInfo.AMDSpecific.L2Cache, Unused);
+ CPUInfo.AMDSpecific.L2Cache, CPUInfo.AMDSpecific.L3Cache);
if CPUInfo.HasCacheInfo then
begin
CPUInfo.L1DataCacheSize := CPUInfo.AMDSpecific.L1DataCache[ciSize];
@@ -4416,6 +4428,9 @@
CPUInfo.L2CacheLineSize := CPUInfo.AMDSpecific.L2Cache and $FF;
CPUInfo.L2CacheAssociativity := (CPUInfo.AMDSpecific.L2Cache shr 12) and $F;
CPUInfo.L2CacheSize := CPUInfo.AMDSpecific.L2Cache shr 16;
+ CPUInfo.L3CacheLineSize := CPUInfo.AMDSpecific.L3Cache and $FF;
+ CPUInfo.L3CacheAssociativity := (CPUInfo.AMDSpecific.L3Cache shr 12) and $F;
+ CPUInfo.L3CacheSize := CPUInfo.AMDSpecific.L3Cache shr 19 {MB}; //(CPUInfo.AMDSpecific.L3Cache shr 18) * 512 {kB};
end;
if ExHiVal >= $80000007 then
CallCPUID($80000007, 0, Unused, Unused, Unused, CPUInfo.AMDSpecific.AdvancedPowerManagement);
@@ -4486,16 +4501,20 @@
CPUInfo.ExMMX := CPUInfo.HasExtendedInfo and ((CPUInfo.AMDSpecific.ExFeatures and EAMD_EXMMX) <> 0);
CPUInfo._3DNow := CPUInfo.HasExtendedInfo and ((CPUInfo.AMDSpecific.ExFeatures and EAMD_3DNOW) <> 0);
CPUInfo.Ex3DNow := CPUInfo.HasExtendedInfo and ((CPUInfo.AMDSpecific.ExFeatures and EAMD_EX3DNOW) <> 0);
+ CPUInfo.SSE := [];
if (CPUInfo.Features and AMD_SSE) <> 0 then
- if (CPUInfo.Features and AMD_SSE2) <> 0 then
- if CPUInfo.HasExtendedInfo and ((CPUInfo.AMDSpecific.Features2 and AMD2_SSE3) <> 0) then
- CPUInfo.SSE := 3
- else
- CPUInfo.SSE := 2
- else
- CPUInfo.SSE := 1
- else
- CPUInfo.SSE := 0;
+ Include(CPUInfo.SSE, sse);
+ if (CPUInfo.Features and AMD_SSE2) <> 0 then
+ Include(CPUInfo.SSE, sse2);
+ if (CPUInfo.AMDSpecific.Features2 and AMD2_SSE3) <> 0 then
+ Include(CPUInfo.SSE, sse3);
+ if CPUInfo.HasExtendedInfo then
+ begin
+ if (CPUInfo.AMDSpecific.ExFeatures2 and EAMD2_SSE4A) <> 0 then
+ Include(CPUInfo.SSE, sse4A);
+ if (CPUInfo.AMDSpecific.ExFeatures2 and EAMD2_SSE5) <> 0 then
+ Include(CPUInfo.SSE, sse5);
+ end;
CPUInfo.Is64Bits := CPUInfo.HasExtendedInfo and ((CPUInfo.AMDSpecific.ExFeatures and EAMD_LONG) <> 0);
CPUInfo.DEPCapable := CPUInfo.HasExtendedInfo and ((CPUInfo.AMDSpecific.ExFeatures and EAMD_NX) <> 0);
end;
@@ -4612,9 +4631,9 @@
if not CPUInfo.HasExtendedInfo then
CPUInfo.CpuName := 'C3';
CPUInfo.MMX := (CPUInfo.Features and VIA_MMX) <> 0;
- if (CPUInfo.Features and VIA_SSE) <> 0
- then CPUInfo.SSE := 1
- else CPUInfo.SSE := 0;
+ CPUInfo.SSE := [];
+ if (CPUInfo.Features and VIA_SSE) <> 0 then
+ Include(CPUInfo.SSE, sse);
CPUInfo._3DNow := (CPUInfo.Features and VIA_3DNOW) <> 0;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-11-02 16:18:09
|
Revision: 2206
http://jcl.svn.sourceforge.net/jcl/?rev=2206&view=rev
Author: outchy
Date: 2007-11-02 09:18:06 -0700 (Fri, 02 Nov 2007)
Log Message:
-----------
Reworking demo exclusion process: now based on dcu dependencies (spin.dcu, mshtml.dcu...).
Modified Paths:
--------------
trunk/jcl/examples/C10.exc
trunk/jcl/examples/C5.exc
trunk/jcl/examples/C6.exc
trunk/jcl/examples/D10.exc
trunk/jcl/examples/D11.exc
trunk/jcl/examples/D5.exc
trunk/jcl/examples/D6.exc
trunk/jcl/examples/D7.exc
trunk/jcl/examples/D9.exc
trunk/jcl/examples/k3.exc
trunk/jcl/install/JclInstall.pas
Added Paths:
-----------
trunk/jcl/examples/ExtraRequirements.exc
Modified: trunk/jcl/examples/C10.exc
===================================================================
--- trunk/jcl/examples/C10.exc 2007-11-02 14:30:48 UTC (rev 2205)
+++ trunk/jcl/examples/C10.exc 2007-11-02 16:18:06 UTC (rev 2206)
@@ -1 +1,2 @@
+ExtraRequirements.exc
visclx.exc
\ No newline at end of file
Modified: trunk/jcl/examples/C5.exc
===================================================================
--- trunk/jcl/examples/C5.exc 2007-11-02 14:30:48 UTC (rev 2205)
+++ trunk/jcl/examples/C5.exc 2007-11-02 16:18:06 UTC (rev 2206)
@@ -1,6 +1,2 @@
-common\multimedia\MidiOutExample.dpr
-windows\clr\ClrDemo.dpr
-windows\debug\sourceloc\SourceLocExample.dpr
-windows\delphitools\peviewer\PeViewer.dpr
-windows\tasks\TaskDemo.dpr
+ExtraRequirements.exc
visclx.exc
\ No newline at end of file
Modified: trunk/jcl/examples/C6.exc
===================================================================
--- trunk/jcl/examples/C6.exc 2007-11-02 14:30:48 UTC (rev 2205)
+++ trunk/jcl/examples/C6.exc 2007-11-02 16:18:06 UTC (rev 2206)
@@ -1,5 +1,2 @@
-common\multimedia\MidiOutExample.dpr
-windows\debug\sourceloc\SourceLocExample.dpr
-windows\delphitools\peviewer\PeViewer.dpr
-windows\tasks\TaskDemo.dpr
+ExtraRequirements.exc
visclx.exc
\ No newline at end of file
Modified: trunk/jcl/examples/D10.exc
===================================================================
--- trunk/jcl/examples/D10.exc 2007-11-02 14:30:48 UTC (rev 2205)
+++ trunk/jcl/examples/D10.exc 2007-11-02 16:18:06 UTC (rev 2206)
@@ -1 +1,2 @@
+ExtraRequirements.exc
visclx.exc
\ No newline at end of file
Modified: trunk/jcl/examples/D11.exc
===================================================================
--- trunk/jcl/examples/D11.exc 2007-11-02 14:30:48 UTC (rev 2205)
+++ trunk/jcl/examples/D11.exc 2007-11-02 16:18:06 UTC (rev 2206)
@@ -1 +1,2 @@
+ExtraRequirements.exc
visclx.exc
\ No newline at end of file
Modified: trunk/jcl/examples/D5.exc
===================================================================
--- trunk/jcl/examples/D5.exc 2007-11-02 14:30:48 UTC (rev 2205)
+++ trunk/jcl/examples/D5.exc 2007-11-02 16:18:06 UTC (rev 2206)
@@ -1,2 +1,2 @@
-windows\clr\ClrDemo.dpr
+ExtraRequirements.exc
visclx.exc
\ No newline at end of file
Modified: trunk/jcl/examples/D6.exc
===================================================================
--- trunk/jcl/examples/D6.exc 2007-11-02 14:30:48 UTC (rev 2205)
+++ trunk/jcl/examples/D6.exc 2007-11-02 16:18:06 UTC (rev 2206)
@@ -1 +1,2 @@
+ExtraRequirements.exc
visclx.exc
\ No newline at end of file
Modified: trunk/jcl/examples/D7.exc
===================================================================
--- trunk/jcl/examples/D7.exc 2007-11-02 14:30:48 UTC (rev 2205)
+++ trunk/jcl/examples/D7.exc 2007-11-02 16:18:06 UTC (rev 2206)
@@ -1 +1,2 @@
+ExtraRequirements.exc
visclx.exc
\ No newline at end of file
Modified: trunk/jcl/examples/D9.exc
===================================================================
--- trunk/jcl/examples/D9.exc 2007-11-02 14:30:48 UTC (rev 2205)
+++ trunk/jcl/examples/D9.exc 2007-11-02 16:18:06 UTC (rev 2206)
@@ -1 +1,2 @@
+ExtraRequirements.exc
visclx.exc
\ No newline at end of file
Added: trunk/jcl/examples/ExtraRequirements.exc
===================================================================
--- trunk/jcl/examples/ExtraRequirements.exc (rev 0)
+++ trunk/jcl/examples/ExtraRequirements.exc 2007-11-02 16:18:06 UTC (rev 2206)
@@ -0,0 +1,5 @@
+common\multimedia\MidiOutExample.dpr=spin.dcu
+common\numformat\QNumFormatExample.dpr=spin.dpu
+windows\debug\sourceloc\SourceLocExample.dpr=spin.dcu
+windows\delphitools\peviewer\PeViewer.dpr=spin.dcu
+windows\tasks\TaskDemo.dpr=MsHtml.dcu
\ No newline at end of file
Property changes on: trunk/jcl/examples/ExtraRequirements.exc
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: trunk/jcl/examples/k3.exc
===================================================================
--- trunk/jcl/examples/k3.exc 2007-11-02 14:30:48 UTC (rev 2205)
+++ trunk/jcl/examples/k3.exc 2007-11-02 16:18:06 UTC (rev 2206)
@@ -45,4 +45,5 @@
common/rtti/RTTIExample.dpr
common/textreader/TextReaderExample.dpr
common/unitversioning/UnitVersioningTest.dpr
-common/unitversioning/UnitVersioningTestDLL.dpr
\ No newline at end of file
+common/unitversioning/UnitVersioningTestDLL.dpr
+ExtraRequirements.exc
\ No newline at end of file
Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas 2007-11-02 14:30:48 UTC (rev 2205)
+++ trunk/jcl/install/JclInstall.pas 2007-11-02 16:18:06 UTC (rev 2206)
@@ -3108,8 +3108,9 @@
procedure ProcessExcludeFile(const ExcFileName: string);
var
DemoExclusionList: TStrings;
- ExclusionFileName, FileName, Edition: string;
- IndexExc, IndexDemo, EditionPos: Integer;
+ ExclusionFileName, FileName, RequiredList, RequiredItem: string;
+ IndexExc, IndexDemo, SepPos, IndexReq: Integer;
+ ExcludeDemo: Boolean;
begin
DemoExclusionList := TStringList.Create;
try
@@ -3120,17 +3121,29 @@
for IndexExc := 0 to DemoExclusionList.Count - 1 do
begin
FileName := DemoExclusionList.Strings[IndexExc];
- EditionPos := Pos('=', FileName);
- if EditionPos > 0 then
+ SepPos := Pos('=', FileName);
+ if SepPos > 0 then
begin
- Edition := Copy(FileName, EditionPos + 1, Length(FileName) - EditionPos);
- SetLength(FileName, EditionPos - 1);
+ ExcludeDemo := False;
+ RequiredList := Copy(FileName, SepPos + 1, Length(FileName) - SepPos);
+ SetLength(FileName, SepPos - 1);
+ for IndexReq := 0 to PathListItemCount(RequiredList) - 1 do
+ begin
+ RequiredItem := PathListGetItem(RequiredList, IndexReq);
+ if AnsiSameText(ExtractFileExt(RequiredItem), '.dcu') then
+ begin
+ ExcludeDemo := not FileExists(PathAddSeparator(Target.LibFolderName) + RequiredItem);
+ if ExcludeDemo then
+ Break;
+ end;
+ end;
end
else
- Edition := '';
- if (Edition = '') or (StrIPos(BorRADToolEditionIDs[Target.Edition], Edition) = 0) then
+ ExcludeDemo := True;
+
+ if ExcludeDemo then
begin
- if ExtractFileExt(FileName) = '.exc' then
+ if AnsiSameText(ExtractFileExt(FileName), '.exc') then
ProcessExcludeFile(FileName)
else
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-11-02 14:30:50
|
Revision: 2205
http://jcl.svn.sourceforge.net/jcl/?rev=2205&view=rev
Author: outchy
Date: 2007-11-02 07:30:48 -0700 (Fri, 02 Nov 2007)
Log Message:
-----------
Container improvements:
- fixed compilation problem with C++Builder: interface list in class declaration must respect inheritance order: ancestor interfaces first, child interfaces next.
- introduction of WideString containers (UCS-2 based)
- renamed TJclStr* containers to TJclAnsiStr* containers
- introduction of aliases for TJclStr* containers targetting AnsiStrings or WideStrings (depending of the CONTAINER_ANSISTR and CONTAINER_WIDESTR compiler defines).
- modification of the installer to set these defines
- modification of template of included files for these new defines
- modification of container examples to demonstrate AnsiString and WideString containers.
Modified Paths:
--------------
trunk/jcl/examples/common/containers/hashing/HashingExampleMain.dfm
trunk/jcl/examples/common/containers/hashing/HashingExampleMain.pas
trunk/jcl/examples/common/containers/lists/ListExampleMain.dfm
trunk/jcl/examples/common/containers/lists/ListExampleMain.pas
trunk/jcl/examples/common/containers/performance/ContainerPerformanceMain.dfm
trunk/jcl/examples/common/containers/performance/ContainerPerformanceMain.pas
trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas
trunk/jcl/examples/common/containers/trees/TreeExampleMain.dfm
trunk/jcl/examples/common/containers/trees/TreeExampleMain.pas
trunk/jcl/install/JclInstall.pas
trunk/jcl/source/common/JclAbstractContainers.pas
trunk/jcl/source/common/JclAlgorithms.pas
trunk/jcl/source/common/JclArrayLists.pas
trunk/jcl/source/common/JclArraySets.pas
trunk/jcl/source/common/JclBase.pas
trunk/jcl/source/common/JclBinaryTrees.pas
trunk/jcl/source/common/JclContainerIntf.pas
trunk/jcl/source/common/JclHashMaps.pas
trunk/jcl/source/common/JclHashSets.pas
trunk/jcl/source/common/JclLinkedLists.pas
trunk/jcl/source/common/JclQueues.pas
trunk/jcl/source/common/JclStacks.pas
trunk/jcl/source/common/JclVectors.pas
trunk/jcl/source/jcl.inc
trunk/jcl/source/jcl.template.inc
trunk/jcl/source/prototypes/JclArrayLists.pas
trunk/jcl/source/prototypes/JclArraySets.pas
trunk/jcl/source/prototypes/JclBinaryTrees.pas
trunk/jcl/source/prototypes/JclHashMaps.pas
trunk/jcl/source/prototypes/JclHashSets.pas
trunk/jcl/source/prototypes/JclLinkedLists.pas
trunk/jcl/source/prototypes/JclQueues.pas
trunk/jcl/source/prototypes/JclStacks.pas
trunk/jcl/source/prototypes/JclVectors.pas
trunk/jcl/source/prototypes/containers/JclArrayLists.imp
trunk/jcl/source/prototypes/containers/JclArraySets.imp
trunk/jcl/source/prototypes/containers/JclBinaryTrees.imp
trunk/jcl/source/prototypes/containers/JclHashMaps.imp
trunk/jcl/source/prototypes/containers/JclHashSets.imp
trunk/jcl/source/prototypes/containers/JclLinkedLists.imp
trunk/jcl/source/prototypes/containers/JclQueues.imp
trunk/jcl/source/prototypes/containers/JclStacks.imp
trunk/jcl/source/prototypes/containers/JclVectors.imp
Modified: trunk/jcl/examples/common/containers/hashing/HashingExampleMain.dfm
===================================================================
--- trunk/jcl/examples/common/containers/hashing/HashingExampleMain.dfm 2007-11-02 12:30:31 UTC (rev 2204)
+++ trunk/jcl/examples/common/containers/hashing/HashingExampleMain.dfm 2007-11-02 14:30:48 UTC (rev 2205)
@@ -1,12 +1,11 @@
object MainForm: TMainForm
Left = 281
Top = 201
- ClientWidth = 489
- ClientHeight = 253
+ Width = 513
+ Height = 280
HorzScrollBar.Range = 476
VertScrollBar.Range = 209
ActiveControl = btnIntfIntfHashMap
- AutoScroll = False
Caption = 'Hashing Example'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@@ -19,8 +18,8 @@
PixelsPerInch = 96
TextHeight = 13
object btnIntfIntfHashMap: TButton
- Left = 16
- Top = 24
+ Left = 8
+ Top = 8
Width = 89
Height = 25
Caption = 'IntfIntfHashMap'
@@ -28,17 +27,17 @@
OnClick = btnIntfIntfHashMapClick
end
object btnIntfHashSet: TButton
- Left = 120
- Top = 24
- Width = 75
+ Left = 103
+ Top = 8
+ Width = 89
Height = 25
Caption = 'IntfHashSet'
TabOrder = 5
OnClick = btnIntfHashSetClick
end
object btnHashMap: TButton
- Left = 16
- Top = 184
+ Left = 8
+ Top = 220
Width = 89
Height = 25
Caption = 'HashMap'
@@ -46,76 +45,76 @@
OnClick = btnHashMapClick
end
object btnHashSet: TButton
- Left = 120
- Top = 184
- Width = 75
+ Left = 103
+ Top = 220
+ Width = 89
Height = 25
Caption = 'HashSet'
TabOrder = 7
OnClick = btnHashSetClick
end
- object btnStrIntfHashMap: TButton
- Left = 16
- Top = 64
- Width = 89
+ object btnAnsiStrIntfHashMap: TButton
+ Left = 8
+ Top = 47
+ Width = 138
Height = 25
- Caption = 'StrIntfHashMap'
+ Caption = 'AnsiStrIntfHashMap'
TabOrder = 1
- OnClick = btnStrIntfHashMapClick
+ OnClick = btnAnsiStrIntfHashMapClick
end
object btnIntfArraySet: TButton
- Left = 216
- Top = 24
- Width = 75
+ Left = 198
+ Top = 8
+ Width = 89
Height = 25
Caption = 'IntfArraySet'
TabOrder = 8
OnClick = btnIntfArraySetClick
end
object btnArraySet: TButton
- Left = 216
- Top = 184
- Width = 75
+ Left = 198
+ Top = 220
+ Width = 89
Height = 25
Caption = 'ArraySet'
TabOrder = 10
OnClick = btnArraySetClick
end
- object btnStrStrHashMap: TButton
- Left = 16
- Top = 104
- Width = 89
+ object btnAnsiStrAnsiStrHashMap: TButton
+ Left = 8
+ Top = 78
+ Width = 138
Height = 25
- Caption = 'StrStrHashMap'
+ Caption = 'AnsiStrAnsiStrHashMap'
TabOrder = 2
- OnClick = btnStrStrHashMapClick
+ OnClick = btnAnsiStrAnsiStrHashMapClick
end
- object btnStrHashMap: TButton
- Left = 16
- Top = 144
- Width = 89
+ object btnAnsiStrHashMap: TButton
+ Left = 8
+ Top = 171
+ Width = 138
Height = 25
- Caption = 'StrHashMap'
+ Caption = 'AnsiStrHashMap'
TabOrder = 3
- OnClick = btnStrHashMapClick
+ OnClick = btnAnsiStrHashMapClick
end
- object btnStrHashSet: TButton
- Left = 120
- Top = 104
- Width = 73
+ object btnAnsiStrHashSet: TButton
+ Left = 8
+ Top = 109
+ Width = 138
Height = 25
- Caption = 'StrHashSet'
+ Caption = 'AnsiStrHashSet'
TabOrder = 6
- OnClick = btnStrHashSetClick
+ OnClick = btnAnsiStrHashSetClick
end
- object btnStrArraySet: TButton
- Left = 216
- Top = 104
- Width = 73
+ object btnAnsiStrArraySet: TButton
+ Left = 8
+ Top = 140
+ Width = 138
Height = 25
- Caption = 'StrArraySet'
+ Caption = 'AnsiStrArraySet'
TabOrder = 9
- OnClick = btnStrArraySetClick
+ OnClick = btnAnsiStrArraySetClick
end
object memResult: TListBox
Left = 304
@@ -126,4 +125,49 @@
ItemHeight = 13
TabOrder = 11
end
+ object btnWideStrIntfHashMap: TButton
+ Left = 152
+ Top = 47
+ Width = 135
+ Height = 25
+ Caption = 'WideStrIntfHashMap'
+ TabOrder = 12
+ OnClick = btnWideStrIntfHashMapClick
+ end
+ object btnWideStrWideStrHashMap: TButton
+ Left = 152
+ Top = 78
+ Width = 135
+ Height = 25
+ Caption = 'WideStrWideStrHashMap'
+ TabOrder = 13
+ OnClick = btnWideStrWideStrHashMapClick
+ end
+ object btnWideStrHashSet: TButton
+ Left = 152
+ Top = 109
+ Width = 135
+ Height = 25
+ Caption = 'WideStrHashSet'
+ TabOrder = 14
+ OnClick = btnWideStrHashSetClick
+ end
+ object btnWideStrArraySet: TButton
+ Left = 152
+ Top = 140
+ Width = 135
+ Height = 25
+ Caption = 'WideStrArraySet'
+ TabOrder = 15
+ OnClick = btnWideStrArraySetClick
+ end
+ object btnWideStrHashMap: TButton
+ Left = 152
+ Top = 171
+ Width = 135
+ Height = 25
+ Caption = 'AnsiStrHashMap'
+ TabOrder = 16
+ OnClick = btnWideStrHashMapClick
+ end
end
Modified: trunk/jcl/examples/common/containers/hashing/HashingExampleMain.pas
===================================================================
--- trunk/jcl/examples/common/containers/hashing/HashingExampleMain.pas 2007-11-02 12:30:31 UTC (rev 2204)
+++ trunk/jcl/examples/common/containers/hashing/HashingExampleMain.pas 2007-11-02 14:30:48 UTC (rev 2205)
@@ -17,25 +17,35 @@
btnIntfHashSet: TButton;
btnHashMap: TButton;
btnHashSet: TButton;
- btnStrIntfHashMap: TButton;
+ btnAnsiStrIntfHashMap: TButton;
btnIntfArraySet: TButton;
btnArraySet: TButton;
- btnStrStrHashMap: TButton;
- btnStrHashMap: TButton;
- btnStrHashSet: TButton;
- btnStrArraySet: TButton;
+ btnAnsiStrAnsiStrHashMap: TButton;
+ btnAnsiStrHashMap: TButton;
+ btnAnsiStrHashSet: TButton;
+ btnAnsiStrArraySet: TButton;
memResult: TListBox;
+ btnWideStrIntfHashMap: TButton;
+ btnWideStrWideStrHashMap: TButton;
+ btnWideStrHashSet: TButton;
+ btnWideStrArraySet: TButton;
+ btnWideStrHashMap: TButton;
procedure btnIntfIntfHashMapClick(Sender: TObject);
- procedure btnStrIntfHashMapClick(Sender: TObject);
+ procedure btnAnsiStrIntfHashMapClick(Sender: TObject);
+ procedure btnWideStrIntfHashMapClick(Sender: TObject);
procedure btnHashMapClick(Sender: TObject);
procedure btnIntfHashSetClick(Sender: TObject);
procedure btnHashSetClick(Sender: TObject);
procedure btnIntfArraySetClick(Sender: TObject);
procedure btnArraySetClick(Sender: TObject);
- procedure btnStrStrHashMapClick(Sender: TObject);
- procedure btnStrHashMapClick(Sender: TObject);
- procedure btnStrHashSetClick(Sender: TObject);
- procedure btnStrArraySetClick(Sender: TObject);
+ procedure btnAnsiStrAnsiStrHashMapClick(Sender: TObject);
+ procedure btnWideStrWideStrHashMapClick(Sender: TObject);
+ procedure btnAnsiStrHashMapClick(Sender: TObject);
+ procedure btnWideStrHashMapClick(Sender: TObject);
+ procedure btnAnsiStrHashSetClick(Sender: TObject);
+ procedure btnWideStrHashSetClick(Sender: TObject);
+ procedure btnAnsiStrArraySetClick(Sender: TObject);
+ procedure btnWideStrArraySetClick(Sender: TObject);
private
{ Private declarations }
public
@@ -126,12 +136,12 @@
memResult.Items.Add('--------------------------------------------------------');
end;
-procedure TMainForm.btnStrIntfHashMapClick(Sender: TObject);
+procedure TMainForm.btnAnsiStrIntfHashMapClick(Sender: TObject);
var
- Map: IJclStrIntfMap;
+ Map: IJclAnsiStrIntfMap;
MyObject: IIntfMyObject;
begin
- Map := TJclStrIntfHashMap.Create(DefaultContainerCapacity);
+ Map := TJclAnsiStrIntfHashMap.Create(DefaultContainerCapacity);
MyObject := TIntfMyObject.Create;
MyObject.Int := 42;
MyObject.Str := 'MyString';
@@ -145,6 +155,25 @@
memResult.Items.Add('--------------------------------------------------------');
end;
+procedure TMainForm.btnWideStrIntfHashMapClick(Sender: TObject);
+var
+ Map: IJclWideStrIntfMap;
+ MyObject: IIntfMyObject;
+begin
+ Map := TJclWideStrIntfHashMap.Create(DefaultContainerCapacity);
+ MyObject := TIntfMyObject.Create;
+ MyObject.Int := 42;
+ MyObject.Str := 'MyString';
+ Map.PutValue('MyKey', MyObject);
+ MyObject := TIntfMyObject.Create;
+ MyObject.Int := 43;
+ MyObject.Str := 'AnotherString';
+ Map.PutValue('MyKey2', MyObject);
+ MyObject := IIntfMyObject(Map.GetValue('MyKey2'));
+ memResult.Items.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str);
+ memResult.Items.Add('--------------------------------------------------------');
+end;
+
procedure TMainForm.btnHashMapClick(Sender: TObject);
var
Map: IJclMap;
@@ -251,12 +280,12 @@
end;
end;
-procedure TMainForm.btnStrStrHashMapClick(Sender: TObject);
+procedure TMainForm.btnAnsiStrAnsiStrHashMapClick(Sender: TObject);
var
- Map: IJclStrStrMap;
- It: IJclStrIterator;
+ Map: IJclAnsiStrAnsiStrMap;
+ It: IJclAnsiStrIterator;
begin
- Map := TJclStrStrHashMap.Create(DefaultContainerCapacity);
+ Map := TJclAnsiStrAnsiStrHashMap.Create(DefaultContainerCapacity);
Map.PutValue('MyKey1', 'MyString1');
Map.PutValue('MyKey2', 'MyString2');
Map.PutValue('MyKey3', 'MyString3');
@@ -271,17 +300,33 @@
memResult.Items.Add('--------------------------------------------------------');
end;
-type
- TLinks = class(TJclStrHashMap);
+procedure TMainForm.btnWideStrWideStrHashMapClick(Sender: TObject);
+var
+ Map: IJclWideStrWideStrMap;
+ It: IJclWideStrIterator;
+begin
+ Map := TJclWideStrWideStrHashMap.Create(DefaultContainerCapacity);
+ Map.PutValue('MyKey1', 'MyString1');
+ Map.PutValue('MyKey2', 'MyString2');
+ Map.PutValue('MyKey3', 'MyString3');
+ It := Map.KeySet.First;
+ while It.HasNext do
+ memResult.Items.Add(It.Next);
+ It := Map.Values.First;
+ while It.HasNext do
+ memResult.Items.Add(It.Next);
+ Map.PutValue('MyKey2', 'AnotherString2');
+ memResult.Items.Add(Map.GetValue('MyKey2'));
+ memResult.Items.Add('--------------------------------------------------------');
+end;
-procedure TMainForm.btnStrHashMapClick(Sender: TObject);
+procedure TMainForm.btnAnsiStrHashMapClick(Sender: TObject);
var
- Map: IJclStrMap;
+ Map: IJclAnsiStrMap;
MyObject: TMyObject;
- It: IJclStrIterator;
- Links: TLinks;
+ It: IJclAnsiStrIterator;
begin
- Map := TJclStrHashMap.Create(DefaultContainerCapacity, False);
+ Map := TJclAnsiStrHashMap.Create(DefaultContainerCapacity, False);
MyObject := TMyObject.Create;
try
MyObject.Int := 42;
@@ -294,22 +339,41 @@
while It.HasNext do
memResult.Items.Add(It.Next);
memResult.Items.Add('--------------------------------------------------------');
+ finally
+ MyObject.Free;
+ end;
+end;
- Links := TLinks.Create(DefaultContainerCapacity, False);
- Links.PutValue('MyKey1', MyObject);
- Links.Remove('MyKey1');
- Links.PutValue('MyKey1', MyObject);
+procedure TMainForm.btnWideStrHashMapClick(Sender: TObject);
+var
+ Map: IJclWideStrMap;
+ MyObject: TMyObject;
+ It: IJclWideStrIterator;
+begin
+ Map := TJclWideStrHashMap.Create(DefaultContainerCapacity, False);
+ MyObject := TMyObject.Create;
+ try
+ MyObject.Int := 42;
+ MyObject.Str := 'MyString';
+
+ Map.PutValue('MyKey1', MyObject);
+ MyObject := TMyObject(Map.GetValue('MyKey1'));
+ memResult.Items.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str);
+ It := Map.KeySet.First;
+ while It.HasNext do
+ memResult.Items.Add(It.Next);
+ memResult.Items.Add('--------------------------------------------------------');
finally
MyObject.Free;
end;
end;
-procedure TMainForm.btnStrHashSetClick(Sender: TObject);
+procedure TMainForm.btnAnsiStrHashSetClick(Sender: TObject);
var
- MySet: IJclStrSet;
- It: IJclStrIterator;
+ MySet: IJclAnsiStrSet;
+ It: IJclAnsiStrIterator;
begin
- MySet := TJclStrHashSet.Create(DefaultContainerCapacity);
+ MySet := TJclAnsiStrHashSet.Create(DefaultContainerCapacity);
MySet.Add('MyString');
MySet.Add('MyString');
It := MySet.First;
@@ -319,13 +383,28 @@
memResult.Items.Add('--------------------------------------------------------');
end;
-procedure TMainForm.btnStrArraySetClick(Sender: TObject);
+procedure TMainForm.btnWideStrHashSetClick(Sender: TObject);
var
- MySet: IJclStrSet;
- It: IJclStrIterator;
+ MySet: IJclWideStrSet;
+ It: IJclWideStrIterator;
+begin
+ MySet := TJclWideStrHashSet.Create(DefaultContainerCapacity);
+ MySet.Add('MyString');
+ MySet.Add('MyString');
+ It := MySet.First;
+ while It.HasNext do
+ memResult.Items.Add(It.Next);
+ memResult.Items.Add(IntToStr(MySet.Size));
+ memResult.Items.Add('--------------------------------------------------------');
+end;
+
+procedure TMainForm.btnAnsiStrArraySetClick(Sender: TObject);
+var
+ MySet: IJclAnsiStrSet;
+ It: IJclAnsiStrIterator;
I: Integer;
begin
- MySet := TJclStrArraySet.Create(DefaultContainerCapacity);
+ MySet := TJclAnsiStrArraySet.Create(DefaultContainerCapacity);
for I := 1 to 8 do
MySet.Add(IntToStr(I));
for I := 8 downto 1 do
@@ -339,5 +418,25 @@
memResult.Items.Add('--------------------------------------------------------');
end;
+procedure TMainForm.btnWideStrArraySetClick(Sender: TObject);
+var
+ MySet: IJclWideStrSet;
+ It: IJclWideStrIterator;
+ I: Integer;
+begin
+ MySet := TJclWideStrArraySet.Create(DefaultContainerCapacity);
+ for I := 1 to 8 do
+ MySet.Add(IntToStr(I));
+ for I := 8 downto 1 do
+ MySet.Add(IntToStr(I));
+ MySet.Add('MyString');
+ MySet.Add('MyString');
+ It := MySet.First;
+ while It.HasNext do
+ memResult.Items.Add(It.Next);
+ memResult.Items.Add(IntToStr(MySet.Size));
+ memResult.Items.Add('--------------------------------------------------------');
+end;
+
end.
Modified: trunk/jcl/examples/common/containers/lists/ListExampleMain.dfm
===================================================================
--- trunk/jcl/examples/common/containers/lists/ListExampleMain.dfm 2007-11-02 12:30:31 UTC (rev 2204)
+++ trunk/jcl/examples/common/containers/lists/ListExampleMain.dfm 2007-11-02 14:30:48 UTC (rev 2205)
@@ -1,12 +1,11 @@
object MainForm: TMainForm
Left = 276
Top = 195
- ClientWidth = 540
- ClientHeight = 250
+ Width = 564
+ Height = 277
HorzScrollBar.Range = 508
VertScrollBar.Range = 217
ActiveControl = btnIntfArrayList
- AutoScroll = False
Caption = 'List Example'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@@ -21,7 +20,7 @@
object btnIntfArrayList: TButton
Left = 24
Top = 24
- Width = 75
+ Width = 89
Height = 25
Caption = 'IntfArrayList'
TabOrder = 0
@@ -30,7 +29,7 @@
object btnIntfLinkedList: TButton
Left = 152
Top = 24
- Width = 75
+ Width = 89
Height = 25
Caption = 'IntfLinkedList'
TabOrder = 3
@@ -39,7 +38,7 @@
object btnIntfVector: TButton
Left = 272
Top = 24
- Width = 75
+ Width = 89
Height = 25
Caption = 'IntfVector'
TabOrder = 6
@@ -47,8 +46,8 @@
end
object btnArrayList: TButton
Left = 24
- Top = 120
- Width = 75
+ Top = 168
+ Width = 89
Height = 25
Caption = 'ArrayList'
TabOrder = 2
@@ -56,8 +55,8 @@
end
object btnLinkedList: TButton
Left = 152
- Top = 120
- Width = 75
+ Top = 168
+ Width = 89
Height = 25
Caption = 'LinkedList'
TabOrder = 5
@@ -65,55 +64,82 @@
end
object btnVector: TButton
Left = 272
- Top = 120
- Width = 75
+ Top = 168
+ Width = 89
Height = 25
Caption = 'Vector'
TabOrder = 8
OnClick = btnVectorClick
end
object memResult: TMemo
- Left = 379
+ Left = 395
Top = 0
Width = 161
- Height = 249
+ Height = 250
Align = alRight
TabOrder = 10
end
object btnMyObjectList: TButton
Left = 152
- Top = 192
- Width = 75
+ Top = 216
+ Width = 89
Height = 25
Caption = 'MyObjectList'
TabOrder = 9
OnClick = btnMyObjectListClick
end
- object btnStrArrayList: TButton
+ object btnAnsiStrArrayList: TButton
Left = 24
Top = 72
- Width = 75
+ Width = 89
Height = 25
- Caption = 'StrArrayList'
+ Caption = 'AnsiStrArrayList'
TabOrder = 1
- OnClick = btnStrArrayListClick
+ OnClick = btnAnsiStrArrayListClick
end
- object btnStrLinkedList: TButton
+ object btnAnsiStrLinkedList: TButton
Left = 152
Top = 72
- Width = 75
+ Width = 89
Height = 25
- Caption = 'StrLinkedList'
+ Caption = 'AnsiStrLinkedList'
TabOrder = 4
- OnClick = btnStrLinkedListClick
+ OnClick = btnAnsiStrLinkedListClick
end
- object btnStrVector: TButton
+ object btnAnsiStrVector: TButton
Left = 272
Top = 72
- Width = 75
+ Width = 89
Height = 25
- Caption = 'StrVector'
+ Caption = 'AnsiStrVector'
TabOrder = 7
- OnClick = btnStrVectorClick
+ OnClick = btnAnsiStrVectorClick
end
+ object btnWideStrArrayList: TButton
+ Left = 24
+ Top = 120
+ Width = 89
+ Height = 25
+ Caption = 'WideStrArrayList'
+ TabOrder = 11
+ OnClick = btnWideStrArrayListClick
+ end
+ object btnWideStrLinkedList: TButton
+ Left = 152
+ Top = 120
+ Width = 89
+ Height = 25
+ Caption = 'WideStrLinkedList'
+ TabOrder = 12
+ OnClick = btnWideStrLinkedListClick
+ end
+ object btnWideStrVector: TButton
+ Left = 272
+ Top = 120
+ Width = 89
+ Height = 25
+ Caption = 'WideStrVector'
+ TabOrder = 13
+ OnClick = btnWideStrVectorClick
+ end
end
Modified: trunk/jcl/examples/common/containers/lists/ListExampleMain.pas
===================================================================
--- trunk/jcl/examples/common/containers/lists/ListExampleMain.pas 2007-11-02 12:30:31 UTC (rev 2204)
+++ trunk/jcl/examples/common/containers/lists/ListExampleMain.pas 2007-11-02 14:30:48 UTC (rev 2205)
@@ -21,9 +21,12 @@
btnVector: TButton;
memResult: TMemo;
btnMyObjectList: TButton;
- btnStrArrayList: TButton;
- btnStrLinkedList: TButton;
- btnStrVector: TButton;
+ btnAnsiStrArrayList: TButton;
+ btnAnsiStrLinkedList: TButton;
+ btnAnsiStrVector: TButton;
+ btnWideStrArrayList: TButton;
+ btnWideStrLinkedList: TButton;
+ btnWideStrVector: TButton;
procedure btnIntfArrayListClick(Sender: TObject);
procedure btnIntfLinkedListClick(Sender: TObject);
procedure btnIntfVectorClick(Sender: TObject);
@@ -31,9 +34,12 @@
procedure btnLinkedListClick(Sender: TObject);
procedure btnVectorClick(Sender: TObject);
procedure btnMyObjectListClick(Sender: TObject);
- procedure btnStrArrayListClick(Sender: TObject);
- procedure btnStrLinkedListClick(Sender: TObject);
- procedure btnStrVectorClick(Sender: TObject);
+ procedure btnAnsiStrArrayListClick(Sender: TObject);
+ procedure btnWideStrArrayListClick(Sender: TObject);
+ procedure btnAnsiStrLinkedListClick(Sender: TObject);
+ procedure btnWideStrLinkedListClick(Sender: TObject);
+ procedure btnAnsiStrVectorClick(Sender: TObject);
+ procedure btnWideStrVectorClick(Sender: TObject);
private
{ Private declarations }
public
@@ -349,16 +355,16 @@
memResult.Lines.Add(List.GetObject(0).Str);
end;
-procedure TMainForm.btnStrArrayListClick(Sender: TObject);
+procedure TMainForm.btnAnsiStrArrayListClick(Sender: TObject);
var
- List, Sub: IJclStrList;
- MyArray: IJclStrArray;
- It: IJclStrIterator;
+ List, Sub: IJclAnsiStrList;
+ MyArray: IJclAnsiStrArray;
+ It: IJclAnsiStrIterator;
I: Integer;
S: string;
begin
memResult.Lines.Clear;
- List := TJclStrArrayList.Create(DefaultContainerCapacity);
+ List := TJclAnsiStrArrayList.Create(DefaultContainerCapacity);
List.Add('MyString');
S := List.GetString(0);
@@ -375,7 +381,7 @@
memResult.Lines.Add(S);
end;
// use [] default of Items[]
- MyArray := List as IJclStrArray;
+ MyArray := List as IJclAnsiStrArray;
for I := 0 to MyArray.Size - 1 do
begin
S := MyArray[I];
@@ -383,6 +389,40 @@
end;
end;
+procedure TMainForm.btnWideStrArrayListClick(Sender: TObject);
+var
+ List, Sub: IJclWideStrList;
+ MyArray: IJclWideStrArray;
+ It: IJclWideStrIterator;
+ I: Integer;
+ S: string;
+begin
+ memResult.Lines.Clear;
+ List := TJclWideStrArrayList.Create(DefaultContainerCapacity);
+ List.Add('MyString');
+
+ S := List.GetString(0);
+ //memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str);
+
+ List.Add('AnotherString');
+
+ Sub := List.SubList(0, 10);
+ // Iteration
+ It := Sub.First;
+ while It.HasNext do
+ begin
+ S := It.Next;
+ memResult.Lines.Add(S);
+ end;
+ // use [] default of Items[]
+ MyArray := List as IJclWideStrArray;
+ for I := 0 to MyArray.Size - 1 do
+ begin
+ S := MyArray[I];
+ memResult.Lines.Add(S);
+ end;
+end;
+
{ TPerson }
function TPerson.GetAge: Integer;
@@ -415,14 +455,14 @@
FName := Value;
end;
-procedure TMainForm.btnStrLinkedListClick(Sender: TObject);
+procedure TMainForm.btnAnsiStrLinkedListClick(Sender: TObject);
var
- List, Sub: IJclStrList;
+ List, Sub: IJclAnsiStrList;
S: string;
- It: IJclStrIterator;
+ It: IJclAnsiStrIterator;
begin
memResult.Lines.Clear;
- List := TJclStrLinkedList.Create(nil);
+ List := TJclAnsiStrLinkedList.Create(nil);
List.Add('MyString');
memResult.Lines.Add(List.GetString(0));
@@ -438,15 +478,38 @@
end;
end;
-procedure TMainForm.btnStrVectorClick(Sender: TObject);
+procedure TMainForm.btnWideStrLinkedListClick(Sender: TObject);
var
- List: IJclStrList;
+ List, Sub: IJclWideStrList;
S: string;
- It: IJclStrIterator;
+ It: IJclWideStrIterator;
+begin
+ memResult.Lines.Clear;
+ List := TJclWideStrLinkedList.Create(nil);
+ List.Add('MyString');
+ memResult.Lines.Add(List.GetString(0));
+
+ List.Add('AnotherString');
+
+ Sub := List.SubList(1, 10);
+
+ It := Sub.First;
+ while It.HasNext do
+ begin
+ S := It.Next;
+ memResult.Lines.Add(S);
+ end;
+end;
+
+procedure TMainForm.btnAnsiStrVectorClick(Sender: TObject);
+var
+ List: IJclAnsiStrList;
+ S: string;
+ It: IJclAnsiStrIterator;
I: Integer;
begin
memResult.Lines.Clear;
- List := TJclStrVector.Create(DefaultContainerCapacity);
+ List := TJclAnsiStrVector.Create(DefaultContainerCapacity);
try
List.Add('MyString');
S := List.GetString(0);
@@ -473,5 +536,40 @@
end;
end;
+procedure TMainForm.btnWideStrVectorClick(Sender: TObject);
+var
+ List: IJclWideStrList;
+ S: string;
+ It: IJclWideStrIterator;
+ I: Integer;
+begin
+ memResult.Lines.Clear;
+ List := TJclWideStrVector.Create(DefaultContainerCapacity);
+ try
+ List.Add('MyString');
+ S := List.GetString(0);
+ memResult.Lines.Add(S);
+
+ List.Add('AnotherString');
+
+ It := List.First;
+ while It.HasNext do
+ begin
+ S := It.Next;
+ memResult.Lines.Add(S);
+ end;
+ // Fastest way
+ for I := 0 to List.Size - 1 do
+ begin
+ S := List.Items[I];
+ memResult.Lines.Add(S);
+ end;
+ List.Clear;
+ finally
+ It := nil; // Force release Iterator before free list !
+ List := nil;
+ end;
+end;
+
end.
Modified: trunk/jcl/examples/common/containers/performance/ContainerPerformanceMain.dfm
===================================================================
--- trunk/jcl/examples/common/containers/performance/ContainerPerformanceMain.dfm 2007-11-02 12:30:31 UTC (rev 2204)
+++ trunk/jcl/examples/common/containers/performance/ContainerPerformanceMain.dfm 2007-11-02 14:30:48 UTC (rev 2205)
@@ -1,7 +1,6 @@
object MainForm: TMainForm
Left = 402
Top = 120
- AutoScroll = False
Caption = 'Container Performance'
ClientHeight = 294
ClientWidth = 569
@@ -34,7 +33,8 @@
Width = 569
Height = 121
Align = alBottom
- DefaultColWidth = 100
+ ColCount = 6
+ DefaultColWidth = 90
RowCount = 4
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine]
TabOrder = 1
@@ -81,10 +81,14 @@
Caption = 'THashedStringList'
OnClick = mnHashedStringListClick
end
- object mnJclStrStrHashMap: TMenuItem
- Caption = 'TJclStrStrHashMap'
- OnClick = mnJclStrStrHashMapClick
+ object mnJclAnsiStrAnsiStrHashMap: TMenuItem
+ Caption = 'TJclAnsiStrAnsiStrHashMap'
+ OnClick = mnJclAnsiStrAnsiStrHashMapClick
end
+ object mnJclWideStrWideStrHashMap: TMenuItem
+ Caption = 'TJclWideStrWideStrHashMap'
+ OnClick = mnJclWideStrWideStrHashMapClick
+ end
object N2: TMenuItem
Caption = '-'
end
Modified: trunk/jcl/examples/common/containers/performance/ContainerPerformanceMain.pas
===================================================================
--- trunk/jcl/examples/common/containers/performance/ContainerPerformanceMain.pas 2007-11-02 12:30:31 UTC (rev 2204)
+++ trunk/jcl/examples/common/containers/performance/ContainerPerformanceMain.pas 2007-11-02 14:30:48 UTC (rev 2205)
@@ -28,10 +28,11 @@
mnBucketList: TMenuItem;
mnJclHashMap: TMenuItem;
mnHashedStringList: TMenuItem;
- mnJclStrStrHashMap: TMenuItem;
+ mnJclAnsiStrAnsiStrHashMap: TMenuItem;
N2: TMenuItem;
mnAllTest: TMenuItem;
HashPerformanceGrid: TStringGrid;
+ mnJclWideStrWideStrHashMap: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure mnAllTestClick(Sender: TObject);
procedure mnListClick(Sender: TObject);
@@ -41,7 +42,8 @@
procedure mnBucketListClick(Sender: TObject);
procedure mnJclHashMapClick(Sender: TObject);
procedure mnHashedStringListClick(Sender: TObject);
- procedure mnJclStrStrHashMapClick(Sender: TObject);
+ procedure mnJclAnsiStrAnsiStrHashMapClick(Sender: TObject);
+ procedure mnJclWideStrWideStrHashMapClick(Sender: TObject);
procedure Exit1Click(Sender: TObject);
public
end;
@@ -73,7 +75,8 @@
HashPerformanceGrid.Cells[1, 0] := 'TBucketList';
HashPerformanceGrid.Cells[2, 0] := 'TJclHashMap';
HashPerformanceGrid.Cells[3, 0] := 'THashedStringList';
- HashPerformanceGrid.Cells[4, 0] := 'TJclStrStrHashMap';
+ HashPerformanceGrid.Cells[4, 0] := 'TJclAnsiStrAnsiStrHashMap';
+ HashPerformanceGrid.Cells[5, 0] := 'TJclWideStrWideStrHashMap';
HashPerformanceGrid.Cells[0, 1] := 'Add';
HashPerformanceGrid.Cells[0, 2] := 'Random';
HashPerformanceGrid.Cells[0, 3] := 'Clear';
@@ -96,7 +99,9 @@
Application.ProcessMessages;
TestHashedStringList(HashPerformanceGrid.Cols[3]);
Application.ProcessMessages;
- TestJclStrStrHashMap(HashPerformanceGrid.Cols[4]);
+ TestJclAnsiStrAnsiStrHashMap(HashPerformanceGrid.Cols[4]);
+ Application.ProcessMessages;
+ TestJclWideStrWideStrHashMap(HashPerformanceGrid.Cols[5]);
end;
procedure TMainForm.mnListClick(Sender: TObject);
@@ -134,11 +139,16 @@
TestHashedStringList(HashPerformanceGrid.Cols[3]);
end;
-procedure TMainForm.mnJclStrStrHashMapClick(Sender: TObject);
+procedure TMainForm.mnJclAnsiStrAnsiStrHashMapClick(Sender: TObject);
begin
- TestJclStrStrHashMap(HashPerformanceGrid.Cols[4]);
+ TestJclAnsiStrAnsiStrHashMap(HashPerformanceGrid.Cols[4]);
end;
+procedure TMainForm.mnJclWideStrWideStrHashMapClick(Sender: TObject);
+begin
+ TestJclWideStrWideStrHashMap(HashPerformanceGrid.Cols[5]);
+end;
+
procedure TMainForm.Exit1Click(Sender: TObject);
begin
Close;
Modified: trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas
===================================================================
--- trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas 2007-11-02 12:30:31 UTC (rev 2204)
+++ trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas 2007-11-02 14:30:48 UTC (rev 2205)
@@ -13,7 +13,8 @@
procedure TestBucketList(Results: TStrings);
procedure TestJclHashMap(Results: TStrings);
procedure TestHashedStringList(Results: TStrings);
-procedure TestJclStrStrHashMap(Results: TStrings);
+procedure TestJclAnsiStrAnsiStrHashMap(Results: TStrings);
+procedure TestJclWideStrWideStrHashMap(Results: TStrings);
implementation
@@ -295,9 +296,9 @@
end;
{$ENDIF ~RTL140_UP}
-procedure TestJclStrStrHashMap(Results: TStrings);
+procedure TestJclAnsiStrAnsiStrHashMap(Results: TStrings);
var
- Map: IJclStrStrMap;
+ Map: IJclAnsiStrAnsiStrMap;
I: Integer;
Res: string;
Start: TDateTime;
@@ -306,7 +307,7 @@
Screen.Cursor := crHourGlass;
try
Start := Now;
- Map := TJclStrStrHashMap.Create(256);
+ Map := TJclAnsiStrAnsiStrHashMap.Create(256);
for I := 0 to 100000 do
Map.PutValue(GenId(123), '');
Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]);
@@ -322,4 +323,31 @@
end;
end;
+procedure TestJclWideStrWideStrHashMap(Results: TStrings);
+var
+ Map: IJclWideStrWideStrMap;
+ I: Integer;
+ Res: string;
+ Start: TDateTime;
+begin
+ Randomize;
+ Screen.Cursor := crHourGlass;
+ try
+ Start := Now;
+ Map := TJclWideStrWideStrHashMap.Create(256);
+ for I := 0 to 100000 do
+ Map.PutValue(GenId(123), '');
+ Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]);
+ Start := Now;
+ for I := 0 to 100000 do
+ Res := Map.GetValue(GenId(123));
+ Results[2] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]);
+ Start := Now;
+ Map.Clear;
+ Results[3] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]);
+ finally
+ Screen.Cursor := crDefault;
+ end;
+end;
+
end.
Modified: trunk/jcl/examples/common/containers/trees/TreeExampleMain.dfm
===================================================================
--- trunk/jcl/examples/common/containers/trees/TreeExampleMain.dfm 2007-11-02 12:30:31 UTC (rev 2204)
+++ trunk/jcl/examples/common/containers/trees/TreeExampleMain.dfm 2007-11-02 14:30:48 UTC (rev 2205)
@@ -1,9 +1,9 @@
object MainForm: TMainForm
Left = 328
Top = 237
+ Caption = 'Binary Tree'
+ ClientHeight = 259
ClientWidth = 462
- ClientHeight = 259
- Caption = 'Binary Tree'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@@ -15,9 +15,9 @@
PixelsPerInch = 96
TextHeight = 13
object btnIntfArrayTree: TButton
- Left = 72
+ Left = 64
Top = 24
- Width = 81
+ Width = 97
Height = 25
Caption = 'IntfBinaryTree'
TabOrder = 1
@@ -27,27 +27,36 @@
Left = 230
Top = 0
Width = 232
- Height = 268
+ Height = 259
Align = alRight
ScrollBars = ssVertical
TabOrder = 2
end
object btnArrayTree: TButton
- Left = 72
- Top = 152
- Width = 81
+ Left = 64
+ Top = 192
+ Width = 97
Height = 25
Caption = 'BinaryTree'
TabOrder = 0
OnClick = btnArrayTreeClick
end
- object btnStrBinaryTree: TButton
- Left = 72
- Top = 88
- Width = 81
+ object btnAnsiStrBinaryTree: TButton
+ Left = 64
+ Top = 80
+ Width = 97
Height = 25
- Caption = 'StrBinaryTree'
+ Caption = 'AnsiStrBinaryTree'
TabOrder = 3
- OnClick = btnStrBinaryTreeClick
+ OnClick = btnAnsiStrBinaryTreeClick
end
+ object btnWideStrBinaryTree: TButton
+ Left = 64
+ Top = 136
+ Width = 97
+ Height = 25
+ Caption = 'WideStrBinaryTree'
+ TabOrder = 4
+ OnClick = btnWideStrBinaryTreeClick
+ end
end
Modified: trunk/jcl/examples/common/containers/trees/TreeExampleMain.pas
===================================================================
--- trunk/jcl/examples/common/containers/trees/TreeExampleMain.pas 2007-11-02 12:30:31 UTC (rev 2204)
+++ trunk/jcl/examples/common/containers/trees/TreeExampleMain.pas 2007-11-02 14:30:48 UTC (rev 2205)
@@ -11,10 +11,12 @@
btnIntfArrayTree: TButton;
memoResult: TMemo;
btnArrayTree: TButton;
- btnStrBinaryTree: TButton;
+ btnAnsiStrBinaryTree: TButton;
+ btnWideStrBinaryTree: TButton;
procedure btnIntfArrayTreeClick(Sender: TObject);
procedure btnArrayTreeClick(Sender: TObject);
- procedure btnStrBinaryTreeClick(Sender: TObject);
+ procedure btnAnsiStrBinaryTreeClick(Sender: TObject);
+ procedure btnWideStrBinaryTreeClick(Sender: TObject);
public
end;
@@ -122,14 +124,14 @@
memoResult.Lines.Add(IntToStr(Integer(It.Next)));
end;
-procedure TMainForm.btnStrBinaryTreeClick(Sender: TObject);
+procedure TMainForm.btnAnsiStrBinaryTreeClick(Sender: TObject);
var
- Tree: IJclStrTree;
+ Tree: IJclAnsiStrTree;
I: Integer;
- It: IJclStrIterator;
+ It: IJclAnsiStrIterator;
begin
memoResult.Lines.Clear;
- Tree := TJclStrBinaryTree.Create(JclAlgorithms.StrSimpleCompare);
+ Tree := TJclAnsiStrBinaryTree.Create(JclAlgorithms.AnsiStrSimpleCompare);
for I := 0 to 17 do
Tree.Add(Format('%.2d', [I]));
@@ -142,5 +144,25 @@
memoResult.Lines.Add(It.Next);
end;
+procedure TMainForm.btnWideStrBinaryTreeClick(Sender: TObject);
+var
+ Tree: IJclWideStrTree;
+ I: Integer;
+ It: IJclWideStrIterator;
+begin
+ memoResult.Lines.Clear;
+ Tree := TJclWideStrBinaryTree.Create(JclAlgorithms.WideStrSimpleCompare);
+ for I := 0 to 17 do
+ Tree.Add(Format('%.2d', [I]));
+
+ if Tree.Contains('15') then
+ memoResult.Lines.Add('contains 15');
+
+ Tree.TraverseOrder := toOrder;
+ It := Tree.First;
+ while It.HasNext do
+ memoResult.Lines.Add(It.Next);
+end;
+
end.
Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas 2007-11-02 12:30:31 UTC (rev 2204)
+++ trunk/jcl/install/JclInstall.pas 2007-11-02 14:30:48 UTC (rev 2205)
@@ -50,6 +50,7 @@
joDefPCRE,
joDefBZip2,
joDefUnicode,
+ joDefContainer,
joDefThreadSafe,
joDefDropObsoleteCode,
joDefUnitVersioning,
@@ -74,6 +75,9 @@
joDefUnicodeRawData,
joDefUnicodeZLibData,
joDefUnicodeBZip2Data,
+ joDefContainerAnsiStr,
+ joDefContainerWideStr,
+ joDefContainerNoStr,
joEnvironment,
joEnvLibPath,
joEnvBrowsingPath,
@@ -366,6 +370,11 @@
RsCaptionDefUnicodeRawData = 'Uncompressed Unicode data';
RsCaptionDefUnicodeZLibData = 'Compressed data using zlib';
RsCaptionDefUnicodeBZip2Data = 'Compressed data using bzip2';
+ // Container options
+ RsCaptionDefContainer = 'Container options';
+ RsCaptionDefContainerAnsiStr = 'Alias AnsiString containers to String containers';
+ RsCaptionDefContainerWideStr = 'Alias WideString containers to String containers';
+ RsCaptionDefContainerNoStr = 'Do not alias anything';
// post compilation
RsCaptionPdbCreate = 'Create PDB debug information';
@@ -467,6 +476,11 @@
RsHintDefUnicodeRawData = 'Link resource containing uncompressed Unicode data (bigger executable size)';
RsHintDefUnicodeZLibData = 'Link resource containing Unicode data compressed with ZLib';
RsHintDefUnicodeBZip2Data = 'Link resource containing Unicode data compressed with BZip2';
+ // Container options
+ RsHintDefContainer = 'Container specific options';
+ RsHintDefContainerAnsiStr = 'Define TJclStr* containers as alias of TJclAnsiStr* containers';
+ RsHintDefContainerWideStr = 'Define TJclStr* containers as alias of TJclWideStr* containers';
+ RsHintDefContainerNoStr = 'Do not define TJclStr* containers';
// post compilation
RsHintPdbCreate = 'Create detailed debug information for libraries';
@@ -563,6 +577,7 @@
(Id: -1; Caption: RsCaptionDefPCRE; Hint: RsHintDefPCRE), // joDefPCRE
(Id: -1; Caption: RsCaptionDefBZip2; Hint: RsHintDefBZip2), // joDefBZip2
(Id: -1; Caption: RsCaptionDefUnicode; Hint: RsHintDefUnicode), // joDefUnicode
+ (Id: -1; Caption: RsCaptionDefContainer; Hint: RsHintDefContainer), // joDefContainer
(Id: -1; Caption: RsCaptionDefThreadSafe; Hint: RsHintDefThreadSafe), // joDefThreadSafe
(Id: -1; Caption: RsCaptionDefDropObsoleteCode; Hint: RsHintDefDropObsoleteCode), // joDefDropObsoleteCode
(Id: -1; Caption: RsCaptionDefUnitVersioning; Hint: RsHintDefUnitVersioning), // joDefUnitVersioning
@@ -587,6 +602,9 @@
(Id: -1; Caption: RsCaptionDefUnicodeRawData; Hint: RsHintDefUnicodeRawData), // joDefUnicodeRawData
(Id: -1; Caption: RsCaptionDefUnicodeZLibData; Hint: RsHintDefUnicodeZLibData), // joDefUnicodeZLibData
(Id: -1; Caption: RsCaptionDefUnicodeBZip2Data; Hint: RsHintDefUnicodeBZip2Data), // joDefUnicodeBZip2Data
+ (Id: -1; Caption: RsCaptionDefContainerAnsiStr; Hint: RsHintDefContainerAnsiStr), // joDefContainerAnsiStr
+ (Id: -1; Caption: RsCaptionDefContainerWideStr; Hint: RsHintDefContainerWideStr), // joDefContainerWideStr
+ (Id: -1; Caption: RsCaptionDefContainerNoStr; Hint: RsHintDefContainerNoStr), // joDefContainerNoStr
(Id: -1; Caption: RsCaptionEnvironment; Hint: RsHintEnvironment), // joEnvironment
(Id: -1; Caption: RsCaptionEnvLibPath; Hint: RsHintEnvLibPath), // joEnvLibPath
(Id: -1; Caption: RsCaptionEnvBrowsingPath; Hint: RsHintEnvBrowsingPath), // joEnvBrowsingPath
@@ -973,11 +991,26 @@
AddOption(joDefDropObsoleteCode, [goChecked], Parent);
if CLRVersion = '' then
AddOption(joDefUnitVersioning, [goChecked], Parent);
+
AddOption(joDefMath, [goChecked], Parent);
AddOption(joDefMathPrecSingle, [goRadioButton], joDefMath);
AddOption(joDefMathPrecDouble, [goRadioButton], joDefMath);
AddOption(joDefMathPrecExtended, [goRadioButton, goChecked], joDefMath);
AddOption(joDefMathExtremeValues, [goChecked], joDefMath);
+
+ AddOption(joDefContainer, [goChecked], Parent);
+ if CLRVersion = '' then
+ begin
+ AddOption(joDefContainerAnsiStr, [goRadioButton, goChecked], joDefContainer);
+ AddOption(joDefContainerWideStr, [goRadioButton], joDefContainer);
+ end
+ else
+ begin
+ AddOption(joDefContainerAnsiStr, [goRadioButton], joDefContainer);
+ AddOption(joDefContainerWideStr, [goRadioButton, goChecked], joDefContainer);
+ end;
+ AddOption(joDefContainerNoStr, [goRadioButton], joDefContainer);
+
if CLRVersion = '' then // these units are not CLR compliant
begin
{$IFDEF MSWINDOWS}
@@ -1473,7 +1506,7 @@
end;
const
- DefineNames: array [joDefThreadSafe..joDefUnicodeBZip2Data] of string =
+ DefineNames: array [joDefThreadSafe..joDefContainerNoStr] of string =
( 'THREADSAFE', 'DROP_OBSOLETE_CODE', 'UNITVERSIONING',
'MATH_SINGLE_PRECISION', 'MATH_DOUBLE_PRECISION', 'MATH_EXTENDED_PRECISION',
'MATH_EXT_EXTREMEVALUES', 'HOOK_DLL_EXCEPTIONS',
@@ -1481,7 +1514,8 @@
'DEBUG_NO_SYMBOLS', 'EDI_WEAK_PACKAGE_UNITS', 'PCRE_STATICLINK',
'PCRE_LINKDLL', 'PCRE_LINKONREQUEST', 'BZIP2_STATICLINK',
'BZIP2_LINKDLL', 'BZIP2_LINKONREQUEST', 'UNICODE_SILENT_FAILURE',
- 'UNICODE_RAW_DATA', 'UNICODE_ZLIB_DATA', 'UNICODE_BZIP2_DATA' );
+ 'UNICODE_RAW_DATA', 'UNICODE_ZLIB_DATA', 'UNICODE_BZIP2_DATA',
+ 'CONTAINER_ANSISTR', 'CONTAINER_WIDESTR', 'CONTAINER_NOSTR' );
var
Option: TJclOption;
Defines: TStrings;
Modified: trunk/jcl/source/common/JclAbstractContainers.pas
===================================================================
--- trunk/jcl/source/common/JclAbstractContainers.pas 2007-11-02 12:30:31 UTC (rev 2204)
+++ trunk/jcl/source/common/JclAbstractContainers.pas 2007-11-02 14:30:48 UTC (rev 2205)
@@ -84,8 +84,8 @@
constructor Create(const ALockDelegate: IInterface);
end;
- TJclAbstractContainer = class(TJclAbstractLockable, IJclContainer,
- {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable)
+ TJclAbstractContainerBase = class(TJclAbstractLockable, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclCloneable, IJclIntfCloneable, IJclContainer)
protected
FAllowDefaultElements: Boolean;
FDuplicates: TDuplicates;
@@ -100,9 +100,9 @@
procedure AutoGrow; virtual;
procedure AutoPack; virtual;
function CheckDuplicate: Boolean;
- function CreateEmptyContainer: TJclAbstractContainer; virtual; abstract;
- procedure AssignDataTo(Dest: TJclAbstractContainer); virtual;
- procedure AssignPropertiesTo(Dest: TJclAbstractContainer); virtual;
+ function CreateEmptyContainer: TJclAbstractContainerBase; virtual; abstract;
+ procedure AssignDataTo(Dest: TJclAbstractContainerBase); virtual;
+ procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); virtual;
{ IJclContainer }
procedure Assign(const Source: IJclContainer);
procedure AssignTo(const Dest: IJclContainer);
@@ -140,8 +140,8 @@
constructor Create(const ALockDelegate: IInterface);
end;
- TJclAbstractIterator = class(TJclAbstractLockable, IJclAbstractIterator,
- {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable)
+ TJclAbstractIterator = class(TJclAbstractLockable, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclCloneable, IJclIntfCloneable, IJclAbstractIterator)
private
FValid: Boolean;
protected
@@ -162,41 +162,77 @@
property Valid: Boolean read FValid write FValid;
end;
- TJclIntfContainer = class(TJclAbstractContainer, IJclContainer,
- {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclIntfEqualityComparer, IJclIntfComparer)
+ TJclIntfAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclCloneable, IJclIntfCloneable, IJclContainer, IJclIntfEqualityComparer, IJclIntfComparer)
protected
function FreeObject(var AInterface: IInterface): IInterface;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
{ IJclIntfEqualityComparer }
function ItemsEqual(const A, B: IInterface): Boolean;
{ IJclIntfComparer }
function ItemsCompare(const A, B: IInterface): Integer;
end;
- TJclStrContainer = class(TJclAbstractContainer, IJclContainer, IJclStrContainer,
- {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclStrEqualityComparer, IJclStrComparer, IJclStrHashConverter)
+ TJclStrAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclCloneable, IJclIntfCloneable, IJclContainer, IJclStrContainer)
protected
FCaseSensitive: Boolean;
+ procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ { IJclStrContainer }
+ function GetCaseSensitive: Boolean; virtual;
+ procedure SetCaseSensitive(Value: Boolean); virtual;
+ end;
+
+ TJclAnsiStrAbstractContainer = class(TJclStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclCloneable, IJclIntfCloneable, IJclContainer, IJclStrContainer, IJclAnsiStrContainer,
+ IJclAnsiStrEqualityComparer, IJclAnsiStrComparer, IJclAnsiStrHashConverter)
+ protected
FEncoding: TJclAnsiStrEncoding;
- procedure AssignPropertiesTo(Dest: TJclAbstractContainer); override;
- function FreeString(var AString: string): string;
+ procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
+ function FreeString(var AString: AnsiString): AnsiString;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
{ IJclAnsiStrContainer }
- function GetCaseSensitive: Boolean; virtual;
function GetEncoding: TJclAnsiStrEncoding; virtual;
- procedure SetCaseSensitive(Value: Boolean); virtual;
procedure SetEncoding(Value: TJclAnsiStrEncoding); virtual;
- { IJclStrEqualityComparer }
- function ItemsEqual(const A, B: string): Boolean;
- { IJclStrComparer }
- function ItemsCompare(const A, B: string): Integer;
- { IJclStrHashConverter }
- function Hash(const AString: string): Integer;
+ { IJclAnsiStrEqualityComparer }
+ function ItemsEqual(const A, B: AnsiString): Boolean;
+ { IJclAnsiStrComparer }
+ function ItemsCompare(const A, B: AnsiString): Integer;
+ { IJclAnsiStrHashConverter }
+ function Hash(const AString: AnsiString): Integer;
end;
- TJclContainer = class(TJclAbstractContainer, IJclContainer, IJclObjectOwner,
- {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclEqualityComparer, IJclComparer)
+ TJclWideStrAbstractContainer = class(TJclStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclCloneable, IJclIntfCloneable, IJclContainer, IJclStrContainer, IJclWideStrContainer,
+ IJclWideStrEqualityComparer, IJclWideStrComparer, IJclWideStrHashConverter)
+ protected
+ FEncoding: TJclWideStrEncoding;
+ procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override;
+ function FreeString(var AString: WideString): WideString;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ { IJclWideStrContainer }
+ function GetEncoding: TJclWideStrEncoding; virtual;
+ procedure SetEncoding(Value: TJclWideStrEncoding); virtual;
+ { IJclWideStrEqualityComparer }
+ function ItemsEqual(const A, B: WideString): Boolean;
+ { IJclWideStrComparer }
+ function ItemsCompare(const A, B: WideString): Integer;
+ { IJclWideStrHashConverter }
+ function Hash(const AString: WideString): Integer;
+ end;
+
+ TJclAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclCloneable, IJclIntfCloneable, IJclContainer, IJclObjectOwner, IJclEqualityComparer, IJclComparer)
private
FOwnsObjects: Boolean;
protected
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
{ IJclEqualityComparer }
function ItemsEqual(A, B: TObject): Boolean;
{ IJclComparer }
@@ -210,11 +246,13 @@
end;
{$IFDEF SUPPORTS_GENERICS}
- TJclContainer<T> = class(TJclAbstractContainer, IJclContainer, IJclItemOwner<T>,
- {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclEqualityComparer<T>, IJclComparer<T>)
+ TJclAbstractContainer<T> = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclCloneable, IJclIntfCloneable, IJclContainer, IJclItemOwner<T>, IJclEqualityComparer<T>, IJclComparer<T>)
private
FOwnsItems: Boolean;
protected
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
{ IJclEqualityComparer<T> }
function ItemsEqual(const A, B: T): Boolean; virtual;
{ IJclComparer<T> }
@@ -228,33 +266,62 @@
end;
{$ENDIF SUPPORTS_GENERICS}
- TJclStrAbstractCollection = class(TJclStrContainer, IJclContainer, IJclStrContainer, IJclStrFlatContainer,
- IJclStrCollection, {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclStrEqualityComparer, IJclStrComparer)
+ TJclAnsiStrAbstractCollection = class(TJclAnsiStrAbstractContainer,
+ {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable, IJclContainer,
+ IJclStrContainer, IJclAnsiStrContainer, IJclAnsiStrFlatContainer, IJclAnsiStrCollection,
+ IJclAnsiStrEqualityComparer, IJclAnsiStrComparer)
protected
- { IJclStrCollection }
- function Add(const AString: string): Boolean; virtual; abstract;
- function AddAll(const ACollection: IJclStrCollection): Boolean; virtual; abstract;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ { IJclAnsiStrCollection }
+ function Add(const AString: AnsiString): Boolean; virtual; abstract;
+ function AddAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract;
procedure Clear; virtual; abstract;
- function Contains(const AString: string): Boolean; virtual; abstract;
- function ContainsAll(const ACollection: IJclStrCollection): Boolean; virtual; abstract;
- function Equals(const ACollection: IJclStrCollection): Boolean; virtual; abstract;
- function First: IJclStrIterator; virtual; abstract;
+ function Contains(const AString: AnsiString): Boolean; virtual; abstract;
+ function ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract;
+ function Equals(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract;
+ function First: IJclAnsiStrIterator; virtual; abstract;
function IsEmpty: Boolean; virtual; abstract;
- function Last: IJclStrIterator; virtual; abstract;
- function Remove(const AString: string): Boolean; overload; virtual; abstract;
- function RemoveAll(const ACollection: IJclStrCollection): Boolean; virtual; abstract;
- function RetainAll(const ACollection: IJclStrCollection): Boolean; virtual; abstract;
+ function Last: IJclAnsiStrIterator; virtual; abstract;
+ function Remove(const AString: AnsiString): Boolean; overload; virtual; abstract;
+ function RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract;
+ function RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract;
function Size: Integer; virtual; abstract;
+ { IJclAnsiStrFlatContainer }
procedure LoadFromStrings(Strings: TStrings);
procedure SaveToStrings(Strings: TStrings);
procedure AppendToStrings(Strings: TStrings);
procedure AppendFromStrings(Strings: TStrings);
function GetAsStrings: TStrings;
- function GetAsDelimited(const Separator: string = AnsiLineBreak): string;
- procedure AppendDelimited(const AString: string; const Separator: string = AnsiLineBreak);
- procedure LoadDelimited(const AString: string; const Separator: string = AnsiLineBreak);
+ function GetAsDelimited(const Separator: AnsiString = AnsiLineBreak): AnsiString;
+ procedure AppendDelimited(const AString: AnsiString; const Separator: AnsiString = AnsiLineBreak);
+ procedure LoadDelimited(const AString: AnsiString; const Separator: AnsiString = AnsiLineBreak);
end;
+ TJclWideStrAbstractCollection = class(TJclWideStrAbstractContainer,
+ {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable, IJclContainer,
+ IJclStrContainer, IJclWideStrContainer, IJclWideStrFlatContainer, IJclWideStrCollection,
+ IJclWideStrEqualityComparer, IJclWideStrComparer)
+ protected
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ { IJclWideStrCollection }
+ function Add(const AString: WideString): Boolean; virtual; abstract;
+ function AddAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract;
+ procedure Clear; virtual; abstract;
+ function Contains(const AString: WideString): Boolean; virtual; abstract;
+ function ContainsAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract;
+ function Equals(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract;
+ function First: IJclWideStrIterator; virtual; abstract;
+ function IsEmpty: Boolean; virtual; abstract;
+ function Last: IJclWideStrIterator; virtual; abstract;
+ function Remove(const AString: WideString): Boolean; overload; virtual; abstract;
+ function RemoveAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract;
+ function RetainAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract;
+ function Size: Integer; virtual; abstract;
+ { IJclWideStrFlatContainer }
+ end;
+
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
@@ -267,6 +334,11 @@
implementation
+{$IFNDEF RTL140_UP}
+uses
+ JclWideStrings;
+{$ENDIF ~RTL140_UP}
+
//=== { TJclAbstractLockable } ===============================================
constructor TJclAbstractLockable.Create(const ALockDelegate: IInterface);
@@ -360,9 +432,9 @@
end;
{$ENDIF THREADSAFE}
-//=== { TJclAbstractContainer } ==============================================
+//=== { TJclAbstractContainerBase } ==========================================
-constructor TJclAbstractContainer.Create(const ALockDelegate: IInterface);
+constructor TJclAbstractContainerBase.Create(const ALockDelegate: IInterface);
begin
inherited Create(ALockDelegate);
@@ -376,17 +448,17 @@
FAutoPackParameter := 4;
end;
-procedure TJclAbstractContainer.Assign(const Source: IJclContainer);
+procedure TJclAbstractContainerBase.Assign(const Source: IJclContainer);
begin
Source.AssignTo(Self);
end;
-procedure TJclAbstractContainer.AssignDataTo(Dest: TJclAbstractContainer);
+procedure TJclAbstractContainerBase.AssignDataTo(Dest: TJclAbstractContainerBase);
begin
// override to customize
end;
-procedure TJclAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainer);
+procedure TJclAbstractContainerBase.AssignPropertiesTo(Dest: TJclAbstractContainerBase);
begin
// override to customize
Dest.SetAllowDefaultElements(GetAllowDefaultElements);
@@ -399,21 +471,21 @@
Dest.SetAutoPackStrategy(GetAutoPackStrategy);
end;
-procedure TJclAbstractContainer.AssignTo(const Dest: IJclContainer);
+procedure TJclAbstractContainerBase.AssignTo(const Dest: IJclContainer);
var
DestObject: TObject;
begin
DestObject := Dest.GetContainerReference;
- if DestObject is TJclAbstractContainer then
+ if DestObject is TJclAbstractContainerBase then
begin
- AssignPropertiesTo(TJclAbstractContainer(DestObject));
- AssignDataTo(TJclAbstractContainer(DestObject));
+ AssignPropertiesTo(TJclAbstractContainerBase(DestObject));
+ AssignDataTo(TJclAbstractContainerBase(DestObject));
end
else
raise EJclAssignError.Create;
end;
-procedure TJclAbstractContainer.AutoGrow;
+procedure TJclAbstractContainerBase.AutoGrow;
begin
case FAutoGrowStrategy of
agsDisabled: ;
@@ -426,7 +498,7 @@
end;
end;
-procedure TJclAbstractContainer.AutoPack;
+procedure TJclAbstractContainerBase.AutoPack;
var
Decrement: Integer;
begin
@@ -446,7 +518,7 @@
SetCapacity(FSize);
end;
-function TJclAbstractContainer.CheckDuplicate: Boolean;
+function TJclAbstractContainerBase.CheckDuplicate: Boolean;
begin
case FDuplicates of
dupIgnore:
@@ -459,9 +531,9 @@
end;
end;
-function TJclAbstractContainer.Clone: TObject;
+function TJclAbstractContainerBase.Clone: TObject;
var
- NewContainer: TJclAbstractContainer;
+ NewContainer: TJclAbstractContainerBase;
begin
{$IFDEF THREADSAFE}
ReadLock;
@@ -477,65 +549,65 @@
{$ENDIF THREADSAFE}
end;
-function TJclAbstractContainer.GetAllowDefaultElements: Boolean;
+function TJclAbstractContainerBase.GetAllowDefaultElements: Boolean;
begin
Result := FAllowDefaultElements;
end;
-function TJclAbstractContainer.GetAutoGrowParameter: Integer;
+function TJclAbstractContainerBase.GetAutoGrowParameter: Integer;
begin
Result := FAutoGrowParameter;
end;
-function TJclAbstractContainer.GetAutoGrowStrategy: TJclAutoGrowStrategy;
+function TJclAbstractContainerBase.GetAutoGrowStrategy: TJclAutoGrowStrategy;
begin
Result := FAutoGrowStrategy;
end;
-function TJclAbstractContainer.GetAutoPackParameter: Integer;
+function TJclAbstractContainerBase.GetAutoPackParameter: Integer;
begin
Result := FAutoPackParameter;
end;
-function TJclAbstractContainer.GetAutoPackStrategy: TJclAutoPackStrategy;
+function TJclAbstractContainerBase.GetAutoPackStrategy: TJclAutoPackStrategy;
begin
Result := FAutoPackStrategy;
end;
-function TJclAbstractContainer.GetCapacity: Integer;
+function TJclAbstractContainerBase.GetCapacity: Integer;
begin
Result := FCapacity;
end;
-function TJclAbstractContainer.GetContainerReference: TObject;
+function TJclAbstractContainerBase.GetContainerReference: TObject;
begin
Result := Self;
end;
-function TJclAbstractContainer.GetDuplicates: TDuplicates;
+function TJclAbstractContainerBase.GetDuplicates: TDuplicates;
begin
Result := FDuplicates;
end;
-function TJclAbstractContainer.GetRemoveSingleElement: Boolean;
+function TJclAbstractContainerBase.GetRemoveSingleElement: Boolean;
begin
Result := FRemoveSingleElement;
end;
-function TJclAbstractContainer.GetReturnDefaultElements: Boolean;
+function TJclAbstractContainerBase.GetReturnDefaultElements: Boolean;
begin
Result := FReturnDefaultElements;
end;
-procedure TJclAbstractContainer.Grow;
+procedure TJclAbstractContainerBase.Grow;
begin
// override to customize
AutoGrow;
end;
-function TJclAbstractContainer.IntfClone: IInterface;
+function TJclAbstractContainerBase.IntfClone: IInterface;
var
- NewContainer: TJclAbstractContainer;
+ NewContainer: TJclAbstractContainerBase;
begin
{$IFDEF THREADSAFE}
ReadLock;
@@ -551,53 +623,53 @@
{$ENDIF THREADSAFE}
end;
-procedure TJclAbstractContainer.Pack;
+procedure TJclAbstractContainerBase.Pack;
begin
// override to customize
SetCapacity(FSize);
end;
-procedure TJclAbstractContainer.SetAllowDefaultElements(Value: Boolean);
+procedure TJclAbstractContainerBase.SetAllowDefaultElements(Value: Boolean);
begin
FAllowDefaultElements := Value;
end;
-procedure TJclAbstractContainer.SetAutoGrowParameter(Value: Integer);
+procedure TJclAbstractContainerBase.SetAutoGrowParameter(Value: Integer);
begin
FAutoGrowParameter := Value;
end;
-procedure TJclAbstractContainer.SetAutoGrowStrategy(Value: TJclAutoGrowStrategy);
+procedure TJclAbstractContainerBase.SetAutoGrowStrategy(Value: TJclAutoGrowStrategy);
begin
FAutoGrowStrategy := Value;
end;
-procedure TJclAbstractContainer.SetAutoPackParameter(Value: Integer);
+procedure TJclAbstra...
[truncated message content] |
|
From: <ou...@us...> - 2007-11-02 12:30:33
|
Revision: 2204
http://jcl.svn.sourceforge.net/jcl/?rev=2204&view=rev
Author: outchy
Date: 2007-11-02 05:30:31 -0700 (Fri, 02 Nov 2007)
Log Message:
-----------
Fixing compilation of demo for Delphi 5.
Modified Paths:
--------------
trunk/jcl/examples/windows/widestring/WideStringDemoMain.dfm
trunk/jcl/examples/windows/widestring/WideStringDemoMain.pas
trunk/jcl/examples/windows/widestring/WideStringExample.dpr
Modified: trunk/jcl/examples/windows/widestring/WideStringDemoMain.dfm
===================================================================
--- trunk/jcl/examples/windows/widestring/WideStringDemoMain.dfm 2007-11-01 14:49:59 UTC (rev 2203)
+++ trunk/jcl/examples/windows/widestring/WideStringDemoMain.dfm 2007-11-02 12:30:31 UTC (rev 2204)
@@ -40,8 +40,6 @@
ViewStyle = vsReport
OnColumnClick = FileListViewColumnClick
OnDblClick = OpenwithNotepad1Click
- ExplicitWidth = 909
- ExplicitHeight = 343
end
object Panel1: TPanel
Left = 0
@@ -50,7 +48,6 @@
Height = 177
Align = alTop
TabOrder = 1
- ExplicitWidth = 909
object Label3: TLabel
Left = 216
Top = 58
@@ -144,8 +141,6 @@
Panels = <>
SimplePanel = True
UseSystemFont = False
- ExplicitTop = 520
- ExplicitWidth = 909
end
object FilePopupMenu: TPopupMenu
Left = 712
Modified: trunk/jcl/examples/windows/widestring/WideStringDemoMain.pas
===================================================================
--- trunk/jcl/examples/windows/widestring/WideStringDemoMain.pas 2007-11-01 14:49:59 UTC (rev 2203)
+++ trunk/jcl/examples/windows/widestring/WideStringDemoMain.pas 2007-11-02 12:30:31 UTC (rev 2204)
@@ -3,7 +3,7 @@
interface
uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls, Menus, ShellAPI,
JclFileUtils, JclUnicode, JclSysInfo, JclFont;
Modified: trunk/jcl/examples/windows/widestring/WideStringExample.dpr
===================================================================
--- trunk/jcl/examples/windows/widestring/WideStringExample.dpr 2007-11-01 14:49:59 UTC (rev 2203)
+++ trunk/jcl/examples/windows/widestring/WideStringExample.dpr 2007-11-02 12:30:31 UTC (rev 2204)
@@ -8,7 +8,6 @@
begin
Application.Initialize;
- Application.MainFormOnTaskbar := True;
Application.Title := 'TWideStringList Example (JclUnicode)';
Application.CreateForm(TForm1, Form1);
Application.Run;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-11-01 14:50:05
|
Revision: 2203
http://jcl.svn.sourceforge.net/jcl/?rev=2203&view=rev
Author: outchy
Date: 2007-11-01 07:49:59 -0700 (Thu, 01 Nov 2007)
Log Message:
-----------
mantis 4277 Can't install JCL on Delphi5: this version of Delphi doesn't implement TInterfacedPersistent: reimplementing assignation structure.
Fixing some hints in JclArrayLists, JclBinaryTrees, JclHashMaps and JclLinkedLists.
Modified Paths:
--------------
trunk/jcl/source/common/JclAbstractContainers.pas
trunk/jcl/source/common/JclArrayLists.pas
trunk/jcl/source/common/JclBinaryTrees.pas
trunk/jcl/source/common/JclContainerIntf.pas
trunk/jcl/source/common/JclHashMaps.pas
trunk/jcl/source/common/JclLinkedLists.pas
trunk/jcl/source/common/JclResources.pas
trunk/jcl/source/prototypes/containers/JclArrayLists.imp
trunk/jcl/source/prototypes/containers/JclBinaryTrees.imp
trunk/jcl/source/prototypes/containers/JclHashMaps.imp
trunk/jcl/source/prototypes/containers/JclLinkedLists.imp
Modified: trunk/jcl/source/common/JclAbstractContainers.pas
===================================================================
--- trunk/jcl/source/common/JclAbstractContainers.pas 2007-11-01 12:52:32 UTC (rev 2202)
+++ trunk/jcl/source/common/JclAbstractContainers.pas 2007-11-01 14:49:59 UTC (rev 2203)
@@ -61,7 +61,7 @@
TJclIntfCriticalSection = JclSysUtils.TJclIntfCriticalSection;
{$ENDIF KEEP_DEPRECATED}
- TJclAbstractLockable = class(TInterfacedPersistent {$IFDEF THREADSAFE}, IJclLockable {$ENDIF THREADSAFE})
+ TJclAbstractLockable = class(TInterfacedObject {$IFDEF THREADSAFE}, IJclLockable {$ENDIF THREADSAFE})
{$IFDEF THREADSAFE}
private
FLockDelegate: IJclLockable;
@@ -103,9 +103,11 @@
function CreateEmptyContainer: TJclAbstractContainer; virtual; abstract;
procedure AssignDataTo(Dest: TJclAbstractContainer); virtual;
procedure AssignPropertiesTo(Dest: TJclAbstractContainer); virtual;
- procedure AssignTo(Dest: TPersistent); override;
{ IJclContainer }
+ procedure Assign(const Source: IJclContainer);
+ procedure AssignTo(const Dest: IJclContainer);
function GetAllowDefaultElements: Boolean; virtual;
+ function GetContainerReference: TObject;
function GetDuplicates: TDuplicates; virtual;
function GetRemoveSingleElement: Boolean; virtual;
function GetReturnDefaultElements: Boolean; virtual;
@@ -138,7 +140,7 @@
constructor Create(const ALockDelegate: IInterface);
end;
- TJclAbstractIterator = class(TJclAbstractLockable,
+ TJclAbstractIterator = class(TJclAbstractLockable, IJclAbstractIterator,
{$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable)
private
FValid: Boolean;
@@ -146,7 +148,10 @@
procedure CheckValid;
function CreateEmptyIterator: TJclAbstractIterator; virtual; abstract;
procedure AssignPropertiesTo(Dest: TJclAbstractIterator); virtual;
- procedure AssignTo(Dest: TPersistent); override;
+ { IJclAbstractIterator }
+ procedure Assign(const Source: IJclAbstractIterator);
+ procedure AssignTo(const Dest: IJclAbstractIterator);
+ function GetIteratorReference: TObject;
{ IJclCloneable }
function Clone: TObject;
{ IJclIntfCloneable }
@@ -371,6 +376,11 @@
FAutoPackParameter := 4;
end;
+procedure TJclAbstractContainer.Assign(const Source: IJclContainer);
+begin
+ Source.AssignTo(Self);
+end;
+
procedure TJclAbstractContainer.AssignDataTo(Dest: TJclAbstractContainer);
begin
// override to customize
@@ -389,15 +399,18 @@
Dest.SetAutoPackStrategy(GetAutoPackStrategy);
end;
-procedure TJclAbstractContainer.AssignTo(Dest: TPersistent);
+procedure TJclAbstractContainer.AssignTo(const Dest: IJclContainer);
+var
+ DestObject: TObject;
begin
- if Dest is TJclAbstractContainer then
+ DestObject := Dest.GetContainerReference;
+ if DestObject is TJclAbstractContainer then
begin
- AssignPropertiesTo(TJclAbstractContainer(Dest));
- AssignDataTo(TJclAbstractContainer(Dest));
+ AssignPropertiesTo(TJclAbstractContainer(DestObject));
+ AssignDataTo(TJclAbstractContainer(DestObject));
end
else
- inherited AssignTo(Dest);
+ raise EJclAssignError.Create;
end;
procedure TJclAbstractContainer.AutoGrow;
@@ -494,6 +507,11 @@
Result := FCapacity;
end;
+function TJclAbstractContainer.GetContainerReference: TObject;
+begin
+ Result := Self;
+end;
+
function TJclAbstractContainer.GetDuplicates: TDuplicates;
begin
Result := FDuplicates;
@@ -592,17 +610,25 @@
FValid := AValid;
end;
+procedure TJclAbstractIterator.Assign(const Source: IJclAbstractIterator);
+begin
+ Source.AssignTo(Self);
+end;
+
procedure TJclAbstractIterator.AssignPropertiesTo(Dest: TJclAbstractIterator);
begin
Dest.FValid := FValid;
end;
-procedure TJclAbstractIterator.AssignTo(Dest: TPersistent);
+procedure TJclAbstractIterator.AssignTo(const Dest: IJclAbstractIterator);
+var
+ DestObject: TObject;
begin
- if Dest is TJclAbstractIterator then
- AssignPropertiesTo(TJclAbstractIterator(Dest))
+ DestObject := Dest.GetIteratorReference;
+ if DestObject is TJclAbstractIterator then
+ AssignPropertiesTo(TJclAbstractIterator(DestObject))
else
- inherited AssignTo(Dest);
+ raise EJclAssignError.Create;
end;
procedure TJclAbstractIterator.CheckValid;
@@ -625,6 +651,11 @@
{$ENDIF THREADSAFE}
end;
+function TJclAbstractIterator.GetIteratorReference: TObject;
+begin
+ Result := Self;
+end;
+
function TJclAbstractIterator.IntfClone: IInterface;
begin
{$IFDEF THREADSAFE}
Modified: trunk/jcl/source/common/JclArrayLists.pas
===================================================================
--- trunk/jcl/source/common/JclArrayLists.pas 2007-11-01 12:52:32 UTC (rev 2202)
+++ trunk/jcl/source/common/JclArrayLists.pas 2007-11-01 14:49:59 UTC (rev 2203)
@@ -954,7 +954,7 @@
ADest.AddAll(Self);
end
else
- if Supports(Dest, IJclIntfCollection, ACollection) then
+ if Supports(IInterface(Dest), IJclIntfCollection, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
@@ -1508,7 +1508,7 @@
ADest.AddAll(Self);
end
else
- if Supports(Dest, IJclStrCollection, ACollection) then
+ if Supports(IInterface(Dest), IJclStrCollection, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
@@ -2062,7 +2062,7 @@
ADest.AddAll(Self);
end
else
- if Supports(Dest, IJclCollection, ACollection) then
+ if Supports(IInterface(Dest), IJclCollection, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
@@ -2617,7 +2617,7 @@
ADest.AddAll(Self);
end
else
- if Supports(Dest, IJclCollection<T>, ACollection) then
+ if Supports(IInterface(Dest), IJclCollection<T>, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
Modified: trunk/jcl/source/common/JclBinaryTrees.pas
===================================================================
--- trunk/jcl/source/common/JclBinaryTrees.pas 2007-11-01 12:52:32 UTC (rev 2202)
+++ trunk/jcl/source/common/JclBinaryTrees.pas 2007-11-01 14:49:59 UTC (rev 2203)
@@ -2065,7 +2065,7 @@
ADest.FRoot := CloneNode(FRoot, nil);
end
else
- if Supports(Dest, IJclIntfCollection, ACollection) then
+ if Supports(IInterface(Dest), IJclIntfCollection, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
@@ -2741,7 +2741,7 @@
ADest.FRoot := CloneNode(FRoot, nil);
end
else
- if Supports(Dest, IJclStrCollection, ACollection) then
+ if Supports(IInterface(Dest), IJclStrCollection, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
@@ -3417,7 +3417,7 @@
ADest.FRoot := CloneNode(FRoot, nil);
end
else
- if Supports(Dest, IJclCollection, ACollection) then
+ if Supports(IInterface(Dest), IJclCollection, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
@@ -4094,7 +4094,7 @@
ADest.FRoot := CloneNode(FRoot, nil);
end
else
- if Supports(Dest, IJclCollection<T>, ACollection) then
+ if Supports(IInterface(Dest), IJclCollection<T>, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
Modified: trunk/jcl/source/common/JclContainerIntf.pas
===================================================================
--- trunk/jcl/source/common/JclContainerIntf.pas 2007-11-01 12:52:32 UTC (rev 2202)
+++ trunk/jcl/source/common/JclContainerIntf.pas 2007-11-01 14:49:59 UTC (rev 2203)
@@ -52,11 +52,17 @@
type
IJclAbstractIterator = interface
['{1064D0B4-D9FC-475D-88BE-520490013B46}']
+ procedure Assign(const Source: IJclAbstractIterator);
+ procedure AssignTo(const Dest: IJclAbstractIterator);
+ function GetIteratorReference: TObject;
end;
IJclContainer = interface
['{C517175A-028E-486A-BF27-5EF7FC3101D9}']
+ procedure Assign(const Source: IJclContainer);
+ procedure AssignTo(const Dest: IJclContainer);
function GetAllowDefaultElements: Boolean;
+ function GetContainerReference: TObject;
function GetDuplicates: TDuplicates;
function GetRemoveSingleElement: Boolean;
function GetReturnDefaultElements: Boolean;
@@ -929,6 +935,12 @@
constructor Create;
end;
+ EJclAssignError = class(EJclContainerError)
+ public
+ // RsEAssignError
+ constructor Create;
+ end;
+
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
@@ -1055,6 +1067,17 @@
{$ENDIF ~CLR}
end;
+//=== { EJclAssignError } ====================================================
+
+constructor EJclAssignError.Create;
+begin
+ {$IFDEF CLR}
+ inherited Create(RsEAssignError);
+ {$ELSE ~CLR}
+ inherited CreateRes(@RsEAssignError);
+ {$ENDIF ~CLR}
+end;
+
{$IFDEF UNITVERSIONING}
initialization
RegisterUnitVersion(HInstance, UnitVersioning);
Modified: trunk/jcl/source/common/JclHashMaps.pas
===================================================================
--- trunk/jcl/source/common/JclHashMaps.pas 2007-11-01 12:52:32 UTC (rev 2202)
+++ trunk/jcl/source/common/JclHashMaps.pas 2007-11-01 14:49:59 UTC (rev 2203)
@@ -701,7 +701,7 @@
{$ENDIF THREADSAFE}
end
else
- if Supports(Dest, IJclIntfIntfMap, AMap) then
+ if Supports(IInterface(Dest), IJclIntfIntfMap, AMap) then
begin
AMap.Clear;
AMap.PutAll(Self);
@@ -1303,7 +1303,7 @@
{$ENDIF THREADSAFE}
end
else
- if Supports(Dest, IJclStrIntfMap, AMap) then
+ if Supports(IInterface(Dest), IJclStrIntfMap, AMap) then
begin
AMap.Clear;
AMap.PutAll(Self);
@@ -1903,7 +1903,7 @@
{$ENDIF THREADSAFE}
end
else
- if Supports(Dest, IJclIntfStrMap, AMap) then
+ if Supports(IInterface(Dest), IJclIntfStrMap, AMap) then
begin
AMap.Clear;
AMap.PutAll(Self);
@@ -2505,7 +2505,7 @@
{$ENDIF THREADSAFE}
end
else
- if Supports(Dest, IJclStrStrMap, AMap) then
+ if Supports(IInterface(Dest), IJclStrStrMap, AMap) then
begin
AMap.Clear;
AMap.PutAll(Self);
@@ -3106,7 +3106,7 @@
{$ENDIF THREADSAFE}
end
else
- if Supports(Dest, IJclIntfMap, AMap) then
+ if Supports(IInterface(Dest), IJclIntfMap, AMap) then
begin
AMap.Clear;
AMap.PutAll(Self);
@@ -3723,7 +3723,7 @@
{$ENDIF THREADSAFE}
end
else
- if Supports(Dest, IJclStrMap, AMap) then
+ if Supports(IInterface(Dest), IJclStrMap, AMap) then
begin
AMap.Clear;
AMap.PutAll(Self);
@@ -4337,7 +4337,7 @@
{$ENDIF THREADSAFE}
end
else
- if Supports(Dest, IJclMap, AMap) then
+ if Supports(IInterface(Dest), IJclMap, AMap) then
begin
AMap.Clear;
AMap.PutAll(Self);
@@ -4969,7 +4969,7 @@
{$ENDIF THREADSAFE}
end
else
- if Supports(Dest, IJclMap<TKey, TValue>, AMap) then
+ if Supports(IInterface(Dest), IJclMap<TKey, TValue>, AMap) then
begin
AMap.Clear;
AMap.PutAll(Self);
Modified: trunk/jcl/source/common/JclLinkedLists.pas
===================================================================
--- trunk/jcl/source/common/JclLinkedLists.pas 2007-11-01 12:52:32 UTC (rev 2202)
+++ trunk/jcl/source/common/JclLinkedLists.pas 2007-11-01 14:49:59 UTC (rev 2203)
@@ -1449,7 +1449,7 @@
ACollection: IJclIntfCollection;
begin
inherited AssignDataTo(Dest);
- if Supports(Dest, IJclIntfCollection, ACollection) then
+ if Supports(IInterface(Dest), IJclIntfCollection, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
@@ -2224,7 +2224,7 @@
ACollection: IJclStrCollection;
begin
inherited AssignDataTo(Dest);
- if Supports(Dest, IJclStrCollection, ACollection) then
+ if Supports(IInterface(Dest), IJclStrCollection, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
@@ -2999,7 +2999,7 @@
ACollection: IJclCollection;
begin
inherited AssignDataTo(Dest);
- if Supports(Dest, IJclCollection, ACollection) then
+ if Supports(IInterface(Dest), IJclCollection, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
@@ -3776,7 +3776,7 @@
ACollection: IJclCollection<T>;
begin
inherited AssignDataTo(Dest);
- if Supports(Dest, IJclCollection<T>, ACollection) then
+ if Supports(IInterface(Dest), IJclCollection<T>, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
Modified: trunk/jcl/source/common/JclResources.pas
===================================================================
--- trunk/jcl/source/common/JclResources.pas 2007-11-01 12:52:32 UTC (rev 2202)
+++ trunk/jcl/source/common/JclResources.pas 2007-11-01 14:49:59 UTC (rev 2203)
@@ -821,6 +821,7 @@
RsENoEqualityComparer = 'Item equality comparer is not assigned';
RsENoComparer = 'Item comparer is not assigned';
RsENoHashConverter = 'Hash converter is not assigned';
+ RsEAssignError = 'Assignation error';
//=== JclCounter =============================================================
resourcestring
Modified: trunk/jcl/source/prototypes/containers/JclArrayLists.imp
===================================================================
--- trunk/jcl/source/prototypes/containers/JclArrayLists.imp 2007-11-01 12:52:32 UTC (rev 2202)
+++ trunk/jcl/source/prototypes/containers/JclArrayLists.imp 2007-11-01 14:49:59 UTC (rev 2203)
@@ -308,7 +308,7 @@
ADest.AddAll(Self);
end
else
- if Supports(Dest, COLLECTIONINTERFACENAME, ACollection) then
+ if Supports(IInterface(Dest), COLLECTIONINTERFACENAME, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
Modified: trunk/jcl/source/prototypes/containers/JclBinaryTrees.imp
===================================================================
--- trunk/jcl/source/prototypes/containers/JclBinaryTrees.imp 2007-11-01 12:52:32 UTC (rev 2202)
+++ trunk/jcl/source/prototypes/containers/JclBinaryTrees.imp 2007-11-01 14:49:59 UTC (rev 2203)
@@ -576,7 +576,7 @@
ADest.FRoot := CloneNode(FRoot, nil);
end
else
- if Supports(Dest, COLLECTIONINTERFACENAME, ACollection) then
+ if Supports(IInterface(Dest), COLLECTIONINTERFACENAME, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
Modified: trunk/jcl/source/prototypes/containers/JclHashMaps.imp
===================================================================
--- trunk/jcl/source/prototypes/containers/JclHashMaps.imp 2007-11-01 12:52:32 UTC (rev 2202)
+++ trunk/jcl/source/prototypes/containers/JclHashMaps.imp 2007-11-01 14:49:59 UTC (rev 2203)
@@ -110,7 +110,7 @@
{$ENDIF THREADSAFE}
end
else
- if Supports(Dest, MAPINTERFACENAME, AMap) then
+ if Supports(IInterface(Dest), MAPINTERFACENAME, AMap) then
begin
AMap.Clear;
AMap.PutAll(Self);
Modified: trunk/jcl/source/prototypes/containers/JclLinkedLists.imp
===================================================================
--- trunk/jcl/source/prototypes/containers/JclLinkedLists.imp 2007-11-01 12:52:32 UTC (rev 2202)
+++ trunk/jcl/source/prototypes/containers/JclLinkedLists.imp 2007-11-01 14:49:59 UTC (rev 2203)
@@ -434,7 +434,7 @@
ACollection: COLLECTIONINTERFACENAME;
begin
inherited AssignDataTo(Dest);
- if Supports(Dest, COLLECTIONINTERFACENAME, ACollection) then
+ if Supports(IInterface(Dest), COLLECTIONINTERFACENAME, ACollection) then
begin
ACollection.Clear;
ACollection.AddAll(Self);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-11-01 12:52:50
|
Revision: 2202
http://jcl.svn.sourceforge.net/jcl/?rev=2202&view=rev
Author: outchy
Date: 2007-11-01 05:52:32 -0700 (Thu, 01 Nov 2007)
Log Message:
-----------
mantis 4256: Endless loop in UnicodeCompose
Modified Paths:
--------------
trunk/jcl/source/windows/JclUnicode.pas
Modified: trunk/jcl/source/windows/JclUnicode.pas
===================================================================
--- trunk/jcl/source/windows/JclUnicode.pas 2007-11-01 12:51:07 UTC (rev 2201)
+++ trunk/jcl/source/windows/JclUnicode.pas 2007-11-01 12:52:32 UTC (rev 2202)
@@ -2167,6 +2167,7 @@
Inc(M);
end;
+ Break;
end;
end;
Result := 1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-11-01 12:51:23
|
Revision: 2201
http://jcl.svn.sourceforge.net/jcl/?rev=2201&view=rev
Author: outchy
Date: 2007-11-01 05:51:07 -0700 (Thu, 01 Nov 2007)
Log Message:
-----------
mantis 4252: Range check error in WideCompose
Modified Paths:
--------------
trunk/jcl/source/windows/JclUnicode.pas
Modified: trunk/jcl/source/windows/JclUnicode.pas
===================================================================
--- trunk/jcl/source/windows/JclUnicode.pas 2007-10-30 17:45:55 UTC (rev 2200)
+++ trunk/jcl/source/windows/JclUnicode.pas 2007-11-01 12:51:07 UTC (rev 2201)
@@ -6754,7 +6754,8 @@
if NbProcessed = 0 then
Break;
- Move(Buffer[NbProcessed], Buffer[0], (BufferSize - NbProcessed) * SizeOf(UCS4));
+ if BufferSize > NbProcessed then
+ Move(Buffer[NbProcessed], Buffer[0], (BufferSize - NbProcessed) * SizeOf(UCS4));
Dec(BufferSize, NbProcessed);
Inc(OutPos);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-10-30 17:45:56
|
Revision: 2200
http://jcl.svn.sourceforge.net/jcl/?rev=2200&view=rev
Author: ahuser
Date: 2007-10-30 10:45:55 -0700 (Tue, 30 Oct 2007)
Log Message:
-----------
- Added "IdeExperts"
- Fixed missing Result:=
Modified Paths:
--------------
trunk/thirdparty/InnoSetup/ComponentInstallerScript.iss
Modified: trunk/thirdparty/InnoSetup/ComponentInstallerScript.iss
===================================================================
--- trunk/thirdparty/InnoSetup/ComponentInstallerScript.iss 2007-10-30 16:31:08 UTC (rev 2199)
+++ trunk/thirdparty/InnoSetup/ComponentInstallerScript.iss 2007-10-30 17:45:55 UTC (rev 2200)
@@ -232,37 +232,45 @@
begin
if not FileExists(Filename) then
Exit;
+ Log('Register IDE expert: ' + Filename);
+ case Kind of
+ ikDelphi:
+ if compinst_installDelphiExpert(Version, PChar(Filename), Description) = 0 then
+ MsgBox('Failed to install IDE expert ' + ExtractFileName(Filename), mbError, MB_OK);
+ ikBCB:
+ if compinst_installBCBExpert(Version, PChar(Filename), Description) = 0 then
+ MsgBox('Failed to install IDE expert ' + ExtractFileName(Filename), mbError, MB_OK);
+ end;
+end;
+
+function UninstallExpert(Kind: TIdeKind; Version: Integer; const Filename: string): Boolean;
+begin
+ Log('Unregister IDE expert: ' + Filename);
+ Result := False;
+ case Kind of
+ ikDelphi:
+ Result := compinst_uninstallDelphiExpert(Version, PChar(Filename)) <> 0;
+ ikBCB:
+ Result := compinst_uninstallBCBExpert(Version, PChar(Filename)) <> 0;
+ end;
+end;
+
+procedure InstallExpertEx(Kind: TIdeKind; Version: Integer; const Filename, Description: string);
+begin
+ if not FileExists(Filename) then
+ Exit;
if EndsText('.bpl', Filename) then
InstallDesignPackage(Kind, Version, Filename)
else
- begin
- Log('Register IDE expert: ' + Filename);
- case Kind of
- ikDelphi:
- if compinst_installDelphiExpert(Version, PChar(Filename), Description) = 0 then
- MsgBox('Failed to install IDE expert ' + ExtractFileName(Filename), mbError, MB_OK);
- ikBCB:
- if compinst_installBCBExpert(Version, PChar(Filename), Description) = 0 then
- MsgBox('Failed to install IDE expert ' + ExtractFileName(Filename), mbError, MB_OK);
- end;
- end;
+ InstallExpert(Kind, Version, Filename, Description);
end;
-function UninstallExpert(Kind: TIdeKind; Version: Integer; const Filename: string): Boolean;
+function UninstallExpertEx(Kind: TIdeKind; Version: Integer; const Filename: string): Boolean;
begin
if EndsText('.bpl', Filename) then
- UninstallDesignPackage(Kind, Version, Filename)
+ Result := UninstallDesignPackage(Kind, Version, Filename)
else
- begin
- Log('Unregister IDE expert: ' + Filename);
- Result := False;
- case Kind of
- ikDelphi:
- Result := compinst_uninstallDelphiExpert(Version, PChar(Filename)) <> 0;
- ikBCB:
- Result := compinst_uninstallBCBExpert(Version, PChar(Filename)) <> 0;
- end;
- end;
+ Result := UninstallExpert(Kind, Version, Filename);
end;
function UninstallExpertsPrefixed(Kind: TIdeKind; Version: Integer; const FilenamePrefix: string): Boolean;
@@ -284,6 +292,9 @@
Value: Integer;
begin
GetSearchPaths(Kind, Version, SearchPaths, DebugPaths, BrowsePaths);
+ if (SearchPaths = '') and (DebugPaths = '') and (BrowsePaths = '') then
+ Exit;
+
if Installing then
begin
Log('Adding search paths: ' + SearchPaths);
@@ -313,7 +324,7 @@
procedure ChangeComponentRegistration(Installing: Boolean; Components: TStrings);
var
- IdeList, PackageList, ExpertList: TStrings;
+ IdeList, PackageList, ExpertList, IdeExpertList: TStrings;
IdeIndex, Index: Integer;
DesignPackageName, ExpertName, Name: string;
IdeKind: TIdeKind;
@@ -324,10 +335,12 @@
IdeList := nil;
PackageList := nil;
ExpertList := nil;
+ IdeExpertList := nil;
try
IdeList := TStringList.Create;
PackageList := TStringList.Create;
ExpertList := TStringList.Create;
+ IdeExpertList := TStringList.Create;
ComponentsFilename := ExpandConstant('{app}\unins00c.dat');
@@ -340,11 +353,13 @@
GetSelectedList(IdeList, 'IDE', Components);
GetSelectedList(PackageList, 'Packages', Components);
GetSelectedList(ExpertList, 'Experts', Components);
+ GetSelectedList(IdeExpertList, 'IdeExperts', Components);
// install per IDE
for IdeIndex := 0 to IdeList.Count - 1 do
begin
ExtractIdeInfo(IdeList[IdeIndex], IdeKind, Version);
+
// install per Package
for Index := 0 to PackageList.Count - 1 do
begin
@@ -372,6 +387,23 @@
if Trim(ExpertName) <> '' then
begin
if Installing then
+ InstallExpertEx(IdeKind, Version, ExpertName, Name)
+ else
+ UninstallExpertEx(IdeKind, Version, ExpertName);
+ end;
+ end;
+ end;
+
+ // install per IdeExpert
+ for Index := 0 to IdeExpertList.Count - 1 do
+ begin
+ Name := ExtractFileName(IdeExpertList[Index]);
+ if Trim(Name) <> '' then
+ begin
+ ExpertName := MapExpert(IdeKind, Version, Name);
+ if Trim(ExpertName) <> '' then
+ begin
+ if Installing then
InstallExpert(IdeKind, Version, ExpertName, Name)
else
UninstallExpert(IdeKind, Version, ExpertName);
@@ -381,6 +413,7 @@
ChangeIdeSearchPaths(IdeKind, Version, Installing);
end;
+
if Installing then
Components.SaveToFile(ComponentsFilename)
else
@@ -388,6 +421,8 @@
finally
IdeList.Free;
PackageList.Free;
+ ExpertList.Free;
+ IdeExpertList.Free;
end;
end;
@@ -439,4 +474,3 @@
UnloadDLL(ExpandConstant('{app}\CompInstall.dll')); // make the file deletable
end;
end;
-
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-10-30 16:31:13
|
Revision: 2199
http://jcl.svn.sourceforge.net/jcl/?rev=2199&view=rev
Author: ahuser
Date: 2007-10-30 09:31:08 -0700 (Tue, 30 Oct 2007)
Log Message:
-----------
Fixed wrong dll import
Modified Paths:
--------------
trunk/thirdparty/InnoSetup/ComponentInstallerScript.iss
Modified: trunk/thirdparty/InnoSetup/ComponentInstallerScript.iss
===================================================================
--- trunk/thirdparty/InnoSetup/ComponentInstallerScript.iss 2007-10-28 09:59:47 UTC (rev 2198)
+++ trunk/thirdparty/InnoSetup/ComponentInstallerScript.iss 2007-10-30 16:31:08 UTC (rev 2199)
@@ -108,9 +108,9 @@
function compinst_isDelphiInstalled(Version: Integer): Integer;
external 'compinst_isDelphiInstalled@files:CompInstall.dll stdcall';
function compinst_isBCBInstalled(Version: Integer): Integer;
- external 'compinst_isDelphiInstalled@files:CompInstall.dll stdcall';
+ external 'compinst_isBCBInstalled@files:CompInstall.dll stdcall';
function compinst_isBDSInstalled(IDEVersion: Integer): Integer;
- external 'compinst_isDelphiInstalled@files:CompInstall.dll stdcall';
+ external 'compinst_isBDSInstalled@files:CompInstall.dll stdcall';
// design package
function compinst_installDelphiDesignPackage(Version: Integer; BplFilename, Description: PChar): Integer;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-10-28 09:59:50
|
Revision: 2198
http://jcl.svn.sourceforge.net/jcl/?rev=2198&view=rev
Author: ahuser
Date: 2007-10-28 02:59:47 -0700 (Sun, 28 Oct 2007)
Log Message:
-----------
ImageBase of JclVcl.bpl was in the image of Jcl.bpl causing a relocation.
Modified Paths:
--------------
trunk/jcl/packages/c6/JclVClx.bpk
trunk/jcl/packages/c6/JclVClx.dpk
trunk/jcl/packages/c6/JclVcl.bpk
trunk/jcl/packages/c6/JclVcl.dpk
trunk/jcl/packages/d10/JclVcl.bdsproj
trunk/jcl/packages/d10/JclVcl.dpk
trunk/jcl/packages/d11/JclVcl.dpk
trunk/jcl/packages/d6/JclVClx.dpk
trunk/jcl/packages/d6/JclVcl.dpk
trunk/jcl/packages/d7/JclVClx.dpk
trunk/jcl/packages/d7/JclVcl.dpk
trunk/jcl/packages/d9/JclVcl.bdsproj
trunk/jcl/packages/d9/JclVcl.dpk
trunk/jcl/packages/k3/JclVClx.bpk
trunk/jcl/packages/k3/JclVClx.dpk
trunk/jcl/packages/xml/JclVClx-R.xml
trunk/jcl/packages/xml/JclVcl-R.xml
Modified: trunk/jcl/packages/c6/JclVClx.bpk
===================================================================
--- trunk/jcl/packages/c6/JclVClx.bpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/c6/JclVClx.bpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -5,7 +5,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml)
- Last generated: 06-08-2007 11:54:52 UTC
+ Last generated: 28-10-2007 09:49:19 UTC
*****************************************************************************
-->
<PROJECT>
@@ -56,7 +56,7 @@
<RFLAGS value=""/>
<AFLAGS value="/mx /w2 /zd"/>
<LFLAGS value="-I..\..\lib\c6 -GB"JclVClx" -D"JEDI Code Library VisualCLX package for C++Builder 6"
- -b:0x48300000 -aa -Tpp -Gpr -x -Gn -Gl -Gi -v"/>
+ -b:0x48450000 -aa -Tpp -Gpr -x -Gn -Gl -Gi -v"/>
<OTHERFILES value=""/>
</OPTIONS>
<LINKER>
Modified: trunk/jcl/packages/c6/JclVClx.dpk
===================================================================
--- trunk/jcl/packages/c6/JclVClx.dpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/c6/JclVClx.dpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml)
- Last generated: 27-02-2006 20:07:09 UTC
+ Last generated: 28-10-2007 09:49:20 UTC
-----------------------------------------------------------------------------
}
@@ -29,7 +29,7 @@
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
-{$IMAGEBASE $48300000}
+{$IMAGEBASE $48450000}
{$DESCRIPTION 'JEDI Code Library VisualCLX package'}
{$LIBSUFFIX 'C60'}
{$RUNONLY}
Modified: trunk/jcl/packages/c6/JclVcl.bpk
===================================================================
--- trunk/jcl/packages/c6/JclVcl.bpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/c6/JclVcl.bpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -5,7 +5,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml)
- Last generated: 06-08-2007 11:54:52 UTC
+ Last generated: 28-10-2007 09:49:19 UTC
*****************************************************************************
-->
<PROJECT>
@@ -59,7 +59,7 @@
<RFLAGS value=""/>
<AFLAGS value="/mx /w2 /zd"/>
<LFLAGS value="-I..\..\lib\c6 -GB"JclVcl" -D"JEDI Code Library VCL package for C++Builder 6"
- -b:0x48200000 -aa -Tpp -Gpr -x -Gn -Gl -Gi -v"/>
+ -b:0x48400000 -aa -Tpp -Gpr -x -Gn -Gl -Gi -v"/>
<OTHERFILES value=""/>
</OPTIONS>
<LINKER>
Modified: trunk/jcl/packages/c6/JclVcl.dpk
===================================================================
--- trunk/jcl/packages/c6/JclVcl.dpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/c6/JclVcl.dpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml)
- Last generated: 09-06-2007 20:20:09 UTC
+ Last generated: 28-10-2007 09:49:20 UTC
-----------------------------------------------------------------------------
}
@@ -29,7 +29,7 @@
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
-{$IMAGEBASE $48200000}
+{$IMAGEBASE $48400000}
{$DESCRIPTION 'JEDI Code Library VCL package'}
{$LIBSUFFIX 'C60'}
{$RUNONLY}
Modified: trunk/jcl/packages/d10/JclVcl.bdsproj
===================================================================
--- trunk/jcl/packages/d10/JclVcl.bdsproj 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/d10/JclVcl.bdsproj 2007-10-28 09:59:47 UTC (rev 2198)
@@ -114,7 +114,7 @@
<Linker Name="GenerateDRC">False</Linker>
<Linker Name="MinStackSize">16384</Linker>
<Linker Name="MaxStackSize">1048576</Linker>
- <Linker Name="ImageBase">$48200000</Linker>
+ <Linker Name="ImageBase">$48400000</Linker>
<Linker Name="ExeDescription">JEDI Code Library VCL package</Linker>
<Linker Name="GenerateHpps">True</Linker>
</Linker>
Modified: trunk/jcl/packages/d10/JclVcl.dpk
===================================================================
--- trunk/jcl/packages/d10/JclVcl.dpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/d10/JclVcl.dpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml)
- Last generated: 09-06-2007 20:20:11 UTC
+ Last generated: 28-10-2007 09:49:23 UTC
-----------------------------------------------------------------------------
}
@@ -29,7 +29,7 @@
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
-{$IMAGEBASE $48200000}
+{$IMAGEBASE $48400000}
{$DESCRIPTION 'JEDI Code Library VCL package'}
{$LIBSUFFIX '100'}
{$RUNONLY}
Modified: trunk/jcl/packages/d11/JclVcl.dpk
===================================================================
--- trunk/jcl/packages/d11/JclVcl.dpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/d11/JclVcl.dpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml)
- Last generated: 09-06-2007 20:20:12 UTC
+ Last generated: 28-10-2007 09:49:23 UTC
-----------------------------------------------------------------------------
}
@@ -29,7 +29,7 @@
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
-{$IMAGEBASE $48200000}
+{$IMAGEBASE $48400000}
{$DESCRIPTION 'JEDI Code Library VCL package'}
{$LIBSUFFIX '110'}
{$RUNONLY}
Modified: trunk/jcl/packages/d6/JclVClx.dpk
===================================================================
--- trunk/jcl/packages/d6/JclVClx.dpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/d6/JclVClx.dpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml)
- Last generated: 27-02-2006 20:07:09 UTC
+ Last generated: 28-10-2007 09:49:20 UTC
-----------------------------------------------------------------------------
}
@@ -29,7 +29,7 @@
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
-{$IMAGEBASE $48300000}
+{$IMAGEBASE $48450000}
{$DESCRIPTION 'JEDI Code Library VisualCLX package'}
{$LIBSUFFIX 'D60'}
{$RUNONLY}
Modified: trunk/jcl/packages/d6/JclVcl.dpk
===================================================================
--- trunk/jcl/packages/d6/JclVcl.dpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/d6/JclVcl.dpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml)
- Last generated: 09-06-2007 20:20:09 UTC
+ Last generated: 28-10-2007 09:49:20 UTC
-----------------------------------------------------------------------------
}
@@ -29,7 +29,7 @@
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
-{$IMAGEBASE $48200000}
+{$IMAGEBASE $48400000}
{$DESCRIPTION 'JEDI Code Library VCL package'}
{$LIBSUFFIX 'D60'}
{$RUNONLY}
Modified: trunk/jcl/packages/d7/JclVClx.dpk
===================================================================
--- trunk/jcl/packages/d7/JclVClx.dpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/d7/JclVClx.dpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml)
- Last generated: 27-02-2006 20:07:09 UTC
+ Last generated: 28-10-2007 09:49:21 UTC
-----------------------------------------------------------------------------
}
@@ -29,7 +29,7 @@
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
-{$IMAGEBASE $48300000}
+{$IMAGEBASE $48450000}
{$DESCRIPTION 'JEDI Code Library VisualCLX package'}
{$LIBSUFFIX '70'}
{$RUNONLY}
Modified: trunk/jcl/packages/d7/JclVcl.dpk
===================================================================
--- trunk/jcl/packages/d7/JclVcl.dpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/d7/JclVcl.dpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml)
- Last generated: 09-06-2007 20:20:09 UTC
+ Last generated: 28-10-2007 09:49:21 UTC
-----------------------------------------------------------------------------
}
@@ -29,7 +29,7 @@
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
-{$IMAGEBASE $48200000}
+{$IMAGEBASE $48400000}
{$DESCRIPTION 'JEDI Code Library VCL package'}
{$LIBSUFFIX '70'}
{$RUNONLY}
Modified: trunk/jcl/packages/d9/JclVcl.bdsproj
===================================================================
--- trunk/jcl/packages/d9/JclVcl.bdsproj 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/d9/JclVcl.bdsproj 2007-10-28 09:59:47 UTC (rev 2198)
@@ -113,7 +113,7 @@
<Linker Name="GenerateDRC">False</Linker>
<Linker Name="MinStackSize">16384</Linker>
<Linker Name="MaxStackSize">1048576</Linker>
- <Linker Name="ImageBase">$48200000</Linker>
+ <Linker Name="ImageBase">$48400000</Linker>
<Linker Name="ExeDescription">JEDI Code Library VCL package</Linker>
</Linker>
<Directories>
Modified: trunk/jcl/packages/d9/JclVcl.dpk
===================================================================
--- trunk/jcl/packages/d9/JclVcl.dpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/d9/JclVcl.dpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml)
- Last generated: 09-06-2007 20:20:10 UTC
+ Last generated: 28-10-2007 09:49:22 UTC
-----------------------------------------------------------------------------
}
@@ -29,7 +29,7 @@
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
-{$IMAGEBASE $48200000}
+{$IMAGEBASE $48400000}
{$DESCRIPTION 'JEDI Code Library VCL package'}
{$LIBSUFFIX '90'}
{$RUNONLY}
Modified: trunk/jcl/packages/k3/JclVClx.bpk
===================================================================
--- trunk/jcl/packages/k3/JclVClx.bpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/k3/JclVClx.bpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -46,7 +46,7 @@
<RFLAGS value=""/>
<AFLAGS value="/mx /w2 /zd"/>
<LFLAGS value="-l../../lib/k3 -I../../lib/k3 -GB"CJclVClx" -N"" -D""
- -b:0x48300000 -aa -Tpp -Gpr -x -Gn -Gl -Gi"/>
+ -b:0x48450000 -aa -Tpp -Gpr -x -Gn -Gl -Gi"/>
</OPTIONS>
<LINKER>
<ALLOBJ value="borinitpkg.o $(PACKAGES) $(OBJFILES)"/>
Modified: trunk/jcl/packages/k3/JclVClx.dpk
===================================================================
--- trunk/jcl/packages/k3/JclVClx.dpk 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/k3/JclVClx.dpk 2007-10-28 09:59:47 UTC (rev 2198)
@@ -4,7 +4,7 @@
DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR
ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml)
- Last generated: 13-09-2007 10:08:46 UTC
+ Last generated: 28-10-2007 09:49:23 UTC
-----------------------------------------------------------------------------
}
@@ -29,7 +29,7 @@
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
-{$IMAGEBASE $48300000}
+{$IMAGEBASE $48450000}
{$DESCRIPTION 'JEDI Code Library VisualCLX package'}
{$LIBSUFFIX '69'}
{$LIBVERSION '1.102.0'}
Modified: trunk/jcl/packages/xml/JclVClx-R.xml
===================================================================
--- trunk/jcl/packages/xml/JclVClx-R.xml 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/xml/JclVClx-R.xml 2007-10-28 09:59:47 UTC (rev 2198)
@@ -6,7 +6,7 @@
<C6PFlags/>
<C5Libs/>
<C6Libs/>
- <ImageBase>48300000</ImageBase>
+ <ImageBase>48450000</ImageBase>
<VersionMajorNumber/>
<VersionMinorNumber/>
<ReleaseNumber/>
Modified: trunk/jcl/packages/xml/JclVcl-R.xml
===================================================================
--- trunk/jcl/packages/xml/JclVcl-R.xml 2007-10-15 11:18:28 UTC (rev 2197)
+++ trunk/jcl/packages/xml/JclVcl-R.xml 2007-10-28 09:59:47 UTC (rev 2198)
@@ -6,7 +6,7 @@
<C6PFlags/>
<C5Libs/>
<C6Libs/>
- <ImageBase>48200000</ImageBase>
+ <ImageBase>48400000</ImageBase>
<VersionMajorNumber/>
<VersionMinorNumber/>
<ReleaseNumber/>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-10-15 11:18:31
|
Revision: 2197
http://jcl.svn.sourceforge.net/jcl/?rev=2197&view=rev
Author: outchy
Date: 2007-10-15 04:18:28 -0700 (Mon, 15 Oct 2007)
Log Message:
-----------
container update:
- now generated from templates (in jcl/source/prototypes/containers/).
- fix for issues in MoveArray (loops were the wrong way, missing range checks).
- binary trees should not corrupt themselves.
- refactoring of all classes to extract common methods moved to JclAbstractContainers.pas
- AnsiString support to be improved to support UTF-8 encoded strings (JclUnicode.pas has to be moved to /jcl/source/common/ first).
- new properties for all containers: allow duplicate elements (either dupAccept, dupIgnore or duperror), return default elements if they don't exist in the container, allow default elements to be added to the container, remove one element or all identical elements.
- new properties for AnsiString containers: case sensitive, encoding (to be improved with UTF-8 support).
- various bug fixes.
- removed default values in constructors to force checks about object ownership.
TODO:
- unicode support UTF-8 (and maybe UCS-2 and UTF-16 if WideString containers are introduced).
- fix internal error on JclHashMaps.pas using Delphi .net 2007 with debug informations.
Modified Paths:
--------------
trunk/jcl/examples/common/containers/hashing/HashingExampleMain.pas
trunk/jcl/examples/common/containers/lists/ListExampleMain.pas
trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas
trunk/jcl/examples/common/containers/trees/TreeExampleMain.pas
trunk/jcl/install/JediInstall.pas
trunk/jcl/install/prototypes/JediGUIMain.pas
trunk/jcl/source/common/JclAbstractContainers.pas
trunk/jcl/source/common/JclAlgorithms.pas
trunk/jcl/source/common/JclArrayLists.pas
trunk/jcl/source/common/JclArraySets.pas
trunk/jcl/source/common/JclBase.pas
trunk/jcl/source/common/JclBinaryTrees.pas
trunk/jcl/source/common/JclContainerIntf.pas
trunk/jcl/source/common/JclHashMaps.pas
trunk/jcl/source/common/JclHashSets.pas
trunk/jcl/source/common/JclLinkedLists.pas
trunk/jcl/source/common/JclQueues.pas
trunk/jcl/source/common/JclResources.pas
trunk/jcl/source/common/JclStacks.pas
trunk/jcl/source/common/JclVectors.pas
trunk/jcl/source/prototypes/JclArrayLists.pas
trunk/jcl/source/prototypes/Makefile.mak
trunk/jcl/source/prototypes/containers/JclArrayLists.imp
Added Paths:
-----------
trunk/jcl/source/prototypes/JclArraySets.pas
trunk/jcl/source/prototypes/JclBinaryTrees.pas
trunk/jcl/source/prototypes/JclHashMaps.pas
trunk/jcl/source/prototypes/JclHashSets.pas
trunk/jcl/source/prototypes/JclLinkedLists.pas
trunk/jcl/source/prototypes/JclQueues.pas
trunk/jcl/source/prototypes/JclStacks.pas
trunk/jcl/source/prototypes/JclVectors.pas
trunk/jcl/source/prototypes/containers/JclArraySets.imp
trunk/jcl/source/prototypes/containers/JclBinaryTrees.imp
trunk/jcl/source/prototypes/containers/JclHashMaps.imp
trunk/jcl/source/prototypes/containers/JclHashSets.imp
trunk/jcl/source/prototypes/containers/JclLinkedLists.imp
trunk/jcl/source/prototypes/containers/JclQueues.imp
trunk/jcl/source/prototypes/containers/JclStacks.imp
trunk/jcl/source/prototypes/containers/JclVectors.imp
Modified: trunk/jcl/examples/common/containers/hashing/HashingExampleMain.pas
===================================================================
--- trunk/jcl/examples/common/containers/hashing/HashingExampleMain.pas 2007-10-06 11:04:18 UTC (rev 2196)
+++ trunk/jcl/examples/common/containers/hashing/HashingExampleMain.pas 2007-10-15 11:18:28 UTC (rev 2197)
@@ -111,7 +111,7 @@
KeyObject: TInterfacedObject;
It: IJclIntfIterator;
begin
- Map := TJclIntfIntfHashMap.Create;
+ Map := TJclIntfIntfHashMap.Create(DefaultContainerCapacity);
MyObject := TIntfMyObject.Create;
MyObject.Int := 42;
MyObject.Str := 'MyString';
@@ -131,7 +131,7 @@
Map: IJclStrIntfMap;
MyObject: IIntfMyObject;
begin
- Map := TJclStrIntfHashMap.Create;
+ Map := TJclStrIntfHashMap.Create(DefaultContainerCapacity);
MyObject := TIntfMyObject.Create;
MyObject.Int := 42;
MyObject.Str := 'MyString';
@@ -152,7 +152,7 @@
KeyObject: TObject;
It: IJclIterator;
begin
- Map := TJclHashMap.Create;
+ Map := TJclHashMap.Create(DefaultContainerCapacity, False, False);
MyObject := TMyObject.Create;
KeyObject := TObject.Create;
try
@@ -166,8 +166,8 @@
memResult.Items.Add(TMyObject(It.Next).Str);
memResult.Items.Add('--------------------------------------------------------');
finally
- // MyObject.Free; // Free in the map (Default: OwnsObject = True)
- // KeyObject.Free;
+ MyObject.Free;
+ KeyObject.Free;
end;
end;
@@ -177,7 +177,7 @@
MyObject: IIntfMyObject;
It: IJclIntfIterator;
begin
- MySet := TJclIntfHashSet.Create;
+ MySet := TJclIntfHashSet.Create(DefaultContainerCapacity);
MyObject := TIntfMyObject.Create;
MyObject.Int := 42;
MyObject.Str := 'MyString';
@@ -196,7 +196,7 @@
MyObject: TMyObject;
It: IJclIterator;
begin
- MySet := TJclHashSet.Create;
+ MySet := TJclHashSet.Create(DefaultContainerCapacity, False);
MyObject := TMyObject.Create;
MyObject.Int := 42;
MyObject.Str := 'MyString';
@@ -215,7 +215,7 @@
MyObject: IIntfMyObject;
It: IJclIntfIterator;
begin
- MySet := TJclIntfArraySet.Create;
+ MySet := TJclIntfArraySet.Create(DefaultContainerCapacity);
MyObject := TIntfMyObject.Create;
MyObject.Int := 42;
MyObject.Str := 'MyString';
@@ -234,17 +234,21 @@
MyObject: TMyObject;
It: IJclIterator;
begin
- MySet := TJclArraySet.Create;
+ MySet := TJclArraySet.Create(DefaultContainerCapacity, False);
MyObject := TMyObject.Create;
- MyObject.Int := 42;
- MyObject.Str := 'MyString';
- MySet.Add(MyObject);
- MySet.Add(MyObject);
- It := MySet.First;
- while It.HasNext do
- memResult.Items.Add(TMyObject(It.Next).Str);
- memResult.Items.Add(IntToStr(MySet.Size));
- memResult.Items.Add('--------------------------------------------------------');
+ try
+ MyObject.Int := 42;
+ MyObject.Str := 'MyString';
+ MySet.Add(MyObject);
+ MySet.Add(MyObject);
+ It := MySet.First;
+ while It.HasNext do
+ memResult.Items.Add(TMyObject(It.Next).Str);
+ memResult.Items.Add(IntToStr(MySet.Size));
+ memResult.Items.Add('--------------------------------------------------------');
+ finally
+ MyObject.Free;
+ end;
end;
procedure TMainForm.btnStrStrHashMapClick(Sender: TObject);
@@ -252,7 +256,7 @@
Map: IJclStrStrMap;
It: IJclStrIterator;
begin
- Map := TJclStrStrHashMap.Create;
+ Map := TJclStrStrHashMap.Create(DefaultContainerCapacity);
Map.PutValue('MyKey1', 'MyString1');
Map.PutValue('MyKey2', 'MyString2');
Map.PutValue('MyKey3', 'MyString3');
@@ -274,26 +278,30 @@
var
Map: IJclStrMap;
MyObject: TMyObject;
- //It: IJclStrIterator;
+ It: IJclStrIterator;
Links: TLinks;
begin
- Map := TJclStrHashMap.Create;
+ Map := TJclStrHashMap.Create(DefaultContainerCapacity, False);
MyObject := TMyObject.Create;
- MyObject.Int := 42;
- MyObject.Str := 'MyString';
+ try
+ MyObject.Int := 42;
+ MyObject.Str := 'MyString';
-{ Map.PutValue('MyKey1', MyObject);
- MyObject := TMyObject(Map.GetValue('MyKey1'));
- memResult.Items.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str);
- It := Map.KeySet.First;
- while It.HasNext do
- memResult.Items.Add(It.Next);
- memResult.Items.Add('--------------------------------------------------------');
- }
- Links := TLinks.Create;
- Links.PutValue('MyKey1', MyObject);
- Links.Remove('MyKey1');
- Links.PutValue('MyKey1', MyObject);
+ Map.PutValue('MyKey1', MyObject);
+ MyObject := TMyObject(Map.GetValue('MyKey1'));
+ memResult.Items.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str);
+ It := Map.KeySet.First;
+ while It.HasNext do
+ memResult.Items.Add(It.Next);
+ memResult.Items.Add('--------------------------------------------------------');
+
+ Links := TLinks.Create(DefaultContainerCapacity, False);
+ Links.PutValue('MyKey1', MyObject);
+ Links.Remove('MyKey1');
+ Links.PutValue('MyKey1', MyObject);
+ finally
+ MyObject.Free;
+ end;
end;
procedure TMainForm.btnStrHashSetClick(Sender: TObject);
@@ -301,7 +309,7 @@
MySet: IJclStrSet;
It: IJclStrIterator;
begin
- MySet := TJclStrHashSet.Create;
+ MySet := TJclStrHashSet.Create(DefaultContainerCapacity);
MySet.Add('MyString');
MySet.Add('MyString');
It := MySet.First;
@@ -317,7 +325,7 @@
It: IJclStrIterator;
I: Integer;
begin
- MySet := TJclStrArraySet.Create;
+ MySet := TJclStrArraySet.Create(DefaultContainerCapacity);
for I := 1 to 8 do
MySet.Add(IntToStr(I));
for I := 8 downto 1 do
Modified: trunk/jcl/examples/common/containers/lists/ListExampleMain.pas
===================================================================
--- trunk/jcl/examples/common/containers/lists/ListExampleMain.pas 2007-10-06 11:04:18 UTC (rev 2196)
+++ trunk/jcl/examples/common/containers/lists/ListExampleMain.pas 2007-10-15 11:18:28 UTC (rev 2197)
@@ -130,7 +130,7 @@
I: Integer;
begin
memResult.Lines.Clear;
- List := TJclIntfArrayList.Create;
+ List := TJclIntfArrayList.Create(DefaultContainerCapacity);
MyObject := TIntfMyObject.Create;
MyObject.Int := 42;
MyObject.Str := 'MyString';
@@ -169,7 +169,7 @@
It: IJclIntfIterator;
begin
memResult.Lines.Clear;
- List := TJclIntfLinkedList.Create;
+ List := TJclIntfLinkedList.Create(nil);
MyObject := TIntfMyObject.Create;
MyObject.Int := 42;
MyObject.Str := 'MyString';
@@ -200,7 +200,7 @@
I: Integer;
begin
memResult.Lines.Clear;
- List := TJclIntfVector.Create;
+ List := TJclIntfVector.Create(DefaultContainerCapacity);
try
MyObject := TIntfMyObject.Create;
MyObject.Int := 42;
@@ -238,7 +238,7 @@
It: IJclIterator;
begin
memResult.Lines.Clear;
- List := TJclArrayList.Create;
+ List := TJclArrayList.Create(DefaultContainerCapacity, True);
MyObject := TMyObject.Create;
MyObject.Int := 42;
MyObject.Str := 'MyString';
@@ -259,7 +259,10 @@
end;
It := List.First;
while It.HasNext do
+ begin
+ It.Next;
It.Remove;
+ end;
end;
procedure TMainForm.btnLinkedListClick(Sender: TObject);
@@ -269,7 +272,7 @@
It: IJclIterator;
begin
memResult.Lines.Clear;
- List := TJclLinkedList.Create;
+ List := TJclLinkedList.Create(nil, True);
MyObject := TMyObject.Create;
MyObject.Int := 42;
MyObject.Str := 'MyString';
@@ -298,7 +301,7 @@
I: Integer;
begin
memResult.Lines.Clear;
- List := TJclVector.Create;
+ List := TJclVector.Create(DefaultContainerCapacity, True);
try
MyObject := TMyObject.Create;
MyObject.Int := 42;
@@ -337,7 +340,7 @@
MyObject: TMyObject;
begin
memResult.Lines.Clear;
- List := TMyObjectList.Create;
+ List := TMyObjectList.Create(DefaultContainerCapacity, True);
MyObject := TMyObject.Create;
MyObject.Int := 42;
MyObject.Str := 'MyString';
@@ -355,7 +358,7 @@
S: string;
begin
memResult.Lines.Clear;
- List := TJclStrArrayList.Create;
+ List := TJclStrArrayList.Create(DefaultContainerCapacity);
List.Add('MyString');
S := List.GetString(0);
@@ -419,7 +422,7 @@
It: IJclStrIterator;
begin
memResult.Lines.Clear;
- List := TJclStrLinkedList.Create;
+ List := TJclStrLinkedList.Create(nil);
List.Add('MyString');
memResult.Lines.Add(List.GetString(0));
@@ -443,7 +446,7 @@
I: Integer;
begin
memResult.Lines.Clear;
- List := TJclStrVector.Create;
+ List := TJclStrVector.Create(DefaultContainerCapacity);
try
List.Add('MyString');
S := List.GetString(0);
Modified: trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas
===================================================================
--- trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas 2007-10-06 11:04:18 UTC (rev 2196)
+++ trunk/jcl/examples/common/containers/performance/ContainerPerformanceTests.pas 2007-10-15 11:18:28 UTC (rev 2197)
@@ -238,7 +238,7 @@
Screen.Cursor := crHourGlass;
try
Start := Now;
- Map := JclHashMaps.TJclHashMap.Create(256, False);
+ Map := JclHashMaps.TJclHashMap.Create(256, False, False);
for I := 0 to 100000 do
Map.PutValue(TObject(Random(100000)), TObject(I));
Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]);
Modified: trunk/jcl/examples/common/containers/trees/TreeExampleMain.pas
===================================================================
--- trunk/jcl/examples/common/containers/trees/TreeExampleMain.pas 2007-10-06 11:04:18 UTC (rev 2196)
+++ trunk/jcl/examples/common/containers/trees/TreeExampleMain.pas 2007-10-15 11:18:28 UTC (rev 2197)
@@ -96,7 +96,10 @@
It := Tree.First;
while It.HasNext do
+ begin
+ It.Next;
It.Remove;
+ end;
end;
procedure TMainForm.btnArrayTreeClick(Sender: TObject);
@@ -106,7 +109,7 @@
It: IJclIterator;
begin
memoResult.Lines.Clear;
- Tree := TJclBinaryTree.Create(JclAlgorithms.IntegerCompare);
+ Tree := TJclBinaryTree.Create(JclAlgorithms.IntegerCompare, True);
for I := 0 to 17 do
Tree.Add(TObject(I));
Modified: trunk/jcl/install/JediInstall.pas
===================================================================
--- trunk/jcl/install/JediInstall.pas 2007-10-06 11:04:18 UTC (rev 2196)
+++ trunk/jcl/install/JediInstall.pas 2007-10-15 11:18:28 UTC (rev 2197)
@@ -349,7 +349,7 @@
inherited Create(nil);
FOptions := TStringList.Create;
- FProducts := TJclIntfArrayList.Create;
+ FProducts := TJclIntfArrayList.Create(1);
FClosing := False;
JediTargetOption := AddInstallOption('joTarget');
Modified: trunk/jcl/install/prototypes/JediGUIMain.pas
===================================================================
--- trunk/jcl/install/prototypes/JediGUIMain.pas 2007-10-06 11:04:18 UTC (rev 2196)
+++ trunk/jcl/install/prototypes/JediGUIMain.pas 2007-10-15 11:18:28 UTC (rev 2197)
@@ -159,7 +159,7 @@
constructor TMainForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
- FPages := TJclIntfArrayList.Create;
+ FPages := TJclIntfArrayList.Create(5);
end;
destructor TMainForm.Destroy;
Modified: trunk/jcl/source/common/JclAbstractContainers.pas
===================================================================
--- trunk/jcl/source/common/JclAbstractContainers.pas 2007-10-06 11:04:18 UTC (rev 2196)
+++ trunk/jcl/source/common/JclAbstractContainers.pas 2007-10-15 11:18:28 UTC (rev 2197)
@@ -61,7 +61,7 @@
TJclIntfCriticalSection = JclSysUtils.TJclIntfCriticalSection;
{$ENDIF KEEP_DEPRECATED}
- TJclAbstractContainer = class(TInterfacedObject {$IFDEF THREADSAFE}, IJclLockable {$ENDIF THREADSAFE})
+ TJclAbstractLockable = class(TInterfacedPersistent {$IFDEF THREADSAFE}, IJclLockable {$ENDIF THREADSAFE})
{$IFDEF THREADSAFE}
private
FLockDelegate: IJclLockable;
@@ -81,18 +81,151 @@
destructor Destroy; override;
{$ENDIF THREADSAFE}
public
- constructor Create(ALockDelegate: IInterface);
+ constructor Create(const ALockDelegate: IInterface);
end;
- TJclAbstractIterator = class(TJclAbstractContainer {$IFDEF THREADSAFE}, IJclLockable {$ENDIF THREADSAFE})
+ TJclAbstractContainer = class(TJclAbstractLockable, IJclContainer,
+ {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable)
+ protected
+ FAllowDefaultElements: Boolean;
+ FDuplicates: TDuplicates;
+ FRemoveSingleElement: Boolean;
+ FReturnDefaultElements: Boolean;
+ FCapacity: Integer;
+ FSize: Integer;
+ FAutoGrowParameter: Integer;
+ FAutoGrowStrategy: TJclAutoGrowStrategy;
+ FAutoPackParameter: Integer;
+ FAutoPackStrategy: TJclAutoPackStrategy;
+ procedure AutoGrow; virtual;
+ procedure AutoPack; virtual;
+ function CheckDuplicate: Boolean;
+ function CreateEmptyContainer: TJclAbstractContainer; virtual; abstract;
+ procedure AssignDataTo(Dest: TJclAbstractContainer); virtual;
+ procedure AssignPropertiesTo(Dest: TJclAbstractContainer); virtual;
+ procedure AssignTo(Dest: TPersistent); override;
+ { IJclContainer }
+ function GetAllowDefaultElements: Boolean; virtual;
+ function GetDuplicates: TDuplicates; virtual;
+ function GetRemoveSingleElement: Boolean; virtual;
+ function GetReturnDefaultElements: Boolean; virtual;
+ procedure SetAllowDefaultElements(Value: Boolean); virtual;
+ procedure SetDuplicates(Value: TDuplicates); virtual;
+ procedure SetRemoveSingleElement(Value: Boolean); virtual;
+ procedure SetReturnDefaultElements(Value: Boolean); virtual;
+ { IJclCloneable }
+ function Clone: TObject;
+ { IJclIntfCloneable }
+ function IntfClone: IInterface;
+ function IJclIntfCloneable.Clone = IntfClone;
+ // IJclGrowable is not in interface list because some descendants won't use this code
+ { IJclGrowable }
+ function GetAutoGrowParameter: Integer; virtual;
+ function GetAutoGrowStrategy: TJclAutoGrowStrategy; virtual;
+ procedure Grow; virtual;
+ procedure SetAutoGrowParameter(Value: Integer); virtual;
+ procedure SetAutoGrowStrategy(Value: TJclAutoGrowStrategy); virtual;
+ // IJclPackable is not in interface list because some descendants won't use this code
+ { IJclPackable }
+ function GetAutoPackParameter: Integer; virtual;
+ function GetAutoPackStrategy: TJclAutoPackStrategy; virtual;
+ function GetCapacity: Integer; virtual;
+ procedure Pack; virtual;
+ procedure SetAutoPackParameter(Value: Integer); virtual;
+ procedure SetAutoPackStrategy(Value: TJclAutoPackStrategy); virtual;
+ procedure SetCapacity(Value: Integer); virtual;
+ public
+ constructor Create(const ALockDelegate: IInterface);
+ end;
+
+ TJclAbstractIterator = class(TJclAbstractLockable,
+ {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable)
private
FValid: Boolean;
+ protected
+ procedure CheckValid;
+ function CreateEmptyIterator: TJclAbstractIterator; virtual; abstract;
+ procedure AssignPropertiesTo(Dest: TJclAbstractIterator); virtual;
+ procedure AssignTo(Dest: TPersistent); override;
+ { IJclCloneable }
+ function Clone: TObject;
+ { IJclIntfCloneable }
+ function IntfClone: IInterface;
+ function IJclIntfCloneable.Clone = IntfClone;
public
+ constructor Create(const ALockDelegate: IInterface; AValid: Boolean);
property Valid: Boolean read FValid write FValid;
end;
- TJclStrCollection = class(TJclAbstractContainer, IJclStrCollection {$IFDEF THREADSAFE},IJclLockable{$ENDIF THREADSAFE})
+ TJclIntfContainer = class(TJclAbstractContainer, IJclContainer,
+ {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclIntfEqualityComparer, IJclIntfComparer)
protected
+ function FreeObject(var AInterface: IInterface): IInterface;
+ { IJclIntfEqualityComparer }
+ function ItemsEqual(const A, B: IInterface): Boolean;
+ { IJclIntfComparer }
+ function ItemsCompare(const A, B: IInterface): Integer;
+ end;
+
+ TJclStrContainer = class(TJclAbstractContainer, IJclContainer, IJclStrContainer,
+ {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclStrEqualityComparer, IJclStrComparer, IJclStrHashConverter)
+ protected
+ FCaseSensitive: Boolean;
+ FEncoding: TJclAnsiStrEncoding;
+ procedure AssignPropertiesTo(Dest: TJclAbstractContainer); override;
+ function FreeString(var AString: string): string;
+ { IJclAnsiStrContainer }
+ function GetCaseSensitive: Boolean; virtual;
+ function GetEncoding: TJclAnsiStrEncoding; virtual;
+ procedure SetCaseSensitive(Value: Boolean); virtual;
+ procedure SetEncoding(Value: TJclAnsiStrEncoding); virtual;
+ { IJclStrEqualityComparer }
+ function ItemsEqual(const A, B: string): Boolean;
+ { IJclStrComparer }
+ function ItemsCompare(const A, B: string): Integer;
+ { IJclStrHashConverter }
+ function Hash(const AString: string): Integer;
+ end;
+
+ TJclContainer = class(TJclAbstractContainer, IJclContainer, IJclObjectOwner,
+ {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclEqualityComparer, IJclComparer)
+ private
+ FOwnsObjects: Boolean;
+ protected
+ { IJclEqualityComparer }
+ function ItemsEqual(A, B: TObject): Boolean;
+ { IJclComparer }
+ function ItemsCompare(A, B: TObject): Integer;
+ { IJclObjectOwner }
+ function FreeObject(var AObject: TObject): TObject; virtual;
+ function GetOwnsObjects: Boolean; virtual;
+ public
+ constructor Create(const ALockDelegate: IInterface; AOwnsObjects: Boolean);
+ property OwnsObjects: Boolean read FOwnsObjects;
+ end;
+
+ {$IFDEF SUPPORTS_GENERICS}
+ TJclContainer<T> = class(TJclAbstractContainer, IJclContainer, IJclItemOwner<T>,
+ {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclEqualityComparer<T>, IJclComparer<T>)
+ private
+ FOwnsItems: Boolean;
+ protected
+ { IJclEqualityComparer<T> }
+ function ItemsEqual(const A, B: T): Boolean; virtual;
+ { IJclComparer<T> }
+ function ItemsCompare(const A, B: T): Integer; virtual;
+ { IJclItemOwner<T> }
+ function FreeItem(var AItem: T): T; virtual;
+ function GetOwnsItems: Boolean; virtual;
+ public
+ constructor Create(const ALockDelegate: IInterface; AOwnsItems: Boolean);
+ property OwnsItems: Boolean read FOwnsItems;
+ end;
+ {$ENDIF SUPPORTS_GENERICS}
+
+ TJclStrAbstractCollection = class(TJclStrContainer, IJclContainer, IJclStrContainer, IJclStrFlatContainer,
+ IJclStrCollection, {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclStrEqualityComparer, IJclStrComparer)
+ protected
{ IJclStrCollection }
function Add(const AString: string): Boolean; virtual; abstract;
function AddAll(const ACollection: IJclStrCollection): Boolean; virtual; abstract;
@@ -129,9 +262,9 @@
implementation
-//=== { TJclAbstractContainer } ==============================================
+//=== { TJclAbstractLockable } ===============================================
-constructor TJclAbstractContainer.Create(ALockDelegate: IInterface);
+constructor TJclAbstractLockable.Create(const ALockDelegate: IInterface);
begin
inherited Create;
{$IFDEF THREADSAFE}
@@ -146,8 +279,7 @@
end;
{$IFDEF THREADSAFE}
-
-destructor TJclAbstractContainer.Destroy;
+destructor TJclAbstractLockable.Destroy;
begin
{$IFDEF CLR}
FReaderWriterLock.Free;
@@ -158,7 +290,7 @@
inherited Destroy;
end;
-procedure TJclAbstractContainer.ReadLock;
+procedure TJclAbstractLockable.ReadLock;
begin
if FLockDelegate <> nil then
FLockDelegate.ReadLock
@@ -172,7 +304,7 @@
{$ENDIF ~CLR}
end;
-procedure TJclAbstractContainer.ReadUnlock;
+procedure TJclAbstractLockable.ReadUnlock;
begin
if FLockDelegate <> nil then
FLockDelegate.ReadUnlock
@@ -186,7 +318,7 @@
{$ENDIF ~CLR}
end;
-procedure TJclAbstractContainer.WriteLock;
+procedure TJclAbstractLockable.WriteLock;
begin
if FLockDelegate <> nil then
FLockDelegate.WriteLock
@@ -204,7 +336,7 @@
{$ENDIF ~CLR}
end;
-procedure TJclAbstractContainer.WriteUnlock;
+procedure TJclAbstractLockable.WriteUnlock;
begin
if FLockDelegate <> nil then
FLockDelegate.WriteUnlock
@@ -221,12 +353,491 @@
FCriticalSection.Release;
{$ENDIF ~CLR}
end;
-
{$ENDIF THREADSAFE}
+//=== { TJclAbstractContainer } ==============================================
+
+constructor TJclAbstractContainer.Create(const ALockDelegate: IInterface);
+begin
+ inherited Create(ALockDelegate);
+
+ FAllowDefaultElements := True;
+ FDuplicates := dupAccept;
+ FRemoveSingleElement := True;
+ FReturnDefaultElements := True;
+ FAutoGrowStrategy := agsProportional;
+ FAutoGrowParameter := 4;
+ FAutoPackStrategy := apsDisabled;
+ FAutoPackParameter := 4;
+end;
+
+procedure TJclAbstractContainer.AssignDataTo(Dest: TJclAbstractContainer);
+begin
+ // override to customize
+end;
+
+procedure TJclAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainer);
+begin
+ // override to customize
+ Dest.SetAllowDefaultElements(GetAllowDefaultElements);
+ Dest.SetDuplicates(GetDuplicates);
+ Dest.SetRemoveSingleElement(GetRemoveSingleElement);
+ Dest.SetReturnDefaultElements(GetReturnDefaultElements);
+ Dest.SetAutoGrowParameter(GetAutoGrowParameter);
+ Dest.SetAutoGrowStrategy(GetAutoGrowStrategy);
+ Dest.SetAutoPackParameter(GetAutoPackParameter);
+ Dest.SetAutoPackStrategy(GetAutoPackStrategy);
+end;
+
+procedure TJclAbstractContainer.AssignTo(Dest: TPersistent);
+begin
+ if Dest is TJclAbstractContainer then
+ begin
+ AssignPropertiesTo(TJclAbstractContainer(Dest));
+ AssignDataTo(TJclAbstractContainer(Dest));
+ end
+ else
+ inherited AssignTo(Dest);
+end;
+
+procedure TJclAbstractContainer.AutoGrow;
+begin
+ case FAutoGrowStrategy of
+ agsDisabled: ;
+ agsAgressive:
+ SetCapacity(FCapacity + 1);
+ agsProportional:
+ SetCapacity(FCapacity + FCapacity div FAutoGrowParameter);
+ agsIncremental:
+ SetCapacity(FCapacity + FAutoGrowParameter);
+ end;
+end;
+
+procedure TJclAbstractContainer.AutoPack;
+var
+ Decrement: Integer;
+begin
+ case FAutoPackStrategy of
+ apsDisabled:
+ Decrement := 0;
+ apsAgressive:
+ Decrement := 1;
+ apsProportional:
+ Decrement := FCapacity div FAutoPackParameter;
+ apsIncremental:
+ Decrement := FAutoPackParameter;
+ else
+ Decrement := 0;
+ end;
+ if (Decrement > 0) and ((FSize + Decrement) <= FCapacity) then
+ SetCapacity(FSize);
+end;
+
+function TJclAbstractContainer.CheckDuplicate: Boolean;
+begin
+ case FDuplicates of
+ dupIgnore:
+ Result := False;
+ dupAccept:
+ Result := True;
+ //dupError: ;
+ else
+ raise EJclDuplicateElementError.Create;
+ end;
+end;
+
+function TJclAbstractContainer.Clone: TObject;
+var
+ NewContainer: TJclAbstractContainer;
+begin
+ {$IFDEF THREADSAFE}
+ ReadLock;
+ try
+ {$ENDIF THREADSAFE}
+ NewContainer := CreateEmptyContainer;
+ AssignDataTo(NewContainer);
+ Result := NewContainer;
+ {$IFDEF THREADSAFE}
+ finally
+ ReadUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function TJclAbstractContainer.GetAllowDefaultElements: Boolean;
+begin
+ Result := FAllowDefaultElements;
+end;
+
+function TJclAbstractContainer.GetAutoGrowParameter: Integer;
+begin
+ Result := FAutoGrowParameter;
+end;
+
+function TJclAbstractContainer.GetAutoGrowStrategy: TJclAutoGrowStrategy;
+begin
+ Result := FAutoGrowStrategy;
+end;
+
+function TJclAbstractContainer.GetAutoPackParameter: Integer;
+begin
+ Result := FAutoPackParameter;
+end;
+
+function TJclAbstractContainer.GetAutoPackStrategy: TJclAutoPackStrategy;
+begin
+ Result := FAutoPackStrategy;
+end;
+
+function TJclAbstractContainer.GetCapacity: Integer;
+begin
+ Result := FCapacity;
+end;
+
+function TJclAbstractContainer.GetDuplicates: TDuplicates;
+begin
+ Result := FDuplicates;
+end;
+
+function TJclAbstractContainer.GetRemoveSingleElement: Boolean;
+begin
+ Result := FRemoveSingleElement;
+end;
+
+function TJclAbstractContainer.GetReturnDefaultElements: Boolean;
+begin
+ Result := FReturnDefaultElements;
+end;
+
+procedure TJclAbstractContainer.Grow;
+begin
+ // override to customize
+ AutoGrow;
+end;
+
+function TJclAbstractContainer.IntfClone: IInterface;
+var
+ NewContainer: TJclAbstractContainer;
+begin
+ {$IFDEF THREADSAFE}
+ ReadLock;
+ try
+ {$ENDIF THREADSAFE}
+ NewContainer := CreateEmptyContainer;
+ AssignDataTo(NewContainer);
+ Result := NewContainer;
+ {$IFDEF THREADSAFE}
+ finally
+ ReadUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+procedure TJclAbstractContainer.Pack;
+begin
+ // override to customize
+ SetCapacity(FSize);
+end;
+
+procedure TJclAbstractContainer.SetAllowDefaultElements(Value: Boolean);
+begin
+ FAllowDefaultElements := Value;
+end;
+
+procedure TJclAbstractContainer.SetAutoGrowParameter(Value: Integer);
+begin
+ FAutoGrowParameter := Value;
+end;
+
+procedure TJclAbstractContainer.SetAutoGrowStrategy(Value: TJclAutoGrowStrategy);
+begin
+ FAutoGrowStrategy := Value;
+end;
+
+procedure TJclAbstractContainer.SetAutoPackParameter(Value: Integer);
+begin
+ FAutoPackParameter := Value;
+end;
+
+procedure TJclAbstractContainer.SetAutoPackStrategy(Value: TJclAutoPackStrategy);
+begin
+ FAutoPackStrategy := Value;
+end;
+
+procedure TJclAbstractContainer.SetCapacity(Value: Integer);
+begin
+ FCapacity := Value;
+end;
+
+procedure TJclAbstractContainer.SetDuplicates(Value: TDuplicates);
+begin
+ FDuplicates := Value;
+end;
+
+procedure TJclAbstractContainer.SetRemoveSingleElement(Value: Boolean);
+begin
+ FRemoveSingleElement := Value;
+end;
+
+procedure TJclAbstractContainer.SetReturnDefaultElements(Value: Boolean);
+begin
+ FReturnDefaultElements := Value;
+end;
+
+//=== { TJclAbstractIterator } ===============================================
+
+constructor TJclAbstractIterator.Create(const ALockDelegate: IInterface; AValid: Boolean);
+begin
+ inherited Create(ALockDelegate);
+ FValid := AValid;
+end;
+
+procedure TJclAbstractIterator.AssignPropertiesTo(Dest: TJclAbstractIterator);
+begin
+ Dest.FValid := FValid;
+end;
+
+procedure TJclAbstractIterator.AssignTo(Dest: TPersistent);
+begin
+ if Dest is TJclAbstractIterator then
+ AssignPropertiesTo(TJclAbstractIterator(Dest))
+ else
+ inherited AssignTo(Dest);
+end;
+
+procedure TJclAbstractIterator.CheckValid;
+begin
+ if not Valid then
+ raise EJclIllegalStateOperationError.Create;
+end;
+
+function TJclAbstractIterator.Clone: TObject;
+begin
+ {$IFDEF THREADSAFE}
+ ReadLock;
+ try
+ {$ENDIF THREADSAFE}
+ Result := CreateEmptyIterator;
+ {$IFDEF THREADSAFE}
+ finally
+ ReadUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function TJclAbstractIterator.IntfClone: IInterface;
+begin
+ {$IFDEF THREADSAFE}
+ ReadLock;
+ try
+ {$ENDIF THREADSAFE}
+ Result := CreateEmptyIterator;
+ {$IFDEF THREADSAFE}
+ finally
+ ReadUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+//=== { TJclIntfContainer } ==================================================
+
+function TJclIntfContainer.FreeObject(var AInterface: IInterface): IInterface;
+begin
+ Result := AInterface;
+ AInterface := nil;
+end;
+
+function TJclIntfContainer.ItemsCompare(const A, B: IInterface): Integer;
+begin
+ if Integer(A) > Integer(B) then
+ Result := 1
+ else
+ if Integer(A) < Integer(B) then
+ Result := -1
+ else
+ Result := 0;
+end;
+
+function TJclIntfContainer.ItemsEqual(const A, B: IInterface): Boolean;
+begin
+ Result := Integer(A) = Integer(B);
+end;
+
+//=== { TJclStrContainer } ===================================================
+
+function TJclStrContainer.Hash(const AString: string): Integer;
+var
+ I: Integer;
+begin
+ Result := 0;
+ case FEncoding of
+ seISO:
+ if FCaseSensitive then
+ for I := 1 to Length(AString) do
+ Inc(Result, Ord(AString[I]) * (I - 1) * 256)
+ else
+ for I := 1 to Length(AString) do
+ Inc(Result, Ord(UpCase(AString[I])) * (I - 1) * 256);
+ //seUTF8:
+ // Result := 0;
+ end;
+end;
+
+function TJclStrContainer.ItemsCompare(const A, B: string): Integer;
+begin
+ case FEncoding of
+ seISO:
+ if FCaseSensitive then
+ Result := CompareStr(A, B)
+ else
+ Result := CompareText(A, B);
+ //seUTF8:
+ // Result := 0;
+ else
+ Result := 0;
+ end;
+end;
+
+function TJclStrContainer.ItemsEqual(const A, B: string): Boolean;
+begin
+ case FEncoding of
+ seISO:
+ if FCaseSensitive then
+ Result := CompareStr(A, B) = 0
+ else
+ Result := CompareText(A, B) = 0;
+ //seUTF8:
+ // Result := 0;
+ else
+ Result := False;
+ end;
+end;
+
+procedure TJclStrContainer.AssignPropertiesTo(Dest: TJclAbstractContainer);
+var
+ ADest: TJclStrContainer;
+begin
+ inherited AssignPropertiesTo(Dest);
+ if Dest is TJclStrContainer then
+ begin
+ ADest := TJclStrContainer(Dest);
+ ADest.SetCaseSensitive(GetCaseSensitive);
+ ADest.SetEncoding(GetEncoding);
+ end;
+end;
+
+function TJclStrContainer.FreeString(var AString: string): string;
+begin
+ Result := AString;
+ AString := '';
+end;
+
+function TJclStrContainer.GetCaseSensitive: Boolean;
+begin
+ Result := FCaseSensitive;
+end;
+
+function TJclStrContainer.GetEncoding: TJclAnsiStrEncoding;
+begin
+ Result := FEncoding;
+end;
+
+procedure TJclStrContainer.SetCaseSensitive(Value: Boolean);
+begin
+ FCaseSensitive := Value;
+end;
+
+procedure TJclStrContainer.SetEncoding(Value: TJclAnsiStrEncoding);
+begin
+ FEncoding := Value;
+end;
+
+//=== { TJclContainer } ======================================================
+
+constructor TJclContainer.Create(const ALockDelegate: IInterface; AOwnsObjects: Boolean);
+begin
+ inherited Create(ALockDelegate);
+ FOwnsObjects := AOwnsObjects;
+end;
+
+function TJclContainer.FreeObject(var AObject: TObject): TObject;
+begin
+ if FOwnsObjects then
+ begin
+ Result := nil;
+ FreeAndNil(AObject);
+ end
+ else
+ begin
+ Result := AObject;
+ AObject := nil;
+ end;
+end;
+
+function TJclContainer.GetOwnsObjects: Boolean;
+begin
+ Result := FOwnsObjects;
+end;
+
+function TJclContainer.ItemsCompare(A, B: TObject): Integer;
+begin
+ if Integer(A) > Integer(B) then
+ Result := 1
+ else
+ if Integer(A) < Integer(B) then
+ Result := -1
+ else
+ Result := 0;
+end;
+
+function TJclContainer.ItemsEqual(A, B: TObject): Boolean;
+begin
+ Result := Integer(A) = Integer(B);
+end;
+
+{$IFDEF SUPPORTS_GENERICS}
+//=== { TJclContainer<T> } ===================================================
+
+constructor TJclContainer<T>.Create(const ALockDelegate: IInterface; AOwnsItems: Boolean);
+begin
+ inherited Create(ALockDelegate);
+ FOwnsItems := AOwnsItems;
+end;
+
+function TJclContainer<T>.FreeItem(var AItem: T): T;
+begin
+ if FOwnsItems then
+ begin
+ Result := Default(T);
+ FreeAndNil(AItem);
+ end
+ else
+ begin
+ Result := AItem;
+ AItem := Default(T);
+ end;
+end;
+
+function TJclContainer<T>.GetOwnsItems: Boolean;
+begin
+ Result := FOwnsItems;
+end;
+
+function TJclContainer<T>.ItemsCompare(const A, B: T): Integer;
+begin
+ raise EJclOperationNotSupportedError.Create;
+end;
+
+function TJclContainer<T>.ItemsEqual(const A, B: T): Boolean;
+begin
+ raise EJclOperationNotSupportedError.Create;
+end;
+
+{$ENDIF SUPPORTS_GENERICS}
+
//=== { TJclStrCollection } ==================================================
-procedure TJclStrCollection.AppendDelimited(const AString, Separator: string);
+procedure TJclStrAbstractCollection.AppendDelimited(const AString, Separator: string);
{$IFDEF CLR}
var
I, StartIndex: Integer;
@@ -274,7 +885,7 @@
end;
{$ENDIF CLR}
-procedure TJclStrCollection.AppendFromStrings(Strings: TStrings);
+procedure TJclStrAbstractCollection.AppendFromStrings(Strings: TStrings);
var
I: Integer;
begin
@@ -282,7 +893,7 @@
Add(Strings[I]);
end;
-procedure TJclStrCollection.AppendToStrings(Strings: TStrings);
+procedure TJclStrAbstractCollection.AppendToStrings(Strings: TStrings);
var
It: IJclStrIterator;
begin
@@ -296,7 +907,7 @@
end;
end;
-function TJclStrCollection.GetAsDelimited(const Separator: string): string;
+function TJclStrAbstractCollection.GetAsDelimited(const Separator: string): string;
var
It: IJclStrIterator;
begin
@@ -308,7 +919,7 @@
Result := Result + Separator + It.Next;
end;
-function TJclStrCollection.GetAsStrings: TStrings;
+function TJclStrAbstractCollection.GetAsStrings: TStrings;
begin
Result := TStringList.Create;
try
@@ -319,19 +930,19 @@
end;
end;
-procedure TJclStrCollection.LoadDelimited(const AString, Separator: string);
+procedure TJclStrAbstractCollection.LoadDelimited(const AString, Separator: string);
begin
Clear;
AppendDelimited(AString, Separator);
end;
-procedure TJclStrCollection.LoadFromStrings(Strings: TStrings);
+procedure TJclStrAbstractCollection.LoadFromStrings(Strings: TStrings);
begin
Clear;
AppendFromStrings(Strings);
end;
-procedure TJclStrCollection.SaveToStrings(Strings: TStrings);
+procedure TJclStrAbstractCollection.SaveToStrings(Strings: TStrings);
begin
Strings.Clear;
AppendToStrings(Strings);
Modified: trunk/jcl/source/common/JclAlgorithms.pas
===================================================================
--- trunk/jcl/source/common/JclAlgorithms.pas 2007-10-06 11:04:18 UTC (rev 2196)
+++ trunk/jcl/source/common/JclAlgorithms.pas 2007-10-15 11:18:28 UTC (rev 2197)
@@ -208,10 +208,7 @@
begin
for I := Count - 1 downto 0 do
if First.HasNext then
- begin
- First.SetObject(F(First.GetObject));
- First.Next;
- end
+ First.SetObject(F(First.Next))
else
Break;
end;
@@ -222,10 +219,7 @@
begin
for I := Count - 1 downto 0 do
if First.HasNext then
- begin
- First.SetString(F(First.GetString));
- First.Next;
- end
+ First.SetString(F(First.Next))
else
Break;
end;
@@ -236,10 +230,7 @@
begin
for I := Count - 1 downto 0 do
if First.HasNext then
- begin
- First.Next;
- First.SetObject(F(First.GetObject));
- end
+ First.SetObject(F(First.Next))
else
Break;
end;
@@ -253,12 +244,11 @@
for I := Count - 1 downto 0 do
if First.HasNext then
begin
- if AComparator(First.GetObject, AInterface) = 0 then
+ if AComparator(First.Next, AInterface) = 0 then
begin
Result := First;
Break;
end;
- First.Next;
end
else
Break;
@@ -273,12 +263,11 @@
for I := Count - 1 downto 0 do
if First.HasNext then
begin
- if AComparator(First.GetString, AString) = 0 then
+ if AComparator(First.Next, AString) = 0 then
begin
Result := First;
Break;
end;
- First.Next;
end
else
Break;
@@ -293,12 +282,11 @@
for I := Count - 1 downto 0 do
if First.HasNext then
begin
- if AComparator(First.GetObject, AObject) = 0 then
+ if AComparator(First.Next, AObject) = 0 then
begin
Result := First;
Break;
end;
- First.Next;
end
else
Break;
@@ -425,8 +413,8 @@
for I := Count - 1 downto 0 do
if First.HasNext then
begin
- First.SetObject(AInterface);
First.Next;
+ First.SetObject(AInterface);
end
else
Break;
@@ -440,8 +428,8 @@
for I := Count - 1 downto 0 do
if First.HasNext then
begin
- First.SetString(AString);
First.Next;
+ First.SetString(AString);
end
else
Break;
@@ -454,8 +442,8 @@
for I := Count - 1 downto 0 do
if First.HasNext then
begin
- First.SetObject(AObject);
First.Next;
+ First.SetObject(AObject);
end
else
Break;
@@ -471,11 +459,10 @@
Exit;
while First.NextIndex < Last.PreviousIndex do
begin
- Obj := First.GetObject;
+ Obj := First.Next;
Last.Previous;
First.SetObject(Last.GetObject);
Last.SetObject(Obj);
- First.Next;
end;
end;
@@ -489,11 +476,10 @@
Exit;
while First.NextIndex <= Last.PreviousIndex do
begin
- Obj := First.GetString;
+ Obj := First.Next;
Last.Previous;
First.SetString(Last.GetString);
Last.SetString(Obj);
- First.Next;
end;
end;
@@ -507,11 +493,10 @@
Exit;
while First.NextIndex <= Last.PreviousIndex do
begin
- Obj := First.GetObject;
+ Obj := First.Next;
Last.Previous;
First.SetObject(Last.GetObject);
Last.SetObject(Obj);
- First.Next;
end;
end;
@@ -642,10 +627,7 @@
begin
for I := Count - 1 downto 0 do
if First.HasNext then
- begin
- First.SetItem(F(First.GetItem));
- First.Next;
- end
+ First.SetItem(F(First.Next))
else
Break;
end;
@@ -659,12 +641,11 @@
for I := Count - 1 downto 0 do
if First.HasNext then
begin
- if AComparator(First.GetItem, AItem) = 0 then
+ if AComparator(First.Next, AItem) = 0 then
begin
Result := First;
Break;
end;
- First.Next;
end
else
Break;
@@ -714,8 +695,8 @@
for I := Count - 1 downto 0 do
if First.HasNext then
begin
- First.SetItem(AItem);
First.Next;
+ First.SetItem(AItem);
end
else
Break;
@@ -731,11 +712,10 @@
Exit;
while First.NextIndex <= Last.PreviousIndex do
begin
- Obj := First.GetItem;
+ Obj := First.Next;
Last.Previous;
First.SetItem(Last.GetItem);
Last.SetItem(Obj);
- First.Next;
end;
end;
Modified: trunk/jcl/source/common/JclArrayLists.pas
===================================================================
--- trunk/jcl/source/common/JclArrayLists.pas 2007-10-06 11:04:18 UTC (rev 2196)
+++ trunk/jcl/source/common/JclArrayLists.pas 2007-10-15 11:18:28 UTC (rev 2197)
@@ -42,6 +42,7 @@
interface
uses
+ Classes,
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
@@ -51,34 +52,22 @@
{$ENDIF CLR}
JclAlgorithms,
{$ENDIF SUPPORTS_GENERICS}
- Classes,
JclBase, JclAbstractContainers, JclContainerIntf;
-
type
- TJclIntfArrayList = class(TJclAbstractContainer, IJclIntfCollection, IJclIntfList, IJclIntfArray,
+ TJclIntfArrayList = class(TJclIntfContainer, IJclIntfCollection, IJclIntfList, IJclIntfArray, IJclContainer, IJclIntfEqualityComparer,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
private
- FCapacity: Integer;
FElementData: JclBase.TDynIInterfaceArray;
- FSize: Integer;
protected
+ procedure AssignDataTo(Dest: TJclAbstractContainer); override;
{ IJclPackable }
- procedure Pack;
- function GetCapacity: Integer;
- procedure SetCapacity(Value: Integer);
- { IJclGrowable }
- procedure Grow; overload; virtual;
- procedure Grow(Increment: Integer); overload;
- procedure Grow(Num, Denom: Integer); overload;
+ procedure SetCapacity(Value: Integer); override;
{ IJclIntfCloneable }
- function IntfClone: IInterface;
function IJclIntfCloneable.Clone = IntfClone;
- { IJclCloneable }
- function Clone: TObject;
{ IJclIntfCollection }
- function Add(const AInterface: IInterface): Boolean; overload;
- function AddAll(const ACollection: IJclIntfCollection): Boolean; overload;
+ function Add(const AInterface: IInterface): Boolean;
+ function AddAll(const ACollection: IJclIntfCollection): Boolean;
procedure Clear;
function Contains(const AInterface: IInterface): Boolean;
function ContainsAll(const ACollection: IJclIntfCollection): Boolean;
@@ -91,45 +80,35 @@
function RetainAll(const ACollection: IJclIntfCollection): Boolean;
function Size: Integer;
{ IJclIntfList }
- procedure Insert(Index: Integer; const AInterface: IInterface); overload;
- function InsertAll(Index: Integer; const ACollection: IJclIntfCollection): Boolean; overload;
+ function Insert(Index: Integer; const AInterface: IInterface): Boolean;
+ function InsertAll(Index: Integer; const ACollection: IJclIntfCollection): Boolean;
function GetObject(Index: Integer): IInterface;
function IndexOf(const AInterface: IInterface): Integer;
function LastIndexOf(const AInterface: IInterface): Integer;
function Remove(Index: Integer): IInterface; overload;
procedure SetObject(Index: Integer; const AInterface: IInterface);
function SubList(First, Count: Integer): IJclIntfList;
+ function CreateEmptyContainer: TJclAbstractContainer; override;
public
- constructor Create(ACapacity: Integer = DefaultContainerCapacity); overload;
+ constructor Create(ACapacity: Integer); overload;
constructor Create(const ACollection: IJclIntfCollection); overload;
destructor Destroy; override;
- property Capacity: Integer read FCapacity write SetCapacity;
end;
- TJclStrArrayList = class(TJclStrCollection, IJclStrCollection, IJclStrList, IJclStrArray,
+ TJclStrArrayList = class(TJclStrAbstractCollection, IJclStrCollection, IJclStrList, IJclStrArray, IJclContainer, IJclStrContainer, IJclStrFlatContainer, IJclStrEqualityComparer,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
private
- FCapacity: Integer;
FElementData: JclBase.TDynStringArray;
- FSize: Integer;
protected
+ procedure AssignDataTo(Dest: TJclAbstractContainer); override;
{ IJclPackable }
- procedure Pack;
- function GetCapacity: Integer;
- procedure SetCapacity(Value: Integer);
- { IJclGrowable }
- procedure Grow; overload; virtual;
- procedure Grow(Increment: Integer); overload;
- procedure Grow(Num, Denom: Integer); overload;
+ procedure SetCapacity(Value: Integer); override;
{ IJclIntfCloneable }
- function IntfClone: IInterface;
function IJclIntfCloneable.Clone = IntfClone;
- { IJclCloneable }
- function Clone: TObject;
{ IJclStrCollection }
- function Add(const AString: string): Boolean; overload; override;
- function AddAll(const ACollection: IJclStrCollection): Boolean; overload; override;
+ function Add(const AString: string): Boolean; override;
+ function AddAll(const ACollection: IJclStrCollection): Boolean; override;
procedure Clear; override;
function Contains(const AString: string): Boolean; override;
function ContainsAll(const ACollection: IJclStrCollection): Boolean; override;
@@ -142,46 +121,35 @@
function RetainAll(const ACollection: IJclStrCollection): Boolean; override;
function Size: Integer; override;
{ IJclStrList }
- procedure Insert(Index: Integer; const AString: string); overload;
- function InsertAll(Index: Integer; const ACollection: IJclStrCollection): Boolean; overload;
+ function Insert(Index: Integer; const AString: string): Boolean;
+ function InsertAll(Index: Integer; const ACollection: IJclStrCollection): Boolean;
function GetString(Index: Integer): string;
function IndexOf(const AString: string): Integer;
function LastIndexOf(const AString: string): Integer;
function Remove(Index: Integer): string; overload;
procedure SetString(Index: Integer; const AString: string);
function SubList(First, Count: Integer): IJclStrList;
+ function CreateEmptyContainer: TJclAbstractContainer; override;
public
- constructor Create(ACapacity: Integer = DefaultContainerCapacity); overload;
+ constructor Create(ACapacity: Integer); overload;
constructor Create(const ACollection: IJclStrCollection); overload;
destructor Destroy; override;
- property Capacity: Integer read FCapacity write SetCapacity;
end;
- TJclArrayList = class(TJclAbstractContainer, IJclCollection, IJclList, IJclArray,
+ TJclArrayList = class(TJclContainer, IJclCollection, IJclList, IJclArray, IJclContainer, IJclObjectOwner, IJclEqualityComparer,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
private
- FCapacity: Integer;
FElementData: JclBase.TDynObjectArray;
- FSize: Integer;
- FOwnsObjects: Boolean;
protected
+ procedure AssignDataTo(Dest: TJclAbstractContainer); override;
{ IJclPackable }
- procedure Pack;
- function GetCapacity: Integer;
- procedure SetCapacity(Value: Integer);
- { IJclGrowable }
- procedure Grow; overload; virtual;
- procedure Grow(Increment: Integer); overload;
- procedure Grow(Num, Denom: Integer); overload;
+ procedure SetCapacity(Value: Integer); override;
{ IJclIntfCloneable }
- function IntfClone: IInterface;
function IJclIntfCloneable.Clone = IntfClone;
- { IJclCloneable }
- function Clone: TObject;
{ IJclCollection }
- function Add(AObject: TObject): Boolean; overload;
- function AddAll(const ACollection: IJclCollection): Boolean; overload;
+ function Add(AObject: TObject): Boolean;
+ function AddAll(const ACollection: IJclCollection): Boolean;
procedure Clear;
function Contains(AObject: TObject): Boolean;
function ContainsAll(const ACollection: IJclCollection): Boolean;
@@ -194,50 +162,36 @@
function RetainAll(const ACollection: IJclCollection): Boolean;
function Size: Integer;
{ IJclList }
- procedure Insert(Index: Integer; AObject: TObject); overload;
- function InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; overload;
+ function Insert(Index: Integer; AObject: TObject): Boolean;
+ function InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean;
function GetObject(Index: Integer): TObject;
function IndexOf(AObject: TObject): Integer;
function LastIndexOf(AObject: TObject): Integer;
function Remove(Index: Integer): TObject; overload;
procedure SetObject(Index: Integer; AObject: TObject);
function SubList(First, Count: Integer): IJclList;
- procedure FreeObject(var AObject: TObject);
+ function CreateEmptyContainer: TJclAbstractContainer; override;
public
- constructor Create(ACapacity: Integer = DefaultContainerCapacity; AOwnsObjects: Boolean = True); overload;
- constructor Create(const ACollection: IJclCollection; AOwnsObjects: Boolean = True); overload;
+ constructor Create(ACapacity: Integer; AOwnsObjects: Boolean); overload;
+ constructor Create(const ACollection: IJclCollection; AOwnsObjects: Boolean); overload;
destructor Destroy; override;
- property Capacity: Integer read FCapacity write SetCapacity;
- property OwnsObjects: Boolean read FOwnsObjects;
end;
{$IFDEF SUPPORTS_GENERICS}
-
- TJclArrayList<T> = class(TJclAbstractContainer, IJclCollection<T>, IJclList<T>, IJclArray<T>,
+ TJclArrayList<T> = class(TJclContainer<T>, IJclCollection<T>, IJclList<T>, IJclArray<T>, IJclContainer, IJclItemOwner<T>, IJclEqualityComparer<T>,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
private
- FCapacity: Integer;
FElementData: TJclBase<T>.TDynArray;
- FSize: Integer;
- FOwnsItems: Boolean;
protected
+ procedure AssignDataTo(Dest: TJclAbstractContainer); override;
{ IJclPackable }
- procedure Pack;
- function GetCapacity: Integer;
- procedure SetCapacity(Value: Integer);
- { IJclGrowable }
- procedure Grow; overload; virtual;
- procedure Grow(Increment: Integer); overload;
- procedure Grow(Num, Denom: Integer); overload;
+ procedure SetCapacity(Value: Integer); override;
{ IJclIntfCloneable }
- function IntfClone: IInterface;
function IJclIntfCloneable.Clone = IntfClone;
- { IJclCloneable }
- function Clone: TObject;
{ IJclCollection<T> }
- function Add(const AItem: T): Boolean; overload;
- function AddAll(const ACollection: IJclCollection<T>): Boolean; overload;
+ function Add(const AItem: T): Boolean;
+ function AddAll(const ACollection: IJclCollection<T>): Boolean;
procedure Clear;
function Contains(const AItem: T): Boolean;
function ContainsAll(const ACollection: IJclCollection<T>): Boolean;
@@ -250,74 +204,63 @@
function RetainAll(const ACollection: IJclCollection<T>): Boolean;
function Size: Integer;
{ IJclList<T> }
- procedure Insert(Index: Integer; const AItem: T); overload;
- function InsertAll(Index: Integer; const ACollection: IJclCollection<T>): Boolean; overload;
+ function Insert(Index: Integer; const AItem: T): Boolean;
+ function InsertAll(Index: Integer; const ACollection: IJclCollection<T>): Boolean;
function GetItem(Index: Integer): T;
function IndexOf(const AItem: T): Integer;
function LastIndexOf(const AItem: T): Integer;
function Remove(Index: Integer): T; overload;
procedure SetItem(Index: Integer; const AItem: T);
function SubList(First, Count: Integer): IJclList<T>;
- function ItemsEqual(const A, B: T): Boolean; virtual; abstract;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; overload; virtual; abstract;
- function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; overload; virtual; abstract;
- procedure FreeItem(var AItem: T);
public
- constructor Create(ACapacity: Integer = DefaultContainerCapacity; AOwnsItems: Boolean = True); overload;
- constructor Create(const ACollection: IJclCollection<T>; AOwnsItems: Boolean = True); overload;
+ constructor Create(ACapacity: Integer; AOwnsItems: Boolean); overload;
+ constructor Create(const ACollection: IJclCollection<T>; AOwnsItems: Boolean); overload;
destructor Destroy; override;
- property Capacity: Integer read FCapacity write SetCapacity;
- property OwnsItems: Boolean read FOwnsItems;
end;
// E = External helper to compare items for equality
// GetHashCode is not used
- TJclArrayListE<T> = class(TJclArrayList<T>, IJclCollection<T>, IJclList<T>, IJclArray<T>,
+ TJclArrayListE<T> = class(TJclArrayList<T>, IJclCollection<T>, IJclList<T>, IJclArray<T>, IJclContainer, IJclItemOwner<T>, IJclEqualityComparer<T>,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
private
FEqualityComparer: IEqualityComparer<T>;
protected
+ procedure AssignPropertiesTo(Dest: TJclAbstractContainer); override;
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; override;
- function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; override;
+ function CreateEmptyContainer: TJclAbstractContainer; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
public
- constructor Create(const AEqualityComparer: IEqualityComparer<T>; ACapacity: Integer = DefaultContainerCapacity;
- AOwnsItems: Boolean = True); overload;
- constructor Create(const AEqualityComparer: IEqualityComparer<T>; const ACollection: IJclCollection<T>;
- AOwnsItems: Boolean = True); overload;
+ constructor Create(const AEqualityComparer: IEqualityComparer<T>; ACapacity: Integer; AOwnsItems: Boolean); overload;
+ constructor Create(const AEqualityComparer: IEqualityComparer<T>; const ACollection: IJclCollection<T>; AOwnsItems: Boolean); overload;
property EqualityComparer: IEqualityComparer<T> read FEqualityComparer write FEqualityComparer;
end;
// F = Function to compare items for equality
- TJclArrayListF<T> = class(TJclArrayList<T>, IJclCollection<T>, IJclList<T>, IJclArray<T>,
+ TJclArrayListF<T> = class(TJclArrayList<T>, IJclCollection<T>, IJclList<T>, IJclArray<T>, IJclContainer, IJclItemOwner<T>, IJclEqualityComparer<T>,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
private
FEqualityCompare: TEqualityCompare<T>;
protected
+ procedure AssignPropertiesTo(Dest: TJclAbstractContainer); override;
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; override;
- function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; override;
+ function CreateEmptyContainer: TJclAbstractContainer; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
public
- constructor Create(const AEqualityCompare: TEqualityCompare<T>; ACapacity: Integer = DefaultContainerCapacity;
- AOwnsItems: Boolean = True); overload;
- constructor Create(const AEqualityCompare: TEqualityCompare<T>; const ACollection: IJclCollection<T>;
- AOwnsItems: Boolean = True); overload;
+ constructor Create(const AEqualityCompare: TEqualityCompare<T>; ACapacity: Integer; AOwnsItems: Boolean); overload;
+ constructor Create(const AEqualityCompare: TEqualityCompare<T>; const ACollection: IJclCollection<T>; AOwnsItems: Boolean); overload;
property EqualityCompare: TEqualityCompare<T> read FEqualityCompare write FEqualityCompare;
end;
// I = Items can compare themselves to others
- TJclArrayListI<T: IEquatable<T>> = class(TJclArrayList<T>, IJclCollection<T>, IJclList<T>, IJclArray<T>,
+ TJclArrayListI<T: IEquatable<T>> = class(TJclArrayList<T>, IJclCollection<T>, IJclList<T>, IJclArray<T>, IJclContainer, IJclItemOwner<T>, IJclEqualityComparer<T>,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
protected
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; override;
- function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; override;
+ function CreateEmptyContainer: TJclAbstractContainer; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
end;
@@ -349,17 +292,16 @@
FCursor: Integer;
FOwnList: IJclIntfList;
protected
- { IJclCloneable }
- function Clone: TObject;
+ procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override;
+ function CreateEmptyIterator: TJclAbstractIterator; override;
{ IJclIntfCloneable }
- function IntfClone: IInterface;
function IJclIntfCloneable.Clone = IntfClone;
{ IJclIntfIterator }
- procedure Add(const AInterface: IInterface);
+ function Add(const AInterface: IInterface): Boolean;
function GetObject: IInterface;
function HasNext: Boolean;
function HasPrevious: Boolean;
- procedure Insert(const AInterface: IInterface);
+ function Insert(const AInterface: IInterface): Boolean;
function Next: IInterface;
function NextIndex: Integer;
function Previous: IInterface;
@@ -372,25 +314,37 @@
constructor TIntfItr.Create(const AOwnList: IJclIntfList; ACursor: Integer; AValid: Boolean);
begin
- inherited Create(AOwnList);
+ inherited Create(AOwnList, AValid);
FOwnList := AOwnList;
FCursor := ACursor;
- Valid := AValid;
end;
-procedure TIntfItr.Add(const AInterface: IInterface);
+function TIntfItr.Add(const AInterface: IInterface): Boolean;
begin
- FOwnList.Add(AInterface);
+ Result := FOwnList.Add(AInterface);
end;
-function TIntfItr.Clone: TObject;
+procedure TIntfItr.AssignPropertiesTo(Dest: TJclAbstractIterator);
+var
+ ADest: TIntfItr;
begin
+ inherited AssignPropertiesTo(Dest);
+ if Dest is TIntfItr then
+ begin
+ ADest := TIntfItr(Dest);
+ ADest.FOwnList := FOwnList;
+ ADest.FCursor := FCursor;
+ end;
+end;
+
+function TIntfItr.CreateEmptyIterator: TJclAbstractIterator;
+begin
Result := TIntfItr.Create(FOwnList, FCursor, Valid);
end;
function TIntfItr.GetObject: IInterface;
begin
- Valid := True;
+ CheckValid;
Result := FOwnList.GetObject(FCursor);
end;
@@ -410,17 +364,12 @@
Result := FCursor >= 0;
end;
-procedure TIntfItr.Insert(const AInterface: IInterface);
+function TIntfItr.Insert(const AInterface: IInterface): Boolean;
begin
- Valid := True;
- FOwnList.Insert(FCursor, AInterface);
+ CheckValid;
+ Result := FOwnList.Insert(FCursor, AInterface);
end;
-function TIntfItr.IntfClone: IInterface;
-begin
- Result := TIntfItr.Create(FOwnList, FCursor, Valid);
-end;
-
function TIntfItr.Next: IInterface;
begin
if Valid then
@@ -457,13 +406,14 @@
procedure TIntfItr.Remove;
begin
+ CheckValid;
Valid := False;
FOwnList.Remove(FCursor);
end;
procedure TIntfItr.SetObject(const AInterface: IInterface);
begin
- Valid := True;
+ CheckValid;
FOwnList.SetObject(FCursor, AInterface);
end;
@@ -476,17 +426,16 @@
FCursor: Integer;
FOwnList: IJclStrList;
protected
- { IJclCloneable }
- function Clone: TObject;
+ procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override;
+ function CreateEmptyIterator: TJclAbstractIterator; override;
{ IJclIntfCloneable }
- function IntfClone: IInterface;
function IJclIntfCloneable.Clone = IntfClone;
{ IJclStrIterator }
- procedure Add(const AString: string);
+ function Add(const AString: string): Boolean;
function Ge...
[truncated message content] |
|
From: <usc...@us...> - 2007-10-06 11:04:26
|
Revision: 2196
http://jcl.svn.sourceforge.net/jcl/?rev=2196&view=rev
Author: uschuster
Date: 2007-10-06 04:04:18 -0700 (Sat, 06 Oct 2007)
Log Message:
-----------
now it does work for all cases of the map file extension
Modified Paths:
--------------
trunk/jcl/experts/debug/tools/MakeJclDbg.dpr
Modified: trunk/jcl/experts/debug/tools/MakeJclDbg.dpr
===================================================================
--- trunk/jcl/experts/debug/tools/MakeJclDbg.dpr 2007-10-03 22:49:46 UTC (rev 2195)
+++ trunk/jcl/experts/debug/tools/MakeJclDbg.dpr 2007-10-06 11:04:18 UTC (rev 2196)
@@ -92,7 +92,7 @@
for I := 0 to FilesList.Count - 1 do
begin
FileName := FilesList[I];
- if ExtractFileExt(FileName) <> '.map' then
+ if not AnsiSameText(ExtractFileExt(FileName), '.map') then
Continue;
Write(#13#10, FilesList[I]);
Result := False;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2007-10-03 22:49:53
|
Revision: 2195
http://jcl.svn.sourceforge.net/jcl/?rev=2195&view=rev
Author: ahuser
Date: 2007-10-03 15:49:46 -0700 (Wed, 03 Oct 2007)
Log Message:
-----------
Version 1.102
Modified Paths:
--------------
trunk/thirdparty/InnoSetup/Install.iss
Modified: trunk/thirdparty/InnoSetup/Install.iss
===================================================================
--- trunk/thirdparty/InnoSetup/Install.iss 2007-10-02 14:08:12 UTC (rev 2194)
+++ trunk/thirdparty/InnoSetup/Install.iss 2007-10-03 22:49:46 UTC (rev 2195)
@@ -7,12 +7,12 @@
; Include_DelphiX Include the binaries for Delphi X (X in 5..11)
; Include_BCBX Include the binaries for C++Builder X (X in 5..6)
-#define JclVersionStr "1.101.0.2647"
+#define JclVersionStr "1.102.0.2726"
#define MyAppName "Jedi Code Library"
#define MyAppVerName "Jedi Code Library " + JclVersionStr
#define MyAppPublisher "JCL Team"
#define MyAppURL "http://jcl.sourceforge.net/"
-#define downloadurl "http://jvcl.sourceforge.net/websetup/jcl"
+#define downloadurl "http://jcl.sourceforge.net/websetup/jcl"
#define Include_Binaries
#define Include_Examples
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-10-02 14:08:13
|
Revision: 2194
http://jcl.svn.sourceforge.net/jcl/?rev=2194&view=rev
Author: outchy
Date: 2007-10-02 07:08:12 -0700 (Tue, 02 Oct 2007)
Log Message:
-----------
RAD Studio 2007 compatibility
Modified Paths:
--------------
trunk/jcl/source/common/JclArrayLists.pas
trunk/jcl/source/common/JclArraySets.pas
trunk/jcl/source/prototypes/JclArrayLists.pas
Modified: trunk/jcl/source/common/JclArrayLists.pas
===================================================================
--- trunk/jcl/source/common/JclArrayLists.pas 2007-10-02 14:05:34 UTC (rev 2193)
+++ trunk/jcl/source/common/JclArrayLists.pas 2007-10-02 14:08:12 UTC (rev 2194)
@@ -259,8 +259,8 @@
procedure SetItem(Index: Integer; const AItem: T);
function SubList(First, Count: Integer): IJclList<T>;
function ItemsEqual(const A, B: T): Boolean; virtual; abstract;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; overload; virtual; abstract;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; overload; virtual; abstract;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; overload; virtual; abstract;
+ function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; overload; virtual; abstract;
procedure FreeItem(var AItem: T);
public
constructor Create(ACapacity: Integer = DefaultContainerCapacity; AOwnsItems: Boolean = True); overload;
@@ -278,8 +278,8 @@
FEqualityComparer: IEqualityComparer<T>;
protected
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
public
@@ -298,8 +298,8 @@
FEqualityCompare: TEqualityCompare<T>;
protected
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
public
@@ -316,8 +316,8 @@
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
protected
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
end;
@@ -3050,14 +3050,14 @@
FEqualityComparer := AEqualityComparer;
end;
-function TJclArrayListE<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+function TJclArrayListE<T>.CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListE<T>.Create(EqualityComparer, ACapacity, False);
+ Result := TJclArrayListE<T>.Create(EqualityComparer, ACapacity, AOwnsItems);
end;
-function TJclArrayListE<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+function TJclArrayListE<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListE<T>.Create(EqualityComparer, ACollection, False);
+ Result := TJclArrayListE<T>.Create(EqualityComparer, ACollection, AOwnsItems);
end;
function TJclArrayListE<T>.ItemsEqual(const A, B: T): Boolean;
@@ -3083,14 +3083,14 @@
FEqualityCompare := AEqualityCompare;
end;
-function TJclArrayListF<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+function TJclArrayListF<T>.CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListF<T>.Create(EqualityCompare, ACapacity, False);
+ Result := TJclArrayListF<T>.Create(EqualityCompare, ACapacity, AOwnsItems);
end;
-function TJclArrayListF<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+function TJclArrayListF<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListF<T>.Create(EqualityCompare, ACollection, False);
+ Result := TJclArrayListF<T>.Create(EqualityCompare, ACollection, AOwnsItems);
end;
function TJclArrayListF<T>.ItemsEqual(const A, B: T): Boolean;
@@ -3107,14 +3107,14 @@
Result := A.Equals(B);
end;
-function TJclArrayListI<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+function TJclArrayListI<T>.CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListI<T>.Create(ACapacity, False);
+ Result := TJclArrayListI<T>.Create(ACapacity, AOwnsItems);
end;
-function TJclArrayListI<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+function TJclArrayListI<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListI<T>.Create(ACollection, False);
+ Result := TJclArrayListI<T>.Create(ACollection, AOwnsItems);
end;
{$ENDIF SUPPORTS_GENERICS}
Modified: trunk/jcl/source/common/JclArraySets.pas
===================================================================
--- trunk/jcl/source/common/JclArraySets.pas 2007-10-02 14:05:34 UTC (rev 2193)
+++ trunk/jcl/source/common/JclArraySets.pas 2007-10-02 14:08:12 UTC (rev 2194)
@@ -146,7 +146,8 @@
protected
function CompareItems(const A, B: T): Integer; override;
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; overload; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; overload; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
public
@@ -166,7 +167,8 @@
protected
function CompareItems(const A, B: T): Integer; override;
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; overload; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; overload; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
public
@@ -185,7 +187,8 @@
protected
function CompareItems(const A, B: T): Integer; override;
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; overload; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; overload; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
end;
@@ -817,11 +820,16 @@
Result := Comparer.Compare(A, B);
end;
-function TJclArraySetE<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+function TJclArraySetE<T>.CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArraySetE<T>.Create(Comparer, ACapacity, False);
+ Result := TJclArraySetE<T>.Create(Comparer, ACapacity, AOwnsItems);
end;
+function TJclArraySetE<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>;
+begin
+ Result := TJclArraySetE<T>.Create(Comparer, ACollection, AOwnsItems);
+end;
+
function TJclArraySetE<T>.ItemsEqual(const A, B: T): Boolean;
begin
if Comparer = nil then
@@ -851,11 +859,16 @@
Result := Compare(A, B);
end;
-function TJclArraySetF<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+function TJclArraySetF<T>.CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArraySetF<T>.Create(Compare, ACapacity, False);
+ Result := TJclArraySetF<T>.Create(Compare, ACapacity, AOwnsItems);
end;
+function TJclArraySetF<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>;
+begin
+ Result := TJclArraySetF<T>.Create(Compare, ACollection, AOwnsItems);
+end;
+
function TJclArraySetF<T>.ItemsEqual(const A, B: T): Boolean;
begin
if not Assigned(Compare) then
@@ -870,11 +883,16 @@
Result := A.CompareTo(B);
end;
-function TJclArraySetI<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+function TJclArraySetI<T>.CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArraySetI<T>.Create(ACapacity, False);
+ Result := TJclArraySetI<T>.Create(ACapacity, AOwnsItems);
end;
+function TJclArraySetI<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>;
+begin
+ Result := TJclArraySetI<T>.Create(ACollection, AOwnsItems);
+end;
+
function TJclArraySetI<T>.ItemsEqual(const A, B: T): Boolean;
begin
Result := A.CompareTo(B) = 0;
Modified: trunk/jcl/source/prototypes/JclArrayLists.pas
===================================================================
--- trunk/jcl/source/prototypes/JclArrayLists.pas 2007-10-02 14:05:34 UTC (rev 2193)
+++ trunk/jcl/source/prototypes/JclArrayLists.pas 2007-10-02 14:08:12 UTC (rev 2194)
@@ -65,8 +65,8 @@
{$JPPEXPANDMACRO JCLARRAYLISTINT(TJclArrayList<T>,TJclAbstractContainer,IJclCollection<T>,IJclList<T>,IJclArray<T>,IJclIterator<T>,TJclBase<T>.TDynArray,,
FOwnsItems: Boolean;,
function ItemsEqual(const A, B: T): Boolean; virtual; abstract;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; overload; virtual; abstract;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; overload; virtual; abstract;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; overload; virtual; abstract;
+ function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; overload; virtual; abstract;
procedure FreeItem(var AItem: T);,
property OwnsItems: Boolean read FOwnsItems;,,; AOwnsItems: Boolean = True,const AItem: T,T,GetItem,SetItem)}
@@ -78,8 +78,8 @@
FEqualityComparer: IEqualityComparer<T>;
protected
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
public
@@ -98,8 +98,8 @@
FEqualityCompare: TEqualityCompare<T>;
protected
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
public
@@ -116,8 +116,8 @@
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
protected
function ItemsEqual(const A, B: T): Boolean; override;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
end;
@@ -218,14 +218,14 @@
FEqualityComparer := AEqualityComparer;
end;
-function TJclArrayListE<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+function TJclArrayListE<T>.CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListE<T>.Create(EqualityComparer, ACapacity, False);
+ Result := TJclArrayListE<T>.Create(EqualityComparer, ACapacity, AOwnsItems);
end;
-function TJclArrayListE<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+function TJclArrayListE<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListE<T>.Create(EqualityComparer, ACollection, False);
+ Result := TJclArrayListE<T>.Create(EqualityComparer, ACollection, AOwnsItems);
end;
function TJclArrayListE<T>.ItemsEqual(const A, B: T): Boolean;
@@ -251,14 +251,14 @@
FEqualityCompare := AEqualityCompare;
end;
-function TJclArrayListF<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+function TJclArrayListF<T>.CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListF<T>.Create(EqualityCompare, ACapacity, False);
+ Result := TJclArrayListF<T>.Create(EqualityCompare, ACapacity, AOwnsItems);
end;
-function TJclArrayListF<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+function TJclArrayListF<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListF<T>.Create(EqualityCompare, ACollection, False);
+ Result := TJclArrayListF<T>.Create(EqualityCompare, ACollection, AOwnsItems);
end;
function TJclArrayListF<T>.ItemsEqual(const A, B: T): Boolean;
@@ -275,14 +275,14 @@
Result := A.Equals(B);
end;
-function TJclArrayListI<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+function TJclArrayListI<T>.CreateEmptyArrayList(ACapacity: Integer; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListI<T>.Create(ACapacity, False);
+ Result := TJclArrayListI<T>.Create(ACapacity, AOwnsItems);
end;
-function TJclArrayListI<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+function TJclArrayListI<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>; AOwnsItems: Boolean): TJclArrayList<T>;
begin
- Result := TJclArrayListI<T>.Create(ACollection, False);
+ Result := TJclArrayListI<T>.Create(ACollection, AOwnsItems);
end;
{$ENDIF SUPPORTS_GENERICS}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-10-02 14:05:38
|
Revision: 2193
http://jcl.svn.sourceforge.net/jcl/?rev=2193&view=rev
Author: outchy
Date: 2007-10-02 07:05:34 -0700 (Tue, 02 Oct 2007)
Log Message:
-----------
jpp compiled with Kylix
Modified Paths:
--------------
trunk/jcl/devtools/jpp
Modified: trunk/jcl/devtools/jpp
===================================================================
(Binary files differ)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-10-02 13:34:41
|
Revision: 2192
http://jcl.svn.sourceforge.net/jcl/?rev=2192&view=rev
Author: outchy
Date: 2007-10-02 06:34:38 -0700 (Tue, 02 Oct 2007)
Log Message:
-----------
pascal preprocessor now supports macro
JclArrayLists.pas generated from templates source/prototypes/JclArrayLists.pas and source/prototypes/containers/JclArrayLists.imp
Modified Paths:
--------------
trunk/jcl/devtools/jpp.exe
trunk/jcl/source/common/JclArrayLists.pas
trunk/jcl/source/prototypes/Makefile.mak
trunk/jpp/JppLexer.pas
trunk/jpp/JppParser.pas
trunk/jpp/JppState.pas
trunk/jpp/jpp.dpr
Added Paths:
-----------
trunk/jcl/source/prototypes/JclArrayLists.pas
trunk/jcl/source/prototypes/containers/
trunk/jcl/source/prototypes/containers/JclArrayLists.imp
Modified: trunk/jcl/devtools/jpp.exe
===================================================================
(Binary files differ)
Modified: trunk/jcl/source/common/JclArrayLists.pas
===================================================================
--- trunk/jcl/source/common/JclArrayLists.pas 2007-09-28 17:20:16 UTC (rev 2191)
+++ trunk/jcl/source/common/JclArrayLists.pas 2007-10-02 13:34:38 UTC (rev 2192)
@@ -1,4 +1,8 @@
{**************************************************************************************************}
+{ WARNING: JEDI preprocessor generated unit. Do not edit. }
+{**************************************************************************************************}
+
+{**************************************************************************************************}
{ }
{ Project JEDI Code Library (JCL) }
{ }
@@ -51,12 +55,13 @@
JclBase, JclAbstractContainers, JclContainerIntf;
type
+
TJclIntfArrayList = class(TJclAbstractContainer, IJclIntfCollection, IJclIntfList, IJclIntfArray,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
private
- FElementData: TDynIInterfaceArray;
+ FCapacity: Integer;
+ FElementData: JclBase.TDynIInterfaceArray;
FSize: Integer;
- FCapacity: Integer;
protected
{ IJclPackable }
procedure Pack;
@@ -101,12 +106,12 @@
property Capacity: Integer read FCapacity write SetCapacity;
end;
- //Daniele Teti 02/03/2005
+
TJclStrArrayList = class(TJclStrCollection, IJclStrCollection, IJclStrList, IJclStrArray,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
private
FCapacity: Integer;
- FElementData: TDynStringArray;
+ FElementData: JclBase.TDynStringArray;
FSize: Integer;
protected
{ IJclPackable }
@@ -152,15 +157,15 @@
property Capacity: Integer read FCapacity write SetCapacity;
end;
+
TJclArrayList = class(TJclAbstractContainer, IJclCollection, IJclList, IJclArray,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
private
FCapacity: Integer;
- FElementData: TDynObjectArray;
+ FElementData: JclBase.TDynObjectArray;
+ FSize: Integer;
FOwnsObjects: Boolean;
- FSize: Integer;
protected
- procedure FreeObject(var AObject: TObject);
{ IJclPackable }
procedure Pack;
function GetCapacity: Integer;
@@ -197,6 +202,7 @@
function Remove(Index: Integer): TObject; overload;
procedure SetObject(Index: Integer; AObject: TObject);
function SubList(First, Count: Integer): IJclList;
+ procedure FreeObject(var AObject: TObject);
public
constructor Create(ACapacity: Integer = DefaultContainerCapacity; AOwnsObjects: Boolean = True); overload;
constructor Create(const ACollection: IJclCollection; AOwnsObjects: Boolean = True); overload;
@@ -207,6 +213,7 @@
{$IFDEF SUPPORTS_GENERICS}
+
TJclArrayList<T> = class(TJclAbstractContainer, IJclCollection<T>, IJclList<T>, IJclArray<T>,
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
private
@@ -215,10 +222,6 @@
FSize: Integer;
FOwnsItems: Boolean;
protected
- function ItemsEqual(const A, B: T): Boolean; virtual; abstract;
- function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; overload;
- function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; overload; virtual; abstract;
- procedure FreeItem(var AItem: T);
{ IJclPackable }
procedure Pack;
function GetCapacity: Integer;
@@ -242,12 +245,12 @@
function First: IJclIterator<T>;
function IsEmpty: Boolean;
function Last: IJclIterator<T>;
- function Remove(AItem: T): Boolean; overload;
+ function Remove(const AItem: T): Boolean; overload;
function RemoveAll(const ACollection: IJclCollection<T>): Boolean;
function RetainAll(const ACollection: IJclCollection<T>): Boolean;
function Size: Integer;
{ IJclList<T> }
- procedure Insert(Index: Integer; AItem: T); overload;
+ procedure Insert(Index: Integer; const AItem: T); overload;
function InsertAll(Index: Integer; const ACollection: IJclCollection<T>): Boolean; overload;
function GetItem(Index: Integer): T;
function IndexOf(const AItem: T): Integer;
@@ -255,6 +258,10 @@
function Remove(Index: Integer): T; overload;
procedure SetItem(Index: Integer; const AItem: T);
function SubList(First, Count: Integer): IJclList<T>;
+ function ItemsEqual(const A, B: T): Boolean; virtual; abstract;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; overload; virtual; abstract;
+ function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; overload; virtual; abstract;
+ procedure FreeItem(var AItem: T);
public
constructor Create(ACapacity: Integer = DefaultContainerCapacity; AOwnsItems: Boolean = True); overload;
constructor Create(const ACollection: IJclCollection<T>; AOwnsItems: Boolean = True); overload;
@@ -271,6 +278,7 @@
FEqualityComparer: IEqualityComparer<T>;
protected
function ItemsEqual(const A, B: T): Boolean; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
@@ -290,6 +298,7 @@
FEqualityCompare: TEqualityCompare<T>;
protected
function ItemsEqual(const A, B: T): Boolean; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
@@ -307,6 +316,7 @@
{$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
protected
function ItemsEqual(const A, B: T): Boolean; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
{ IJclIntfCloneable }
function IJclIntfCloneable.Clone = IntfClone;
@@ -329,8 +339,9 @@
uses
SysUtils;
-//=== { TIntfItr } ===========================================================
+//=== { TIntfItr } ===============================================================
+
type
TIntfItr = class(TJclAbstractIterator, IJclIntfIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
IJclIntfCloneable, IJclCloneable)
@@ -380,7 +391,7 @@
function TIntfItr.GetObject: IInterface;
begin
Valid := True;
- Result := FOwnList.GetObject(FCursor)
+ Result := FOwnList.GetObject(FCursor);
end;
function TIntfItr.HasNext: Boolean;
@@ -456,7 +467,7 @@
FOwnList.SetObject(FCursor, AInterface);
end;
-//=== { TStrItr } ============================================================
+//=== { TStrItr } ===============================================================
type
TStrItr = class(TJclAbstractIterator, IJclStrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
@@ -526,17 +537,17 @@
Result := FCursor >= 0;
end;
-function TStrItr.IntfClone: IInterface;
-begin
- Result := TStrItr.Create(FOwnList, FCursor, Valid);
-end;
-
procedure TStrItr.Insert(const AString: string);
begin
Valid := True;
FOwnList.Insert(FCursor, AString);
end;
+function TStrItr.IntfClone: IInterface;
+begin
+ Result := TStrItr.Create(FOwnList, FCursor, Valid);
+end;
+
function TStrItr.Next: string;
begin
if Valid then
@@ -653,17 +664,17 @@
Result := FCursor >= 0;
end;
-function TItr.IntfClone: IInterface;
-begin
- Result := TItr.Create(FOwnList, FCursor, Valid);
-end;
-
procedure TItr.Insert(AObject: TObject);
begin
Valid := True;
FOwnList.Insert(FCursor, AObject);
end;
+function TItr.IntfClone: IInterface;
+begin
+ Result := TItr.Create(FOwnList, FCursor, Valid);
+end;
+
function TItr.Next: TObject;
begin
if Valid then
@@ -782,17 +793,17 @@
Result := FCursor >= 0;
end;
-function TItr<T>.IntfClone: IInterface;
-begin
- Result := TItr<T>.Create(FOwnList, FCursor, Valid);
-end;
-
procedure TItr<T>.Insert(const AItem: T);
begin
Valid := True;
FOwnList.Insert(FCursor, AItem);
end;
+function TItr<T>.IntfClone: IInterface;
+begin
+ Result := TItr<T>.Create(FOwnList, FCursor, Valid);
+end;
+
function TItr<T>.Next: T;
begin
if Valid then
@@ -838,15 +849,16 @@
Valid := True;
FOwnList.SetItem(FCursor, AItem);
end;
-
{$ENDIF SUPPORTS_GENERICS}
-//=== { TJclIntfArrayList } ==================================================
+//=== { TJclIntfArrayList } ======================================================
+
constructor TJclIntfArrayList.Create(ACapacity: Integer);
begin
inherited Create(nil);
FSize := 0;
+
if ACapacity < 0 then
FCapacity := 0
else
@@ -958,7 +970,7 @@
{$ENDIF THREADSAFE}
Result := False;
for I := 0 to FSize - 1 do
- if FElementData[I] = AInterface then
+ if (FElementData[I] = AInterface) then
begin
Result := True;
Break;
@@ -1007,7 +1019,7 @@
Exit;
It := ACollection.First;
for I := 0 to FSize - 1 do
- if FElementData[I] <> It.Next then
+ if not (FElementData[I] = It.Next) then
Exit;
Result := True;
{$IFDEF THREADSAFE}
@@ -1084,7 +1096,7 @@
if Capacity = 0 then
Capacity := 64
else
- Grow(16);
+ Capacity := Capacity + 16;
{$IFDEF THREADSAFE}
finally
WriteUnlock;
@@ -1102,7 +1114,7 @@
{$ENDIF THREADSAFE}
Result := -1;
for I := 0 to FSize - 1 do
- if FElementData[I] = AInterface then
+ if (FElementData[I] = AInterface) then
begin
Result := I;
Break;
@@ -1125,7 +1137,7 @@
if FSize = Capacity then
Grow;
if FSize <> Index then
- MoveArray(FElementData, Index, Index + 1, FSize - Index);
+ JclBase.MoveArray(FElementData, Index, Index + 1, FSize - Index);
FElementData[Index] := AInterface;
Inc(FSize);
{$IFDEF THREADSAFE}
@@ -1152,7 +1164,7 @@
InsertionSize := ACollection.Size;
if (FSize + InsertionSize) >= Capacity then
Grow(InsertionSize);
- MoveArray(FElementData, Index, Index + InsertionSize, FSize - Index);
+ JclBase.MoveArray(FElementData, Index, Index + InsertionSize, FSize - Index);
Inc(FSize, InsertionSize);
It := ACollection.First;
Result := It.HasNext;
@@ -1202,7 +1214,7 @@
{$ENDIF THREADSAFE}
Result := -1;
for I := FSize - 1 downto 0 do
- if FElementData[I] = AInterface then
+ if (FElementData[I] = AInterface) then
begin
Result := I;
Break;
@@ -1238,11 +1250,11 @@
{$ENDIF THREADSAFE}
Result := False;
for I := FSize - 1 downto 0 do
- if FElementData[I] = AInterface then // Removes all AInterface
+ if (FElementData[I] = AInterface) then // Removes all AInterface
begin
- FElementData[I] := nil; // Force Release
+ FElementData[I] := nil;
if FSize <> I then
- MoveArray(FElementData, I + 1, I, FSize - I);
+ JclBase.MoveArray(FElementData, I + 1, I, FSize - I);
Dec(FSize);
Result := True;
end;
@@ -1264,7 +1276,7 @@
Result := FElementData[Index];
FElementData[Index] := nil;
if FSize <> Index then
- MoveArray(FElementData, Index + 1, Index, FSize - Index);
+ JclBase.MoveArray(FElementData, Index + 1, Index, FSize - Index);
Dec(FSize);
{$IFDEF THREADSAFE}
finally
@@ -1343,6 +1355,7 @@
{$ENDIF THREADSAFE}
if (Index < 0) or (Index >= FSize) then
raise EJclOutOfBoundsError.Create;
+ FElementData[Index] := nil;
FElementData[Index] := AInterface;
{$IFDEF THREADSAFE}
finally
@@ -1378,12 +1391,14 @@
{$ENDIF THREADSAFE}
end;
-//=== { TJclStrArrayList } ===================================================
+//=== { TJclStrArrayList } ======================================================
+
constructor TJclStrArrayList.Create(ACapacity: Integer);
begin
inherited Create(nil);
FSize := 0;
+
if ACapacity < 0 then
FCapacity := 0
else
@@ -1440,7 +1455,6 @@
while It.HasNext do
begin
// (rom) inlining Add() gives about 5 percent performance increase
- // without THREADSAFE and about 30 percent with THREADSAFE
if FSize = Capacity then
Grow;
FElementData[FSize] := It.Next;
@@ -1496,7 +1510,7 @@
{$ENDIF THREADSAFE}
Result := False;
for I := 0 to FSize - 1 do
- if FElementData[I] = AString then
+ if (FElementData[I] = AString) then
begin
Result := True;
Break;
@@ -1545,7 +1559,7 @@
Exit;
It := ACollection.First;
for I := 0 to FSize - 1 do
- if FElementData[I] <> It.Next then
+ if not (FElementData[I] = It.Next) then
Exit;
Result := True;
{$IFDEF THREADSAFE}
@@ -1640,7 +1654,7 @@
{$ENDIF THREADSAFE}
Result := -1;
for I := 0 to FSize - 1 do
- if FElementData[I] = AString then
+ if (FElementData[I] = AString) then
begin
Result := I;
Break;
@@ -1663,7 +1677,7 @@
if FSize = Capacity then
Grow;
if FSize <> Index then
- MoveArray(FElementData, Index, Index + 1, FSize - Index);
+ JclBase.MoveArray(FElementData, Index, Index + 1, FSize - Index);
FElementData[Index] := AString;
Inc(FSize);
{$IFDEF THREADSAFE}
@@ -1683,16 +1697,14 @@
try
{$ENDIF THREADSAFE}
Result := False;
-
if (Index < 0) or (Index > FSize) then
raise EJclOutOfBoundsError.Create;
-
if ACollection = nil then
Exit;
InsertionSize := ACollection.Size;
- if FSize + InsertionSize >= Capacity then
+ if (FSize + InsertionSize) >= Capacity then
Grow(InsertionSize);
- MoveArray(FElementData, Index, Index + InsertionSize, FSize - Index);
+ JclBase.MoveArray(FElementData, Index, Index + InsertionSize, FSize - Index);
Inc(FSize, InsertionSize);
It := ACollection.First;
Result := It.HasNext;
@@ -1742,7 +1754,7 @@
{$ENDIF THREADSAFE}
Result := -1;
for I := FSize - 1 downto 0 do
- if FElementData[I] = AString then
+ if (FElementData[I] = AString) then
begin
Result := I;
Break;
@@ -1778,11 +1790,11 @@
{$ENDIF THREADSAFE}
Result := False;
for I := FSize - 1 downto 0 do
- if FElementData[I] = AString then // Removes all AString
+ if (FElementData[I] = AString) then // Removes all AString
begin
- FElementData[I] := ''; // Force Release
+ FElementData[I] := '';
if FSize <> I then
- MoveArray(FElementData, I + 1, I, FSize - I);
+ JclBase.MoveArray(FElementData, I + 1, I, FSize - I);
Dec(FSize);
Result := True;
end;
@@ -1804,7 +1816,7 @@
Result := FElementData[Index];
FElementData[Index] := '';
if FSize <> Index then
- MoveArray(FElementData, Index + 1, Index, FSize - Index);
+ JclBase.MoveArray(FElementData, Index + 1, Index, FSize - Index);
Dec(FSize);
{$IFDEF THREADSAFE}
finally
@@ -1883,7 +1895,8 @@
{$ENDIF THREADSAFE}
if (Index < 0) or (Index >= FSize) then
raise EJclOutOfBoundsError.Create;
- FElementData[Index] := AString
+ FElementData[Index] := '';
+ FElementData[Index] := AString;
{$IFDEF THREADSAFE}
finally
WriteUnlock;
@@ -1918,6 +1931,7 @@
{$ENDIF THREADSAFE}
end;
+
//=== { TJclArrayList } ======================================================
constructor TJclArrayList.Create(ACapacity: Integer; AOwnsObjects: Boolean);
@@ -2018,7 +2032,7 @@
ReadLock;
try
{$ENDIF THREADSAFE}
- Result := TJclArrayList.Create(Self, False); // Only one can have FOwnsObject = True
+ Result := TJclArrayList.Create(Self, False); // Only one container can own objects
{$IFDEF THREADSAFE}
finally
ReadUnlock;
@@ -2036,7 +2050,7 @@
{$ENDIF THREADSAFE}
Result := False;
for I := 0 to FSize - 1 do
- if FElementData[I] = AObject then
+ if (FElementData[I] = AObject) then
begin
Result := True;
Break;
@@ -2085,7 +2099,7 @@
Exit;
It := ACollection.First;
for I := 0 to FSize - 1 do
- if FElementData[I] <> It.Next then
+ if not (FElementData[I] = It.Next) then
Exit;
Result := True;
{$IFDEF THREADSAFE}
@@ -2188,7 +2202,7 @@
{$ENDIF THREADSAFE}
Result := -1;
for I := 0 to FSize - 1 do
- if FElementData[I] = AObject then
+ if (FElementData[I] = AObject) then
begin
Result := I;
Break;
@@ -2211,7 +2225,7 @@
if FSize = Capacity then
Grow;
if FSize <> Index then
- MoveArray(FElementData, Index, Index + 1, FSize - Index);
+ JclBase.MoveArray(FElementData, Index, Index + 1, FSize - Index);
FElementData[Index] := AObject;
Inc(FSize);
{$IFDEF THREADSAFE}
@@ -2236,9 +2250,9 @@
if ACollection = nil then
Exit;
InsertionSize := ACollection.Size;
- if FSize + InsertionSize >= Capacity then
+ if (FSize + InsertionSize) >= Capacity then
Grow(InsertionSize);
- MoveArray(FElementData, Index, Index + InsertionSize, FSize - Index);
+ JclBase.MoveArray(FElementData, Index, Index + InsertionSize, FSize - Index);
Inc(FSize, InsertionSize);
It := ACollection.First;
Result := It.HasNext;
@@ -2260,7 +2274,7 @@
ReadLock;
try
{$ENDIF THREADSAFE}
- Result := TJclArrayList.Create(Self, False); // Only one can have FOwnsObject = True
+ Result := TJclArrayList.Create(Self, False); // Only one container can own objects
{$IFDEF THREADSAFE}
finally
ReadUnlock;
@@ -2288,7 +2302,7 @@
{$ENDIF THREADSAFE}
Result := -1;
for I := FSize - 1 downto 0 do
- if FElementData[I] = AObject then
+ if (FElementData[I] = AObject) then
begin
Result := I;
Break;
@@ -2324,11 +2338,11 @@
{$ENDIF THREADSAFE}
Result := False;
for I := FSize - 1 downto 0 do
- if FElementData[I] = AObject then // Removes all AObject
+ if (FElementData[I] = AObject) then // Removes all AObject
begin
FreeObject(FElementData[I]);
if FSize <> I then
- MoveArray(FElementData, I + 1, I, FSize - I);
+ JclBase.MoveArray(FElementData, I + 1, I, FSize - I);
Dec(FSize);
Result := True;
end;
@@ -2353,7 +2367,7 @@
Result := FElementData[Index];
FreeObject(FElementData[Index]);
if FSize <> Index then
- MoveArray(FElementData, Index + 1, Index, FSize - Index);
+ JclBase.MoveArray(FElementData, Index + 1, Index, FSize - Index);
Dec(FSize);
{$IFDEF THREADSAFE}
finally
@@ -2394,7 +2408,7 @@
Result := False;
if ACollection = nil then
Exit;
- for I := FSize - 1 to 0 do
+ for I := FSize - 1 downto 0 do
if not ACollection.Contains(FElementData[I]) then
Remove(I);
{$IFDEF THREADSAFE}
@@ -2458,7 +2472,7 @@
Last := First + Count - 1;
if Last >= FSize then
Last := FSize - 1;
- Result := TJclArrayList.Create(Count, False);
+ Result := TJclArrayList.Create(Count, False); // Only one container can own objects
for I := First to Last do
Result.Add(FElementData[I]);
{$IFDEF THREADSAFE}
@@ -2467,11 +2481,11 @@
end;
{$ENDIF THREADSAFE}
end;
-
{$IFDEF SUPPORTS_GENERICS}
-//=== { TJclArrayList<T> } ===================================================
+//=== { TJclArrayList<T> } ======================================================
+
constructor TJclArrayList<T>.Create(ACapacity: Integer; AOwnsItems: Boolean);
begin
inherited Create(nil);
@@ -2489,7 +2503,7 @@
// (rom) disabled because the following Create already calls inherited
// inherited Create;
if ACollection = nil then
- raise EJclIllegalArgumentError.Create;
+ raise EJclNoCollectionError.Create;
Create(ACollection.Size, AOwnsItems);
AddAll(ACollection);
end;
@@ -2570,7 +2584,7 @@
ReadLock;
try
{$ENDIF THREADSAFE}
- Result := CreateEmptyArrayList(Self);
+ Result := CreateEmptyArrayList(Self, False); // Only one container can own items
{$IFDEF THREADSAFE}
finally
ReadUnlock;
@@ -2588,7 +2602,7 @@
{$ENDIF THREADSAFE}
Result := False;
for I := 0 to FSize - 1 do
- if ItemsEqual(AItem, FElementData[I]) then
+ if ItemsEqual(FElementData[I], AItem) then
begin
Result := True;
Break;
@@ -2621,12 +2635,6 @@
{$ENDIF THREADSAFE}
end;
-function TJclArrayList<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
-begin
- Result := CreateEmptyArrayList(ACollection.Size);
- Result.AddAll(ACollection);
-end;
-
function TJclArrayList<T>.Equals(const ACollection: IJclCollection<T>): Boolean;
var
I: Integer;
@@ -2643,7 +2651,7 @@
Exit;
It := ACollection.First;
for I := 0 to FSize - 1 do
- if ItemsEqual(FElementData[I], It.Next) then
+ if not ItemsEqual(FElementData[I], It.Next) then
Exit;
Result := True;
{$IFDEF THREADSAFE}
@@ -2660,7 +2668,7 @@
procedure TJclArrayList<T>.FreeItem(var AItem: T);
begin
- if OwnsItems then
+ if FOwnsItems then
FreeAndNil(AItem)
else
AItem := Default(T);
@@ -2688,19 +2696,13 @@
{$ENDIF THREADSAFE}
end;
-procedure TJclArrayList<T>.Grow;
+procedure TJclArrayList<T>.Grow(Increment: Integer);
begin
{$IFDEF THREADSAFE}
WriteLock;
try
{$ENDIF THREADSAFE}
- if Capacity > 64 then
- Capacity := Capacity + Capacity div 4
- else
- if Capacity = 0 then
- Capacity := 64
- else
- Capacity := Capacity + 16;
+ Capacity := Capacity + Increment;
{$IFDEF THREADSAFE}
finally
WriteUnlock;
@@ -2708,13 +2710,13 @@
{$ENDIF THREADSAFE}
end;
-procedure TJclArrayList<T>.Grow(Increment: Integer);
+procedure TJclArrayList<T>.Grow(Num, Denom: Integer);
begin
{$IFDEF THREADSAFE}
WriteLock;
try
{$ENDIF THREADSAFE}
- Capacity := Capacity + Increment;
+ Capacity := Capacity * Num div Denom;
{$IFDEF THREADSAFE}
finally
WriteUnlock;
@@ -2722,13 +2724,19 @@
{$ENDIF THREADSAFE}
end;
-procedure TJclArrayList<T>.Grow(Num, Denom: Integer);
+procedure TJclArrayList<T>.Grow;
begin
{$IFDEF THREADSAFE}
WriteLock;
try
{$ENDIF THREADSAFE}
- Capacity := Capacity * Num div Denom;
+ if Capacity > 64 then
+ Capacity := Capacity + Capacity div 4
+ else
+ if Capacity = 0 then
+ Capacity := 64
+ else
+ Capacity := Capacity + 16;
{$IFDEF THREADSAFE}
finally
WriteUnlock;
@@ -2746,7 +2754,7 @@
{$ENDIF THREADSAFE}
Result := -1;
for I := 0 to FSize - 1 do
- if ItemsEqual(AItem, FElementData[I]) then
+ if ItemsEqual(FElementData[I], AItem) then
begin
Result := I;
Break;
@@ -2758,7 +2766,7 @@
{$ENDIF THREADSAFE}
end;
-procedure TJclArrayList<T>.Insert(Index: Integer; AItem: T);
+procedure TJclArrayList<T>.Insert(Index: Integer; const AItem: T);
begin
{$IFDEF THREADSAFE}
WriteLock;
@@ -2794,9 +2802,9 @@
if ACollection = nil then
Exit;
InsertionSize := ACollection.Size;
- if FSize + InsertionSize >= Capacity then
+ if (FSize + InsertionSize) >= Capacity then
Grow(InsertionSize);
- TJclBase<T>.MoveArray(FElementData, Index, Index + InsertionSize, Size - Index);
+ TJclBase<T>.MoveArray(FElementData, Index, Index + InsertionSize, FSize - Index);
Inc(FSize, InsertionSize);
It := ACollection.First;
Result := It.HasNext;
@@ -2818,7 +2826,7 @@
ReadLock;
try
{$ENDIF THREADSAFE}
- Result := CreateEmptyArrayList(Self);
+ Result := CreateEmptyArrayList(Self, False); // Only one container can own items
{$IFDEF THREADSAFE}
finally
ReadUnlock;
@@ -2846,7 +2854,7 @@
{$ENDIF THREADSAFE}
Result := -1;
for I := FSize - 1 downto 0 do
- if ItemsEqual(AItem, FElementData[I]) then
+ if ItemsEqual(FElementData[I], AItem) then
begin
Result := I;
Break;
@@ -2872,7 +2880,7 @@
{$ENDIF THREADSAFE}
end;
-function TJclArrayList<T>.Remove(AItem: T): Boolean;
+function TJclArrayList<T>.Remove(const AItem: T): Boolean;
var
I: Integer;
begin
@@ -2882,7 +2890,7 @@
{$ENDIF THREADSAFE}
Result := False;
for I := FSize - 1 downto 0 do
- if ItemsEqual(AItem, FElementData[I]) then // Removes all AObject
+ if ItemsEqual(FElementData[I], AItem) then // Removes all AItem
begin
FreeItem(FElementData[I]);
if FSize <> I then
@@ -2952,7 +2960,7 @@
Result := False;
if ACollection = nil then
Exit;
- for I := FSize - 1 to 0 do
+ for I := FSize - 1 downto 0 do
if not ACollection.Contains(FElementData[I]) then
Remove(I);
{$IFDEF THREADSAFE}
@@ -3016,7 +3024,7 @@
Last := First + Count - 1;
if Last >= FSize then
Last := FSize - 1;
- Result := CreateEmptyArrayList(Count);
+ Result := CreateEmptyArrayList(Count, False); // Only one container can own items
for I := First to Last do
Result.Add(FElementData[I]);
{$IFDEF THREADSAFE}
@@ -3042,6 +3050,16 @@
FEqualityComparer := AEqualityComparer;
end;
+function TJclArrayListE<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+begin
+ Result := TJclArrayListE<T>.Create(EqualityComparer, ACapacity, False);
+end;
+
+function TJclArrayListE<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+begin
+ Result := TJclArrayListE<T>.Create(EqualityComparer, ACollection, False);
+end;
+
function TJclArrayListE<T>.ItemsEqual(const A, B: T): Boolean;
begin
if EqualityComparer = nil then
@@ -3049,11 +3067,6 @@
Result := EqualityComparer.Equals(A, B);
end;
-function TJclArrayListE<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
-begin
- Result := TJclArrayListE<T>.Create(EqualityComparer, ACapacity, False);
-end;
-
//=== { TJclArrayListF<T> } ==================================================
constructor TJclArrayListF<T>.Create(const AEqualityCompare: TEqualityCompare<T>;
@@ -3070,6 +3083,16 @@
FEqualityCompare := AEqualityCompare;
end;
+function TJclArrayListF<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+begin
+ Result := TJclArrayListF<T>.Create(EqualityCompare, ACapacity, False);
+end;
+
+function TJclArrayListF<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+begin
+ Result := TJclArrayListF<T>.Create(EqualityCompare, ACollection, False);
+end;
+
function TJclArrayListF<T>.ItemsEqual(const A, B: T): Boolean;
begin
if not Assigned(EqualityCompare) then
@@ -3077,11 +3100,6 @@
Result := EqualityCompare(A, B);
end;
-function TJclArrayListF<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
-begin
- Result := TJclArrayListF<T>.Create(EqualityCompare, ACapacity, False);
-end;
-
//=== { TJclArrayListI<T> } ==================================================
function TJclArrayListI<T>.ItemsEqual(const A, B: T): Boolean;
@@ -3094,6 +3112,11 @@
Result := TJclArrayListI<T>.Create(ACapacity, False);
end;
+function TJclArrayListI<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+begin
+ Result := TJclArrayListI<T>.Create(ACollection, False);
+end;
+
{$ENDIF SUPPORTS_GENERICS}
{$IFDEF UNITVERSIONING}
Copied: trunk/jcl/source/prototypes/JclArrayLists.pas (from rev 2188, trunk/jcl/source/common/JclArrayLists.pas)
===================================================================
--- trunk/jcl/source/prototypes/JclArrayLists.pas (rev 0)
+++ trunk/jcl/source/prototypes/JclArrayLists.pas 2007-10-02 13:34:38 UTC (rev 2192)
@@ -0,0 +1,299 @@
+{**************************************************************************************************}
+{ }
+{ 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 ArrayList.pas. }
+{ }
+{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by }
+{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) }
+{ All rights reserved. }
+{ }
+{ Contributors: }
+{ Florent Ouchet (outchy) }
+{ }
+{**************************************************************************************************}
+{ }
+{ The Delphi Container Library }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: $ }
+{ Revision: $Rev:: $ }
+{ Author: $Author:: $ }
+{ }
+{**************************************************************************************************}
+
+unit JclArrayLists;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ {$IFDEF SUPPORTS_GENERICS}
+ {$IFDEF CLR}
+ System.Collections.Generic,
+ {$ENDIF CLR}
+ JclAlgorithms,
+ {$ENDIF SUPPORTS_GENERICS}
+ Classes,
+ JclBase, JclAbstractContainers, JclContainerIntf;
+{$I Containers\JclArrayLists.imp}
+type
+{$JPPEXPANDMACRO JCLARRAYLISTINT(TJclIntfArrayList,TJclAbstractContainer,IJclIntfCollection,IJclIntfList,IJclIntfArray,IJclIntfIterator,JclBase.TDynIInterfaceArray,,,,,,,const AInterface: IInterface,IInterface,GetObject,SetObject)}
+
+{$JPPEXPANDMACRO JCLARRAYLISTINT(TJclStrArrayList,TJclStrCollection,IJclStrCollection,IJclStrList,IJclStrArray,IJclStrIterator,JclBase.TDynStringArray,,,,, override;,,const AString: string,string,GetString,SetString)}
+
+{$JPPEXPANDMACRO JCLARRAYLISTINT(TJclArrayList,TJclAbstractContainer,IJclCollection,IJclList,IJclArray,IJclIterator,JclBase.TDynObjectArray,,
+ FOwnsObjects: Boolean;,
+ procedure FreeObject(var AObject: TObject);,
+ property OwnsObjects: Boolean read FOwnsObjects;,,; AOwnsObjects: Boolean = True,AObject: TObject,TObject,GetObject,SetObject)}
+
+ {$IFDEF SUPPORTS_GENERICS}
+
+{$JPPEXPANDMACRO JCLARRAYLISTINT(TJclArrayList<T>,TJclAbstractContainer,IJclCollection<T>,IJclList<T>,IJclArray<T>,IJclIterator<T>,TJclBase<T>.TDynArray,,
+ FOwnsItems: Boolean;,
+ function ItemsEqual(const A, B: T): Boolean; virtual; abstract;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; overload; virtual; abstract;
+ function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; overload; virtual; abstract;
+ procedure FreeItem(var AItem: T);,
+ property OwnsItems: Boolean read FOwnsItems;,,; AOwnsItems: Boolean = True,const AItem: T,T,GetItem,SetItem)}
+
+ // E = External helper to compare items for equality
+ // GetHashCode is not used
+ TJclArrayListE<T> = class(TJclArrayList<T>, IJclCollection<T>, IJclList<T>, IJclArray<T>,
+ {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
+ private
+ FEqualityComparer: IEqualityComparer<T>;
+ protected
+ function ItemsEqual(const A, B: T): Boolean; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ public
+ constructor Create(const AEqualityComparer: IEqualityComparer<T>; ACapacity: Integer = DefaultContainerCapacity;
+ AOwnsItems: Boolean = True); overload;
+ constructor Create(const AEqualityComparer: IEqualityComparer<T>; const ACollection: IJclCollection<T>;
+ AOwnsItems: Boolean = True); overload;
+
+ property EqualityComparer: IEqualityComparer<T> read FEqualityComparer write FEqualityComparer;
+ end;
+
+ // F = Function to compare items for equality
+ TJclArrayListF<T> = class(TJclArrayList<T>, IJclCollection<T>, IJclList<T>, IJclArray<T>,
+ {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
+ private
+ FEqualityCompare: TEqualityCompare<T>;
+ protected
+ function ItemsEqual(const A, B: T): Boolean; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ public
+ constructor Create(const AEqualityCompare: TEqualityCompare<T>; ACapacity: Integer = DefaultContainerCapacity;
+ AOwnsItems: Boolean = True); overload;
+ constructor Create(const AEqualityCompare: TEqualityCompare<T>; const ACollection: IJclCollection<T>;
+ AOwnsItems: Boolean = True); overload;
+
+ property EqualityCompare: TEqualityCompare<T> read FEqualityCompare write FEqualityCompare;
+ end;
+
+ // I = Items can compare themselves to others
+ TJclArrayListI<T: IEquatable<T>> = class(TJclArrayList<T>, IJclCollection<T>, IJclList<T>, IJclArray<T>,
+ {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
+ protected
+ function ItemsEqual(const A, B: T): Boolean; override;
+ function CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>; override;
+ function CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>; override;
+ { IJclIntfCloneable }
+ function IJclIntfCloneable.Clone = IntfClone;
+ end;
+
+ {$ENDIF SUPPORTS_GENERICS}
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL$';
+ Revision: '$Revision$';
+ Date: '$Date$';
+ LogPath: 'JCL\source\common'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+ SysUtils;
+
+{$JPPEXPANDMACRO JCLITRIMP(TIntfItr,IJclIntfIterator,IJclIntfList,const AInterface: IInterface,AInterface,IInterface,GetObject,SetObject)}
+{$JPPEXPANDMACRO JCLITRIMP(TStrItr,IJclStrIterator,IJclStrList,const AString: string,AString,string,GetString,SetString)}
+{$JPPEXPANDMACRO JCLITRIMP(TItr,IJclIterator,IJclList,AObject: TObject,AObject,TObject,GetObject,SetObject)}
+
+{$IFDEF SUPPORTS_GENERICS}
+{$JPPEXPANDMACRO JCLITRIMP(TItr<T>,IJclIterator<T>,IJclList<T>,const AItem: T,AItem,T,GetItem,SetItem)}
+{$ENDIF SUPPORTS_GENERICS}
+
+{$JPPDEFINEMACRO ITEMSEQUAL(Item1, Item2)(Item1 =Item2)}
+{$JPPDEFINEMACRO ITEMFREE(AItem)AItem := nil;}
+{$JPPDEFINEMACRO LISTCREATE(Param1)TJclIntfArrayList.Create(Param1);}
+{$JPPEXPANDMACRO JCLARRAYLISTIMP(TJclIntfArrayList,,,,,Result := FElementData[Index];,IJclIntfCollection,IJclIntfIterator,TIntfItr,IJclIntfList,const AInterface: IInterface,AInterface,GetObject,SetObject,IInterface,nil,JclBase.)}
+{$JPPUNDEFMACRO ITEMSEQUAL(Item1, Item2)}
+{$JPPUNDEFMACRO ITEMFREE(AItem)}
+{$JPPUNDEFMACRO LISTCREATE(Param1)}
+
+{$JPPDEFINEMACRO ITEMSEQUAL(Item1, Item2)(Item1 =Item2)}
+{$JPPDEFINEMACRO ITEMFREE(AItem)AItem := '';}
+{$JPPDEFINEMACRO LISTCREATE(Param1)TJclStrArrayList.Create(Param1);}
+{$JPPEXPANDMACRO JCLARRAYLISTIMP(TJclStrArrayList,,,,,Result := FElementData[Index];,IJclStrCollection,IJclStrIterator,TStrItr,IJclStrList,const AString: string,AString,GetString,SetString,string,'',JclBase.)}
+{$JPPUNDEFMACRO ITEMSEQUAL(Item1, Item2)}
+{$JPPUNDEFMACRO ITEMFREE(AItem)}
+{$JPPUNDEFMACRO LISTCREATE(Param1)}
+
+{$JPPDEFINEMACRO ITEMSEQUAL(Item1, Item2)(Item1 =Item2)}
+{$JPPDEFINEMACRO ITEMFREE(AItem)FreeObject(AItem);}
+{$JPPDEFINEMACRO LISTCREATE(Param1)TJclArrayList.Create(Param1, False); // Only one container can own objects}
+{$JPPEXPANDMACRO JCLARRAYLISTIMP(TJclArrayList,; AOwnsObjects: Boolean,FOwnsObjects := AOwnsObjects;,\, AOwnsObjects,
+procedure TJclArrayList.FreeObject(var AObject: TObject);
+begin
+ if FOwnsObjects then
+ FreeAndNil(AObject)
+ else
+ AObject := nil;
+end;
+,if OwnsObjects then
+ Result := nil
+ else
+ Result := FElementData[Index];,IJclCollection,IJclIterator,TItr,IJclList,AObject: TObject,AObject,GetObject,SetObject,TObject,nil,JclBase.)}
+{$JPPUNDEFMACRO ITEMSEQUAL(Item1, Item2)}
+{$JPPUNDEFMACRO ITEMFREE(AItem)}
+{$JPPUNDEFMACRO LISTCREATE(Param1)}
+{$IFDEF SUPPORTS_GENERICS}
+
+{$JPPDEFINEMACRO ITEMSEQUAL(Item1, Item2)ItemsEqual(Item1,Item2)}
+{$JPPDEFINEMACRO ITEMFREE(AItem)FreeItem(AItem);}
+{$JPPDEFINEMACRO LISTCREATE(Param1)CreateEmptyArrayList(Param1, False); // Only one container can own items}
+{$JPPEXPANDMACRO JCLARRAYLISTIMP(TJclArrayList<T>,; AOwnsItems: Boolean,FOwnsItems := AOwnsItems;,\, AOwnsItems,
+procedure TJclArrayList<T>.FreeItem(var AItem: T);
+begin
+ if FOwnsItems then
+ FreeAndNil(AItem)
+ else
+ AItem := Default(T);
+end;
+,if OwnsItems then
+ Result := Default(T)
+ else
+ Result := FElementData[Index];,IJclCollection<T>,IJclIterator<T>,TItr<T>,IJclList<T>,const AItem: T,AItem,GetItem,SetItem,T,Default(T),TJclBase<T>.)}
+{$JPPUNDEFMACRO ITEMSEQUAL(Item1, Item2)}
+{$JPPUNDEFMACRO ITEMFREE(AItem)}
+{$JPPUNDEFMACRO LISTCREATE(Param1)}
+
+//=== { TJclArrayListE<T> } ==================================================
+
+constructor TJclArrayListE<T>.Create(const AEqualityComparer: IEqualityComparer<T>; ACapacity: Integer;
+ AOwnsItems: Boolean);
+begin
+ inherited Create(ACapacity, AOwnsItems);
+ FEqualityComparer := AEqualityComparer;
+end;
+
+constructor TJclArrayListE<T>.Create(const AEqualityComparer: IEqualityComparer<T>;
+ const ACollection: IJclCollection<T>; AOwnsItems: Boolean);
+begin
+ inherited Create(ACollection, AOwnsItems);
+ FEqualityComparer := AEqualityComparer;
+end;
+
+function TJclArrayListE<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+begin
+ Result := TJclArrayListE<T>.Create(EqualityComparer, ACapacity, False);
+end;
+
+function TJclArrayListE<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+begin
+ Result := TJclArrayListE<T>.Create(EqualityComparer, ACollection, False);
+end;
+
+function TJclArrayListE<T>.ItemsEqual(const A, B: T): Boolean;
+begin
+ if EqualityComparer = nil then
+ raise EJclNoEqualityComparerError.Create;
+ Result := EqualityComparer.Equals(A, B);
+end;
+
+//=== { TJclArrayListF<T> } ==================================================
+
+constructor TJclArrayListF<T>.Create(const AEqualityCompare: TEqualityCompare<T>;
+ ACapacity: Integer; AOwnsItems: Boolean);
+begin
+ inherited Create(ACapacity, AOwnsItems);
+ FEqualityCompare := AEqualityCompare;
+end;
+
+constructor TJclArrayListF<T>.Create(const AEqualityCompare: TEqualityCompare<T>; const ACollection: IJclCollection<T>;
+ AOwnsItems: Boolean);
+begin
+ inherited Create(ACollection, AOwnsItems);
+ FEqualityCompare := AEqualityCompare;
+end;
+
+function TJclArrayListF<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+begin
+ Result := TJclArrayListF<T>.Create(EqualityCompare, ACapacity, False);
+end;
+
+function TJclArrayListF<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+begin
+ Result := TJclArrayListF<T>.Create(EqualityCompare, ACollection, False);
+end;
+
+function TJclArrayListF<T>.ItemsEqual(const A, B: T): Boolean;
+begin
+ if not Assigned(EqualityCompare) then
+ raise EJclNoEqualityComparerError.Create;
+ Result := EqualityCompare(A, B);
+end;
+
+//=== { TJclArrayListI<T> } ==================================================
+
+function TJclArrayListI<T>.ItemsEqual(const A, B: T): Boolean;
+begin
+ Result := A.Equals(B);
+end;
+
+function TJclArrayListI<T>.CreateEmptyArrayList(ACapacity: Integer): TJclArrayList<T>;
+begin
+ Result := TJclArrayListI<T>.Create(ACapacity, False);
+end;
+
+function TJclArrayListI<T>.CreateEmptyArrayList(const ACollection: IJclCollection<T>): TJclArrayList<T>;
+begin
+ Result := TJclArrayListI<T>.Create(ACollection, False);
+end;
+
+{$ENDIF SUPPORTS_GENERICS}
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
+
Modified: trunk/jcl/source/prototypes/Makefile.mak
===================================================================
--- trunk/jcl/source/prototypes/Makefile.mak 2007-09-28 17:20:16 UTC (rev 2191)
+++ trunk/jcl/source/prototypes/Makefile.mak 2007-10-02 13:34:38 UTC (rev 2192)
@@ -6,17 +6,18 @@
jpp = ..\..\devtools\jpp.exe
-Options = -c -dJCL -dSUPPORTS_DEFAULTPARAMS -dSUPPORTS_INT64
-CommonOptions = $(Options) -f..\common\\
-VclOptions = $(Options) -dVCL -uVisualCLX -dMSWINDOWS -uUnix -dBitmap32 -x1:..\vcl\Jcl
-VClxOptions = $(Options) -uVCL -dVisualCLX -dHAS_UNIT_TYPES -uBitmap32 -x1:..\visclx\JclQ
-WinOptions = $(Options) -dMSWINDOWS -uUNIX -uHAS_UNIT_LIBC -f..\windows\\
-Win32Options = $(Options) -uHAS_UNIT_LIBC -f..\windows\\
-UnixOptions = $(Options) -uMSWINDOWS -dUNIX -f..\unix\\
-ZlibOptions = -uSTATIC_GZIO
+Options = -c -dJCL -dSUPPORTS_DEFAULTPARAMS -dSUPPORTS_INT64
+CommonOptions = $(Options) -f..\common\\
+VclOptions = $(Options) -dVCL -uVisualCLX -dMSWINDOWS -uUnix -dBitmap32 -x1:..\vcl\Jcl
+VClxOptions = $(Options) -uVCL -dVisualCLX -dHAS_UNIT_TYPES -uBitmap32 -x1:..\visclx\JclQ
+WinOptions = $(Options) -dMSWINDOWS -uUNIX -uHAS_UNIT_LIBC -f..\windows\\
+Win32Options = $(Options) -uHAS_UNIT_LIBC -f..\windows\\
+ContainerOptions = $(Options) -m -ijcl.inc -f..\Common\\
+UnixOptions = $(Options) -uMSWINDOWS -dUNIX -f..\unix\\
+ZlibOptions = -uSTATIC_GZIO
-release: VCL VisualCLX Windows Unix
+release: VCL VisualCLX Windows Unix Containers
VCL: ..\vcl\JclGraphics.pas \
..\vcl\JclGraphUtils.pas
@@ -30,8 +31,11 @@
Unix: ..\unix\zlibh.pas
-zlib: ..\windows\zlibh.pas ..\unix\zlibh.pas
+zlib: ..\windows\zlibh.pas \
+ ..\unix\zlibh.pas
+Containers: ..\Common\JclArrayLists.pas
+
..\vcl\JclGraphics.pas: \
_Graphics.pas
$(jpp) $(VclOptions) $?
@@ -66,6 +70,10 @@
echo Win-zlib
$(jpp) $(WinOptions) $(ZlibOptions) -uZLIB_DLL $?
+..\Common\JclArrayLists.pas: \
+ JclArrayLists.pas
+ $(jpp) $(ContainerOptions) $?
+
{.}.pas{..\common}.pas:
$(jpp) $(CommonOptions) $<
Property changes on: trunk/jcl/source/prototypes/containers
___________________________________________________________________
Name: bugtraq:url
+ http://homepages.codegear.com/jedi/issuetracker/view.php?id=%BUGID%
Name: bugtraq:message
+ (Mantis #%BUGID%)
Name: svn:ignore
+ *.~*
__history
Name: bugtraq:logregex
+ [Mm]antis #?(\d+)(,? ?#?(\d+))+
(\d+)
Copied: trunk/jcl/source/prototypes/containers/JclArrayLists.imp (from rev 2188, trunk/jcl/source/common/JclArrayLists.pas)
===================================================================
--- trunk/jcl/source/prototypes/containers/JclArrayLists.imp (rev 0)
+++ trunk/jcl/source/prototypes/containers/JclArrayLists.imp 2007-10-02 13:34:38 UTC (rev 2192)
@@ -0,0 +1,723 @@
+(*$JPPDEFINEMACRO JCLARRAYLISTINT(SELFCLASSNAME, ANCESTORCLASSNAME, COLLECTIONINTERFACENAME, LISTINTERFACENAME, ARRAYINTERFACENAME, ITRINTERFACENAME,
+ DYNARRAYTYPE, INTERFACELISTADDITIONAL, PRIVATEADDITIONAL, PROTECTEDADDITIONAL, PUBLICADDITIONAL, COLLECTIONFLAGS,
+ OWNERSHIPDECLARATION, PARAMETERDECLARATION, TYPENAME, GETTERNAME, SETTERNAME)
+ SELFCLASSNAME = class(ANCESTORCLASSNAME, COLLECTIONINTERFACENAME, LISTINTERFACENAME, ARRAYINTERFACENAME,INTERFACELISTADDITIONAL
+ {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable)
+ private
+ FCapacity: Integer;
+ FElementData: DYNARRAYTYPE;
+ FSize: Integer;PRIVATEADDITIONAL
+ protected
+ { IJclPackable }
+ procedure Pack;
+ function GetCapacity: Integer;
+ procedure SetCapacity(Value: Integer);
+ { IJclGrowable }
+ procedure Grow; overload; virtual;
+ procedure Grow(Increment: Integer); overload;
+ procedure Grow(Num, Denom: Integer); overload;
+ { IJclIntfCloneable }
+ function IntfClone: IInterface;
+ function IJclIntfCloneable.Clone = IntfClone;
+ { IJclCloneable }
+ function Clone: TObject;
+ { COLLECTIONINTERFACENAME }
+ function Add(PARAMETERDECLARATION): Boolean; overload;COLLECTIONFLAGS
+ function AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; overload;COLLECTIONFLAGS
+ procedure Clear;COLLECTIONFLAGS
+ function Contains(PARAMETERDECLARATION): Boolean;COLLECTIONFLAGS
+ function ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS
+ function Equals(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS
+ function First: ITRINTERFACENAME;COLLECTIONFLAGS
+ function IsEmpty: Boolean;COLLECTIONFLAGS
+ function Last: ITRINTERFACENAME;COLLECTIONFLAGS
+ function Remove(PARAMETERDECLARATION): Boolean; overload;COLLECTIONFLAGS
+ function RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS
+ function RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS
+ function Size: Integer;COLLECTIONFLAGS
+ { LISTINTERFACENAME }
+ procedure Insert(Index: Integer; PARAMETERDECLARATION); overload;
+ function InsertAll(Index: Integer; const ACollection: COLLECTIONINTERFACENAME): Boolean; overload;
+ function GETTERNAME(Index: Integer): TYPENAME;
+ function IndexOf(PARAMETERDECLARATION): Integer;
+ function LastIndexOf(PARAMETERDECLARATION): Integer;
+ function Remove(Index: Integer): TYPENAME; overload;
+ procedure SETTERNAME(Index: Integer; PARAMETERDECLARATION);
+ function SubList(First, Count: Integer): LISTINTERFACENAME;PROTECTEDADDITIONAL
+ public
+ constructor Create(ACapacity: Integer = DefaultContainerCapacityOWNERSHIPDECLARATION); overload;
+ constructor Create(const ACollection: COLLECTIONINTERFACENAMEOWNERSHIPDECLARATION); overload;
+ destructor Destroy; override;
+ property Capacity: Integer read FCapacity write SetCapacity;PUBLICADDITIONAL
+ end;*)
+(*$JPPDEFINEMACRO JCLITRIMP(SELFCLASSNAME, ITRINTERFACENAME, LISTINTERFACENAME,
+ PARAMETERDECLARATION, PARAMETERNAME, TYPENAME, GETTERNAME, SETTERNAME)
+//=== { SELFCLASSNAME } ===============================================================
+
+type
+ SELFCLASSNAME = class(TJclAbstractIterator, ITRINTERFACENAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE}
+ IJclIntfCloneable, IJclCloneable)
+ private
+ FCursor: Integer;
+ FOwnList: LISTINTERFACENAME;
+ protected
+ { IJclCloneable }
+ function Clone: TObject;
+ { IJclIntfCloneable }
+ function IntfClone: IInterface;
+ function IJclIntfCloneable.Clone = IntfClone;
+ { ITRINTERFACENAME }
+ procedure Add(PARAMETERDECLARATION);
+ function GETTERNAME: TYPENAME;
+ function HasNext: Boolean;
+ function HasPrevious: Boolean;
+ procedure Insert(PARAMETERDECLARATION);
+ function Next: TYPENAME;
+ function NextIndex: Integer;
+ function Previous: TYPENAME;
+ function PreviousIndex: Integer;
+ procedure Remove;
+ procedure SETTERNAME(PARAMETERDECLARATION);
+ public
+ constructor Create(const AOwnList: LISTINTERFACENAME; ACursor: Integer; AValid: Boolean);
+ end;
+
+constructor SELFCLASSNAME.Create(const AOwnList: LISTINTERFACENAME; ACursor: Integer; AValid: Boolean);
+begin
+ inherited Create(AOwnList);
+ FOwnList := AOwnList;
+ FCursor := ACursor;
+ Valid := AValid;
+end;
+
+procedure SELFCLASSNAME.Add(PARAMETERDECLARATION);
+begin
+ FOwnList.Add(PARAMETERNAME);
+end;
+
+function SELFCLASSNAME.Clone: TObject;
+begin
+ Result := SELFCLASSNAME.Create(FOwnList, FCursor, Valid);
+end;
+
+function SELFCLASSNAME.GETTERNAME: TYPENAME;
+begin
+ Valid := True;
+ Result := FOwnList.GETTERNAME(FCursor);
+end;
+
+function SELFCLASSNAME.HasNext: Boolean;
+begin
+ if Valid then
+ Result := FCursor < (FOwnList.Size - 1)
+ else
+ Result := FCursor < FOwnList.Size;
+end;
+
+function SELFCLASSNAME.HasPrevious: Boolean;
+begin
+ if Valid then
+ Result := FCursor > 0
+ else
+ Result := FCursor >= 0;
+end;
+
+procedure SELFCLASSNAME.Insert(PARAMETERDECLARATION);
+begin
+ Valid := True;
+ FOwnList.Insert(FCursor, PARAMETERNAME);
+end;
+
+function SELFCLASSNAME.IntfClone: IInterface;
+begin
+ Result := SELFCLASSNAME.Create(FOwnList, FCursor, Valid);
+end;
+
+function SELFCLASSNAME.Next: TYPENAME;
+begin
+ if Valid then
+ Inc(FCursor)
+ else
+ Valid := True;
+ Result := FOwnList.GETTERNAME(FCursor);
+end;
+
+function SELFCLASSNAME.NextIndex: Integer;
+begin
+ if Valid then
+ Result := FCursor + 1
+ else
+ Result := FCursor;
+end;
+
+function SELFCLASSNAME.Previous: TYPENAME;
+begin
+ if Valid then
+ Dec(FCursor)
+ else
+ Valid := True;
+ Result := FOwnList.GETTERNAME(FCursor);
+end;
+
+function SELFCLASSNAME.PreviousIndex: Integer;
+begin
+ if Valid then
+ Result := FCursor - 1
+ else
+ Result := FCursor;
+end;
+
+procedure SELFCLASSNAME.Remove;
+begin
+ Valid := False;
+ FOwnList.Remove(FCursor);
+end;
+
+procedure SELFCLASSNAME.SETTERNAME(PARAMETERDECLARATION);
+begin
+ Valid := True;
+ FOwnList.SETTERNAME(FCursor, PARAMETERNAME);
+end;*)
+
+(*$JPPDEFINEMACRO JCLARRAYLISTIMP(SELFCLASSNAME,
+ OWNERSHIPDECLARATION, OWNERSHIPASSIGNMENT, OWNERSHIPPARAMETER, OWNERSHIPFREEIMP, REMOVEASSIGNMENT,
+ COLLECTIONINTERFACENAME, ITRINTERFACENAME, ITRCLASSNAME, LISTINTERFACENAME,
+ PARAMETERDECLARATION, PARAMETERNAME, GETTERNAME, SETTERNAME, TYPENAME, DEFAULTVALUE, MOVEARRAYPREFIX)
+//=== { SELFCLASSNAME } ======================================================
+
+constructor SELFCLASSNAME.Create(ACapacity: IntegerOWNERSHIPDECLARATION);
+begin
+ inherited Create(nil);
+ FSize := 0;
+ OWNERSHIPASSIGNMENT
+ if ACapacity < 0 then
+ FCapacity := 0
+ else
+ FCapacity := ACapacity;
+ SetLength(FElementData, FCapacity);
+end;
+
+constructor SELFCLASSNAME.Create(const ACollection: COLLECTIONINTERFACENAMEOWNERSHIPDECLARATION);
+begin
+ // (rom) disabled because the following Create already calls inherited
+ // inherited Create;
+ if ACollection = nil then
+ raise EJclNoCollectionError.Create;
+ Create(ACollection.SizeOWNERSHIPPARAMETER);
+ AddAll(ACollection);
+end;
+
+destructor SELFCLASSNAME.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+function SELFCLASSNAME.Add(PARAMETERDECLARATION): Boolean;
+begin
+ {$IFDEF THREADSAFE}
+ WriteLock;
+ try
+ {$ENDIF THREADSAFE}
+ if FSize = Capacity then
+ Grow;
+ FElementData[FSize] := PARAMETERNAME;
+ Inc(FSize);
+ Result := True;
+ {$IFDEF THREADSAFE}
+ finally
+ WriteUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function SELFCLASSNAME.AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;
+var
+ It: ITRINTERFACENAME;
+begin
+ {$IFDEF THREADSAFE}
+ WriteLock;
+ try
+ {$ENDIF THREADSAFE}
+ Result := False;
+ if ACollection = nil then
+ Exit;
+ It := ACollection.First;
+ while It.HasNext do
+ begin
+ // (rom) inlining Add() gives about 5 percent performance increase
+ if FSize = Capacity then
+ Grow;
+ FElementData[FSize] := It.Next;
+ Inc(FSize);
+ end;
+ Result := True;
+ {$IFDEF THREADSAFE}
+ finally
+ WriteUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+procedure SELFCLASSNAME.Clear;
+var
+ I: Integer;
+begin
+ {$IFDEF THREADSAFE}
+ WriteLock;
+ try
+ {$ENDIF THREADSAFE}
+ for I := 0 to FSize - 1 do
+ {$JPPEXPANDMACRO ITEMFREE(FElementData[I])}
+ FSize := 0;
+ {$IFDEF THREADSAFE}
+ finally
+ WriteUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function SELFCLASSNAME.Clone: TObject;
+begin
+ {$IFDEF THREADSAFE}
+ ReadLock;
+ try
+ {$ENDIF THREADSAFE}
+ Result := {$JPPEXPANDMACRO LISTCREATE(Self)}
+ {$IFDEF THREADSAFE}
+ finally
+ ReadUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function SELFCLASSNAME.Contains(PARAMETERDECLARATION): Boolean;
+var
+ I: Integer;
+begin
+ {$IFDEF THREADSAFE}
+ ReadLock;
+ try
+ {$ENDIF THREADSAFE}
+ Result := False;
+ for I := 0 to FSize - 1 do
+ if {$JPPEXPANDMACRO ITEMSEQUAL(FElementData[I], PARAMETERNAME)} then
+ begin
+ Result := True;
+ Break;
+ end;
+ {$IFDEF THREADSAFE}
+ finally
+ ReadUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function SELFCLASSNAME.ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;
+var
+ It: ITRINTERFACENAME;
+begin
+ {$IFDEF THREADSAFE}
+ ReadLock;
+ try
+ {$ENDIF THREADSAFE}
+ Result := True;
+ if ACollection = nil then
+ Exit;
+ It := ACollection.First;
+ while Result and It.HasNext do
+ Result := Contains(It.Next);
+ {$IFDEF THREADSAFE}
+ finally
+ ReadUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function SELFCLASSNAME.Equals(const ACollection: COLLECTIONINTERFACENAME): Boolean;
+var
+ I: Integer;
+ It: ITRINTERFACENAME;
+begin
+ {$IFDEF THREADSAFE}
+ ReadLock;
+ try
+ {$ENDIF THREADSAFE}
+ Result := False;
+ if ACollection = nil then
+ Exit;
+ if FSize <> ACollection.Size then
+ Exit;
+ It := ACollection.First;
+ for I := 0 to FSize - 1 do
+ if not {$JPPEXPANDMACRO ITEMSEQUAL(FElementData[I], It.Next)} then
+ Exit;
+ Result := True;
+ {$IFDEF THREADSAFE}
+ finally
+ ReadUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function SELFCLASSNAME.First: ITRINTERFACENAME;
+begin
+ Result := ITRCLASSNAME.Create(Self, 0, False);
+end;
+OWNERSHIPFREEIMP
+function SELFCLASSNAME.GetCapacity: Integer;
+begin
+ Result := FCapacity;
+end;
+
+function SELFCLASSNAME.GETTERNAME(Index: Integer): TYPENAME;
+begin
+ {$IFDEF THREADSAFE}
+ ReadLock;
+ try
+ {$ENDIF THREADSAFE}
+ if (Index < 0) or (Index >= FSize) then
+ Result := DEFAULTVALUE
+ else
+ Result := FElementData[Index];
+ {$IFDEF THREADSAFE}
+ finally
+ ReadUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+procedure SELFCLASSNAME.Grow(Increment: Integer);
+begin
+ {$IFDEF THREADSAFE}
+ WriteLock;
+ try
+ {$ENDIF THREADSAFE}
+ Capacity := Capacity + Increment;
+ {$IFDEF THREADSAFE}
+ finally
+ WriteUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+procedure SELFCLASSNAME.Grow(Num, Denom: Integer);
+begin
+ {$IFDEF THREADSAFE}
+ WriteLock;
+ try
+ {$ENDIF THREADSAFE}
+ Capacity := Capacity * Num div Denom;
+ {$IFDEF THREADSAFE}
+ finally
+ WriteUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+procedure SELFCLASSNAME.Grow;
+begin
+ {$IFDEF THREADSAFE}
+ WriteLock;
+ try
+ {$ENDIF THREADSAFE}
+ if Capacity > 64 then
+ Capacity := Capacity + Capacity div 4
+ else
+ if Capacity = 0 then
+ Capacity := 64
+ else
+ Capacity := Capacity + 16;
+ {$IFDEF THREADSAFE}
+ finally
+ WriteUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function SELFCLASSNAME.IndexOf(PARAMETERDECLARATION): Integer;
+var
+ I: Integer;
+begin
+ {$IFDEF THREADSAFE}
+ ReadLock;
+ try
+ {$ENDIF THREADSAFE}
+ Result := -1;
+ for I := 0 to FSize - 1 do
+ if {$JPPEXPANDMACRO ITEMSEQUAL(FElementData[I], PARAMETERNAME)} then
+ begin
+ Result := I;
+ Break;
+ end;
+ {$IFDEF THREADSAFE}
+ finally
+ ReadUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+procedure SELFCLASSNAME.Insert(Index: Integer; PARAMETERDECLARATION);
+begin
+ {$IFDEF THREADSAFE}
+ WriteLock;
+ try
+ {$ENDIF THREADSAFE}
+ if (Index < 0) or (Index > FSize) then
+ raise EJclOutOfBoundsError.Create;
+ if FSize = Capacity then
+ Grow;
+ if FSize <> Index then
+ MOVEARRAYPREFIXMoveArray(FElementData, Index, Index + 1, FSize - Index);
+ FElementData[Index] := PARAMETERNAME;
+ Inc(FSize);
+ {$IFDEF THREADSAFE}
+ finally
+ WriteUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function SELFCLASSNAME.InsertAll(Index: Integer; const ACollection: COLLECTIONINTERFACENAME): Boolean;
+var
+ It: ITRINTERFACENAME;
+ InsertionSize: Integer;
+begin
+ {$IFDEF THREADSAFE}
+ WriteLock;
+ try
+ {$ENDIF THREADSAFE}
+ Result := False;
+ if (Index < 0) or (Index > FSize) then
+ raise EJclOutOfBoundsError.Create;
+ if ACollection = nil then
+ Exit;
+ InsertionSize := ACollection.Size;
+ if (FSize + InsertionSize) >= Capacity then
+ Grow(InsertionSize);
+ MOVEARRAYPREFIXMoveArray(FElementData, Index, Index + InsertionSize, FSize - Index);
+ Inc(FSize, InsertionSize);
+ It := ACollection.First;
+ Result := It.HasNext;
+ while It.HasNext do
+ begin
+ FElementData[Index] := It.Next;
+ Inc(Index);
+ end;
+ {$IFDEF THREADSAFE}
+ finally
+ WriteUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function SELFCLASSNAME.IntfClone: IInterface;
+begin
+ {$IFDEF THREADSAFE}
+ ReadLock;
+ try
+ {$ENDIF THREADSAFE}
+ Result := {$JPPEXPANDMACRO LISTCREATE(Self)}
+ {$IFDEF THREADSAFE}
+ finally
+ ReadUnlock;
+ end;
+ {$ENDIF THREADSAFE}
+end;
+
+function SELFCLASSNAME.IsEmpty: Boolean;
+begin
+ Result...
[truncated message content] |
|
From: <ou...@us...> - 2007-09-28 17:20:22
|
Revision: 2191
http://jcl.svn.sourceforge.net/jcl/?rev=2191&view=rev
Author: outchy
Date: 2007-09-28 10:20:16 -0700 (Fri, 28 Sep 2007)
Log Message:
-----------
Mantis 4232 TJclSCManager.Refresh fails with invalid services
Modified Paths:
--------------
trunk/jcl/source/windows/JclSvcCtrl.pas
Modified: trunk/jcl/source/windows/JclSvcCtrl.pas
===================================================================
--- trunk/jcl/source/windows/JclSvcCtrl.pas 2007-09-26 20:00:42 UTC (rev 2190)
+++ trunk/jcl/source/windows/JclSvcCtrl.pas 2007-09-28 17:20:16 UTC (rev 2191)
@@ -1022,7 +1022,11 @@
for I := 0 to ServicesReturned - 1 do
begin
NtSvc := TJclNtService.Create(Self, PEss^);
- NtSvc.Refresh;
+ try
+ NtSvc.Refresh;
+ except
+ // trap invalid services
+ end;
Inc(PEss);
end;
finally
@@ -1082,7 +1086,11 @@
I: Integer;
begin
for I := 0 to GetServiceCount - 1 do
+ try
GetService(I).Refresh;
+ except
+ // trap invalid services
+ end;
end;
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-09-26 20:00:43
|
Revision: 2190
http://jcl.svn.sourceforge.net/jcl/?rev=2190&view=rev
Author: outchy
Date: 2007-09-26 13:00:42 -0700 (Wed, 26 Sep 2007)
Log Message:
-----------
Registry keys have to be absolute
Modified Paths:
--------------
trunk/jcl/source/common/JclBorlandTools.pas
Modified: trunk/jcl/source/common/JclBorlandTools.pas
===================================================================
--- trunk/jcl/source/common/JclBorlandTools.pas 2007-09-26 18:28:42 UTC (rev 2189)
+++ trunk/jcl/source/common/JclBorlandTools.pas 2007-09-26 20:00:42 UTC (rev 2190)
@@ -961,11 +961,11 @@
PathSep = ';';
{$ENDIF ~RTL140_UP}
- MSHelpSystemKeyName = 'SOFTWARE\Microsoft\Windows\Help';
+ MSHelpSystemKeyName = '\SOFTWARE\Microsoft\Windows\Help';
- BCBKeyName = 'SOFTWARE\Borland\C++Builder';
- BDSKeyName = 'SOFTWARE\Borland\BDS';
- DelphiKeyName = 'SOFTWARE\Borland\Delphi';
+ BCBKeyName = '\SOFTWARE\Borland\C++Builder';
+ BDSKeyName = '\SOFTWARE\Borland\BDS';
+ DelphiKeyName = '\SOFTWARE\Borland\Delphi';
BDSVersions: array [1..5] of TBDSVersionInfo = (
(
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-09-26 18:28:47
|
Revision: 2189
http://jcl.svn.sourceforge.net/jcl/?rev=2189&view=rev
Author: outchy
Date: 2007-09-26 11:28:42 -0700 (Wed, 26 Sep 2007)
Log Message:
-----------
several fixes for multiple profiles support:
- support for Delphi 5 and C++Builder 5
- fixed exception if product is not supported
- fixed ghost process after elevation request
- fixed subversion properties
- check path environment variables for all users
- profile page is created only in multiple profile mode
Modified Paths:
--------------
trunk/jcl/install/JclInstall.pas
trunk/jcl/install/JediProfiles.pas
trunk/jcl/install/VclGui/JediGUIProfiles.dfm
trunk/jcl/install/VclGui/JediGUIProfiles.pas
trunk/jcl/source/common/JclBorlandTools.pas
Property Changed:
----------------
trunk/jcl/install/JediProfiles.pas
trunk/jcl/install/VclGui/JediGUIProfiles.dfm
trunk/jcl/install/VclGui/JediGUIProfiles.pas
Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas 2007-09-26 11:32:58 UTC (rev 2188)
+++ trunk/jcl/install/JclInstall.pas 2007-09-26 18:28:42 UTC (rev 2189)
@@ -1369,10 +1369,6 @@
end;
function CheckDirectories: Boolean;
- {$IFDEF MSWINDOWS}
- var
- PathEnvVar: string;
- {$ENDIF MSWINDOWS}
begin
Result := True;
@@ -1409,21 +1405,6 @@
GUI.Dialog(Format(RsErrorCantCreatePath, [GetDcpPath]), dtError, [drCancel]);
end;
end;
- {$IFDEF MSWINDOWS}
- if CLRVersion = '' then
- begin
- PathEnvVar := RegReadStringDef(HKCU, RegHKCUEnvironmentVar, PathEnvironmentVar, '');
- PathListIncludeItems(PathEnvVar, RegReadStringDef(HKLM, RegHKLMEnvironmentVar, PathEnvironmentVar, ''));
- ExpandEnvironmentVar(PathEnvVar);
- if (PathListItemIndex(PathEnvVar, GetBplPath) = -1) and (PathListItemIndex(PathEnvVar, PathAddSeparator(GetBplPath)) = -1)
- and Assigned(GUI) and (GUI.Dialog(RsWarningAddPathToEnvironment, dtWarning, [drYes, drNo]) = drYes) then
- begin
- PathEnvVar := RegReadStringDef(HKCU, RegHKCUEnvironmentVar, PathEnvironmentVar, '');
- PathListIncludeItems(PathEnvVar, GetBplPath);
- RegWriteString(HKCU, RegHKCUEnvironmentVar, PathEnvironmentVar, PathEnvVar);
- end;
- end;
- {$ENDIF MSWINDOWS}
end;
end;
@@ -1790,11 +1771,29 @@
end;
function RegisterPackages(ATarget: TJclBorRADToolInstallation): Boolean;
+ {$IFDEF MSWINDOWS}
+ var
+ PathEnvVar: string;
+ {$ENDIF MSWINDOWS}
begin
{$IFDEF MSWINDOWS}
- InstallJediRegInformation(Target.ConfigDataLocation, 'JCL',
- Format('%d.%d.%d.%d', [JclVersionMajor, JclVersionMinor, JclVersionRelease, JclVersionBuild]),
- GetDcpPath, GetBplPath, Distribution.FJclPath, ATarget.RootKey);
+ if CLRVersion = '' then
+ begin
+ InstallJediRegInformation(ATarget.ConfigDataLocation, 'JCL',
+ Format('%d.%d.%d.%d', [JclVersionMajor, JclVersionMinor, JclVersionRelease, JclVersionBuild]),
+ GetDcpPath, GetBplPath, Distribution.FJclPath, ATarget.RootKey);
+
+ PathEnvVar := RegReadStringDef(ATarget.RootKey, RegHKCUEnvironmentVar, PathEnvironmentVar, '');
+ PathListIncludeItems(PathEnvVar, RegReadStringDef(HKLM, RegHKLMEnvironmentVar, PathEnvironmentVar, ''));
+ ExpandEnvironmentVar(PathEnvVar);
+ if (PathListItemIndex(PathEnvVar, GetBplPath) = -1) and (PathListItemIndex(PathEnvVar, PathAddSeparator(GetBplPath)) = -1)
+ and Assigned(GUI) and (GUI.Dialog(RsWarningAddPathToEnvironment, dtWarning, [drYes, drNo]) = drYes) then
+ begin
+ PathEnvVar := RegReadStringDef(ATarget.RootKey, RegHKCUEnvironmentVar, PathEnvironmentVar, '');
+ PathListIncludeItems(PathEnvVar, GetBplPath);
+ RegWriteString(ATarget.RootKey, RegHKCUEnvironmentVar, PathEnvironmentVar, PathEnvVar);
+ end;
+ end;
{$ENDIF MSWINDOWS}
Result := True;
end;
@@ -3236,10 +3235,12 @@
brCppBuilder :
Result := Target.VersionNumber in [5, 6];
brBorlandDevStudio :
- Result := Target.VersionNumber in [1, 2, 3, 4, 5];
+ Result := ((Target.VersionNumber in [1, 2]) and (bpDelphi32 in Target.Personalities))
+ or (Target.VersionNumber in [3, 4, 5]);
else
Result := False;
end;
+ Result := Result and (Target.Personalities * [bpDelphi32, bpBCBuilder32, bpDelphiNet32, bpDelphiNet64] <> []);
{$ENDIF ~KYLIX}
end;
var
@@ -3433,16 +3434,20 @@
ReadMePage := GUI.CreateReadmePage;
ReadMePage.Caption := Version;
ReadMePage.ReadmeFileName := FJclReadmeFileName;
- FProfilesPage := GUI.CreateProfilesPage;
- FProfilesPage.Caption := 'Profiles';
- Settings := InstallCore.Configuration;
- if Settings <> nil then
- for Index := 0 to InstallCore.ProfilesManager.ProfileCount - 1 do
+ if InstallCore.ProfilesManager.MultipleProfileMode then
begin
- ProfileName := InstallCore.ProfilesManager.ProfileNames[Index];
- if Settings.ValueExists(ProfilesSectionName, ProfileName) then
- FProfilesPage.IsProfileEnabled[Index] := Settings.OptionAsBoolByName[ProfilesSectionName, ProfileName];
+ FProfilesPage := GUI.CreateProfilesPage;
+ FProfilesPage.Caption := 'Profiles';
+
+ Settings := InstallCore.Configuration;
+ if Settings <> nil then
+ for Index := 0 to InstallCore.ProfilesManager.ProfileCount - 1 do
+ begin
+ ProfileName := InstallCore.ProfilesManager.ProfileNames[Index];
+ if Settings.ValueExists(ProfilesSectionName, ProfileName) then
+ FProfilesPage.IsProfileEnabled[Index] := Settings.OptionAsBoolByName[ProfilesSectionName, ProfileName];
+ end;
end;
end;
Modified: trunk/jcl/install/JediProfiles.pas
===================================================================
--- trunk/jcl/install/JediProfiles.pas 2007-09-26 11:32:58 UTC (rev 2188)
+++ trunk/jcl/install/JediProfiles.pas 2007-09-26 18:28:42 UTC (rev 2189)
@@ -1,291 +1,295 @@
-{**************************************************************************************************}
-{ }
-{ Project JEDI Code Library (JCL) extension }
-{ }
-{ 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 JediProfiles.pas. }
-{ }
-{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by Florent Ouchet }
-{ are Copyright (C) of Florent Ouchet. All Rights Reserved. }
-{ }
-{ Contributors: }
-{ }
-{**************************************************************************************************}
-{ }
-{ Core unit to manipulate multiple users' profiles at install time }
-{ }
-{**************************************************************************************************}
-{ }
-{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
-{ Revision: $Rev:: 2175 $ }
-{ Author: $Author:: outchy $ }
-{ }
-{**************************************************************************************************}
-
-unit JediProfiles;
-
-{$I jcl.inc}
-
-interface
-
-uses
- {$IFDEF MSWINDOWS}
- Windows,
- {$ENDIF MSWINDOWS}
- SysUtils,
- Classes,
- JediInstall;
-
-type
- {$IFDEF MSWINDOWS}
- TJediProfile = record
- UserName: string;
- SID: string;
- LocalProfile: string;
- UserKey: HKEY;
- CloseKey: Boolean;
- UnloadKey: Boolean;
- end;
- {$ENDIF MSWINDOWS}
-
- TJediProfilesManager = class(TInterfacedObject, IJediProfilesManager)
- private
- FMultipleProfileMode: Boolean;
- {$IFDEF MSWINDOWS}
- FProfiles: array of TJediProfile;
- procedure LoadProfiles;
- {$ENDIF MSWINDOWS}
- public
- destructor Destroy; override;
- { IJediProfileManager }
- function CheckPrerequisites: Boolean;
- function GetMultipleProfileMode: Boolean;
- function GetProfileKey(Index: Integer): LongWord; // HKEY is Windows specific
- function GetProfileCount: Integer;
- function GetProfileName(Index: Integer): string;
- procedure SetMultipleProfileMode(Value: Boolean);
- property MultipleProfileMode: Boolean read GetMultipleProfileMode write SetMultipleProfileMode;
- end;
-
-implementation
-
-{$IFDEF MSWINDOWS}
-uses
- JclAnsiStrings,
- JclFileUtils,
- JclRegistry,
- JclSecurity,
- JclShell,
- JclSysInfo,
- JclWin32;
-
-const
- RegProfileListKey = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList';
-{$ENDIF MSWINDOWS}
-
-//=== { TJediProfileManager } ================================================
-
-destructor TJediProfilesManager.Destroy;
-{$IFDEF MSWINDOWS}
-var
- Index: Integer;
-{$ENDIF MSWINDOWS}
-begin
- {$IFDEF MSWINDOWS}
- for Index := Low(FProfiles) to High(FProfiles) do
- begin
- if FProfiles[Index].CloseKey then
- begin
- Windows.RegFlushKey(FProfiles[Index].UserKey);
- Windows.RegCloseKey(FProfiles[Index].UserKey);
- end;
-
- if FProfiles[Index].UnloadKey then
- Windows.RegUnLoadKey(HKUS, PAnsiChar(FProfiles[Index].SID));
- end;
- SetLength(FProfiles, 0);
- {$ENDIF MSWINDOWS}
- inherited Destroy;
-end;
-
-function TJediProfilesManager.CheckPrerequisites: Boolean;
-{$IFDEF MSWINDOWS}
-var
- InstallGUI: IJediInstallGUI;
- Fork: Boolean;
- Parameters: string;
- Index: Integer;
-{$ENDIF MSWINDOWS}
-begin
- {$IFDEF MSWINDOWS}
- FMultipleProfileMode := FMultipleProfileMode and IsWinNT;
- Result := not FMultipleProfileMode;
- if not Result then
- begin
- Result := IsElevated;
- if not Result then
- begin
- // attempt to fork as an administrator
- InstallGUI := InstallCore.InstallGUI;
- if Assigned(InstallGUI) then
- Fork := InstallGUI.Dialog('Installation requires administrator privilege, do you want to run installer with' +
- ' administrator rights', dtConfirmation, [drYes, drNo]) = drYes
- else
- Fork := True;
- if Fork then
- begin
- Parameters := '';
- for Index := 1 to ParamCount do
- Parameters := Parameters + AnsiQuotedStr(ParamStr(Index), AnsiDoubleQuote);
- ShellExecAndWait(ParamStr(0), Parameters, 'runas');
- Result := False;
- end
- else
- begin
- // single profile installation for current user
- FMultipleProfileMode := False;
- Result := True;
- end;
- end;
- end;
- if FMultipleProfileMode and Result then
- LoadProfiles;
- {$ENDIF MSWINDOWS}
- {$IFDEF UNIX}
- // don't know how to enumerate profiles on Linux
- Result := not FMultipleProfileMode;
- FMultipleProfileMode := False;
- {$ENDIF UNIX}
-end;
-
-function TJediProfilesManager.GetMultipleProfileMode: Boolean;
-begin
- Result := FMultipleProfileMode;
-end;
-
-function TJediProfilesManager.GetProfileCount: Integer;
-begin
- {$IFDEF MSWINDOWS}
- if FMultipleProfileMode then
- Result := Length(FProfiles)
- else
- {$ENDIF MSWINDOWS}
- Result := 0;
-end;
-
-function TJediProfilesManager.GetProfileKey(Index: Integer): LongWord;
-{$IFDEF MSWINDOWS}
-var
- NtUserFileName: string;
- Key: HKEY;
-{$ENDIF MSWINDOWS}
-begin
- {$IFDEF MSWINDOWS}
- if FMultipleProfileMode then
- begin
- if FProfiles[Index].UserKey = 0 then
- begin
- if AnsiSameText(FProfiles[Index].UserName, GetLocalUserName) then
- FProfiles[Index].UserKey := HKCU
- else
- begin
- NtUserFileName := PathAddSeparator(FProfiles[Index].LocalProfile) + 'NTUSER.DAT';
- if not RegKeyExists(HKUS, '\' + FProfiles[Index].SID) then
- begin
- EnableProcessPrivilege(True, SE_RESTORE_NAME);
- EnableProcessPrivilege(True, SE_BACKUP_NAME);
- if RegLoadKey(HKUS, PAnsiChar(FProfiles[Index].SID), PAnsiChar(NtUserFileName)) = ERROR_SUCCESS then
- FProfiles[Index].UnloadKey := True
- else
- RaiseLastOSError;
- end;
- if RegOpenKey(HKUS, PAnsiChar(FProfiles[Index].SID), Key) = ERROR_SUCCESS then
- FProfiles[Index].CloseKey := True
- else
- raise EJclSecurityError.CreateFmt('Unable to load profile for user "%s"', [FProfiles[Index].UserName]);
- FProfiles[Index].UserKey := Key;
- end;
- end;
- Result := FProfiles[Index].UserKey;
- end
- else
- Result := HKCU;
- {$ENDIF MSWINDOWS}
- {$IFDEF LINUX}
- Result := 0;
- {$ENDIF LINUX}
-end;
-
-function TJediProfilesManager.GetProfileName(Index: Integer): string;
-begin
- {$IFDEF MSWINDOWS}
- if FMultipleProfileMode then
- Result := FProfiles[Index].UserName
- else
- {$ENDIF MSWINDOWS}
- Result := '';
-end;
-
-{$IFDEF MSWINDOWS}
-procedure TJediProfilesManager.LoadProfiles;
-var
- Index: Integer;
- SID: PSID;
- DataSize: Cardinal;
- Name, Domain, KeyName, SIDStr, ProfileDir: string;
- RegProfiles: TStrings;
-begin
- if FMultipleProfileMode then
- begin
- RegProfiles := TStringList.Create;
- try
- GetMem(SID, SECURITY_MAX_SID_SIZE);
- try
- if RegGetKeyNames(HKLM, RegProfileListKey, RegProfiles) then
- for Index := 0 to RegProfiles.Count - 1 do
- begin
- KeyName := RegProfileListKey + '\' + RegProfiles.Strings[Index];
- if RegReadBinaryEx(HKLM, KeyName, 'Sid', SID^, SECURITY_MAX_SID_SIZE, DataSize, False)
- and RegReadAnsiStringEx(HKLM, KeyName, 'ProfileImagePath', ProfileDir, False) then
- begin
- try
- SIDStr := SIDToString(SID);
- LookupAccountBySid(SID, Name, Domain);
- if SameText(Domain, GetLocalComputerName) then
- begin
- SetLength(FProfiles, Length(FProfiles) + 1);
- FProfiles[High(FProfiles)].UserName := Name;
- FProfiles[High(FProfiles)].SID := SIDStr;
- FProfiles[High(FProfiles)].LocalProfile := ProfileDir;
- FProfiles[High(FProfiles)].UserKey := 0;
- FProfiles[High(FProfiles)].CloseKey := False;
- FProfiles[High(FProfiles)].UnloadKey := False;
- end;
- except
- // trap deleted accounts
- end;
- end;
- end;
- finally
- FreeMem(SID);
- end;
- finally
- RegProfiles.Free;
- end;
- end;
-end;
-{$ENDIF MSWINDOWS}
-
-procedure TJediProfilesManager.SetMultipleProfileMode(Value: Boolean);
-begin
- FMultipleProfileMode := Value;
-end;
-
-end.
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) extension }
+{ }
+{ 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 JediProfiles.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by Florent Ouchet }
+{ are Copyright (C) of Florent Ouchet. All Rights Reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Core unit to manipulate multiple users' profiles at install time }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: $ }
+{ Revision: $Rev:: $ }
+{ Author: $Author:: $ }
+{ }
+{**************************************************************************************************}
+
+unit JediProfiles;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ENDIF MSWINDOWS}
+ SysUtils,
+ Classes,
+ JediInstall;
+
+type
+ {$IFDEF MSWINDOWS}
+ TJediProfile = record
+ UserName: string;
+ SID: string;
+ LocalProfile: string;
+ UserKey: HKEY;
+ CloseKey: Boolean;
+ UnloadKey: Boolean;
+ end;
+ {$ENDIF MSWINDOWS}
+
+ TJediProfilesManager = class(TInterfacedObject, IJediProfilesManager)
+ private
+ FMultipleProfileMode: Boolean;
+ {$IFDEF MSWINDOWS}
+ FProfiles: array of TJediProfile;
+ procedure LoadProfiles;
+ {$ENDIF MSWINDOWS}
+ public
+ destructor Destroy; override;
+ { IJediProfileManager }
+ function CheckPrerequisites: Boolean;
+ function GetMultipleProfileMode: Boolean;
+ function GetProfileKey(Index: Integer): LongWord; // HKEY is Windows specific
+ function GetProfileCount: Integer;
+ function GetProfileName(Index: Integer): string;
+ procedure SetMultipleProfileMode(Value: Boolean);
+ property MultipleProfileMode: Boolean read GetMultipleProfileMode write SetMultipleProfileMode;
+ end;
+
+implementation
+
+{$IFDEF MSWINDOWS}
+uses
+ JclAnsiStrings,
+ JclFileUtils,
+ JclRegistry,
+ JclSecurity,
+ JclShell,
+ JclSysInfo,
+ JclWin32;
+
+const
+ RegProfileListKey = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList';
+{$ENDIF MSWINDOWS}
+
+//=== { TJediProfileManager } ================================================
+
+destructor TJediProfilesManager.Destroy;
+{$IFDEF MSWINDOWS}
+var
+ Index: Integer;
+{$ENDIF MSWINDOWS}
+begin
+ {$IFDEF MSWINDOWS}
+ for Index := Low(FProfiles) to High(FProfiles) do
+ begin
+ if FProfiles[Index].CloseKey then
+ begin
+ Windows.RegFlushKey(FProfiles[Index].UserKey);
+ Windows.RegCloseKey(FProfiles[Index].UserKey);
+ end;
+
+ if FProfiles[Index].UnloadKey then
+ Windows.RegUnLoadKey(HKUS, PAnsiChar(FProfiles[Index].SID));
+ end;
+ SetLength(FProfiles, 0);
+ {$ENDIF MSWINDOWS}
+ inherited Destroy;
+end;
+
+function TJediProfilesManager.CheckPrerequisites: Boolean;
+{$IFDEF MSWINDOWS}
+var
+ InstallGUI: IJediInstallGUI;
+ Fork: Boolean;
+ Parameters: string;
+ Index: Integer;
+{$ENDIF MSWINDOWS}
+begin
+ {$IFDEF MSWINDOWS}
+ FMultipleProfileMode := FMultipleProfileMode and IsWinNT;
+ Result := not FMultipleProfileMode;
+ if not Result then
+ begin
+ Result := IsElevated;
+ if not Result then
+ begin
+ // attempt to fork as an administrator
+ InstallGUI := InstallCore.InstallGUI;
+ if Assigned(InstallGUI) then
+ Fork := InstallGUI.Dialog('Installation requires administrator privilege, do you want to run installer with' +
+ ' administrator rights?', dtConfirmation, [drYes, drNo]) = drYes
+ else
+ Fork := True;
+ if Fork then
+ begin
+ Parameters := '';
+ for Index := 1 to ParamCount do
+ Parameters := Parameters + AnsiQuotedStr(ParamStr(Index), AnsiDoubleQuote);
+ ShellExecEx(ParamStr(0), Parameters, 'runas');
+ Result := False;
+ end
+ else
+ begin
+ // single profile installation for current user
+ FMultipleProfileMode := False;
+ Result := True;
+ end;
+ end;
+ end;
+ if FMultipleProfileMode and Result then
+ LoadProfiles;
+ {$ENDIF MSWINDOWS}
+ {$IFDEF UNIX}
+ // don't know how to enumerate profiles on Linux
+ Result := not FMultipleProfileMode;
+ FMultipleProfileMode := False;
+ {$ENDIF UNIX}
+end;
+
+function TJediProfilesManager.GetMultipleProfileMode: Boolean;
+begin
+ Result := FMultipleProfileMode;
+end;
+
+function TJediProfilesManager.GetProfileCount: Integer;
+begin
+ {$IFDEF MSWINDOWS}
+ if FMultipleProfileMode then
+ Result := Length(FProfiles)
+ else
+ {$ENDIF MSWINDOWS}
+ Result := 0;
+end;
+
+function TJediProfilesManager.GetProfileKey(Index: Integer): LongWord;
+{$IFDEF MSWINDOWS}
+var
+ NtUserFileName: string;
+ Key: HKEY;
+{$ENDIF MSWINDOWS}
+begin
+ {$IFDEF MSWINDOWS}
+ if FMultipleProfileMode then
+ begin
+ if FProfiles[Index].UserKey = 0 then
+ begin
+ if AnsiSameText(FProfiles[Index].UserName, GetLocalUserName) then
+ FProfiles[Index].UserKey := HKCU
+ else
+ begin
+ NtUserFileName := PathAddSeparator(FProfiles[Index].LocalProfile) + 'NTUSER.DAT';
+ if not RegKeyExists(HKUS, '\' + FProfiles[Index].SID) then
+ begin
+ EnableProcessPrivilege(True, SE_RESTORE_NAME);
+ EnableProcessPrivilege(True, SE_BACKUP_NAME);
+ if RegLoadKey(HKUS, PAnsiChar(FProfiles[Index].SID), PAnsiChar(NtUserFileName)) = ERROR_SUCCESS then
+ FProfiles[Index].UnloadKey := True
+ else
+ {$IFDEF COMPILER5}
+ RaiseLastWin32Error;
+ {$ELSE ~COMPILER5}
+ RaiseLastOSError;
+ {$ENDIF ~COMPILER5}
+ end;
+ if RegOpenKey(HKUS, PAnsiChar(FProfiles[Index].SID), Key) = ERROR_SUCCESS then
+ FProfiles[Index].CloseKey := True
+ else
+ raise EJclSecurityError.CreateFmt('Unable to load profile for user "%s"', [FProfiles[Index].UserName]);
+ FProfiles[Index].UserKey := Key;
+ end;
+ end;
+ Result := FProfiles[Index].UserKey;
+ end
+ else
+ Result := HKCU;
+ {$ENDIF MSWINDOWS}
+ {$IFDEF LINUX}
+ Result := 0;
+ {$ENDIF LINUX}
+end;
+
+function TJediProfilesManager.GetProfileName(Index: Integer): string;
+begin
+ {$IFDEF MSWINDOWS}
+ if FMultipleProfileMode then
+ Result := FProfiles[Index].UserName
+ else
+ {$ENDIF MSWINDOWS}
+ Result := '';
+end;
+
+{$IFDEF MSWINDOWS}
+procedure TJediProfilesManager.LoadProfiles;
+var
+ Index: Integer;
+ SID: PSID;
+ DataSize: Cardinal;
+ Name, Domain, KeyName, SIDStr, ProfileDir: string;
+ RegProfiles: TStrings;
+begin
+ if FMultipleProfileMode then
+ begin
+ RegProfiles := TStringList.Create;
+ try
+ GetMem(SID, SECURITY_MAX_SID_SIZE);
+ try
+ if RegGetKeyNames(HKLM, RegProfileListKey, RegProfiles) then
+ for Index := 0 to RegProfiles.Count - 1 do
+ begin
+ KeyName := RegProfileListKey + '\' + RegProfiles.Strings[Index];
+ if RegReadBinaryEx(HKLM, KeyName, 'Sid', SID^, SECURITY_MAX_SID_SIZE, DataSize, False)
+ and RegReadAnsiStringEx(HKLM, KeyName, 'ProfileImagePath', ProfileDir, False) then
+ begin
+ try
+ SIDStr := SIDToString(SID);
+ LookupAccountBySid(SID, Name, Domain);
+ if SameText(Domain, GetLocalComputerName) then
+ begin
+ SetLength(FProfiles, Length(FProfiles) + 1);
+ FProfiles[High(FProfiles)].UserName := Name;
+ FProfiles[High(FProfiles)].SID := SIDStr;
+ FProfiles[High(FProfiles)].LocalProfile := ProfileDir;
+ FProfiles[High(FProfiles)].UserKey := 0;
+ FProfiles[High(FProfiles)].CloseKey := False;
+ FProfiles[High(FProfiles)].UnloadKey := False;
+ end;
+ except
+ // trap deleted accounts
+ end;
+ end;
+ end;
+ finally
+ FreeMem(SID);
+ end;
+ finally
+ RegProfiles.Free;
+ end;
+ end;
+end;
+{$ENDIF MSWINDOWS}
+
+procedure TJediProfilesManager.SetMultipleProfileMode(Value: Boolean);
+begin
+ FMultipleProfileMode := Value;
+end;
+
+end.
Property changes on: trunk/jcl/install/JediProfiles.pas
___________________________________________________________________
Name: svn:keywords
+ URL HeadURL Author LastChangedBy Date LastChangedDate Rev Revision LastChangedRevision Id
Name: svn:eol-style
+ native
Modified: trunk/jcl/install/VclGui/JediGUIProfiles.dfm
===================================================================
--- trunk/jcl/install/VclGui/JediGUIProfiles.dfm 2007-09-26 11:32:58 UTC (rev 2188)
+++ trunk/jcl/install/VclGui/JediGUIProfiles.dfm 2007-09-26 18:28:42 UTC (rev 2189)
@@ -1,27 +1,27 @@
-object ProfilesFrame: TProfilesFrame
- Left = 0
- Top = 0
- Width = 320
- Height = 240
- AutoScroll = True
- TabOrder = 0
- object MemoComment: TMemo
- Left = 16
- Top = 16
- Width = 281
- Height = 73
- Anchors = [akLeft, akTop, akRight]
- BorderStyle = bsNone
- Lines.Strings = (
-
- 'Select profile in the list below. Note that only remote profiles' +
- ' logged on local computer and local profiles are available.'
-
- 'If a profile has not IDE settings, the JCL won'#39't be installed on' +
- ' it.')
- ParentColor = True
- ReadOnly = True
- TabOrder = 0
- WordWrap = False
- end
-end
+object ProfilesFrame: TProfilesFrame
+ Left = 0
+ Top = 0
+ Width = 320
+ Height = 240
+ AutoScroll = True
+ TabOrder = 0
+ object MemoComment: TMemo
+ Left = 16
+ Top = 16
+ Width = 281
+ Height = 73
+ Anchors = [akLeft, akTop, akRight]
+ BorderStyle = bsNone
+ Lines.Strings = (
+
+ 'Select profile in the list below. Note that only remote profiles' +
+ ' logged on local computer and local profiles are available.'
+
+ 'If a profile has not IDE settings, the JCL won'#39't be installed on' +
+ ' it.')
+ ParentColor = True
+ ReadOnly = True
+ TabOrder = 0
+ WordWrap = False
+ end
+end
Property changes on: trunk/jcl/install/VclGui/JediGUIProfiles.dfm
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: trunk/jcl/install/VclGui/JediGUIProfiles.pas
===================================================================
--- trunk/jcl/install/VclGui/JediGUIProfiles.pas 2007-09-26 11:32:58 UTC (rev 2188)
+++ trunk/jcl/install/VclGui/JediGUIProfiles.pas 2007-09-26 18:28:42 UTC (rev 2189)
@@ -1,103 +1,103 @@
-{**************************************************************************************************}
-{ }
-{ Project JEDI Code Library (JCL) extension }
-{ }
-{ 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 JediGUIProfiles.pas. }
-{ }
-{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by Florent Ouchet }
-{ are Copyright (C) of Florent Ouchet. All Rights Reserved. }
-{ }
-{ Contributors: }
-{ }
-{**************************************************************************************************}
-{ }
-{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
-{ Revision: $Rev:: 2175 $ }
-{ Author: $Author:: outchy $ }
-{ }
-{**************************************************************************************************}
-
-unit JediGUIProfiles;
-
-{$I jcl.inc}
-
-interface
-
-uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, JediInstall, StdCtrls, ComCtrls;
-
-type
- TProfilesFrame = class(TFrame, IJediProfilesPage, IJediPage)
- MemoComment: TMemo;
- public
- constructor Create(AOwner: TComponent); override;
- // IJediPage
- function GetCaption: string;
- procedure SetCaption(const Value: string);
- function GetHintAtPos(ScreenX, ScreenY: Integer): string;
- // IJediProfilesPage
- function GetProfileEnabled(Index: Integer): Boolean;
- procedure SetProfileEnabled(Index: Integer; Value: Boolean);
- end;
-
-implementation
-
-{$R *.dfm}
-
-//=== { TProfilesFrame } =====================================================
-
-constructor TProfilesFrame.Create(AOwner: TComponent);
-var
- Index: Integer;
- ACheckBox: TCheckBox;
- AProfilesManager: IJediProfilesManager;
-begin
- inherited Create(AOwner);
- MemoComment.WordWrap := True;
- AProfilesManager := InstallCore.ProfilesManager;
- for Index := 0 to AProfilesManager.ProfileCount - 1 do
- begin
- ACheckBox := TCheckBox.Create(Self);
- ACheckBox.SetBounds(48, Index * 32 + 100, Width - 96, ACheckBox.Height);
- ACheckBox.Anchors := [akLeft, akTop, akRight];
- ACheckBox.Parent := Self;
- ACheckBox.Checked := True;
- ACheckBox.Caption := AProfilesManager.ProfileNames[Index];
- end;
-end;
-
-function TProfilesFrame.GetCaption: string;
-begin
- Result := (Parent as TTabSheet).Caption;
-end;
-
-function TProfilesFrame.GetHintAtPos(ScreenX, ScreenY: Integer): string;
-begin
- Result := '';
-end;
-
-function TProfilesFrame.GetProfileEnabled(Index: Integer): Boolean;
-begin
- Result := (Controls[Index + 1] as TCheckBox).Checked;
-end;
-
-procedure TProfilesFrame.SetCaption(const Value: string);
-begin
- (Parent as TTabSheet).Caption := Value;
-end;
-
-procedure TProfilesFrame.SetProfileEnabled(Index: Integer; Value: Boolean);
-begin
- (Controls[Index + 1] as TCheckBox).Checked := Value;
-end;
-
-end.
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) extension }
+{ }
+{ 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 JediGUIProfiles.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by Florent Ouchet }
+{ are Copyright (C) of Florent Ouchet. All Rights Reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: $ }
+{ Revision: $Rev:: $ }
+{ Author: $Author:: $ }
+{ }
+{**************************************************************************************************}
+
+unit JediGUIProfiles;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, JediInstall, StdCtrls, ComCtrls;
+
+type
+ TProfilesFrame = class(TFrame, IJediProfilesPage, IJediPage)
+ MemoComment: TMemo;
+ public
+ constructor Create(AOwner: TComponent); override;
+ // IJediPage
+ function GetCaption: string;
+ procedure SetCaption(const Value: string);
+ function GetHintAtPos(ScreenX, ScreenY: Integer): string;
+ // IJediProfilesPage
+ function GetProfileEnabled(Index: Integer): Boolean;
+ procedure SetProfileEnabled(Index: Integer; Value: Boolean);
+ end;
+
+implementation
+
+{$R *.dfm}
+
+//=== { TProfilesFrame } =====================================================
+
+constructor TProfilesFrame.Create(AOwner: TComponent);
+var
+ Index: Integer;
+ ACheckBox: TCheckBox;
+ AProfilesManager: IJediProfilesManager;
+begin
+ inherited Create(AOwner);
+ MemoComment.WordWrap := True;
+ AProfilesManager := InstallCore.ProfilesManager;
+ for Index := 0 to AProfilesManager.ProfileCount - 1 do
+ begin
+ ACheckBox := TCheckBox.Create(Self);
+ ACheckBox.SetBounds(48, Index * 32 + 100, Width - 96, ACheckBox.Height);
+ ACheckBox.Anchors := [akLeft, akTop, akRight];
+ ACheckBox.Parent := Self;
+ ACheckBox.Checked := True;
+ ACheckBox.Caption := AProfilesManager.ProfileNames[Index];
+ end;
+end;
+
+function TProfilesFrame.GetCaption: string;
+begin
+ Result := (Parent as TTabSheet).Caption;
+end;
+
+function TProfilesFrame.GetHintAtPos(ScreenX, ScreenY: Integer): string;
+begin
+ Result := '';
+end;
+
+function TProfilesFrame.GetProfileEnabled(Index: Integer): Boolean;
+begin
+ Result := (Controls[Index + 1] as TCheckBox).Checked;
+end;
+
+procedure TProfilesFrame.SetCaption(const Value: string);
+begin
+ (Parent as TTabSheet).Caption := Value;
+end;
+
+procedure TProfilesFrame.SetProfileEnabled(Index: Integer; Value: Boolean);
+begin
+ (Controls[Index + 1] as TCheckBox).Checked := Value;
+end;
+
+end.
Property changes on: trunk/jcl/install/VclGui/JediGUIProfiles.pas
___________________________________________________________________
Name: svn:keywords
+ URL HeadURL Author LastChangedBy Date LastChangedDate Rev Revision LastChangedRevision Id
Name: svn:eol-style
+ native
Modified: trunk/jcl/source/common/JclBorlandTools.pas
===================================================================
--- trunk/jcl/source/common/JclBorlandTools.pas 2007-09-26 11:32:58 UTC (rev 2188)
+++ trunk/jcl/source/common/JclBorlandTools.pas 2007-09-26 18:28:42 UTC (rev 2189)
@@ -791,6 +791,7 @@
procedure SetCppSearchPath(const Value: TJclBorRADToolPath);
procedure SetCppLibraryPath(const Value: TJclBorRADToolPath);
function GetMaxDelphiCLRVersion: string;
+ function GetDCCIL: TJclDCCIL;
function GetMsBuildEnvOptionsFileName: string;
function GetMsBuildEnvOption(const OptionName: string): string;
@@ -849,7 +850,7 @@
property DualPackageInstallation: Boolean read FDualPackageInstallation write SetDualPackageInstallation;
property Help2Manager: TJclHelp2Manager read FHelp2Manager;
- property DCCIL: TJclDCCIL read FDCCIL;
+ property DCCIL: TJclDCCIL read GetDCCIL;
property MaxDelphiCLRVersion: string read GetMaxDelphiCLRVersion;
property PdbCreate: Boolean read FPdbCreate write FPdbCreate;
end;
@@ -4714,7 +4715,6 @@
inherited Create(AConfigDataLocation, ARootKey);
FHelp2Manager := TJclHelp2Manager.Create(Self);
- { TODO : .net 64 bit }
if ConfigData.ReadString(PersonalitiesSection, 'C#Builder', '') <> '' then
Include(FPersonalities, bpCSBuilder32);
if ConfigData.ReadString(PersonalitiesSection, 'BCB', '') <> '' then
@@ -4723,21 +4723,20 @@
Include(FPersonalities, bpDelphi32);
if (ConfigData.ReadString(PersonalitiesSection, 'Delphi.NET', '') <> '') or
(ConfigData.ReadString(PersonalitiesSection, 'Delphi8', '') <> '') then
+ begin
Include(FPersonalities, bpDelphiNet32);
+ if VersionNumber >= 5 then
+ Include(FPersonalities, bpDelphiNet64);
+ end;
if clDcc32 in CommandLineTools then
Include(FPersonalities, bpDelphi32);
-
- if FPersonalities = [] then
- raise EJclBorRadException.CreateRes(@RsENoSupportedPersonality);
-
- FDCCIL := TJclDCCIL.Create(Self);
end;
destructor TJclBDSInstallation.Destroy;
begin
- FDCCIL.Free;
- FHelp2Manager.Free;
+ FreeAndNil(FDCCIL);
+ FreeAndNil(FHelp2Manager);
inherited Destroy;
end;
@@ -4986,6 +4985,17 @@
Result := ConfigData.ReadString(GetCppPathsKeyName, CppLibraryPathValueName, '');
end;
+function TJclBDSInstallation.GetDCCIL: TJclDCCIL;
+begin
+ if not Assigned(FDCCIL) then
+ begin
+ if not (clDccIL in CommandLineTools) then
+ raise EJclBorRadException.CreateResFmt(@RsENotFound, [DccILExeName]);
+ FDCCIL := TJclDCCIL.Create(Self);
+ end;
+ Result := FDCCIL;
+end;
+
function TJclBDSInstallation.GetDCPOutputPath: string;
begin
case IDEVersionNumber of
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-09-26 11:32:59
|
Revision: 2188
http://jcl.svn.sourceforge.net/jcl/?rev=2188&view=rev
Author: outchy
Date: 2007-09-26 04:32:58 -0700 (Wed, 26 Sep 2007)
Log Message:
-----------
Installation on multiple profiles (accounts) at the same time.
Modified Paths:
--------------
trunk/jcl/install/JclInstall.pas
trunk/jcl/install/JediInstall.pas
trunk/jcl/install/JediInstaller.dpr
trunk/jcl/install/JediRegInfo.pas
trunk/jcl/install/prototypes/JediGUIMain.pas
trunk/jcl/source/common/JclBorlandTools.pas
Added Paths:
-----------
trunk/jcl/Install multiple profiles.bat
trunk/jcl/install/JediProfiles.pas
trunk/jcl/install/VclGui/JediGUIProfiles.dfm
trunk/jcl/install/VclGui/JediGUIProfiles.pas
Added: trunk/jcl/Install multiple profiles.bat
===================================================================
--- trunk/jcl/Install multiple profiles.bat (rev 0)
+++ trunk/jcl/Install multiple profiles.bat 2007-09-26 11:32:58 UTC (rev 2188)
@@ -0,0 +1 @@
+Install Latest /MultipleProfiles
\ No newline at end of file
Property changes on: trunk/jcl/Install multiple profiles.bat
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas 2007-09-26 11:28:20 UTC (rev 2187)
+++ trunk/jcl/install/JclInstall.pas 2007-09-26 11:32:58 UTC (rev 2188)
@@ -142,12 +142,15 @@
FLogFileName: string;
FSilent: Boolean;
FRuntimeInstallation: Boolean;
+ FProfilesTargets: TObjectList;
procedure AddDemo(const Directory: string; const FileInfo: TSearchRec);
procedure AddDemos(const Directory: string);
function GetDemoList: TStringList;
function MakePath(const FormatStr: string): string;
procedure WriteLog(const Msg: string);
function GetEnabled: Boolean;
+ function GetIsProfileEnabled(Index: Integer): Boolean;
+ function GetProfilesTarget(Index: Integer): TJclBorRADToolInstallation;
protected
// if CLRVersion = '' then it is a native installation
constructor Create(JclDistribution: TJclDistribution;
@@ -157,13 +160,13 @@
{$IFDEF MSWINDOWS}
function CompileCLRPackage(const Name: string): Boolean;
{$ENDIF MSWINDOWS}
- function CompilePackage(const Name: string; InstallPackage: Boolean): Boolean;
+ function CompilePackage(const Name: string): Boolean;
function CompileApplication(FileName: string): Boolean;
- function UninstallPackage(const Name: string): Boolean;
+ function DeletePackage(const Name: string): Boolean;
procedure ConfigureBpr2Mak(const PackageFileName: string);
{$IFDEF MSWINDOWS}
- function CompileExpert(const Name: string; InstallExpert: Boolean): Boolean;
- function UninstallExpert(const Option: TJclOption): Boolean;
+ function CompileExpert(const Name: string): Boolean;
+ function DeleteExpert(const Option: TJclOption): Boolean;
{$ENDIF MSWINDOWS}
function GetBplPath: string;
@@ -195,6 +198,9 @@
property LogFileName: string read FLogFileName;
property Silent: Boolean read FSilent write FSilent;
property RuntimeInstallation: Boolean read FRuntimeInstallation; // false for C#Builder 1, Delphi 8 and .net targets
+
+ property IsProfileEnabled[Index: Integer]: Boolean read GetIsProfileEnabled;
+ property ProfileTargets[Index: Integer]: TJclBorRADToolInstallation read GetProfilesTarget;
end;
TJclDistribution = class (TInterfacedObject, IJediProduct)
@@ -225,39 +231,8 @@
{$ENDIF MSWINDOWS}
FRadToolInstallations: TJclBorRADToolInstallations;
FTargetInstalls: TObjectList;
-{ FIniFile: TMemIniFile;
- FOnStarting: TInstallationEvent;
- FOnEnding: TInstallationEvent;
- FInstalling: Boolean;
- function CreateInstall(Target: TJclBorRADToolInstallation): Boolean;
- function GetTargetInstall(Installation: TJclBorRADToolInstallation): TJclInstallation;
- procedure InitInstallationTargets; }
+ FProfilesPage: IJediProfilesPage;
function GetVersion: string;
- {protected
- constructor Create;
- function DocFileName(const BaseFileName: string): string;
- procedure SetTool(const Value: IJediInstallTool);
- property TargetInstall[Target: TJclBorRADToolInstallation]: TJclInstallation read GetTargetInstall;
- public
- destructor Destroy; override;
- function FeatureInfoFileName(FeatureID: Cardinal): string;
- function GetHint(Option: TJediInstallOption): string;
- function InitInformation(const ApplicationFileName: string): Boolean;
- function Install: Boolean;
- function Uninstall: Boolean;
- function ReadmeFileName: string;
- procedure SetOnWriteLog(Installation: TJclBorRADToolInstallation; Value: TTextHandler);
- procedure SetOnEnding(Value: TInstallationEvent);
- procedure SetOnStarting(Value: TInstallationEvent);
- function Supports(Target: TJclBorRADToolInstallation): Boolean;
- property BinDir: string read FJclBinDir;
- property ChmHelpFileName: string read FJclChmHelpFileName;
- property HlpHelpFileName: string read FJclHlpHelpFileName;
- property HxSHelpFileName: string read FJclHxSHelpFileName;
- property Installing: Boolean read FInstalling;
- property Path: string read FJclPath;
- property SourceDir: string read FJclSourceDir;
- property Tool: IJediInstallTool read FTool write SetTool;}
property Version: string read GetVersion;
function CreateInstall(Target: TJclBorRADToolInstallation): Boolean;
function GetTargetInstall(Index: Integer): TJclInstallation;
@@ -317,6 +292,8 @@
property GUI: IJediInstallGUI read FGUI;
property NbEnabled: Integer read FNbEnabled;
property NbInstalled: Integer read FNbInstalled;
+
+ property ProfilesPage: IJediProfilesPage read FProfilesPage;
end;
implementation
@@ -760,6 +737,8 @@
RegHKCUEnvironmentVar = 'Environment';
RegHKLMEnvironmentVar = 'SYSTEM\CurrentControlSet\Control\Session Manager\Environment';
+ ProfilesSectionName = 'Profiles';
+
resourcestring
RsInstallMessage = 'Installing %s...';
//RsStatusDetailMessage = 'Installing %s for %s...';
@@ -843,10 +822,21 @@
FDemoSectionName := Target.Name + ' demos';
FLogFileName := Format('%sbin%s%s.log', [Distribution.JclPath, DirDelimiter, TargetName]);
FLogLines := TJclSimpleLog.Create(FLogFileName);
+
+ FProfilesTargets := TObjectList.Create;
+ FProfilesTargets.Count := InstallCore.ProfilesManager.ProfileCount;
+ FProfilesTargets.OwnsObjects := False;
end;
destructor TJclInstallation.Destroy;
+var
+ Index: Integer;
begin
+ if Assigned(FProfilesTargets) then
+ for Index := 0 to FProfilesTargets.Count - 1 do
+ if FProfilesTargets.Items[Index] <> Target then
+ FProfilesTargets.Items[Index].Free;
+ FProfilesTargets.Free;
FDemoList.Free;
FLogLines.Free;
FGUI := nil;
@@ -860,6 +850,22 @@
Result := OptionCheckedById[OptionData[joLibrary].Id];
end;
+function TJclInstallation.GetIsProfileEnabled(Index: Integer): Boolean;
+var
+ AProfilesPage: IJediProfilesPage;
+ ASettings: IJediConfiguration;
+begin
+ AProfilesPage := FDistribution.ProfilesPage;
+ ASettings := InstallCore.Configuration;
+ if AProfilesPage <> nil then
+ Result := AProfilesPage.IsProfileEnabled[Index]
+ else
+ if ASettings <> nil then
+ Result := ASettings.OptionAsBoolByName[ProfilesSectionName, InstallCore.ProfilesManager.ProfileNames[Index]]
+ else
+ Result := True;
+end;
+
function TJclInstallation.GetOptionChecked(Option: TJclOption): Boolean;
begin
Result := OptionCheckedById[OptionData[Option].Id];
@@ -881,6 +887,31 @@
end;
end;
+function TJclInstallation.GetProfilesTarget(Index: Integer): TJclBorRADToolInstallation;
+{$IFDEF MSWINDOWS}
+var
+ RootKey: LongWord;
+begin
+ if FProfilesTargets.Items[Index] = nil then
+ begin
+ RootKey := InstallCore.ProfilesManager.GetProfileKey(Index);
+ if RootKey <> HKCU then
+ begin
+ FProfilesTargets.Items[Index] := TJclBorRADToolInstallationClass(Target.ClassType).Create(Target.ConfigDataLocation, RootKey);
+ TJclBorRADToolInstallation(FProfilesTargets.Items[Index]).OutputCallback := Target.OutputCallback;
+ end
+ else
+ FProfilesTargets.Items[Index] := Target;
+ end;
+ Result := FProfilesTargets.Items[Index] as TJclBorRADToolInstallation;
+end;
+{$ENDIF MSWINDOWS}
+{$IFDEF LINUX}
+begin
+ Result := nil;
+end;
+{$ENDIF LINUX}
+
procedure TJclInstallation.MarkOptionBegin(Id: Integer);
begin
if Assigned(GUIPage) then
@@ -1302,14 +1333,18 @@
end;
function TJclInstallation.Install: Boolean;
-
+var
+ AProfilesManager: IJediProfilesManager;
+
procedure WriteIntroduction;
var
Personality: TJclBorPersonality;
+ Index: Integer;
begin
+ WriteLog(StrRepeat('=', 80));
WriteLog(Distribution.Version);
WriteLog('');
- WriteLog(StrPadRight(TargetName, 44, '='));
+ WriteLog(StrPadRight(StrRepeat('=', 10) + TargetName, 80, '='));
WriteLog('');
WriteLog('Installed personalities :');
for Personality := Low(TJclBorPersonality) to High(TJclBorPersonality) do
@@ -1317,7 +1352,20 @@
begin
WriteLog(JclBorPersonalityDescription[Personality]);
end;
- WriteLog(StrRepeat('=', 44));
+ WriteLog('');
+ WriteLog(StrRepeat('=', 80));
+ WriteLog('');
+ if AProfilesManager.MultipleProfileMode then
+ begin
+ for Index := 0 to AProfilesManager.ProfileCount - 1 do
+ if IsProfileEnabled[Index] then
+ WriteLog(AProfilesManager.ProfileNames[Index]);
+ end
+ else
+ WriteLog('Single profile installation');
+ WriteLog('');
+ WriteLog(StrRepeat('=', 80));
+ WriteLog('');
end;
function CheckDirectories: Boolean;
@@ -1502,7 +1550,7 @@
end;
end;
- function SetEnvironment: Boolean;
+ function SetEnvironment(ATarget: TJclBorRADToolInstallation): Boolean;
begin
Result := True;
if OptionChecked[joEnvironment] then
@@ -1512,14 +1560,14 @@
if OptionChecked[joEnvLibPath] then
begin
MarkOptionBegin(joEnvLibPath);
- Result := Target.AddToLibrarySearchPath(FLibReleaseDir) and Target.AddToLibrarySearchPath(Distribution.JclSourceDir);
+ Result := ATarget.AddToLibrarySearchPath(FLibReleaseDir) and ATarget.AddToLibrarySearchPath(Distribution.JclSourceDir);
if Result then
begin
WriteLog(Format('Added "%s;%s" to library search path.', [FLibReleaseDir, Distribution.JclSourceDir]));
{$IFDEF MSWINDOWS}
- if (Target.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in Target.Personalities)
+ if (ATarget.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in ATarget.Personalities)
and OptionChecked[joDualPackages] then
- with TJclBDSInstallation(Target) do
+ with TJclBDSInstallation(ATarget) do
begin
Result := AddToCppSearchPath(FLibReleaseDir) and AddToCppSearchPath(Distribution.JclSourceDir) and
((IDEVersionNumber < 5) or AddToCppLibraryPath(FLibReleaseDir));
@@ -1529,9 +1577,9 @@
WriteLog('Failed to add cpp search paths.');
end;
{$ENDIF MSWINDOWS}
- if Target.IsTurboExplorer then
+ if ATarget.IsTurboExplorer then
begin
- Result := Target.AddToLibrarySearchPath(Distribution.JclSourcePath);
+ Result := ATarget.AddToLibrarySearchPath(Distribution.JclSourcePath);
if Result then
WriteLog(Format('Added "%s" to library search path.', [Distribution.JclSourcePath]))
else
@@ -1548,14 +1596,14 @@
MarkOptionBegin(joEnvBrowsingPath);
if Result then
begin
- Result := Target.AddToLibraryBrowsingPath(Distribution.JclSourcePath);
+ Result := ATarget.AddToLibraryBrowsingPath(Distribution.JclSourcePath);
if Result then
begin
WriteLog(Format('Added "%s" to library browsing path.', [Distribution.JclSourcePath]));
{$IFDEF MSWINDOWS}
- if (Target.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in Target.Personalities)
+ if (ATarget.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in ATarget.Personalities)
and OptionChecked[joDualPackages] then
- with TJclBDSInstallation(Target) do
+ with TJclBDSInstallation(ATarget) do
begin
Result := AddToCppBrowsingPath(Distribution.JclSourcePath);
if Result then
@@ -1576,7 +1624,7 @@
if Result and OptionChecked[joEnvDebugDCUPath] then
begin
MarkOptionBegin(joEnvDebugDCUPath);
- Result := Target.AddToDebugDCUPath(FLibDebugDir);
+ Result := ATarget.AddToDebugDCUPath(FLibDebugDir);
if Result then
WriteLog(Format('Added "%s" to Debug DCU Path.', [FLibDebugDir]))
else
@@ -1715,24 +1763,19 @@
MarkOptionBegin(joPackages);
if CLRVersion = '' then
begin
- {$IFDEF MSWINDOWS}
- InstallJediRegInformation(Target.ConfigDataLocation, 'JCL',
- Format('%d.%d.%d.%d', [JclVersionMajor, JclVersionMinor, JclVersionRelease, JclVersionBuild]),
- GetDcpPath, GetBplPath, Distribution.FJclPath);
- {$ENDIF MSWINDOWS}
- Result := CompilePackage(FullPackageFileName(Target, JclDpk), False);
+ Result := CompilePackage(FullPackageFileName(Target, JclDpk));
if Result and OptionChecked[joVclPackage] then
begin
MarkOptionBegin(joVclPackage);
- Result := Result and CompilePackage(FullPackageFileName(Target, JclVclDpk), False);
+ Result := Result and CompilePackage(FullPackageFileName(Target, JclVclDpk));
MarkOptionEnd(joVclPackage, Result);
end;
if Result and OptionChecked[joClxPackage] then
begin
MarkOptionBegin(joClxPackage);
- Result := Result and CompilePackage(FullPackageFileName(Target, JclVClxDpk), False);
+ Result := Result and CompilePackage(FullPackageFileName(Target, JclVClxDpk));
MarkOptionEnd(joClxPackage, Result);
end;
@@ -1746,8 +1789,18 @@
end;
end;
+ function RegisterPackages(ATarget: TJclBorRADToolInstallation): Boolean;
+ begin
+ {$IFDEF MSWINDOWS}
+ InstallJediRegInformation(Target.ConfigDataLocation, 'JCL',
+ Format('%d.%d.%d.%d', [JclVersionMajor, JclVersionMinor, JclVersionRelease, JclVersionBuild]),
+ GetDcpPath, GetBplPath, Distribution.FJclPath, ATarget.RootKey);
+ {$ENDIF MSWINDOWS}
+ Result := True;
+ end;
+
{$IFDEF MSWINDOWS}
- function InstallExperts: Boolean;
+ function CompileExperts: Boolean;
var
Option: TJclOption;
DLLExperts: Boolean;
@@ -1769,9 +1822,9 @@
else if Option = joExpertsDLL then
DLLExperts := OptionChecked[Option]
else if DLLExperts then
- Result := CompileExpert(FullLibraryFileName(Target, ExpertPaths[Option]), True)
+ Result := CompileExpert(FullLibraryFileName(Target, ExpertPaths[Option]))
else
- Result := CompilePackage(FullPackageFileName(Target,ExpertPaths[Option]), True);
+ Result := CompilePackage(FullPackageFileName(Target,ExpertPaths[Option]));
MarkOptionEnd(Option, Result);
if not Result then
Break;
@@ -1779,6 +1832,46 @@
MarkOptionEnd(joExperts, Result);
end;
end;
+
+ function RegisterExperts(ATarget: TJclBorRADToolInstallation): Boolean;
+ var
+ Option: TJclOption;
+ DLLExperts: Boolean;
+ ProjectFileName: string;
+ begin
+ Result := True;
+ if OptionChecked[joExperts] then
+ begin
+ MarkOptionBegin(joExperts);
+ DLLExperts := False;
+ // dual packages useless for experts
+ if ATarget.RadToolKind = brBorlandDevStudio then
+ TJclBDSInstallation(ATarget).DualPackageInstallation := False;
+ for Option := Low(ExpertPaths) to High(ExpertPaths) do
+ if OptionChecked[Option] then
+ begin
+ MarkOptionBegin(Option);
+ if Option = joExpertsDsgnPackages then
+ // nothing, default value
+ else if Option = joExpertsDLL then
+ DLLExperts := OptionChecked[Option]
+ else if DLLExperts then
+ begin
+ ProjectFileName := Distribution.JclPath + FullLibraryFileName(ATarget, ExpertPaths[Option]);
+ Result := ATarget.RegisterExpert(ProjectFileName, GetBplPath, PathExtractFileNameNoExt(ProjectFileName));
+ end
+ else
+ begin
+ ProjectFileName := Distribution.JclPath + FullPackageFileName(ATarget,ExpertPaths[Option]);
+ Result := ATarget.RegisterPackage(ProjectFileName, GetBplPath, PathExtractFileNameNoExt(ProjectFileName));
+ end;
+ MarkOptionEnd(Option, Result);
+ if not Result then
+ Break;
+ end;
+ MarkOptionEnd(joExperts, Result);
+ end;
+ end;
{$ENDIF MSWINDOWS}
function InstallRepository: Boolean;
@@ -1965,8 +2058,12 @@
MarkOptionEnd(joMakeDemos, Result);
end;
end;
-
+
+var
+ Index: Integer;
+ ATarget: TJclBorRADToolInstallation;
begin
+ AProfilesManager := InstallCore.ProfilesManager;
try
Target.OutputCallback := WriteLog;
@@ -1982,10 +2079,29 @@
FLogLines.ClearLog;
WriteIntroduction;
- Result := CheckDirectories and SetStaticOptions and SetEnvironment
- and MakeUnits and CompilePackages
- {$IFDEF MSWINDOWS} and InstallExperts and InstallHelpFiles {$ENDIF MSWINDOWS}
- and InstallRepository and MakeDemos;
+ Result := CheckDirectories and SetStaticOptions and MakeUnits and CompilePackages and InstallRepository
+ and MakeDemos {$IFDEF MSWINDOWS}and CompileExperts and InstallHelpFiles{$ENDIF MSWINDOWS};
+ if Result then
+ begin
+ if AProfilesManager.MultipleProfileMode then
+ begin
+ for Index := 0 to AProfilesManager.ProfileCount - 1 do
+ if IsProfileEnabled[Index] then
+ begin
+ ATarget := ProfileTargets[Index];
+ if ATarget.Valid then
+ begin
+ WriteLog(StrPadRight(StrRepeat('=', 10) + InstallCore.ProfilesManager.ProfileNames[Index], 80, '='));
+ Result := Result and SetEnvironment(ATarget) and RegisterPackages(ATarget)
+ {$IFDEF MSWINDOWS}and RegisterExperts(ATarget){$ENDIF MSWINDOWS};
+ end;
+ end;
+ end
+ else
+ Result := Result and SetEnvironment(Target) and RegisterPackages(Target)
+ {$IFDEF MSWINDOWS}and RegisterExperts(Target){$ENDIF MSWINDOWS};
+ end;
+
if not Result then
begin
Silent := True;
@@ -2033,18 +2149,18 @@
end;
function TJclInstallation.Uninstall(AUninstallHelp: Boolean): Boolean;
- procedure RemoveEnvironment;
+ procedure RemoveEnvironment(ATarget: TJclBorRADToolInstallation);
begin
//ioJclEnvLibPath
if CLRVersion = '' then
begin
- if Target.RemoveFromLibrarySearchPath(FLibReleaseDir) and Target.RemoveFromLibrarySearchPath(Distribution.JclSourceDir) then
+ if ATarget.RemoveFromLibrarySearchPath(FLibReleaseDir) and ATarget.RemoveFromLibrarySearchPath(Distribution.JclSourceDir) then
WriteLog(Format('Removed "%s;%s" from library search path.', [FLibReleaseDir, Distribution.JclSourceDir]))
else
WriteLog('Failed to remove library search path.');
{$IFDEF MSWINDOWS}
- if (Target.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in Target.Personalities) then
- with TJclBDSInstallation(Target) do
+ if (ATarget.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in ATarget.Personalities) then
+ with TJclBDSInstallation(ATarget) do
begin
if RemoveFromCppSearchPath(FLibReleaseDir) and RemoveFromCppSearchPath(Distribution.JclSourceDir) and
((IDEVersionNumber < 5) or RemoveFromCppLibraryPath(FLibReleaseDir)) then
@@ -2055,13 +2171,13 @@
{$ENDIF MSWINDOWS}
//ioJclEnvBrowsingPath
- if Target.RemoveFromLibraryBrowsingPath(Distribution.JclSourcePath) then
+ if ATarget.RemoveFromLibraryBrowsingPath(Distribution.JclSourcePath) then
WriteLog(Format('Removed "%s" from library browsing path.', [Distribution.JclSourcePath]))
else
WriteLog('Failed to remove library browsing path.');
{$IFDEF MSWINDOWS}
- if (Target.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in Target.Personalities) then
- with TJclBDSInstallation(Target) do
+ if (ATarget.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in ATarget.Personalities) then
+ with TJclBDSInstallation(ATarget) do
begin
if RemoveFromCppBrowsingPath(Distribution.JclSourcePath) then
WriteLog(Format('Removed "%s" from cpp browsing path.', [Distribution.JclSourcePath]))
@@ -2071,7 +2187,7 @@
{$ENDIF MSWINDOWS}
//ioJclEnvDebugDCUPath
- if Target.RemoveFromDebugDCUPath(FLibDebugDir) then
+ if ATarget.RemoveFromDebugDCUPath(FLibDebugDir) then
WriteLog(Format('Removed "%s" from Debug DCU Path.', [FLibDebugDir]));
end;
end;
@@ -2111,25 +2227,45 @@
//ioJclCheckHppFiles: ; // nothing to do
end;
- procedure UninstallPackages;
+ procedure UnregisterPackages(ATarget: TJclBorRADToolInstallation);
begin
if CLRVersion = '' then
begin
+ {$IFNDEF KYLIX}
+ if ATarget.RadToolKind = brBorlandDevStudio then
+ begin
+ (ATarget as TJclBDSInstallation).CleanPackageCache(BinaryFileName(GetBPLPath, Distribution.JclPath + FullPackageFileName(ATarget, JclDpk)));
+ if RuntimeInstallation and ATarget.SupportsVisualCLX then
+ (ATarget as TJclBDSInstallation).CleanPackageCache(BinaryFileName(GetBPLPath, Distribution.JclPath + FullPackageFileName(ATarget, JclVClxDpk)));
+ if RuntimeInstallation and ATarget.SupportsVCL then
+ (ATarget as TJclBDSInstallation).CleanPackageCache(BinaryFileName(GetBPLPath, Distribution.JclPath + FullPackageFileName(ATarget, JclVclDpk)));
+ end;
+ {$ENDIF KYLIX}
//ioJclPackages
- UninstallPackage(FullPackageFileName(Target, JclDpk));
- if (Target.RadToolKind = brBorlandDevStudio) and (Target.IDEVersionNumber = 5) then
+ ATarget.UnregisterPackage(Distribution.JclPath + FullPackageFileName(ATarget, JclDpk));
+ if RuntimeInstallation and ATarget.SupportsVisualCLX then
+ ATarget.UnregisterPackage(Distribution.JclPath + FullPackageFileName(ATarget, JclVClxDpk));
+ if RuntimeInstallation and ATarget.SupportsVCL then
+ ATarget.UnregisterPackage(Distribution.JclPath + FullPackageFileName(ATarget, JclVclDpk));
+ {$IFDEF MSWINDOWS}
+ RemoveJediRegInformation(Target.ConfigDataLocation, 'JCL', ATarget.RootKey);
+ {$ENDIF MSWINDOWS}
+ end;
+ end;
+ procedure DeletePackages;
+ begin
+ if CLRVersion = '' then
+ begin
+ DeletePackage(FullPackageFileName(Target, JclDpk));
if RuntimeInstallation and Target.SupportsVisualCLX then
- UninstallPackage(FullPackageFileName(Target, JclVClxDpk));
+ DeletePackage(FullPackageFileName(Target, JclVClxDpk));
if RuntimeInstallation and Target.SupportsVCL then
- UninstallPackage(FullPackageFileName(Target, JclVclDpk));
- {$IFDEF MSWINDOWS}
- RemoveJediRegInformation(Target.ConfigDataLocation, 'JCL');
- {$ENDIF MSWINDOWS}
+ DeletePackage(FullPackageFileName(Target, JclVclDpk));
end;
end;
{$IFDEF MSWINDOWS}
- procedure UninstallExperts;
+ procedure UnregisterExperts(ATarget: TJclBorRADToolInstallation);
var
Option: TJclOption;
begin
@@ -2137,10 +2273,22 @@
begin
for Option := Low(ExpertPaths) to High(ExpertPaths) do
if not (Option in [joExpertsDsgnPackages, joExpertsDLL]) then
- UninstallExpert(Option);
+ ATarget.UnregisterExpert(Distribution.JclPath + FullLibraryFileName(ATarget, ExpertPaths[Option]));
end;
end;
+ procedure DeleteExperts;
+ var
+ Option: TJclOption;
+ begin
+ if CLRVersion = '' then
+ begin
+ for Option := Low(ExpertPaths) to High(ExpertPaths) do
+ if not (Option in [joExpertsDsgnPackages, joExpertsDLL]) then
+ DeleteExpert(Option);
+ end;
+ end;
+
procedure UninstallHelp;
procedure RemoveHelpFromIdeTools;
var
@@ -2225,7 +2373,12 @@
end;
end;
+var
+ Index: Integer;
+ AProfilesManager: IJediProfilesManager;
+ ATarget: TJclBorRADToolInstallation;
begin
+ AProfilesManager := InstallCore.ProfilesManager;
try
Target.OutputCallback := WriteLog;
if Assigned(GUI) then
@@ -2235,13 +2388,40 @@
WriteLog(StrPadRight('Starting Uninstall process', 44, '.'));
- RemoveEnvironment;
+ if AProfilesManager.MultipleProfileMode then
+ begin
+ for Index := 0 to AProfilesManager.ProfileCount - 1 do
+ if IsProfileEnabled[Index] then
+ begin
+ ATarget := ProfileTargets[Index];
+ if ATarget.Valid then
+ begin
+ RemoveEnvironment(ATarget);
+ {$IFDEF MSWINDOWS}
+ if not Target.IsTurboExplorer then
+ UnregisterExperts(ATarget);
+ {$ENDIF MSWINDOWS}
+ if not Target.IsTurboExplorer then
+ UnregisterPackages(ATarget);
+ end;
+ end;
+ end
+ else
+ begin
+ RemoveEnvironment(Target);
+ {$IFDEF MSWINDOWS}
+ if not Target.IsTurboExplorer then
+ UnregisterExperts(Target);
+ {$ENDIF MSWINDOWS}
+ if not Target.IsTurboExplorer then
+ UnregisterPackages(Target);
+ end;
+
RemoveMake;
if not Target.IsTurboExplorer then
- UninstallPackages;
+ DeletePackages;
{$IFDEF MSWINDOWS}
- if not Target.IsTurboExplorer then
- UninstallExperts;
+ DeleteExperts;
if AUninstallHelp then
UninstallHelp;
{$ENDIF MSWINDOWS}
@@ -2582,7 +2762,7 @@
end;
{$ENDIF MSWINDOWS}
-function TJclInstallation.CompilePackage(const Name: string; InstallPackage: Boolean): Boolean;
+function TJclInstallation.CompilePackage(const Name: string): Boolean;
var
PackageFileName: string;
{$IFNDEF KYLIX}
@@ -2590,35 +2770,24 @@
{$ENDIF}
begin
PackageFileName := PathAddSeparator(Distribution.JclPath) + Name;
- if InstallPackage then
- WriteLog(Format('Installing package %s...', [PackageFileName]))
- else
- WriteLog(Format('Compiling package %s...', [PackageFileName]));
+ WriteLog(Format('Compiling package %s...', [PackageFileName]));
if Assigned(GUIPage) then
GUIPage.CompilationStart(ExtractFileName(Name));
if IsDelphiPackage(PackageFileName) and (bpDelphi32 in Target.Personalities) then
begin
- if InstallPackage then
- Result := Target.InstallPackage(PackageFileName, GetBplPath, GetDcpPath)
- else
- begin
- {$IFNDEF KYLIX}
- if Target.RadToolKind = brBorlandDevStudio then
- (Target as TJclBDSInstallation).CleanPackageCache(BinaryFileName(GetBplPath, PackageFileName));
- {$ENDIF ~KYLIX}
- Result := Target.CompilePackage(PackageFileName, GetBplPath, GetDcpPath);
- end;
+ {$IFNDEF KYLIX}
+ if Target.RadToolKind = brBorlandDevStudio then
+ (Target as TJclBDSInstallation).CleanPackageCache(BinaryFileName(GetBplPath, PackageFileName));
+ {$ENDIF ~KYLIX}
+ Result := Target.CompilePackage(PackageFileName, GetBplPath, GetDcpPath);
end
else if IsBCBPackage(PackageFileName) and (bpBCBuilder32 in Target.Personalities) then
begin
ConfigureBpr2Mak(PackageFileName);
{$IFDEF KYLIX}
- if InstallPackage then
- Result := Target.InstallPackage(PackageFileName, GetBplPath, GetDcpPath)
- else
- Result := Target.CompilePackage(PackageFileName, GetBplPath, GetDcpPath);
+ Result := Target.CompilePackage(PackageFileName, GetBplPath, GetDcpPath);
{$ELSE ~KYLIX}
if Target.RadToolKind = brBorlandDevStudio then
@@ -2627,14 +2796,9 @@
// to satisfy JVCL (and eventually other libraries), create a .dcp file;
// Note: it is put out to .bpl path to make life easier for JVCL
DpkPackageFileName := ChangeFileExt(PackageFileName, SourceExtensionDelphiPackage);
- if InstallPackage then
- Result := ((not FileExists(DpkPackageFileName))
- or Target.InstallPackage(DpkPackageFileName, GetBplPath, GetDcpPath))
- and Target.InstallPackage(PackageFileName, GetBplPath, GetDcpPath)
- else
- Result := ((not FileExists(DpkPackageFileName))
- or Target.CompilePackage(DpkPackageFileName, GetBplPath, GetDcpPath))
- and Target.CompilePackage(PackageFileName, GetBplPath, GetDcpPath);
+ Result := ((not FileExists(DpkPackageFileName))
+ or Target.CompilePackage(DpkPackageFileName, GetBplPath, GetDcpPath))
+ and Target.CompilePackage(PackageFileName, GetBplPath, GetDcpPath);
{$ENDIF ~KYLIX}
end
else
@@ -2671,28 +2835,27 @@
end;
end;
-function TJclInstallation.UninstallPackage(const Name: string): Boolean;
+function TJclInstallation.DeletePackage(const Name: string): Boolean;
var
PackageFileName: string;
+ BPLFileName: string;
begin
- WriteLog(Format('Removing package %s.', [Name]));
+ WriteLog(Format('Deleting package %s.', [Name]));
PackageFileName := Distribution.JclPath + Format(Name, [Target.VersionNumberStr]);
- {$IFNDEF KYLIX}
- if Target.RadToolKind = brBorlandDevStudio then
- (Target as TJclBDSInstallation).CleanPackageCache(BinaryFileName(GetBPLPath, PackageFileName));
- {$ENDIF KYLIX}
+ BPLFileName := BinaryFileName(GetBplPath, PackageFileName);
- Result := Target.UninstallPackage(PackageFileName, GetBPLPath, GetDCPPath);
+ Result := FileDelete(BPLFileName);
+ Result := FileDelete(ChangeFileExt(BPLFileName, CompilerExtensionMAP)) or Result;
// delete DCP files that were created to bpl path (old behavior)
- FileDelete(PathAddSeparator(GetBPLPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionDCP);
+ Result := FileDelete(PathAddSeparator(GetBPLPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionDCP) or Result;
// delete DCP files that were created to target dcp path (old behavior)
- FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionDCP);
+ Result := FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionDCP) or Result;
// delete BPI files that were created to target dcp path (old behavior)
- FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionBPI);
+ Result := FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionBPI) or Result;
// delete LIB files that were created to target dcp path (old behaviour)
- FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionLIB);
+ Result := FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionLIB) or Result;
// TODO : evtl. remove .HPP Files
if Result then
@@ -2732,7 +2895,7 @@
end;
{$IFDEF MSWINDOWS}
-function TJclInstallation.CompileExpert(const Name: string; InstallExpert: Boolean): Boolean;
+function TJclInstallation.CompileExpert(const Name: string): Boolean;
var
ProjectFileName, ProjectBinaryFileName, ProjectDEFFileName,
ProjectDescription: string;
@@ -2748,21 +2911,13 @@
begin
ProjectFileName := PathAddSeparator(Distribution.JclPath) + Name;
- if InstallExpert then
- WriteLog(Format('Installing expert %s...', [ProjectFileName]))
- else
- WriteLog(Format('Compiling expert %s...', [ProjectFileName]));
+ WriteLog(Format('Compiling expert %s...', [ProjectFileName]));
if Assigned(GUIPage) then
GUIPage.CompilationStart(ExtractFileName(Name));
if IsDelphiProject(ProjectFileName) and (bpDelphi32 in Target.Personalities) then
- begin
- if InstallExpert then
- Result := Target.InstallExpert(ProjectFileName, GetBplPath, GetDcpPath)
- else
- Result := Target.CompileProject(ProjectFileName, GetBplPath, GetDcpPath);
- end
+ Result := Target.CompileProject(ProjectFileName, GetBplPath, GetDcpPath)
else if IsBCBProject(ProjectFileName) and (bpBCBuilder32 in Target.Personalities) then
begin
ConfigureBpr2Mak(ProjectFileName);
@@ -2834,13 +2989,8 @@
end;
if Result and (not FirstCompilationOk) then
- begin
// second compilation
- if InstallExpert then
- Result := Target.InstallExpert(ProjectFileName, GetBplPath, GetDcpPath)
- else
- Result := Target.CompileProject(ProjectFileName, GetBplPath, GetDcpPath);
- end
+ Result := Target.CompileProject(ProjectFileName, GetBplPath, GetDcpPath)
else if not Result then
WriteLog('Internal entry point not found');
end
@@ -2856,7 +3006,7 @@
WriteLog('... failed ' + ProjectFileName);
end;
-function TJclInstallation.UninstallExpert(const Option: TJclOption): Boolean;
+function TJclInstallation.DeleteExpert(const Option: TJclOption): Boolean;
function OldExpertBPLFileName(const BaseName: string): string;
const
@@ -2882,35 +3032,18 @@
var
BaseName: string;
- BPLFileName: string;
- PackageFileName: string;
LibraryFileName: string;
begin
Result := False;
BaseName := ExpertPaths[Option];
- // uninstall package if it exists
- PackageFileName := FullPackageFileName(Target, BaseName);
- LibraryFileName := FullLibraryFileName(Target, BaseName);
+ LibraryFileName := Distribution.JclPath + FullLibraryFileName(Target, BaseName);
- if FileExists(Distribution.JclPath + PackageFileName) then
- begin
- Result := UninstallPackage(PackageFileName);
- if (Target.RadToolKind = brBorlandDevStudio) and (Target.IDEVersionNumber = 5) then
- Target.IdePackages.RemovePackage(PathAddSeparator(GetBplPath) + PathExtractFileNameNoExt(PackageFileName) + '100.bpl');
- // eventually remove old expert packages to avoid annoying package conflicts during IDE startup;
- // for simplicity, .dcp files are not handled
- BaseName := ExtractFileName(BaseName);
- BPLFileName := OldExpertBPLFileName(BaseName);
- Target.IdePackages.RemovePackage(BPLFileName);
- FileDelete(BPLFileName);
- end;
-
if FileExists(Distribution.JclPath + LibraryFileName) then
begin
WriteLog(Format('Removing expert %s', [LibraryFileName]));
// delete DLL experts
- Result := Target.UninstallExpert(Distribution.JclPath + LibraryFileName, GetBPLPath);
+ Result := FileDelete(BinaryFileName(GetBplPath, LibraryFileName));
if Result then
WriteLog('...done.')
else
@@ -3050,7 +3183,12 @@
procedure TJclDistribution.Close;
var
I: Integer;
+ Settings: IJediConfiguration;
begin
+ Settings := InstallCore.Configuration;
+ if Assigned(Settings) and Assigned(FProfilesPage) then
+ for I := 0 to InstallCore.ProfilesManager.ProfileCount - 1 do
+ Settings.OptionAsBoolByName[ProfilesSectionName, InstallCore.ProfilesManager.ProfileNames[I]] := FProfilesPage.IsProfileEnabled[I];
for I := 0 to TargetInstallCount - 1 do
TargetInstalls[I].Close;
FGUI := nil;
@@ -3244,9 +3382,10 @@
procedure TJclDistribution.Init;
procedure InitDistribution;
var
- ExceptDialogsPath, InstallerFileName: string;
+ ExceptDialogsPath, InstallerFileName, ProfileName: string;
ReadMePage: IJediReadMePage;
Index: Integer;
+ Settings: IJediConfiguration;
begin
InstallerFileName := ParamStr(0);
@@ -3294,6 +3433,17 @@
ReadMePage := GUI.CreateReadmePage;
ReadMePage.Caption := Version;
ReadMePage.ReadmeFileName := FJclReadmeFileName;
+ FProfilesPage := GUI.CreateProfilesPage;
+ FProfilesPage.Caption := 'Profiles';
+
+ Settings := InstallCore.Configuration;
+ if Settings <> nil then
+ for Index := 0 to InstallCore.ProfilesManager.ProfileCount - 1 do
+ begin
+ ProfileName := InstallCore.ProfilesManager.ProfileNames[Index];
+ if Settings.ValueExists(ProfilesSectionName, ProfileName) then
+ FProfilesPage.IsProfileEnabled[Index] := Settings.OptionAsBoolByName[ProfilesSectionName, ProfileName];
+ end;
end;
{$IFDEF MSWINDOWS}
@@ -3494,7 +3644,7 @@
// step 3: inform the user and execute RegHelper
// simple dialog explaining user why we need credentials
- if Assigned(GUI) and ((not IsAdministrator) or (IsWinVista or IsWinServer2008)) then
+ if Assigned(GUI) and not IsElevated then
GUI.Dialog(RsHTMLHelp2Credentials, dtInformation, [drOK]);
// RegHelper.exe manifest requires elevation on Vista
Modified: trunk/jcl/install/JediInstall.pas
===================================================================
--- trunk/jcl/install/JediInstall.pas 2007-09-26 11:28:20 UTC (rev 2187)
+++ trunk/jcl/install/JediInstall.pas 2007-09-26 11:32:58 UTC (rev 2188)
@@ -108,6 +108,13 @@
property Progress: Integer read GetProgress write SetProgress;
end;
+ IJediProfilesPage = interface(IJediPage)
+ ['{23CD1150-A05F-4C64-A3A5-5335874DF942}']
+ function GetProfileEnabled(Index: Integer): Boolean;
+ procedure SetProfileEnabled(Index: Integer; Value: Boolean);
+ property IsProfileEnabled[Index: Integer]: Boolean read GetProfileEnabled write SetProfileEnabled;
+ end;
+
TOptionRec = record
Name: string;
Value: string;
@@ -162,6 +169,7 @@
Options: TDialogResponses = [drOK]): TDialogResponse;
function CreateReadmePage: IJediReadmePage;
function CreateInstallPage: IJediInstallPage;
+ function CreateProfilesPage: IJediProfilesPage;
function GetPageCount: Integer;
function GetPage(Index: Integer): IJediPage;
function GetStatus: string;
@@ -202,6 +210,20 @@
procedure Close;
end;
+ IJediProfilesManager = interface
+ ['{5B818F08-3325-492A-BFC3-9489F749CB78}']
+ function CheckPrerequisites: Boolean;
+ function GetMultipleProfileMode: Boolean;
+ function GetProfileKey(Index: Integer): LongWord; // HKEY is Windows specific
+ function GetProfileCount: Integer;
+ function GetProfileName(Index: Integer): string;
+ procedure SetMultipleProfileMode(Value: Boolean);
+ property ProfileKeys[Index: Integer]: LongWord read GetProfileKey;
+ property ProfileNames[Index: Integer]: string read GetProfileName;
+ property ProfileCount: Integer read GetProfileCount;
+ property MultipleProfileMode: Boolean read GetMultipleProfileMode write SetMultipleProfileMode;
+ end;
+
TJediInstallGUICreator = function: IJediInstallGUI;
TJediConfigurationCreator = function: IJediConfiguration;
@@ -219,6 +241,7 @@
FInstallGUICreator: TJediInstallGUICreator;
FConfiguration: IJediConfiguration;
FConfigurationCreator: TJediConfigurationCreator;
+ FProfilesManager: IJediProfilesManager;
function GetProductCount: Integer;
function GetProduct(Index: Integer): IJediProduct;
function GetInstallGUI: IJediInstallGUI;
@@ -254,6 +277,7 @@
property Configuration: IJediConfiguration read GetConfiguration;
property ConfigurationCreator: TJediConfigurationCreator read FConfigurationCreator
write FConfigurationCreator;
+ property ProfilesManager: IJediProfilesManager read FProfilesManager;
end;
var
@@ -276,7 +300,8 @@
implementation
uses
- JclArrayLists, JclFileUtils;
+ JclArrayLists, JclFileUtils,
+ JediProfiles;
var
InternalInstallCore: TJediInstallCore = nil;
@@ -327,6 +352,8 @@
FProducts := TJclIntfArrayList.Create;
FClosing := False;
JediTargetOption := AddInstallOption('joTarget');
+
+ FProfilesManager := TJediProfilesManager.Create;
end;
destructor TJediInstallCore.Destroy;
@@ -347,13 +374,17 @@
Index: Integer;
AInstallGUI: IJediInstallGUI;
begin
- AInstallGUI := InstallGUI;
+ FProfilesManager.MultipleProfileMode := ParamPos('MultipleProfiles') >= 1;
+ if FProfilesManager.CheckPrerequisites then
+ begin
+ AInstallGUI := InstallGUI;
- for Index := FProducts.Size - 1 downto 0 do
- (FProducts.GetObject(Index) as IJediProduct).Init;
+ for Index := FProducts.Size - 1 downto 0 do
+ (FProducts.GetObject(Index) as IJediProduct).Init;
- if Assigned(AInstallGUI) then
- AInstallGUI.Execute;
+ if Assigned(AInstallGUI) then
+ AInstallGUI.Execute;
+ end;
end;
function TJediInstallCore.GetConfiguration: IJediConfiguration;
Modified: trunk/jcl/install/JediInstaller.dpr
===================================================================
--- trunk/jcl/install/JediInstaller.dpr 2007-09-26 11:28:20 UTC (rev 2187)
+++ trunk/jcl/install/JediInstaller.dpr 2007-09-26 11:32:58 UTC (rev 2188)
@@ -22,7 +22,9 @@
FrmCompile in 'VclGui\FrmCompile.pas' {FormCompile},
JediGUIReadme in 'VclGui\JediGUIReadme.pas' {ReadmeFrame: TFrame},
JediGUIInstall in 'VclGui\JediGUIInstall.pas' {InstallFrame: TFrame},
- JediGUIMain in 'VclGui\JediGUIMain.pas' {MainForm};
+ JediGUIMain in 'VclGui\JediGUIMain.pas' {MainForm},
+ JediGUIProfiles in 'VclGui\JediGUIProfiles.pas' {ProfilesFrame: TFrame},
+ JediProfiles in 'JediProfiles.pas';
{$R *.res}
{$R ..\source\windows\JclCommCtrlAsInvoker.res}
Added: trunk/jcl/install/JediProfiles.pas
===================================================================
--- trunk/jcl/install/JediProfiles.pas (rev 0)
+++ trunk/jcl/install/JediProfiles.pas 2007-09-26 11:32:58 UTC (rev 2188)
@@ -0,0 +1,291 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) extension }
+{ }
+{ 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 JediProfiles.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by Florent Ouchet }
+{ are Copyright (C) of Florent Ouchet. All Rights Reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Core unit to manipulate multiple users' profiles at install time }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ Revision: $Rev:: 2175 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JediProfiles;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ENDIF MSWINDOWS}
+ SysUtils,
+ Classes,
+ JediInstall;
+
+type
+ {$IFDEF MSWINDOWS}
+ TJediProfile = record
+ UserName: string;
+ SID: string;
+ LocalProfile: string;
+ UserKey: HKEY;
+ CloseKey: Boolean;
+ UnloadKey: Boolean;
+ end;
+ {$ENDIF MSWINDOWS}
+
+ TJediProfilesManager = class(TInterfacedObject, IJediProfilesManager)
+ private
+ FMultipleProfileMode: Boolean;
+ {$IFDEF MSWINDOWS}
+ FProfiles: array of TJediProfile;
+ procedure LoadProfiles;
+ {$ENDIF MSWINDOWS}
+ public
+ destructor Destroy; override;
+ { IJediProfileManager }
+ function CheckPrerequisites: Boolean;
+ function GetMultipleProfileMode: Boolean;
+ function GetProfileKey(Index: Integer): LongWord; // HKEY is Windows specific
+ function GetProfileCount: Integer;
+ function GetProfileName(Index: Integer): string;
+ procedure SetMultipleProfileMode(Value: Boolean);
+ property MultipleProfileMode: Boolean read GetMultipleProfileMode write SetMultipleProfileMode;
+ end;
+
+implementation
+
+{$IFDEF MSWINDOWS}
+uses
+ JclAnsiStrings,
+ JclFileUtils,
+ JclRegistry,
+ JclSecurity,
+ JclShell,
+ JclSysInfo,
+ JclWin32;
+
+const
+ RegProfileListKey = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList';
+{$ENDIF MSWINDOWS}
+
+//=== { TJediProfileManager } ================================================
+
+destructor TJediProfilesManager.Destroy;
+{$IFDEF MSWINDOWS}
+var
+ Index: Integer;
+{$ENDIF MSWINDOWS}
+begin
+ {$IFDEF MSWINDOWS}
+ for Index := Low(FProfiles) to High(FProfiles) do
+ begin
+ if FProfiles[Index].CloseKey then
+ begin
+ Windows.RegFlushKey(FProfiles[Index].UserKey);
+ Windows.RegCloseKey(FProfiles[Index].UserKey);
+ end;
+
+ if FProfiles[Index].UnloadKey then
+ Windows.RegUnLoadKey(HKUS, PAnsiChar(FProfiles[Index].SID));
+ end;
+ SetLength(FProfiles, 0);
+ {$ENDIF MSWINDOWS}
+ inherited Destroy;
+end;
+
+function TJediProfilesManager.CheckPrerequisites: Boolean;
+{$IFDEF MSWINDOWS}
+var
+ InstallGUI: IJediInstallGUI;
+ Fork: Boolean;
+ Parameters: string;
+ Index: Integer;
+{$ENDIF MSWINDOWS}
+begin
+ {$IFDEF MSWINDOWS}
+ FMultipleProfileMode := FMultipleProfileMode and IsWinNT;
+ Result := not FMultipleProfileMode;
+ if not Result then
+ begin
+ Result := IsElevated;
+ if not Result then
+ begin
+ // attempt to fork as an administrator
+ InstallGUI := InstallCore.InstallGUI;
+ if Assigned(InstallGUI) then
+ Fork := InstallGUI.Dialog('Installation requires administrator privilege, do you want to run installer with' +
+ ' administrator rights', dtConfirmation, [drYes, drNo]) = drYes
+ else
+ Fork := True;
+ if Fork then
+ begin
+ Parameters := '';
+ for Index := 1 to ParamCount do
+ Parameters := Parameters + AnsiQuotedStr(ParamStr(Index), AnsiDoubleQuote);
+ ShellExecAndWait(ParamStr(0), Parameters, 'runas');
+ Result := False;
+ end
+ else
+ begin
+ // single profile installation for current user
+ FMultipleProfileMode := False;
+ Result := True;
+ end;
+ end;
+ end;
+ if FMultipleProfileMode and Result then
+ LoadProfiles;
+ {$ENDIF MSWINDOWS}
+ {$IFDEF UNIX}
+ // don't know how to enumerate profiles on Linux
+ Result := not FMultipleProfileMode;
+ FMultipleProfileMode := False;
+ {$ENDIF UNIX}
+end;
+
+function TJediProfilesManager.GetMultipleProfileMode: Boolean;
+begin
+ Result := FMultipleProfileMode;
+end;
+
+function TJediProfilesManager.GetProfileCount: Integer;
+begin
+ {$IFDEF MSWINDOWS}
+ if FMultipleProfileMode then
+ Result := Length(FProfiles)
+ else
+ {$ENDIF MSWINDOWS}
+ Result := 0;
+end;
+
+function TJediProfilesManager.GetProfileKey(Index: Integer): LongWord;
+{$IFDEF MSWINDOWS}
+var
+ NtUserFileName: string;
+ Key: HKEY;
+{$ENDIF MSWINDOWS}
+begin
+ {$IFDEF MSWINDOWS}
+ if FMultipleProfileMode then
+ begin
+ if FProfiles[Index].UserKey = 0 then
+ begin
+ if AnsiSameText(FProfiles[Index].UserName, GetLocalUserName) then
+ FProfiles[Index].UserKey := HKCU
+ else
+ begin
+ NtUserFileName := PathAddSeparator(FProfiles[Index].LocalProfile) + 'NTUSER.DAT';
+ if not RegKeyExists(HKUS, '\' + FProfiles[Index].SID) then
+ begin
+ EnableProcessPrivilege(True, SE_RESTORE_NAME);
+ EnableProcessPrivilege(True, SE_BACKUP_NAME);
+ if RegLoadKey(HKUS, PAnsiChar(FProfiles[Index].SID), PAnsiChar(NtUserFileName)) = ERROR_SUCCESS then
+ FProfiles[Index].UnloadKey := True
+ else
+ RaiseLastOSError;
+ end;
+ if RegOpenKey(HKUS, PAnsiChar(FProfiles[Index].SID), Key) = ERROR_SUCCESS then
+ FProfiles[Index].CloseKey := True
+ else
+ raise EJclSecurityError.CreateFmt('Unable to load profile for user "%s"', [FProfiles[Index].UserName]);
+ FProfiles[Index].UserKey := Key;
+ end;
+ end;
+ Result := FProfiles[Index].UserKey;
+ end
+ else
+ Result := HKCU;
+ {$ENDIF MSWINDOWS}
+ {$IFDEF LINUX}
+ Result := 0;
+ {$ENDIF LINUX}
+end;
+
+function TJediProfilesManager.GetProfileName(Index: Integer): string;
+begin
+ {$IFDEF MSWINDOWS}
+ if FMultipleProfileMode then
+ Result := FProfiles[Index].UserName
+ else
+ {$ENDIF MSWINDOWS}
+ Result := '';
+end;
+
+{$IFDEF MSWINDOWS}
+procedure TJediProfilesManager.LoadProfiles;
+var
+ Index: Integer;
+ SID: PSID;
+ DataSize: Cardinal;
+ Name, Domain, KeyName, SIDStr, ProfileDir: string;
+ RegProfiles: TStrings;
+begin
+ if FMultipleProfileMode then
+ begin
+ RegProfiles := TStringList.Create;
+ try
+ GetMem(SID, SECURITY_MAX_SID_SIZE);
+ try
+ if RegGetKeyNames(HKLM, RegProfileListKey, RegProfiles) then
+ for Index := 0 to RegProfiles.Count - 1 do
+ begin
+ KeyName := RegProfileListKey + '\' + RegProfiles.Strings[Index];
+ if RegReadBinaryEx(HKLM, KeyName, 'Sid', SID^, SECURITY_MAX_SID_SIZE, DataSize, False)
+ and RegReadAnsiStringEx(HKLM, KeyName, 'ProfileImagePath', ProfileDir, False) then
+ begin
+ try
+ SIDStr := SIDToString(SID);
+ LookupAccountBySid(SID, Name, Domain);
+ if SameText(Domain, GetLocalComputerName) then
+ begin
+ SetLength(FProfiles, Length(FProfiles) + 1);
+ FProfiles[High(FProfiles)].UserName := Name;
+ FProfiles[High(FProfiles)].SID := SIDStr;
+ FProfiles[High(FProfiles)].LocalProfile := ProfileDir;
+ FProfiles[High(FProfiles)].UserKey := 0;
+ FProfiles[High(FProfiles)].CloseKey := False;
+ FProfiles[High(FProfiles)].UnloadKey := False;
+ end;
+ except
+ // trap deleted accounts
+ end;
+ end;
+ end;
+ finally
+ FreeMem(SID);
+ end;
+ finally
+ RegProfiles.Free;
+ end;
+ end;
+end;
+{$ENDIF MSWINDOWS}
+
+procedure TJediProfilesManager.SetMultipleProfileMode(Value: Boolean);
+begin
+ FMultipleProfileMode := Value;
+end;
+
+end.
Modified: trunk/jcl/install/JediRegInfo.pas
===================================================================
--- trunk/jcl/install/JediRegInfo.pas 2007-09-26 11:28:20 UTC (rev 2187)
+++ trunk/jcl/install/JediRegInfo.pas 2007-09-26 11:32:58 UTC (rev 2188)
@@ -39,7 +39,7 @@
interface
uses
- SysUtils, Classes;
+ Windows, SysUtils, Classes;
type
TJediInformation = record
@@ -53,20 +53,22 @@
values into the registry key IdeRegKey\Jedi\ProjectName. Returns True if the
values could be written. }
function InstallJediRegInformation(const IdeRegKey, ProjectName, Version, DcpDir,
- BplDir, RootDir: string): Boolean;
+ BplDir, RootDir: string; RootKey: HKEY = HKEY_CURRENT_USER): Boolean;
{ RemoveJediInformation() deletes the registry key IdeRegKey\Jedi\ProjectName.
If there is no further subkeys to IdeRegKey\Jedi and no values in this key,
the whole Jedi-key is deleted. }
-procedure RemoveJediRegInformation(const IdeRegKey, ProjectName: string);
+procedure RemoveJediRegInformation(const IdeRegKey, ProjectName: string;
+ RootKey: HKEY = HKEY_CURRENT_USER);
{ ReadJediInformation() reads the JEDI Information from the registry. Returns
False if Version='' or DcpDir='' or BplDir='' or RootDir=''. }
function ReadJediRegInformation(const IdeRegKey, ProjectName: string; out Version,
- DcpDir, BplDir, RootDir: string): Boolean; overload;
+ DcpDir, BplDir, RootDir: string; RootKey: HKEY = HKEY_CURRENT_USER): Boolean; overload;
{ ReadJediInformation() reads the JEDI Information from the registry. }
-function ReadJediRegInformation(const IdeRegKey, ProjectName: string): TJediInformation; overload;
+function ReadJediRegInformation(const IdeRegKey, ProjectName: string
+ ; RootKey: HKEY = HKEY_CURRENT_USER): TJediInformation; overload;
{ ParseVersionNumber() converts a version number 'major.minor.release.build' to
cardinal like the JclBase JclVersion constant. If the VersionStr is invalid
@@ -76,7 +78,7 @@
implementation
uses
- Windows, Registry;
+ Registry;
{$IFNDEF RTL140_UP}
function ExcludeTrailingPathDelimiter(const Path: string): string;
@@ -89,7 +91,7 @@
{$ENDIF ~RTL140_UP}
function InstallJediRegInformation(const IdeRegKey, ProjectName, Version, DcpDir,
- BplDir, RootDir: string): Boolean;
+ BplDir, RootDir: string; RootKey: HKEY): Boolean;
var
Reg: TRegistry;
begin
@@ -98,7 +100,7 @@
begin
Reg := TRegistry.Create;
try
- Reg.RootKey := HKEY_CURRENT_USER;
+ Reg.RootKey := RootKey;
if Reg.OpenKey(IdeRegKey + '\Jedi', True) then // do not localize
Reg.CloseKey;
if Reg.OpenKey(IdeRegKey + '\Jedi\' + ProjectName, True) then // do not localize
@@ -115,7 +117,7 @@
end;
end;
-procedure RemoveJediRegInformation(const IdeRegKey, ProjectName: string);
+procedure RemoveJediRegInformation(const IdeRegKey, ProjectName: string; RootKey: HKEY);
var
Reg: TRegistry;
Names: TStringList;
@@ -123,7 +125,7 @@
begin
Reg := TRegistry.Create;
try
- Reg.RootKey := HKEY_CURRENT_USER;
+ Reg.RootKey := RootKey;
// (outchy) do not delete target settings
// Reg.DeleteKey(IdeRegKey + '\Jedi\' + ProjectName); // do not localize
@@ -179,7 +181,7 @@
end;
function ReadJediRegInformation(const IdeRegKey, ProjectName: string; out Version,
- DcpDir, BplDir, RootDir: string): Boolean; overload;
+ DcpDir, BplDir, RootDir: string; RootKey: HKEY): Boolean; overload;
var
Reg: TRegistry;
begin
@@ -189,7 +191,7 @@
RootDir := '';
Reg := TRegistry.Create;
try
- Reg.RootKey := HKEY_CURRENT_USER;
+ Reg.RootKey := RootKey;
if Reg.OpenKeyReadOnly(IdeRegKey + '\Jedi\' + ProjectName) then // do not localize
begin
if Reg.ValueExists('Version') then // do not localize
@@ -207,10 +209,10 @@
Result := (Version <> '') and (DcpDir <> '') and (BplDir <> '') and (RootDir <> '');
end;
-function ReadJediRegInformation(const IdeRegKey, ProjectName: string): TJediInformation;
+function ReadJediRegInformation(const IdeRegKey, ProjectName: string; RootKey: HKEY): TJediInformation;
begin
ReadJediRegInformation(IdeRegKey, ProjectName, Result.Version, Result.DcpDir,
- Result.BplDir, Result.RootDir);
+ Result.BplDir, Result.RootDir, RootKey);
end;
function ParseVersionNumber(const VersionStr: string): Cardinal;
Added: trunk/jcl/install/VclGui/JediGUIProfiles.dfm
===================================================================
--- trunk/jcl/install/VclGui/JediGUIProfiles.dfm (rev 0)
+++ trunk/jcl/install/VclGui/JediGUIProfiles.dfm 2007-09-26 11:32:58 UTC (rev 2188)
@@ -0,0 +1,27 @@
+object ProfilesFrame: TProfilesFrame
+ Left = 0
+ Top = 0
+ Width = 320
+ Height = 240
+ AutoScroll = True
+ TabOrder = 0
+ object MemoComment: TMemo
+ Left = 16
+ Top = 16
+ Width = 281
+ Height = 73
+ Anchors = [akLeft, akTop, akRight]
+ BorderStyle = bsNone
+ Lines.Strings = (
+
+ 'Select profile in the list below. Note that only remote profiles' +
+ ' logged on local computer and local profiles are available.'
+
+ 'If a profile has not IDE settings, the JCL won'#39't be installed on' +
+ ' it.')
+ ParentColor = True
+ ReadOnly = True
+ TabOrder = 0
+ WordWrap = False
+ end
+end
Added: trunk/jcl/install/VclGui/JediGUIProfiles.pas
===================================================================
--- trunk/jcl/install/VclGui/JediGUIProfiles.pas (rev 0)
+++ trunk/jcl/install/VclGui/JediGUIProfiles.pas 2007-09-26 11:32:58 UTC (rev 2188)
@@ -0,0 +1,103 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) extension }
+{ }
+{ 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 JediGUIProfiles.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by Florent Ouchet }
+{ are Copyright (C) of Florent Ouchet. All Rights Reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ Revision: $Rev:: 2175 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JediGUIProfiles;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, JediInstall, StdCtrls, ComCtrls;
+
+type
+ TProfilesFrame = class(TFrame, IJediProfilesPage, IJediPage)
+ MemoComment: TMemo;
+ public
+ constructor Create(AOwner: TComponent); override;
+ // IJediPage
+ fun...
[truncated message content] |
49 messages has been excluded from this view by a project administrator.
