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: <jg...@us...> - 2009-02-15 02:48:07
|
Revision: 2638
http://jcl.svn.sourceforge.net/jcl/?rev=2638&view=rev
Author: jgsoft
Date: 2009-02-15 02:48:03 +0000 (Sun, 15 Feb 2009)
Log Message:
-----------
Improper use of PChar caused TJclGZIPDecompressionStream to fail with Delphi 2009. Changed to PByte.
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-02-08 20:49:48 UTC (rev 2637)
+++ trunk/jcl/source/common/JclCompression.pas 2009-02-15 02:48:03 UTC (rev 2638)
@@ -2672,8 +2672,8 @@
function TJclGZIPDecompressionStream.ReadCompressedData(Sender: TObject; var Buffer;
Count: Longint): Longint;
var
- BufferAddr: PChar;
- FooterAddr: PChar;
+ BufferAddr: PByte;
+ FooterAddr: PByte;
begin
if (Count = 0) or FDataEnded then
begin
@@ -2689,7 +2689,7 @@
raise EJclCompressionError.CreateRes(@RsCompressionGZipDataTruncated);
end;
- BufferAddr := @Char(Buffer);
+ BufferAddr := @Byte(Buffer);
Move(FFooter, Buffer, SizeOf(FFooter));
Result := FStream.Read(BufferAddr[SizeOf(FFooter)], Count - SizeOf(FFooter))
+ FStream.Read(FFooter, SizeOf(FFooter));
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-08 20:49:51
|
Revision: 2637
http://jcl.svn.sourceforge.net/jcl/?rev=2637&view=rev
Author: outchy
Date: 2009-02-08 20:49:48 +0000 (Sun, 08 Feb 2009)
Log Message:
-----------
Unicode compatibility.
Modified Paths:
--------------
trunk/jcl/source/common/JclPCRE.pas
Modified: trunk/jcl/source/common/JclPCRE.pas
===================================================================
--- trunk/jcl/source/common/JclPCRE.pas 2009-02-08 20:35:14 UTC (rev 2636)
+++ trunk/jcl/source/common/JclPCRE.pas 2009-02-08 20:49:48 UTC (rev 2637)
@@ -26,7 +26,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -471,8 +471,7 @@
Index := Index * 2;
FromPos := TranslateIndex(FSubject, roUTF8 in Options, FVector^[Index] + 1);
ToPos := TranslateIndex(FSubject, roUTF8 in Options, FVector^[Index + 1] + 1) - 1;
- SetLength(Result, ToPos - FromPos + 1);
- Move(FSubject[FromPos], Result[1], ToPos - FromPos + 1);
+ Result := Copy(FSubject, FromPos, ToPos - FromPos + 1);
end;
end;
@@ -486,7 +485,7 @@
begin
if not Assigned(FChangedCaptures) then
FChangedCaptures := TList.Create;
-
+
// Always resize to the max length to avoid repeated allocations.
FChangedCaptures.Capacity := FCaptureCount;
SetLength(FResultValues, FCaptureCount);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-08 20:35:18
|
Revision: 2636
http://jcl.svn.sourceforge.net/jcl/?rev=2636&view=rev
Author: outchy
Date: 2009-02-08 20:35:14 +0000 (Sun, 08 Feb 2009)
Log Message:
-----------
Fixed capture truncation when located at the end of the buffer.
Modified Paths:
--------------
trunk/jcl/source/common/JclPCRE.pas
Modified: trunk/jcl/source/common/JclPCRE.pas
===================================================================
--- trunk/jcl/source/common/JclPCRE.pas 2009-02-08 18:43:06 UTC (rev 2635)
+++ trunk/jcl/source/common/JclPCRE.pas 2009-02-08 20:35:14 UTC (rev 2636)
@@ -225,7 +225,7 @@
raise EJclUnexpectedEOSequenceError.Create
else
if StrPos > StrLen then
- Result := StrLen
+ Result := StrLen + 1
else
Result := StrPos;
end
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2009-02-08 18:43:09
|
Revision: 2635
http://jcl.svn.sourceforge.net/jcl/?rev=2635&view=rev
Author: uschuster
Date: 2009-02-08 18:43:06 +0000 (Sun, 08 Feb 2009)
Log Message:
-----------
TUnitVersion.RCSfile does now also "parse" SVN URL's
Modified Paths:
--------------
trunk/jcl/source/common/JclUnitVersioning.pas
Modified: trunk/jcl/source/common/JclUnitVersioning.pas
===================================================================
--- trunk/jcl/source/common/JclUnitVersioning.pas 2009-02-08 18:23:35 UTC (rev 2634)
+++ trunk/jcl/source/common/JclUnitVersioning.pas 2009-02-08 18:43:06 UTC (rev 2635)
@@ -202,6 +202,12 @@
Break;
end;
end;
+ // the + is to have SVN not touch the string
+ if StartsWith('$' + 'URL: ', Result) then // a SVN command
+ begin
+ Delete(Result, 1, 6);
+ Delete(Result, Length(Result) - 1, 2);
+ end;
end;
function TUnitVersion.Revision: string;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2009-02-08 18:23:44
|
Revision: 2634
http://jcl.svn.sourceforge.net/jcl/?rev=2634&view=rev
Author: uschuster
Date: 2009-02-08 18:23:35 +0000 (Sun, 08 Feb 2009)
Log Message:
-----------
StrToInt64 is required for SolidBlockSize
Modified Paths:
--------------
trunk/jcl/examples/windows/compression/archive/UProperties.pas
Modified: trunk/jcl/examples/windows/compression/archive/UProperties.pas
===================================================================
--- trunk/jcl/examples/windows/compression/archive/UProperties.pas 2009-02-08 15:37:36 UTC (rev 2633)
+++ trunk/jcl/examples/windows/compression/archive/UProperties.pas 2009-02-08 18:23:35 UTC (rev 2634)
@@ -172,7 +172,7 @@
procedure TFormArchiveSettings.EditSolidBlockSizeExit(Sender: TObject);
begin
- FSolid.SolidBlockSize := StrToInt(EditSolidBlockSize.Text);
+ FSolid.SolidBlockSize := StrToInt64(EditSolidBlockSize.Text);
RefreshValues;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-08 15:37:38
|
Revision: 2633
http://jcl.svn.sourceforge.net/jcl/?rev=2633&view=rev
Author: outchy
Date: 2009-02-08 15:37:36 +0000 (Sun, 08 Feb 2009)
Log Message:
-----------
Support for solid archive properties in dialog.
Modified Paths:
--------------
trunk/jcl/examples/windows/compression/archive/UProperties.dfm
trunk/jcl/examples/windows/compression/archive/UProperties.pas
Modified: trunk/jcl/examples/windows/compression/archive/UProperties.dfm
===================================================================
--- trunk/jcl/examples/windows/compression/archive/UProperties.dfm 2009-02-08 15:36:05 UTC (rev 2632)
+++ trunk/jcl/examples/windows/compression/archive/UProperties.dfm 2009-02-08 15:37:36 UTC (rev 2633)
@@ -3,7 +3,7 @@
Top = 0
BorderStyle = bsDialog
Caption = 'Archive settings'
- ClientHeight = 311
+ ClientHeight = 371
ClientWidth = 493
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@@ -62,7 +62,7 @@
Left = 8
Top = 111
Width = 273
- Height = 193
+ Height = 226
Caption = 'Compression properties:'
TabOrder = 1
object LabelCompressionLevel: TLabel
@@ -105,6 +105,14 @@
Caption = '&Number of passes:'
FocusControl = EditNumberOfPasses
end
+ object LabelSolidBlockSize: TLabel
+ Left = 16
+ Top = 192
+ Width = 74
+ Height = 13
+ Caption = '&Solid block size:'
+ FocusControl = EditSolidBlockSize
+ end
object EditCompressionLevel: TEdit
Left = 216
Top = 24
@@ -158,12 +166,23 @@
Text = '0'
OnExit = EditNumberOfPassesExit
end
+ object EditSolidBlockSize: TEdit
+ Left = 136
+ Top = 190
+ Width = 121
+ Height = 21
+ BiDiMode = bdRightToLeft
+ ParentBiDiMode = False
+ TabOrder = 5
+ Text = '0'
+ OnExit = EditSolidBlockSizeExit
+ end
end
object GroupBox1: TGroupBox
Left = 296
Top = 8
Width = 185
- Height = 207
+ Height = 218
Caption = 'Content:'
TabOrder = 2
object CheckBoxRemoveSfxBlock: TCheckBox
@@ -229,10 +248,19 @@
TabOrder = 6
OnExit = CheckBoxSaveLastSaveDateTimeExit
end
+ object CheckBoxSolidExtension: TCheckBox
+ Left = 16
+ Top = 190
+ Width = 153
+ Height = 17
+ Caption = 'Solid archive by e&xtension'
+ TabOrder = 7
+ OnExit = CheckBoxSolidExtensionExit
+ end
end
object ButtonClose: TButton
Left = 328
- Top = 243
+ Top = 257
Width = 121
Height = 25
Caption = 'Close'
Modified: trunk/jcl/examples/windows/compression/archive/UProperties.pas
===================================================================
--- trunk/jcl/examples/windows/compression/archive/UProperties.pas 2009-02-08 15:36:05 UTC (rev 2632)
+++ trunk/jcl/examples/windows/compression/archive/UProperties.pas 2009-02-08 15:37:36 UTC (rev 2633)
@@ -33,6 +33,9 @@
CheckBoxSaveLastAccessDateTime: TCheckBox;
CheckBoxSaveLastSaveDateTime: TCheckBox;
ButtonClose: TButton;
+ CheckBoxSolidExtension: TCheckBox;
+ LabelSolidBlockSize: TLabel;
+ EditSolidBlockSize: TEdit;
procedure EditPasswordExit(Sender: TObject);
procedure EditNumberOfThreadsExit(Sender: TObject);
procedure EditCompressionLevelExit(Sender: TObject);
@@ -47,6 +50,8 @@
procedure CheckBoxSaveCreationDateTimeExit(Sender: TObject);
procedure CheckBoxSaveLastAccessDateTimeExit(Sender: TObject);
procedure CheckBoxSaveLastSaveDateTimeExit(Sender: TObject);
+ procedure CheckBoxSolidExtensionExit(Sender: TObject);
+ procedure EditSolidBlockSizeExit(Sender: TObject);
protected
FArchive: TJclCompressionArchive;
FNumberOfThreads: IJclArchiveNumberOfThreads;
@@ -62,6 +67,7 @@
FSaveLastAccessDateTime: IJclArchiveSaveLastAccessDateTime;
FSaveLastWriteDateTime: IJclArchiveSaveLastWriteDateTime;
FAlgoritm: IJclArchiveAlgorithm;
+ FSolid: IJclArchiveSolid;
public
class procedure Execute(Archive: TJclCompressionArchive);
procedure RefreshValues;
@@ -116,6 +122,12 @@
RefreshValues;
end;
+procedure TFormArchiveSettings.CheckBoxSolidExtensionExit(Sender: TObject);
+begin
+ FSolid.SolidExtension := CheckBoxSolidExtension.Checked;
+ RefreshValues;
+end;
+
procedure TFormArchiveSettings.ComboBoxCompressionMethodExit(Sender: TObject);
begin
FCompressionMethod.CompressionMethod := TJclCompressionMethod(GetEnumValue(TypeInfo(TJclCompressionMethod),ComboBoxCompressionMethod.Text));
@@ -158,6 +170,12 @@
RefreshValues;
end;
+procedure TFormArchiveSettings.EditSolidBlockSizeExit(Sender: TObject);
+begin
+ FSolid.SolidBlockSize := StrToInt(EditSolidBlockSize.Text);
+ RefreshValues;
+end;
+
class procedure TFormArchiveSettings.Execute(Archive: TJclCompressionArchive);
var
AFormSettings: TFormArchiveSettings;
@@ -178,6 +196,7 @@
Supports(IUnknown(Archive),IJclArchiveSaveCreationDateTime,AFormSettings.FSaveCreationDateTime);
Supports(IUnknown(Archive),IJclArchiveSaveLastAccessDateTime,AFormSettings.FSaveLastAccessDateTime);
Supports(IUnknown(Archive),IJclArchiveSaveLastWriteDateTime,AFormSettings.FSaveLastWriteDateTime);
+ Supports(IUnknown(Archive),IJclArchiveSolid,AFormSettings.FSolid);
AFormSettings.FArchive := Archive;
if Assigned(AFormSettings.FCompressionLevel) then
@@ -235,6 +254,11 @@
EditNumberOfPasses.Text := IntToStr(FNumberOfPasses.NumberOfPasses)
else
EditNumberOfPasses.Enabled := False;
+ // solid block size
+ if Assigned(FSolid) then
+ EditSolidBlockSize.Text := IntToStr(FSolid.SolidBlockSize)
+ else
+ EditSolidBlockSize.Enabled := False;
// remove sfx
CheckBoxRemoveSfxBlock.Enabled := Assigned(FRemoveSfxBlock);
CheckBoxRemoveSfxBlock.Checked := Assigned(FRemoveSfxBlock) and FRemoveSfxBlock.RemoveSfxBlock;
@@ -256,6 +280,9 @@
// save last write date time
CheckBoxSaveLastSaveDateTime.Enabled := Assigned(FSaveLastWriteDateTime);
CheckBoxSaveLastSaveDateTime.Checked := Assigned(FSaveLastWriteDateTime) and FSaveLastWriteDateTime.SaveLastWriteDateTime;
+ // solid by extension
+ CheckBoxSolidExtension.Enabled := Assigned(FSolid);
+ CheckBoxSolidExtension.Checked := Assigned(FSolid) and FSolid.SolidExtension;
end;
end.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-08 15:36:10
|
Revision: 2632
http://jcl.svn.sourceforge.net/jcl/?rev=2632&view=rev
Author: outchy
Date: 2009-02-08 15:36:05 +0000 (Sun, 08 Feb 2009)
Log Message:
-----------
The list has to be invalidated when items are deleted.
Modified Paths:
--------------
trunk/jcl/examples/windows/compression/archive/UMain.pas
Modified: trunk/jcl/examples/windows/compression/archive/UMain.pas
===================================================================
--- trunk/jcl/examples/windows/compression/archive/UMain.pas 2009-02-08 15:33:33 UTC (rev 2631)
+++ trunk/jcl/examples/windows/compression/archive/UMain.pas 2009-02-08 15:36:05 UTC (rev 2632)
@@ -159,6 +159,7 @@
end;
ListView1.Items.Count := FArchive.ItemCount;
+ ListView1.Invalidate;
end;
procedure TFormMain.ActionDeleteRWUpdate(Sender: TObject);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-08 15:33:39
|
Revision: 2631
http://jcl.svn.sourceforge.net/jcl/?rev=2631&view=rev
Author: outchy
Date: 2009-02-08 15:33:33 +0000 (Sun, 08 Feb 2009)
Log Message:
-----------
Support for solid archives.
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-02-08 14:01:57 UTC (rev 2630)
+++ trunk/jcl/source/common/JclCompression.pas 2009-02-08 15:33:33 UTC (rev 2631)
@@ -878,6 +878,16 @@
property SupportedAlgorithms: TDynCardinalArray read GetSupportedAlgorithms;
end;
+ IJclArchiveSolid = interface
+ ['{6902C54C-1577-422C-B18B-E27953A28661}']
+ function GetSolidBlockSize: Int64;
+ function GetSolidExtension: Boolean;
+ procedure SetSolidBlockSize(const Value: Int64);
+ procedure SetSolidExtension(Value: Boolean);
+ property SolidBlockSize: Int64 read GetSolidBlockSize write SetSolidBlockSize;
+ property SolidExtension: Boolean read GetSolidExtension write SetSolidExtension;
+ end;
+
TJclCompressItem = class(TJclCompressionItem)
protected
procedure CheckGetProperty(AProperty: TJclCompressionItemProperty); override;
@@ -1133,7 +1143,8 @@
TJcl7zCompressArchive = class(TJclSevenzipCompressArchive, IJclArchiveCompressionLevel, IJclArchiveDictionarySize,
IJclArchiveNumberOfThreads, IJclArchiveRemoveSfxBlock, IJclArchiveCompressHeader, IJclArchiveEncryptHeader,
- IJclArchiveSaveCreationDateTime, IJclArchiveSaveLastAccessDateTime, IJclArchiveSaveLastWriteDateTime, IInterface)
+ IJclArchiveSaveCreationDateTime, IJclArchiveSaveLastAccessDateTime, IJclArchiveSaveLastWriteDateTime,
+ IJclArchiveSolid, IInterface)
private
FNumberOfThreads: Cardinal;
FEncryptHeader: Boolean;
@@ -1145,6 +1156,8 @@
FSaveLastAccessDateTime: Boolean;
FSaveCreationDateTime: Boolean;
FSaveLastWriteDateTime: Boolean;
+ FSolidBlockSize: Int64;
+ FSolidExtension: Boolean;
protected
function GetCLSID: TGUID; override;
procedure CreateCompressionObject; override;
@@ -1183,6 +1196,11 @@
{ IJclArchiveSaveLastWriteDateTime }
function GetSaveLastWriteDateTime: Boolean;
procedure SetSaveLastWriteDateTime(Value: Boolean);
+ { IJclArchiveSolid }
+ function GetSolidBlockSize: Int64;
+ function GetSolidExtension: Boolean;
+ procedure SetSolidBlockSize(const Value: Int64);
+ procedure SetSolidExtension(Value: Boolean);
end;
TJclTarCompressArchive = class(TJclSevenzipCompressArchive, IInterface)
@@ -4492,11 +4510,13 @@
FItemIndex: Integer;
FStream: TStream;
FOwnsStream: Boolean;
+ FTruncateOnRelease: Boolean;
+ FMaximumPosition: Int64;
procedure NeedStream;
procedure ReleaseStream;
public
constructor Create(AArchive: TJclCompressionArchive; AItemIndex: Integer); overload;
- constructor Create(AStream: TStream; AOwnsStream: Boolean); overload;
+ constructor Create(AStream: TStream; AOwnsStream: Boolean; ATruncateOnRelease: Boolean); overload;
destructor Destroy; override;
// ISequentialOutStream
function Write(Data: Pointer; Size: Cardinal; ProcessedSize: PCardinal): HRESULT; stdcall;
@@ -4513,9 +4533,11 @@
FItemIndex := AItemIndex;
FStream := nil;
FOwnsStream := False;
+ FMaximumPosition := 0;
+ FTruncateOnRelease := False;
end;
-constructor TJclSevenzipOutStream.Create(AStream: TStream; AOwnsStream: Boolean);
+constructor TJclSevenzipOutStream.Create(AStream: TStream; AOwnsStream: Boolean; ATruncateOnRelease: Boolean);
begin
inherited Create;
@@ -4523,6 +4545,8 @@
FItemIndex := -1;
FStream := AStream;
FOwnsStream := AOwnsStream;
+ FMaximumPosition := 0;
+ FTruncateOnRelease := ATruncateOnRelease;
end;
destructor TJclSevenzipOutStream.Destroy;
@@ -4543,6 +4567,10 @@
procedure TJclSevenzipOutStream.ReleaseStream;
begin
+ // truncate to the maximum position that was written
+ if FTruncateOnRelease then
+ FStream.Size := FMaximumPosition;
+
if Assigned(FArchive) then
FArchive.Items[FItemIndex].ReleaseStream
else
@@ -4572,12 +4600,15 @@
Result := S_OK;
FStream.Size := NewSize;
+ if FTruncateOnRelease and (FMaximumPosition < NewSize) then
+ FMaximumPosition := NewSize;
end;
function TJclSevenzipOutStream.Write(Data: Pointer; Size: Cardinal;
ProcessedSize: PCardinal): HRESULT;
var
Processed: Cardinal;
+ APosition: Int64;
begin
NeedStream;
@@ -4585,6 +4616,12 @@
Processed := FStream.Write(Data^, Size);
if Assigned(ProcessedSize) then
ProcessedSize^ := Processed;
+ if FTruncateOnRelease then
+ begin
+ APosition := FStream.Position;
+ if FMaximumPosition < APosition then
+ FMaximumPosition := APosition;
+ end;
end;
//=== { TJclSevenzipInStream } ===============================================
@@ -4864,6 +4901,11 @@
end;
end;
+procedure GetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface);
+begin
+ // TODO properties from ASevenzipArchive to AJclArchive
+end;
+
procedure SetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface);
var
PropertySetter: Sevenzip.ISetProperties;
@@ -4881,6 +4923,7 @@
SaveLastAccessDateTime: IJclArchiveSaveLastAccessDateTime;
SaveLastWriteDateTime: IJclArchiveSaveLastWriteDateTime;
Algorithm: IJclArchiveAlgorithm;
+ Solid: IJclArchiveSolid;
PropNames: array of PWideChar;
PropValues: array of TPropVariant;
@@ -4954,7 +4997,7 @@
AddWideStringProperty('EM', EncryptionMethodName[EncryptionMethod.EncryptionMethod]);
if Supports(AJclArchive, IJclArchiveDictionarySize, DictionarySize) and Assigned(DictionarySize) then
- AddCardinalProperty('D', DictionarySize.DictionarySize);
+ AddWideStringProperty('D', IntToStr(DictionarySize.DictionarySize) + 'B');
if Supports(AJclArchive, IJclArchiveNumberOfPasses, NumberOfPasses) and Assigned(NumberOfPasses) then
AddCardinalProperty('PASS', NumberOfPasses.NumberOfPasses);
@@ -4986,7 +5029,19 @@
if Supports(AJclArchive, IJclArchiveAlgorithm, Algorithm) and Assigned(Algorithm) then
AddCardinalProperty('A', Algorithm.Algorithm);
+
+ if Supports(AJclArchive, IJclArchiveSolid, Solid) and Assigned(Solid) then
+ begin
+ if Solid.SolidExtension then
+ AddWideStringProperty('S', 'E');
+ if Solid.SolidBlockSize > 0 then
+ AddWideStringProperty('S', IntToStr(Solid.SolidBlockSize) + 'B')
+ else
+ AddWideStringProperty('S', IntToStr(Solid.SolidBlockSize) + 'F');
+ end;
end;
+ if Length(PropNames) > 0 then
+ SevenZipCheck(PropertySetter.SetProperties(@PropNames[0], @PropValues[0], Length(PropNames)));
end;
end;
@@ -5251,10 +5306,10 @@
FCompressing := True;
try
- SplitStream := TJclDynamicSplitStream.Create;
+ SplitStream := TJclDynamicSplitStream.Create(False);
SplitStream.OnVolume := NeedVolume;
SplitStream.OnVolumeMaxSize := NeedVolumeMaxSize;
- OutStream := TJclSevenzipOutStream.Create(SplitStream, True);
+ OutStream := TJclSevenzipOutStream.Create(SplitStream, True, False);
UpdateCallback := TJclSevenzipUpdateCallback.Create(Self);
SetSevenzipArchiveCompressionProperties(Self, FOutArchive);
@@ -5290,6 +5345,8 @@
FSaveLastAccessDateTime := True;
FSaveCreationDateTime := True;
FSaveLastWriteDateTime := True;
+ FSolidBlockSize := High(Cardinal);
+ FSolidExtension := False;
end;
function TJcl7zCompressArchive.GetCLSID: TGUID;
@@ -5357,6 +5414,16 @@
Result := FSaveLastWriteDateTime;
end;
+function TJcl7zCompressArchive.GetSolidBlockSize: Int64;
+begin
+ Result := FSolidBlockSize;
+end;
+
+function TJcl7zCompressArchive.GetSolidExtension: Boolean;
+begin
+ Result := FSolidExtension;
+end;
+
class function TJcl7zCompressArchive.MultipleItemContainer: Boolean;
begin
Result := True;
@@ -5440,6 +5507,18 @@
FSaveLastWriteDateTime := Value;
end;
+procedure TJcl7zCompressArchive.SetSolidBlockSize(const Value: Int64);
+begin
+ CheckNotCompressing;
+ FSolidBlockSize := Value;
+end;
+
+procedure TJcl7zCompressArchive.SetSolidExtension(Value: Boolean);
+begin
+ CheckNotCompressing;
+ FSolidExtension := Value;
+end;
+
//=== { TJclZipCompressArchive } =============================================
class function TJclZipCompressArchive.ArchiveExtensions: string;
@@ -6156,7 +6235,7 @@
begin
if (FVolumeMaxSize <> 0) or (FVolumes.Count <> 0) then
begin
- SplitStream := TJclDynamicSplitStream.Create;
+ SplitStream := TJclDynamicSplitStream.Create(False);
SplitStream.OnVolume := NeedVolume;
SplitStream.OnVolumeMaxSize := NeedVolumeMaxSize;
AInStream := TJclSevenzipInStream.Create(SplitStream, True);
@@ -6170,6 +6249,8 @@
MaxCheckStartPosition := 1 shl 22;
SevenzipCheck(FInArchive.Open(AInStream, @MaxCheckStartPosition, OpenCallback));
+ GetSevenzipArchiveCompressionProperties(Self, FInArchive);
+
FOpened := True;
end;
end;
@@ -6839,10 +6920,10 @@
FCompressing := True;
try
- SplitStream := TJclDynamicSplitStream.Create;
+ SplitStream := TJclDynamicSplitStream.Create(True);
SplitStream.OnVolume := NeedVolume;
SplitStream.OnVolumeMaxSize := NeedVolumeMaxSize;
- OutStream := TJclSevenzipOutStream.Create(SplitStream, True);
+ OutStream := TJclSevenzipOutStream.Create(SplitStream, True, True);
UpdateCallback := TJclSevenzipUpdateCallback.Create(Self);
SetSevenzipArchiveCompressionProperties(Self, FOutArchive);
@@ -7010,22 +7091,18 @@
procedure TJclSevenzipUpdateArchive.OpenArchive;
var
- SplitStream: TJclDynamicSplitStream;
OpenCallback: IArchiveOpenCallback;
MaxCheckStartPosition: Int64;
AInStream: IInStream;
+ SplitStream: TJclDynamicSplitStream;
begin
if not FOpened then
begin
- if (FVolumeMaxSize <> 0) or (FVolumes.Count <> 0) then
- begin
- SplitStream := TJclDynamicSplitStream.Create;
- SplitStream.OnVolume := NeedVolume;
- SplitStream.OnVolumeMaxSize := NeedVolumeMaxSize;
- AInStream := TJclSevenzipInStream.Create(SplitStream, True);
- end
- else
- AInStream := TJclSevenzipInStream.Create(NeedVolume(0), False);
+ SplitStream := TJclDynamicSplitStream.Create(True);
+ SplitStream.OnVolume := NeedVolume;
+ SplitStream.OnVolumeMaxSize := NeedVolumeMaxSize;
+
+ AInStream := TJclSevenzipInStream.Create(SplitStream, True);
OpenCallback := TJclSevenzipOpenCallback.Create(Self);
SetSevenzipArchiveCompressionProperties(Self, FInArchive);
@@ -7033,6 +7110,8 @@
MaxCheckStartPosition := 1 shl 22;
SevenzipCheck(FInArchive.Open(AInStream, @MaxCheckStartPosition, OpenCallback));
+ GetSevenzipArchiveCompressionProperties(Self, FInArchive);
+
FOpened := True;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-08 14:02:00
|
Revision: 2630
http://jcl.svn.sourceforge.net/jcl/?rev=2630&view=rev
Author: outchy
Date: 2009-02-08 14:01:57 +0000 (Sun, 08 Feb 2009)
Log Message:
-----------
TJclSplitStream: new parameter to force the position in volume before any access
Modified Paths:
--------------
trunk/jcl/source/common/JclStreams.pas
Modified: trunk/jcl/source/common/JclStreams.pas
===================================================================
--- trunk/jcl/source/common/JclStreams.pas 2009-02-08 12:13:13 UTC (rev 2629)
+++ trunk/jcl/source/common/JclStreams.pas 2009-02-08 14:01:57 UTC (rev 2630)
@@ -458,6 +458,7 @@
FVolumeMaxSize: Int64;
FPosition: Int64;
FVolumePosition: Int64;
+ FForcePosition: Boolean;
protected
function GetVolume(Index: Integer): TStream; virtual; abstract;
function GetVolumeMaxSize(Index: Integer): Int64; virtual; abstract;
@@ -465,7 +466,7 @@
procedure SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64); override;
procedure InternalLoadVolume(Index: Integer);
public
- constructor Create;
+ constructor Create(AForcePosition: Boolean = False);
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
{$IFDEF CLR}
@@ -475,6 +476,8 @@
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
{$ENDIF ~CLR}
+
+ property ForcePosition: Boolean read FForcePosition write FForcePosition;
end;
TJclVolumeEvent = function(Index: Integer): TStream of object;
@@ -508,7 +511,7 @@
function GetVolume(Index: Integer): TStream; override;
function GetVolumeMaxSize(Index: Integer): Int64; override;
public
- constructor Create;
+ constructor Create(AForcePosition: Boolean = False);
destructor Destroy; override;
function AddVolume(AStream: TStream; AMaxSize: Int64 = 0;
@@ -2426,7 +2429,7 @@
//=== { TJclSplitStream } ====================================================
-constructor TJclSplitStream.Create;
+constructor TJclSplitStream.Create(AForcePosition: Boolean);
begin
inherited Create;
FVolume := nil;
@@ -2434,6 +2437,7 @@
FVolumeMaxSize := 0;
FPosition := 0;
FVolumePosition := 0;
+ FForcePosition := AForcePosition;
end;
function TJclSplitStream.GetSize: Int64;
@@ -2500,6 +2504,10 @@
Total := Count;
repeat
+ // force position
+ if ForcePosition then
+ StreamSeek(FVolume, FVolumePosition, soBeginning);
+
// try to read (Count) bytes from current stream
{$IFDEF CLR}
LoopRead := FVolume.Read(Buffer, Offset, Count);
@@ -2662,6 +2670,10 @@
Total := Count;
repeat
+ // force position
+ if ForcePosition then
+ StreamSeek(FVolume, FVolumePosition, soBeginning);
+
// do not write more than (VolumeMaxSize) bytes in current stream
if (FVolumeMaxSize > 0) and ((Count + FVolumePosition) > FVolumeMaxSize) then
LoopWritten := FVolumeMaxSize - FVolumePosition
@@ -2712,9 +2724,9 @@
//=== { TJclStaticSplitStream } ===========================================
-constructor TJclStaticSplitStream.Create;
+constructor TJclStaticSplitStream.Create(AForcePosition: Boolean);
begin
- inherited Create;
+ inherited Create(AForcePosition);
FVolumes := TObjectList.Create(True);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2009-02-08 12:13:18
|
Revision: 2629
http://jcl.svn.sourceforge.net/jcl/?rev=2629&view=rev
Author: uschuster
Date: 2009-02-08 12:13:13 +0000 (Sun, 08 Feb 2009)
Log Message:
-----------
fixed compilation with D5/D6
JclOtaExcDlgFileFrame.pas: - ToolsAPI.GetActiveProject is only defined for D7 and higher, but this is still available as class function of TJclOTAExpertBase (scope confusion?)
- ToolsAPI.omtForm is only defined for D6 and higher and thatswhy we use now the new constant JclRepositoryModuleTypeForm from JclOtaConsts
JclOtaConsts.pas: added JclRepositoryModuleTypeForm, because ToolsAPI.omtForm does not exist in D5
Modified Paths:
--------------
trunk/jcl/experts/common/JclOtaConsts.pas
trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas
Modified: trunk/jcl/experts/common/JclOtaConsts.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaConsts.pas 2009-02-07 11:42:08 UTC (rev 2628)
+++ trunk/jcl/experts/common/JclOtaConsts.pas 2009-02-08 12:13:13 UTC (rev 2629)
@@ -36,7 +36,7 @@
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
- ToolsApi;
+ ToolsAPI;
const
DelphiRootDirKeyValue = 'RootDir';
@@ -45,7 +45,7 @@
DelphiEnvironmentVar = 'DELPHI';
{$IFDEF COMPILER6_UP}
EnvironmentVarsKey = 'Environment Variables';
- {$ENDIF COMP\xCFLER6_UP}
+ {$ENDIF COMPILER6_UP}
//=== Various constants shared by different experts ========================
JclLeft = 'Left';
@@ -133,6 +133,7 @@
//=== Repository Expert ====================================================
JclRepositoryCategoryDelphiFiles = {$IFDEF BDS} sCategoryDelphiNewFiles {$ELSE BDS} '' {$ENDIF BDS};
JclRepositoryCategoryCBuilderFiles = {$IFDEF BDS} sCategoryCBuilderNewFiles {$ELSE BDS} '' {$ENDIF BDS};
+ JclRepositoryModuleTypeForm = {$IFDEF COMPILER6_UP} omtForm {$ELSE COMPILER6_UP} 0 {$ENDIF COMPILER6_UP};
//=== Version Control Expert ===============================================
JclVersionCtrlMenuName = 'JclVersionCtrlMenu';
Modified: trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas
===================================================================
--- trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas 2009-02-07 11:42:08 UTC (rev 2628)
+++ trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas 2009-02-08 12:13:13 UTC (rev 2629)
@@ -38,7 +38,7 @@
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
- JclBorlandTools, JclOtaWizardFrame, JclOtaExcDlgRepository;
+ JclBorlandTools, JclOtaWizardFrame, JclOtaExcDlgRepository, JclOtaConsts, JclOtaUtils;
type
TJclOtaExcDlgFilePage = class(TJclWizardFrame)
@@ -86,7 +86,7 @@
{$R *.dfm}
uses
- ToolsApi,
+ ToolsAPI,
JclStrings,
JclOtaResources;
@@ -182,7 +182,7 @@
ProposedModuleName: string;
Index: Integer;
begin
- AProject := GetActiveProject;
+ AProject := TJclOTAExpertBase.GetActiveProject;
ValidFormName := IsValidIdent(EditFormName.Text);
ProposedModuleName := ChangeFileExt(ExtractFileName(EditFileName.Text), '');
ValidFileName := (ProposedModuleName = '') or IsValidIdent(ProposedModuleName);
@@ -195,7 +195,7 @@
for Index := 0 to AProject.GetModuleCount - 1 do
begin
AModuleInfo := AProject.GetModule(Index);
- if ValidFormName and (AModuleInfo.ModuleType = omtForm) and StrSame(EditFormName.Text, AModuleInfo.FormName) then
+ if ValidFormName and (AModuleInfo.ModuleType = JclRepositoryModuleTypeForm) and StrSame(EditFormName.Text, AModuleInfo.FormName) then
ValidFormName := False;
if ValidFileName and (ProposedModuleName <> '') and StrSame(ProposedModuleName, ChangeFileExt(ExtractFileName(AModuleInfo.FileName), '')) then
ValidFileName := False;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-07 11:57:04
|
Revision: 2628
http://jcl.svn.sourceforge.net/jcl/?rev=2628&view=rev
Author: outchy
Date: 2009-02-07 11:42:08 +0000 (Sat, 07 Feb 2009)
Log Message:
-----------
The exception dialog module name should not conflict with any current project existing modules (including current project main module).
Modified Paths:
--------------
trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas
Modified: trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas
===================================================================
--- trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas 2009-02-07 10:51:46 UTC (rev 2627)
+++ trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas 2009-02-07 11:42:08 UTC (rev 2628)
@@ -20,7 +20,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -179,22 +179,29 @@
AProject: IOTAProject;
AModuleInfo: IOTAModuleInfo;
ValidFormName, ValidFileName: Boolean;
- ProposedFileName: string;
+ ProposedModuleName: string;
Index: Integer;
begin
AProject := GetActiveProject;
ValidFormName := IsValidIdent(EditFormName.Text);
- ProposedFileName := ExtractFileName(EditFileName.Text);
- ValidFileName := (ProposedFileName = '') or IsValidIdent(ChangeFileExt(ProposedFileName, ''));
+ ProposedModuleName := ChangeFileExt(ExtractFileName(EditFileName.Text), '');
+ ValidFileName := (ProposedModuleName = '') or IsValidIdent(ProposedModuleName);
+
if Assigned(AProject) then
+ begin
+ if ValidFileName and (ProposedModuleName <> '') and StrSame(ProposedModuleName, ChangeFileExt(ExtractFileName(AProject.FileName), '')) then
+ ValidFileName := False;
+
for Index := 0 to AProject.GetModuleCount - 1 do
begin
AModuleInfo := AProject.GetModule(Index);
if ValidFormName and (AModuleInfo.ModuleType = omtForm) and StrSame(EditFormName.Text, AModuleInfo.FormName) then
ValidFormName := False;
- if ValidFileName and (ProposedFileName <> '') and StrSame(ProposedFileName, ExtractFileName(AModuleInfo.FileName)) then
+ if ValidFileName and (ProposedModuleName <> '') and StrSame(ProposedModuleName, ChangeFileExt(ExtractFileName(AModuleInfo.FileName), '')) then
ValidFileName := False;
end;
+ end;
+
Result := ValidFormName and ValidFileName and (ComboBoxLanguage.ItemIndex > -1) and (EditFormName.Text <> '') and (EditFormAncestor.Text <> '')
and (( SelectedLanguage = Params.ActivePersonality)
or (EditFileName.Text <> ''));
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2009-02-07 10:51:50
|
Revision: 2627
http://jcl.svn.sourceforge.net/jcl/?rev=2627&view=rev
Author: jedi_mbe
Date: 2009-02-07 10:51:46 +0000 (Sat, 07 Feb 2009)
Log Message:
-----------
Fixed so this unit actually compiles; test cases have not yet been checked
Modified Paths:
--------------
trunk/qa/automated/dunit/units/TestJclContainer.pas
Modified: trunk/qa/automated/dunit/units/TestJclContainer.pas
===================================================================
--- trunk/qa/automated/dunit/units/TestJclContainer.pas 2009-02-07 10:49:05 UTC (rev 2626)
+++ trunk/qa/automated/dunit/units/TestJclContainer.pas 2009-02-07 10:51:46 UTC (rev 2627)
@@ -64,7 +64,7 @@
I.AppendDelimited(sl.Text);
for x := 0 to sl.Count - 1 do
- CheckEquals(sl[x], I.Items[x]);
+ CheckEquals(sl[x], I.Strings[x]);
s := sl.Text;
sl.Text := I.GetAsDelimited;
@@ -93,8 +93,8 @@
begin
case ImplentationType of
litArray: Result := TJclStrArrayList.Create;
- litLinkedList: Result := TJclStrLinkedList.Create;
- litVector: Result := TJclStrVector.Create;
+ litLinkedList: Result := TJclStrLinkedList.Create(nil);
+ litVector: Result := TJclStrVector.Create(500);
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2009-02-07 10:49:09
|
Revision: 2626
http://jcl.svn.sourceforge.net/jcl/?rev=2626&view=rev
Author: jedi_mbe
Date: 2009-02-07 10:49:05 +0000 (Sat, 07 Feb 2009)
Log Message:
-----------
Added case-insensitive versions of StrHasPrefix and StrPrefixIndex
Modified Paths:
--------------
trunk/help/Strings.dtx
trunk/jcl/source/common/JclStrings.pas
trunk/qa/automated/dunit/units/TestJclStrings.pas
Modified: trunk/help/Strings.dtx
===================================================================
--- trunk/help/Strings.dtx 2009-02-07 10:26:07 UTC (rev 2625)
+++ trunk/help/Strings.dtx 2009-02-07 10:49:05 UTC (rev 2626)
@@ -1069,8 +1069,9 @@
Description:
StrHasPrefix returns whether the string is prefixed with at least one of the strings
supplied in the Prefixes array. In other words, for each string in the Prefixes
- array it determined if the supplied string starts with that prefix. Note that
- the routine exits as soon as a match is found.
+ array it's determined if the supplied string starts with that prefix. Note that
+ the routine exits as soon as a match is found and matching is case-sensitive (use
+ StrIHasPrefix for a case-insensitive matching version).
Parameters:
S - The string to test.
Prefixes - Array of prefixes to test for.
@@ -1078,10 +1079,31 @@
If the supplied string is prefixed with one of the supplied prefixes the routine
returns True, otherwise it returns False.
See also:
- StrPrefixIndex
+ StrIHasPrefix, StrPrefixIndex
Donator:
Anthony Steele
--------------------------------------------------------------------------------
+@@StrIHasPrefix
+<GROUP StringManipulation.StringSearchandReplaceRoutines>
+Summary:
+ Returns whether a string is prefixed by one of the supplied strings.
+Description:
+ StrHasPrefix returns whether the string is prefixed with at least one of the strings
+ supplied in the Prefixes array. In other words, for each string in the Prefixes
+ array it's determined if the supplied string starts with that prefix. Note that
+ the routine exits as soon as a match is found and matching is case-insensitive (use
+ StrHasPrefix for a case-sensitive matching version).
+Parameters:
+ S - The string to test.
+ Prefixes - Array of prefixes to test for.
+Result:
+ If the supplied string is prefixed with one of the supplied prefixes the routine
+ returns True, otherwise it returns False.
+See also:
+ StrHasPrefix, StrIPrefixIndex
+Donator:
+ Anthony Steele
+--------------------------------------------------------------------------------
@@StrIndex
<GROUP StringManipulation.StringSearchandReplaceRoutines>
Summary:
@@ -1161,6 +1183,29 @@
Donator:
Anthony Steele
--------------------------------------------------------------------------------
+@@StrIPrefixIndex
+<GROUP StringManipulation.StringSearchandReplaceRoutines>
+Summary:
+ Returns the index at which a string appears which is used as a prefix.
+Description:
+ StrPrefixIndex returns the index into the prefixes array at which a string appears
+ with which the supplied string is prefixed. For example,
+ StrPrefixIndex('banana', ['call', 'ban', 'bana']) will return 1. Note that as
+ can be seen from the example, as soon as a prefix is found the routine stops and
+ doesn't attempt to find a better (longer) match. Matching is case-insensitive; use
+ StrPrefixIndex for a case-insensitive version.
+Parameters:
+ S - The string to test.
+ Prefixes - The list of prefixes.
+Result:
+ The zero based index into Prefixes at which the first string appears that is used
+ as a prefix in the supplied string. If none of the Prefixes array strings qualifies
+ the result is -1.
+See Also
+ StrIHasPrefix, StrPrefixIndex
+Donator:
+ Anthony Steele
+--------------------------------------------------------------------------------
@@StrIsOneOf
<GROUP StringManipulation.StringSearchandReplaceRoutines>
Summary:
@@ -1253,7 +1298,8 @@
with which the supplied string is prefixed. For example,
StrPrefixIndex('banana', ['call', 'ban', 'bana']) will return 1. Note that as
can be seen from the example, as soon as a prefix is found the routine stops and
- doesn't attempt to find a better (longer) match.
+ doesn't attempt to find a better (longer) match. Matching is case-sensitive; use
+ StrIPrefixIndex for a case-insensitive version.
Parameters:
S - The string to test.
Prefixes - The list of prefixes.
@@ -1261,6 +1307,8 @@
The zero based index into Prefixes at which the first string appears that is used
as a prefix in the supplied string. If none of the Prefixes array strings qualifies
the result is -1.
+See Also
+ StrHasPrefix, StrIPrefixIndex
Donator:
Anthony Steele
--------------------------------------------------------------------------------
Modified: trunk/jcl/source/common/JclStrings.pas
===================================================================
--- trunk/jcl/source/common/JclStrings.pas 2009-02-07 10:26:07 UTC (rev 2625)
+++ trunk/jcl/source/common/JclStrings.pas 2009-02-07 10:49:05 UTC (rev 2626)
@@ -259,8 +259,10 @@
function StrFind(const Substr, S: string; const Index: Integer = 1): Integer;
function StrHasPrefix(const S: string; const Prefixes: array of string): Boolean;
function StrIndex(const S: string; const List: array of string): Integer;
+function StrIHasPrefix(const S: string; const Prefixes: array of string): Boolean;
function StrILastPos(const SubStr, S: string): Integer;
function StrIPos(const SubStr, S: string): Integer;
+function StrIPrefixIndex(const S: string; const Prefixes: array of string): Integer;
function StrIsOneOf(const S: string; const List: array of string): Boolean;
function StrLastPos(const SubStr, S: string): Integer;
function StrMatch(const Substr, S: string; const Index: Integer = 1): Integer;
@@ -3067,6 +3069,11 @@
end;
end;
+function StrIHasPrefix(const S: string; const Prefixes: array of string): Boolean;
+begin
+ Result := StrIPrefixIndex(S, Prefixes) > -1;
+end;
+
function StrILastPos(const SubStr, S: string): Integer;
begin
Result := StrLastPos(StrUpper(SubStr), StrUpper(S));
@@ -3081,6 +3088,23 @@
{$ENDIF CLR}
end;
+function StrIPrefixIndex(const S: string; const Prefixes: array of string): Integer;
+var
+ I: Integer;
+ Test: string;
+begin
+ Result := -1;
+ for I := Low(Prefixes) to High(Prefixes) do
+ begin
+ Test := StrLeft(S, Length(Prefixes[I]));
+ if CompareText(Test, Prefixes[I]) = 0 then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
function StrIsOneOf(const S: string; const List: array of string): Boolean;
begin
Result := StrIndex(S, List) > -1;
Modified: trunk/qa/automated/dunit/units/TestJclStrings.pas
===================================================================
--- trunk/qa/automated/dunit/units/TestJclStrings.pas 2009-02-07 10:26:07 UTC (rev 2625)
+++ trunk/qa/automated/dunit/units/TestJclStrings.pas 2009-02-07 10:49:05 UTC (rev 2626)
@@ -132,9 +132,11 @@
procedure _StrFillChar;
procedure _StrFind;
procedure _StrHasPrefix;
+ procedure _StrIHasPrefix;
procedure _StrIndex;
procedure _StrILastPos;
procedure _StrIPos;
+ procedure _StrIPrefixIndex;
procedure _StrIsOneOf;
procedure _StrLastPos;
procedure _StrMatch;
@@ -1619,7 +1621,7 @@
CheckEquals(False, StrHasPrefix('', []), 'StrHasPrefix1');
CheckEquals(False, StrHasPrefix('', ['TEST']), 'StrHasPrefix2');
CheckEquals(False, StrHasPrefix('', ['TEST', 'TEST2']), 'StrHasPrefix3');
- CheckEquals(True, StrHasPrefix('Test', ['TEST', 'TEST2', 'Test']), 'StrHasPrefix4');
+ CheckEquals(False, StrHasPrefix('Test', ['TEST', 'TEST2']), 'StrHasPrefix4');
CheckEquals(True, StrHasPrefix('Test2', ['TEST', 'TEST2', 'Test']), 'StrHasPrefix5');
CheckEquals(True, StrHasPrefix('Test12345', ['TEST', 'TEST2', 'Test']), 'StrHasPrefix6');
CheckEquals(True, StrHasPrefix('Test21234', ['TEST', 'TEST2', 'Test']), 'StrHasPrefix7');
@@ -1627,6 +1629,19 @@
//--------------------------------------------------------------------------------------------------
+procedure TJclStringSearchandReplace._StrIHasPrefix;
+begin
+ CheckEquals(False, StrIHasPrefix('', []), 'StrIHasPrefix1');
+ CheckEquals(False, StrIHasPrefix('', ['TEST']), 'StrIHasPrefix2');
+ CheckEquals(False, StrIHasPrefix('', ['TEST', 'TEST2']), 'StrIHasPrefix3');
+ CheckEquals(True, StrIHasPrefix('Test', ['TEST', 'TEST2']), 'StrIHasPrefix4');
+ CheckEquals(True, StrIHasPrefix('Test2', ['TEST', 'TEST2']), 'StrIHasPrefix5');
+ CheckEquals(True, StrIHasPrefix('Test12345', ['TEST', 'TEST2']), 'StrIHasPrefix6');
+ CheckEquals(True, StrIHasPrefix('Test21234', ['TEST', 'TEST2']), 'StrIHasPrefix7');
+end;
+
+//--------------------------------------------------------------------------------------------------
+
procedure TJclStringSearchandReplace._StrIndex;
begin
end;
@@ -1645,34 +1660,46 @@
//--------------------------------------------------------------------------------------------------
+procedure TJclStringSearchandReplace._StrIPrefixIndex;
+begin
+ CheckEquals(0, StrIPrefixIndex('Project',['Pro']), 'StrIPrefixIndex1');
+ CheckEquals(0, StrIPrefixIndex('Project',['Pro','Con']), 'StrIPrefixIndex2');
+ CheckEquals(0, StrIPrefixIndex('Project',['']), 'StrIPrefixIndex3');
+ CheckEquals(1, StrIPrefixIndex('Project',['Con','Pro']), 'StrIPrefixIndex4');
+ CheckEquals(1, StrIPrefixIndex('Project',['Con','PRO']), 'StrIPrefixIndex5');
+ CheckEquals(-1, StrIPrefixIndex('Project',['Con','PRA']), 'StrIPrefixIndex5');
+end;
+
+//--------------------------------------------------------------------------------------------------
+
procedure TJclStringSearchandReplace._StrIsOneOf;
begin
- CheckEquals(StrIsOneOf('Test', ['a','atest','Test', 'Fest']), True, 'StrIsOneOf_1');
- CheckEquals(StrIsOneOf('Test', ['a','atest', 'Fest']), False, 'StrIsOneOf_2');
- CheckEquals(StrIsOneOf('', ['a','atest', 'Fest']), False, 'StrIsOneOf_3');
+ CheckEquals(True, StrIsOneOf('Test', ['a','atest','Test', 'Fest']), 'StrIsOneOf_1');
+ CheckEquals(False, StrIsOneOf('Test', ['a','atest', 'Fest']), 'StrIsOneOf_2');
+ CheckEquals(False, StrIsOneOf('', ['a','atest', 'Fest']), 'StrIsOneOf_3');
end;
//--------------------------------------------------------------------------------------------------
procedure TJclStringSearchandReplace._StrLastPos;
begin
- CheckEquals(StrLastPos('a', 'aaaaaaaaaa'), 10, 'StrLastPos_1');
- CheckEquals(StrLastPos('aba', 'aabaaababababababa'), 16, 'StrLastPos_2');
- CheckEquals(StrLastPos('abba', 'abbaabbabba'), 8, 'StrLastPos_3');
- CheckEquals(StrLastPos('_abba', 'abbaabbabba'), 0, 'StrLastPos_4');
- CheckEquals(StrLastPos('_abba', 'abba_abbabba'), 5, 'StrLastPos_5');
- CheckEquals(StrLastPos('ABA', 'aabaaaABAbabababa'), 7, 'StrLastPos_6');
+ CheckEquals(10, StrLastPos('a', 'aaaaaaaaaa'), 'StrLastPos_1');
+ CheckEquals(16, StrLastPos('aba', 'aabaaababababababa'), 'StrLastPos_2');
+ CheckEquals(8, StrLastPos('abba', 'abbaabbabba'), 'StrLastPos_3');
+ CheckEquals(0, StrLastPos('_abba', 'abbaabbabba'), 'StrLastPos_4');
+ CheckEquals(5, StrLastPos('_abba', 'abba_abbabba'), 'StrLastPos_5');
+ CheckEquals(7, StrLastPos('ABA', 'aabaaaABAbabababa'), 'StrLastPos_6');
end;
//--------------------------------------------------------------------------------------------------
procedure TJclStringSearchandReplace._StrMatch;
begin
- CheckEquals(StrMatch('','Test',1),0,'StrMatch_1');
- CheckEquals(StrMatch('Test','Test',1),1,'StrMatch_2');
- CheckEquals(StrMatch('Test','aTest',1),2,'StrMatch_3');
- CheckEquals(StrMatch('Test','abTest',1),3,'StrMatch_4');
- CheckEquals(StrMatch('Test','abcTest',1),4,'StrMatch_5');
+ CheckEquals(0, StrMatch('', 'Test', 1), 'StrMatch_1');
+ CheckEquals(1, StrMatch('Test', 'Test', 1), 'StrMatch_2');
+ CheckEquals(2, StrMatch('Test', 'aTest', 1), 'StrMatch_3');
+ CheckEquals(3, StrMatch('Test', 'abTest', 1), 'StrMatch_4');
+ CheckEquals(4, StrMatch('Test', 'abcTest', 1), 'StrMatch_5');
end;
//--------------------------------------------------------------------------------------------------
@@ -1722,10 +1749,11 @@
procedure TJclStringSearchandReplace._StrPrefixIndex;
begin
- CheckEquals(StrPrefixIndex('Project',['Pro']),0,'StrPrefixIndex');
- CheckEquals(StrPrefixIndex('Project',['Pro','Con']),0,'StrPrefixIndex');
- CheckEquals(StrPrefixIndex('Project',['']),0,'StrPrefixIndex');
- CheckEquals(StrPrefixIndex('Project',['Con','Pro']),1,'StrPrefixIndex');
+ CheckEquals(0, StrPrefixIndex('Project',['Pro']), 'StrPrefixIndex1');
+ CheckEquals(0, StrPrefixIndex('Project',['Pro','Con']), 'StrPrefixIndex2');
+ CheckEquals(0, StrPrefixIndex('Project',['']), 'StrPrefixIndex3');
+ CheckEquals(1, StrPrefixIndex('Project',['Con','Pro']), 'StrPrefixIndex4');
+ CheckEquals(-1, StrPrefixIndex('Project',['Con','PRO']), 'StrPrefixIndex5');
end;
//--------------------------------------------------------------------------------------------------
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2009-02-07 10:26:10
|
Revision: 2625
http://jcl.svn.sourceforge.net/jcl/?rev=2625&view=rev
Author: uschuster
Date: 2009-02-07 10:26:07 +0000 (Sat, 07 Feb 2009)
Log Message:
-----------
fixed compilation with D7 and BDS1 (the second parameter for IsValidIdent was introduced in BDS2 and we can omit it since it is false by default and there is no way to distinguish between BDS1 and BDS2)
Modified Paths:
--------------
trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas
Modified: trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas
===================================================================
--- trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas 2009-02-07 10:00:47 UTC (rev 2624)
+++ trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas 2009-02-07 10:26:07 UTC (rev 2625)
@@ -183,9 +183,9 @@
Index: Integer;
begin
AProject := GetActiveProject;
- ValidFormName := IsValidIdent(EditFormName.Text, False);
+ ValidFormName := IsValidIdent(EditFormName.Text);
ProposedFileName := ExtractFileName(EditFileName.Text);
- ValidFileName := (ProposedFileName = '') or IsValidIdent(ChangeFileExt(ProposedFileName, ''), False);
+ ValidFileName := (ProposedFileName = '') or IsValidIdent(ChangeFileExt(ProposedFileName, ''));
if Assigned(AProject) then
for Index := 0 to AProject.GetModuleCount - 1 do
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2009-02-07 10:00:56
|
Revision: 2624
http://jcl.svn.sourceforge.net/jcl/?rev=2624&view=rev
Author: uschuster
Date: 2009-02-07 10:00:47 +0000 (Sat, 07 Feb 2009)
Log Message:
-----------
removed BOM
Modified Paths:
--------------
trunk/jcl/source/common/JclResources.pas
Modified: trunk/jcl/source/common/JclResources.pas
===================================================================
--- trunk/jcl/source/common/JclResources.pas 2009-02-05 22:19:56 UTC (rev 2623)
+++ trunk/jcl/source/common/JclResources.pas 2009-02-07 10:00:47 UTC (rev 2624)
@@ -1,4 +1,4 @@
-{**************************************************************************************************}
+{**************************************************************************************************}
{ }
{ Project JEDI Code Library (JCL) }
{ }
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-05 22:37:11
|
Revision: 2623
http://jcl.svn.sourceforge.net/jcl/?rev=2623&view=rev
Author: outchy
Date: 2009-02-05 22:19:56 +0000 (Thu, 05 Feb 2009)
Log Message:
-----------
Mantis 4692: Jcl Exception Dialog for Delphi crashes while re-adding the exception form.
Modified Paths:
--------------
trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas
Modified: trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas
===================================================================
--- trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas 2009-02-05 21:35:53 UTC (rev 2622)
+++ trunk/jcl/experts/repository/JclOtaExcDlgFileFrame.pas 2009-02-05 22:19:56 UTC (rev 2623)
@@ -86,7 +86,9 @@
{$R *.dfm}
uses
- JclStrings, JclOtaResources;
+ ToolsApi,
+ JclStrings,
+ JclOtaResources;
//=== { TJclOtaExcDlgFilePage } ==============================================
@@ -173,8 +175,27 @@
end;
function TJclOtaExcDlgFilePage.GetSupportsNext: Boolean;
+var
+ AProject: IOTAProject;
+ AModuleInfo: IOTAModuleInfo;
+ ValidFormName, ValidFileName: Boolean;
+ ProposedFileName: string;
+ Index: Integer;
begin
- Result := (ComboBoxLanguage.ItemIndex > -1) and (EditFormName.Text <> '') and (EditFormAncestor.Text <> '')
+ AProject := GetActiveProject;
+ ValidFormName := IsValidIdent(EditFormName.Text, False);
+ ProposedFileName := ExtractFileName(EditFileName.Text);
+ ValidFileName := (ProposedFileName = '') or IsValidIdent(ChangeFileExt(ProposedFileName, ''), False);
+ if Assigned(AProject) then
+ for Index := 0 to AProject.GetModuleCount - 1 do
+ begin
+ AModuleInfo := AProject.GetModule(Index);
+ if ValidFormName and (AModuleInfo.ModuleType = omtForm) and StrSame(EditFormName.Text, AModuleInfo.FormName) then
+ ValidFormName := False;
+ if ValidFileName and (ProposedFileName <> '') and StrSame(ProposedFileName, ExtractFileName(AModuleInfo.FileName)) then
+ ValidFileName := False;
+ end;
+ Result := ValidFormName and ValidFileName and (ComboBoxLanguage.ItemIndex > -1) and (EditFormName.Text <> '') and (EditFormAncestor.Text <> '')
and (( SelectedLanguage = Params.ActivePersonality)
or (EditFileName.Text <> ''));
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-05 22:37:05
|
Revision: 2622
http://jcl.svn.sourceforge.net/jcl/?rev=2622&view=rev
Author: outchy
Date: 2009-02-05 21:35:53 +0000 (Thu, 05 Feb 2009)
Log Message:
-----------
Mantis 4673: ShellLinkCreate does not work with Unicode.
Modified Paths:
--------------
trunk/jcl/source/windows/JclShell.pas
Modified: trunk/jcl/source/windows/JclShell.pas
===================================================================
--- trunk/jcl/source/windows/JclShell.pas 2009-02-05 21:27:48 UTC (rev 2621)
+++ trunk/jcl/source/windows/JclShell.pas 2009-02-05 21:35:53 UTC (rev 2622)
@@ -1019,8 +1019,13 @@
end;
const
+ {$IFDEF SUPPORTS_UNICODE}
+ IID_IShellLink: TGUID = { IID_IShellLinkW }
+ (D1:$000214F9; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
+ {$ELSE ~SUPPORTS_UNICODE}
IID_IShellLink: TGUID = { IID_IShellLinkA }
(D1:$000214EE; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
+ {$ENDIF ~SUPPORTS_UNICODE}
function ShellLinkCreateSystem(const Link: TShellLink; const Folder: Integer;
const FileName: string): HRESULT;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-05 21:27:55
|
Revision: 2621
http://jcl.svn.sourceforge.net/jcl/?rev=2621&view=rev
Author: outchy
Date: 2009-02-05 21:27:48 +0000 (Thu, 05 Feb 2009)
Log Message:
-----------
Mantis 4676 DotNetFormat does not handle UnicodeString type when argument passed as Variant type.
Code in JclSimpleXml and JclStringList lacked support for UnicodeStrings as well.
Modified Paths:
--------------
trunk/jcl/source/common/JclSimpleXml.pas
trunk/jcl/source/common/JclStringLists.pas
trunk/jcl/source/common/JclStrings.pas
Modified: trunk/jcl/source/common/JclSimpleXml.pas
===================================================================
--- trunk/jcl/source/common/JclSimpleXml.pas 2009-02-04 21:14:50 UTC (rev 2620)
+++ trunk/jcl/source/common/JclSimpleXml.pas 2009-02-05 21:27:48 UTC (rev 2621)
@@ -3652,6 +3652,28 @@
StorageStream.Free;
end;
end;
+ {$IFDEF SUPPORTS_UNICODE_STRING}
+ varUString:
+ begin
+ StorageStream := TStringStream.Create('');
+ try
+ ConversionString := TJclUTF16Stream.Create(StorageStream, False);
+ try
+ ConversionString.WriteBOM;
+ TXMLVarData(Source).XML.SaveToStringStream(ConversionString, '', nil);
+ ConversionString.Flush;
+ finally
+ ConversionString.Free;
+ end;
+ VarDataClear(Dest);
+ Dest.VUString := nil;
+ Dest.VType := varUString;
+ UnicodeString(Dest.VUString) := UnicodeString(StorageStream.DataString);
+ finally
+ StorageStream.Free;
+ end;
+ end;
+ {$ENDIF SUPPORTS_UNICODE_STRING}
else
RaiseCastError;
end;
Modified: trunk/jcl/source/common/JclStringLists.pas
===================================================================
--- trunk/jcl/source/common/JclStringLists.pas 2009-02-04 21:14:50 UTC (rev 2620)
+++ trunk/jcl/source/common/JclStringLists.pas 2009-02-05 21:27:48 UTC (rev 2621)
@@ -494,33 +494,40 @@
else
Add(A[I].ToString);
{$ELSE}
- with A[I] do
- case VType of
- vtInteger:
- Add(IntToStr(VInteger));
- vtBoolean:
- Add(string(BoolToStr[VBoolean]));
- vtChar:
- Add(string(AnsiString(VChar)));
- vtExtended:
- Add(FloatToStr(VExtended^));
- vtString:
- Add(string(VString^));
- vtPChar:
- Add(string(AnsiString(VPChar)));
- vtObject:
- Add(VObject.ClassName);
- vtClass:
- Add(VClass.ClassName);
- vtAnsiString:
- Add(string(VAnsiString));
- vtCurrency:
- Add(CurrToStr(VCurrency^));
- vtVariant:
- Add(string(VVariant^));
- vtInt64:
- Add(IntToStr(VInt64^));
- end;
+ case A[I].VType of
+ vtInteger:
+ Add(IntToStr(A[I].VInteger));
+ vtBoolean:
+ Add(string(BoolToStr[A[I].VBoolean]));
+ vtChar:
+ Add(string(AnsiString(A[I].VChar)));
+ vtExtended:
+ Add(FloatToStr(A[I].VExtended^));
+ vtString:
+ Add(string(A[I].VString^));
+ vtPChar:
+ Add(string(AnsiString(A[I].VPChar)));
+ vtPWideChar:
+ Add(string(WideString(A[I].VPWideChar)));
+ vtObject:
+ Add(A[I].VObject.ClassName);
+ vtClass:
+ Add(A[I].VClass.ClassName);
+ vtAnsiString:
+ Add(string(A[I].VAnsiString));
+ vtWideString:
+ Add(string(A[I].VWideString));
+ vtCurrency:
+ Add(CurrToStr(A[I].VCurrency^));
+ vtVariant:
+ Add(string(A[I].VVariant^));
+ vtInt64:
+ Add(IntToStr(A[I].VInt64^));
+ {$IFDEF SUPPORTS_UNICODE_STRING}
+ vtUnicodeString:
+ Add(string(A[I].VUnicodeString));
+ {$ENDIF SUPPORTS_UNICODE_STRING}
+ end;
{$ENDIF CLR}
Result := FSelfAsInterface;
end;
Modified: trunk/jcl/source/common/JclStrings.pas
===================================================================
--- trunk/jcl/source/common/JclStrings.pas 2009-02-04 21:14:50 UTC (rev 2620)
+++ trunk/jcl/source/common/JclStrings.pas 2009-02-05 21:27:48 UTC (rev 2621)
@@ -49,7 +49,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -4968,7 +4968,10 @@
{$ENDIF COMPILER5}
varString:
Result := string(V.VString);
-
+ {$IFDEF SUPPORTS_UNICODE_STRING}
+ varUString:
+ Result := string(V.VUString);
+ {$ENDIF SUPPORTS_UNICODE_STRING}
{varArray,
varDispatch,
varError,
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2009-02-04 21:14:52
|
Revision: 2620
http://jcl.svn.sourceforge.net/jcl/?rev=2620&view=rev
Author: jedi_mbe
Date: 2009-02-04 21:14:50 +0000 (Wed, 04 Feb 2009)
Log Message:
-----------
Missing file for the Notifier/Listener pattern
Modified Paths:
--------------
trunk/help/hlpgrps.dtx
Modified: trunk/help/hlpgrps.dtx
===================================================================
--- trunk/help/hlpgrps.dtx 2009-02-04 21:09:17 UTC (rev 2619)
+++ trunk/help/hlpgrps.dtx 2009-02-04 21:14:50 UTC (rev 2620)
@@ -210,6 +210,80 @@
<TITLE MultiMedia>
<TOPICORDER 1800>
--------------------------------------------------------------------------------
+@@BaseServices.Notifications
+<GROUP BaseServices>
+<TITLE Notifier/listener pattern>
+<TOPICORDER 1850>
+The notifier/listener pattern allows for both generalizing the sending of
+notifications to multiple interested parties (listeners) and ease of adding new
+ways of processing notifications without needing to change any code.
+
+An example of this pattern can be found in .NET, where one can find a
+Trace class and a number of derived TraceListener classes. Using that example,
+the Trace class is an IJclNotifier implementer and the TraceListener an
+IJclListener interface. However, the .NET Trace and TraceListener setup is a
+specific implementation and doesn't need an IJclNotificationMessage implementer;
+the Trace class simply calls specific methods of the TraceListener. The JEDI
+Code Library provides a more generic approach to this pattern.
+
+* Notifiers *
+A notifier (any class implementing IJclNotifier) has only two distinct tasks:
+
+* Managing a list of listeners (IJclListener implementing classes)
+* Notify all registered listeners
+
+The first task is generally performed before a certain process within an
+application is started or after it has finished.
+
+The second task is performed by the class or methods that are part of a process.
+At any moment a message (IJclNotificationMessage implementing class) can be
+constructed and passed on to the Notification method.
+
+* Listeners *
+A listener (any class implementing IJclListener) has a single method that will
+be called by a notifier whenever its notify method is called. The method will
+specify the message that was passed to the notifier's notify method. A listener
+can check incoming notifications for additional or derived interface(s) and
+either process the notification or ignore it based on those interface(s).
+
+During processing the additional or derived interface(s) may provide additional
+information regarding the nature of the notification.
+
+* Notification messages *
+A notification message (any class implementing IJclNotificationMessage) is just
+place holder. Normally, one would either create a derived interface or add
+additional interfaces to the message implementation class, adding such
+information as context or other data that may be of interest to listeners.
+
+* Setting up a notifier/listener pattern *
+In general setting up a specific notification sub system involves the steps as
+outlined below. It's not unthinkable that for certain situations you'll need
+additional steps or may skip steps.
+
+1 create a notifier
+ The JEDI Code Library simplifies this task: create an instance of
+ TJclBaseNotifier and you're good to go in most cases. Assign the instance
+ to a variable declared as IJclNotifier, so that you can use the notifier
+ (the class itself declares the methods protected since it is assumed they
+ will be used through the interface reference at all times).
+
+2 create notification messages
+ Notification messages describe to the listener what has happened. If all you
+ need is a simple notification a proces has finished, you could suffice with
+ TJclBaseNotificationMessage. In most cases, however, you will need to
+ declare additional interfaces (use Ctrl+Shift+G to create a GUID). These
+ interfaces can have additional properties and/or functions to provide data
+ to the listener, but a message supporting a certain interface could be all
+ the information you'd need. Then you'll need to create one or more classes
+ that will implement these interfaces (in whatever combination you need).
+
+3 create a listener
+ In most cases you could simply derive a class from TJclBaseListener.
+ Alternatively you could create a new class to implement the IJclListener
+ interface, or - in case of a VCL application - have your MainForm implement
+ the interface. The interface has only one method and it will be passed an
+ IJclNotificationMessage instance.
+--------------------------------------------------------------------------------
@@OrdinalMathandLogic
<GROUP JCL>
<TITLE Ordinal Math and Logic>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2009-02-04 21:09:28
|
Revision: 2619
http://jcl.svn.sourceforge.net/jcl/?rev=2619&view=rev
Author: jedi_mbe
Date: 2009-02-04 21:09:17 +0000 (Wed, 04 Feb 2009)
Log Message:
-----------
Added new notifier/listener pattern
Modified Paths:
--------------
trunk/help/JCLHelp.dox
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/d11/Jcl.dpk
trunk/jcl/packages/d11/Jcl.dproj
trunk/jcl/packages/d12/Jcl.dpk
trunk/jcl/packages/d12/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/k3/Jcl.bpk
trunk/jcl/packages/k3/Jcl.dpk
trunk/jcl/packages/xml/Jcl-R.xml
trunk/qa/automated/dunit/JclTests.dpr
Added Paths:
-----------
trunk/help/Notify.dtx
trunk/jcl/source/common/JclNotify.pas
trunk/qa/automated/dunit/units/TestJclNotify.pas
Modified: trunk/help/JCLHelp.dox
===================================================================
--- trunk/help/JCLHelp.dox 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/help/JCLHelp.dox 2009-02-04 21:09:17 UTC (rev 2619)
@@ -137298,7 +137298,7 @@
SavedValues=1
[Source Files]
-Count=136
+Count=138
File0=8087.dtx
File1=AppInst.dtx
File10=ExprEval.dtx
@@ -137341,6 +137341,8 @@
File133=..\jcl\source\windows\JclWin32.pas
File134=..\jcl\source\windows\JclWin32Ex.pas
File135=..\jcl\source\windows\JclWinMIDI.pas
+File136=..\jcl\source\common\JclNotify.pas
+File137=Notify.dtx
File14=Hardlinks.dtx
File15=hlpgrps.dtx
File16=IncludedFiles.dtx
Added: trunk/help/Notify.dtx
===================================================================
--- trunk/help/Notify.dtx (rev 0)
+++ trunk/help/Notify.dtx 2009-02-04 21:09:17 UTC (rev 2619)
@@ -0,0 +1,161 @@
+@@IJclListener
+<GROUP Notifications>
+Summary
+ Interface for listener implementations.
+Description
+ IJclListener defines the interface required in a notifier/listener pattern
+ setup. It consists of a single method, called by the notifier for each message
+ being passed to it.
+
+ See the <LINK @@BaseServices.Notifications, topic on notifier/listener pattern>
+ for more information on how to use this and related interfaces.
+Donator
+ Marcel Bestebroer
+--------------------------------------------------------------------------------
+@@IJclListener.Notification
+Summary
+ Notification callback.
+Description
+ Notification is called by the notifier's <LINK IJclNotifier.Notify, Notify>
+ method if the listener is registered with the notifier.
+
+ The provided message is passed on from the process calling the
+ <LINK IJclNotifier.Notify, Notify> method. Most real world implementations
+ will have implemented additional interfaces (or an interface derived from
+ IJclNotificationMessage) to provide actual information on the nature of the
+ notification.
+Parameters
+ msg - A message containing additional information on the nature of the
+ notification.
+--------------------------------------------------------------------------------
+@@IJclNotifier
+<GROUP Notifications>
+Summary
+ Interface for notifier implementations.
+Description
+ IJclNotifier defines the interface required in a notifier/listener pattern
+ setup. It consists of a two management methods and a notifier method.
+
+ See the <LINK @@BaseServices.Notifications, topic on notifier/listener pattern>
+ for more information on how to use this and related interfaces.
+Donator
+ Marcel Bestebroer
+--------------------------------------------------------------------------------
+@@IJclNotifier.Add
+Summary
+ Adds a listener to the notifier.
+Description
+ Add will register the specified listener with the notifier. If the specified
+ listener is already registered with the notifier, nothing will happen.
+Parameters
+ listener - The IJclListener implementation to register with the notifier.
+--------------------------------------------------------------------------------
+@@IJclNotifier.Notify
+Summary
+ Notifies all listeners of an event.
+Description
+ Notify will iterate all registered listeners and call their
+ <LINK IJclNotificationMessage.Notification, Notification> method, passing the
+ provided message.
+Parameters
+ msg - A message containing additional information on the nature of the
+ notification. The message is passed on to the listeners currently
+ registered with the notifier.
+--------------------------------------------------------------------------------
+@@IJclNotifier.Remove
+Summary
+ Removes a listener from the notifier.
+Description
+ Remove will unregister the specified listener from the notifier. If the
+ specified listener is not registered with the notifier, nothing will happen.
+Parameters
+ listener - The IJclListener implementation to unregister from the notifier.
+--------------------------------------------------------------------------------
+@@IJclNotificationMessage
+<GROUP Notifications>
+Summary
+ Interface for notification message implementations.
+Description
+ IJclNotificationMessage defines the interface required in a notifier/listener
+ pattern setup. It serves as a place holder to various notification messages
+ and implementers will either use a derived interface or additional interface
+ to provide process-specific information.
+
+ See the <LINK @@BaseServices.Notifications, topic on notifier/listener pattern>
+ for more information on how to use this and related interfaces.
+Donator
+ Marcel Bestebroer
+--------------------------------------------------------------------------------
+@@TJclBaseNotifier
+<GROUP Notifications>
+Summary
+ Base implementation of IJclNotifier.
+Description
+ TJclBaseNotifier is a base implementation of IJclNotifier. It provides
+ notification in a sequential order, using the same order in which listeners
+ were registered.
+
+*Thread safety *
+ If the unit is compiled with the THREADSAFE define, all access to the
+ notifier list is protected using a multi-read/exclusive-write synchronization
+ object.
+
+ Sending notifications is seen as a read-only operation since the list is not
+ modified.
+
+ Note that TJclBaseNotifier does not create threads when generating the
+ notifications. Each listener is notified in a sequential manner, where each
+ listener will have to wait for the previous listener to finish. A call to the
+ IJclNotifier.Notify will thus not finish until all listeners have processed
+ the notification.
+
+* Notes *
+ Using this implementation does not imply TJclBaseListener or
+ TJclBaseNotificationMessage have to be used; TJclBaseNotifier will handle
+ any IJclListener and IJclNotificationMessage implementation.
+Donator
+ Marcel Bestebroer
+--------------------------------------------------------------------------------
+@@TJclBaseNotifier.Add
+<ALIAS IJclNotifier.Add>
+--------------------------------------------------------------------------------
+@@TJclBaseNotifier.Notify
+<ALIAS IJclNotifier.Notify>
+--------------------------------------------------------------------------------
+@@TJclBaseNotifier.Remove
+<ALIAS IJclNotifier.Remove>
+--------------------------------------------------------------------------------
+@@TJclBaseNotificationMessage
+<GROUP Notifications>
+Summary
+ Base implementation of IJclNotificationMessage.
+Description
+ TJclBaseNotificationMessage is a base implementation of IJclNotificationMessage.
+ Since the interface only serves as a place holder, you should create
+ derivatives of this class, implementing either one or more additional
+ interfaces, or implementing an interface derived from IJclNotificationMessage.
+
+* Notes *
+ Using this implementation does not imply TJclBaseNotifier or
+ TJclBaseListener have to be used; TJclBaseNotificationMessage will be handled
+ by any IJclListener and IJclNotificationMessage implementation.
+Donator
+ Marcel Bestebroer
+--------------------------------------------------------------------------------
+@@TJclBaseListener
+<GROUP Notifications>
+Summary
+ Base implementation of IJclListener.
+Description
+ TJclBaseListener is a base implementation of IJclListener. It declares an
+ empty, virtual implementation for the Notification method. Descendants should
+ override the method to process the notification messages.
+
+* Notes *
+ Using this implementation does not imply TJclBaseNotifier or
+ TJclBaseNotificationMessage have to be used; TJclBaseListener will handle
+ any IJclNotifier and IJclNotificationMessage implementation.
+Donator
+ Marcel Bestebroer
+--------------------------------------------------------------------------------
+
Modified: trunk/jcl/packages/c5/JclC50.bpk
===================================================================
--- trunk/jcl/packages/c5/JclC50.bpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/c5/JclC50.bpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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-09-2008 16:39:07 UTC
+ Last generated: 04-02-2009 20:52:01 UTC
*****************************************************************************
-->
<PROJECT>
@@ -38,6 +38,7 @@
..\..\lib\c5\JclMath.obj
..\..\lib\c5\JclMIDI.obj
..\..\lib\c5\JclMime.obj
+ ..\..\lib\c5\JclNotify.obj
..\..\lib\c5\JclPCRE.obj
..\..\lib\c5\JclResources.obj
..\..\lib\c5\JclRTTI.obj
Modified: trunk/jcl/packages/c5/JclC50.cpp
===================================================================
--- trunk/jcl/packages/c5/JclC50.cpp 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/c5/JclC50.cpp 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 06-09-2008 16:39:07 UTC
+ Last generated: 04-02-2009 20:52:01 UTC
-----------------------------------------------------------------------------
*/
@@ -35,6 +35,7 @@
USEUNIT("..\..\source\common\JclMath.pas");
USEUNIT("..\..\source\common\JclMIDI.pas");
USEUNIT("..\..\source\common\JclMime.pas");
+USEUNIT("..\..\source\common\JclNotify.pas");
USEUNIT("..\..\source\common\JclPCRE.pas");
USEUNIT("..\..\source\common\JclResources.pas");
USEUNIT("..\..\source\common\JclRTTI.pas");
Modified: trunk/jcl/packages/c5/JclC50.dpk
===================================================================
--- trunk/jcl/packages/c5/JclC50.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/c5/JclC50.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 06-09-2008 16:39:08 UTC
+ Last generated: 04-02-2009 20:52:02 UTC
-----------------------------------------------------------------------------
}
@@ -63,6 +63,7 @@
JclMath in '..\..\source\common\JclMath.pas' ,
JclMIDI in '..\..\source\common\JclMIDI.pas' ,
JclMime in '..\..\source\common\JclMime.pas' ,
+ JclNotify in '..\..\source\common\JclNotify.pas' ,
JclPCRE in '..\..\source\common\JclPCRE.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
Modified: trunk/jcl/packages/c6/Jcl.bpk
===================================================================
--- trunk/jcl/packages/c6/Jcl.bpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/c6/Jcl.bpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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-09-2008 16:39:08 UTC
+ Last generated: 04-02-2009 20:52:02 UTC
*****************************************************************************
-->
<PROJECT>
@@ -38,6 +38,7 @@
..\..\lib\c6\JclMath.obj
..\..\lib\c6\JclMIDI.obj
..\..\lib\c6\JclMime.obj
+ ..\..\lib\c6\JclNotify.obj
..\..\lib\c6\JclPCRE.obj
..\..\lib\c6\JclResources.obj
..\..\lib\c6\JclRTTI.obj
@@ -166,6 +167,7 @@
<FILE FILENAME="..\..\source\common\JclMath.pas" FORMNAME="" UNITNAME="JclMath" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\common\JclMIDI.pas" FORMNAME="" UNITNAME="JclMIDI" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\common\JclMime.pas" FORMNAME="" UNITNAME="JclMime" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="..\..\source\common\JclNotify.pas" FORMNAME="" UNITNAME="JclNotify" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\common\JclPCRE.pas" FORMNAME="" UNITNAME="JclPCRE" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\common\JclResources.pas" FORMNAME="" UNITNAME="JclResources" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="..\..\source\common\JclRTTI.pas" FORMNAME="" UNITNAME="JclRTTI" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
Modified: trunk/jcl/packages/c6/Jcl.dpk
===================================================================
--- trunk/jcl/packages/c6/Jcl.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/c6/Jcl.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 06-09-2008 16:39:08 UTC
+ Last generated: 04-02-2009 20:52:02 UTC
-----------------------------------------------------------------------------
}
@@ -63,6 +63,7 @@
JclMath in '..\..\source\common\JclMath.pas' ,
JclMIDI in '..\..\source\common\JclMIDI.pas' ,
JclMime in '..\..\source\common\JclMime.pas' ,
+ JclNotify in '..\..\source\common\JclNotify.pas' ,
JclPCRE in '..\..\source\common\JclPCRE.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
Modified: trunk/jcl/packages/cs1/Jcl.dpk
===================================================================
--- trunk/jcl/packages/cs1/Jcl.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/cs1/Jcl.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 06-09-2008 16:39:10 UTC
+ Last generated: 04-02-2009 20:52:05 UTC
-----------------------------------------------------------------------------
}
@@ -64,6 +64,7 @@
JclMath in '..\..\source\common\JclMath.pas' ,
JclMIDI in '..\..\source\common\JclMIDI.pas' ,
JclMime in '..\..\source\common\JclMime.pas' ,
+ JclNotify in '..\..\source\common\JclNotify.pas' ,
JclPCRE in '..\..\source\common\JclPCRE.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
Modified: trunk/jcl/packages/d10/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d10/Jcl.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/d10/Jcl.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 06-09-2008 16:39:11 UTC
+ Last generated: 04-02-2009 20:52:06 UTC
-----------------------------------------------------------------------------
}
@@ -64,6 +64,7 @@
JclMath in '..\..\source\common\JclMath.pas' ,
JclMIDI in '..\..\source\common\JclMIDI.pas' ,
JclMime in '..\..\source\common\JclMime.pas' ,
+ JclNotify in '..\..\source\common\JclNotify.pas' ,
JclPCRE in '..\..\source\common\JclPCRE.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
Modified: trunk/jcl/packages/d11/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d11/Jcl.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/d11/Jcl.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 11-09-2008 22:13:46 UTC
+ Last generated: 04-02-2009 20:52:06 UTC
-----------------------------------------------------------------------------
}
@@ -64,6 +64,7 @@
JclMath in '..\..\source\common\JclMath.pas' ,
JclMIDI in '..\..\source\common\JclMIDI.pas' ,
JclMime in '..\..\source\common\JclMime.pas' ,
+ JclNotify in '..\..\source\common\JclNotify.pas' ,
JclPCRE in '..\..\source\common\JclPCRE.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
Modified: trunk/jcl/packages/d11/Jcl.dproj
===================================================================
--- trunk/jcl/packages/d11/Jcl.dproj 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/d11/Jcl.dproj 2009-02-04 21:09:17 UTC (rev 2619)
@@ -110,6 +110,7 @@
<DCCReference Include="..\..\source\common\JclMath.pas" />
<DCCReference Include="..\..\source\common\JclMIDI.pas" />
<DCCReference Include="..\..\source\common\JclMime.pas" />
+ <DCCReference Include="..\..\source\common\JclNotify.pas" />
<DCCReference Include="..\..\source\common\JclPCRE.pas" />
<DCCReference Include="..\..\source\common\JclResources.pas" />
<DCCReference Include="..\..\source\common\JclRTTI.pas" />
Modified: trunk/jcl/packages/d12/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d12/Jcl.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/d12/Jcl.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 11-09-2008 22:13:47 UTC
+ Last generated: 04-02-2009 20:52:07 UTC
-----------------------------------------------------------------------------
}
@@ -64,6 +64,7 @@
JclMath in '..\..\source\common\JclMath.pas' ,
JclMIDI in '..\..\source\common\JclMIDI.pas' ,
JclMime in '..\..\source\common\JclMime.pas' ,
+ JclNotify in '..\..\source\common\JclNotify.pas' ,
JclPCRE in '..\..\source\common\JclPCRE.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
Modified: trunk/jcl/packages/d12/Jcl.dproj
===================================================================
--- trunk/jcl/packages/d12/Jcl.dproj 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/d12/Jcl.dproj 2009-02-04 21:09:17 UTC (rev 2619)
@@ -87,6 +87,7 @@
<DCCReference Include="..\..\source\common\JclMath.pas" />
<DCCReference Include="..\..\source\common\JclMIDI.pas" />
<DCCReference Include="..\..\source\common\JclMime.pas" />
+ <DCCReference Include="..\..\source\common\JclNotify.pas" />
<DCCReference Include="..\..\source\common\JclPCRE.pas" />
<DCCReference Include="..\..\source\common\JclResources.pas" />
<DCCReference Include="..\..\source\common\JclRTTI.pas" />
Modified: trunk/jcl/packages/d5/JclD50.dpk
===================================================================
--- trunk/jcl/packages/d5/JclD50.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/d5/JclD50.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 06-09-2008 16:39:08 UTC
+ Last generated: 04-02-2009 20:52:03 UTC
-----------------------------------------------------------------------------
}
@@ -63,6 +63,7 @@
JclMath in '..\..\source\common\JclMath.pas' ,
JclMIDI in '..\..\source\common\JclMIDI.pas' ,
JclMime in '..\..\source\common\JclMime.pas' ,
+ JclNotify in '..\..\source\common\JclNotify.pas' ,
JclPCRE in '..\..\source\common\JclPCRE.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
Modified: trunk/jcl/packages/d6/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d6/Jcl.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/d6/Jcl.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 06-09-2008 16:39:09 UTC
+ Last generated: 04-02-2009 20:52:03 UTC
-----------------------------------------------------------------------------
}
@@ -64,6 +64,7 @@
JclMath in '..\..\source\common\JclMath.pas' ,
JclMIDI in '..\..\source\common\JclMIDI.pas' ,
JclMime in '..\..\source\common\JclMime.pas' ,
+ JclNotify in '..\..\source\common\JclNotify.pas' ,
JclPCRE in '..\..\source\common\JclPCRE.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
Modified: trunk/jcl/packages/d7/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d7/Jcl.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/d7/Jcl.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 06-09-2008 16:39:09 UTC
+ Last generated: 04-02-2009 20:52:04 UTC
-----------------------------------------------------------------------------
}
@@ -64,6 +64,7 @@
JclMath in '..\..\source\common\JclMath.pas' ,
JclMIDI in '..\..\source\common\JclMIDI.pas' ,
JclMime in '..\..\source\common\JclMime.pas' ,
+ JclNotify in '..\..\source\common\JclNotify.pas' ,
JclPCRE in '..\..\source\common\JclPCRE.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
Modified: trunk/jcl/packages/d8/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d8/Jcl.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/d8/Jcl.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 06-09-2008 16:39:09 UTC
+ Last generated: 04-02-2009 20:52:04 UTC
-----------------------------------------------------------------------------
}
@@ -64,6 +64,7 @@
JclMath in '..\..\source\common\JclMath.pas' ,
JclMIDI in '..\..\source\common\JclMIDI.pas' ,
JclMime in '..\..\source\common\JclMime.pas' ,
+ JclNotify in '..\..\source\common\JclNotify.pas' ,
JclPCRE in '..\..\source\common\JclPCRE.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
Modified: trunk/jcl/packages/d9/Jcl.dpk
===================================================================
--- trunk/jcl/packages/d9/Jcl.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/d9/Jcl.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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: 06-09-2008 16:39:10 UTC
+ Last generated: 04-02-2009 20:52:05 UTC
-----------------------------------------------------------------------------
}
@@ -64,6 +64,7 @@
JclMath in '..\..\source\common\JclMath.pas' ,
JclMIDI in '..\..\source\common\JclMIDI.pas' ,
JclMime in '..\..\source\common\JclMime.pas' ,
+ JclNotify in '..\..\source\common\JclNotify.pas' ,
JclPCRE in '..\..\source\common\JclPCRE.pas' ,
JclResources in '..\..\source\common\JclResources.pas' ,
JclRTTI in '..\..\source\common\JclRTTI.pas' ,
Modified: trunk/jcl/packages/k3/Jcl.bpk
===================================================================
--- trunk/jcl/packages/k3/Jcl.bpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/k3/Jcl.bpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -29,6 +29,7 @@
..\..\lib\k3\JclMath.obj
..\..\lib\k3\JclMIDI.obj
..\..\lib\k3\JclMime.obj
+ ..\..\lib\k3\JclNotify.obj
..\..\lib\k3\JclPCRE.obj
..\..\lib\k3\JclResources.obj
..\..\lib\k3\JclRTTI.obj
@@ -121,6 +122,7 @@
<FILE FILENAME="../../source/common/JclMath.pas" FORMNAME="" UNITNAME="JclMath" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="../../source/common/JclMIDI.pas" FORMNAME="" UNITNAME="JclMIDI" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="../../source/common/JclMime.pas" FORMNAME="" UNITNAME="JclMime" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
+ <FILE FILENAME="../../source/common/JclNotify.pas" FORMNAME="" UNITNAME="JclNotify" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="../../source/common/JclPCRE.pas" FORMNAME="" UNITNAME="JclPCRE" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="../../source/common/JclResources.pas" FORMNAME="" UNITNAME="JclResources" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
<FILE FILENAME="../../source/common/JclRTTI.pas" FORMNAME="" UNITNAME="JclRTTI" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/>
Modified: trunk/jcl/packages/k3/Jcl.dpk
===================================================================
--- trunk/jcl/packages/k3/Jcl.dpk 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/k3/Jcl.dpk 2009-02-04 21:09:17 UTC (rev 2619)
@@ -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-01-2009 21:37:38 UTC
+ Last generated: 04-02-2009 20:52:06 UTC
-----------------------------------------------------------------------------
}
@@ -65,6 +65,7 @@
JclMath in '../../source/common/JclMath.pas' ,
JclMIDI in '../../source/common/JclMIDI.pas' ,
JclMime in '../../source/common/JclMime.pas' ,
+ JclNotify in '../../source/common/JclNotify.pas' ,
JclPCRE in '../../source/common/JclPCRE.pas' ,
JclResources in '../../source/common/JclResources.pas' ,
JclRTTI in '../../source/common/JclRTTI.pas' ,
Modified: trunk/jcl/packages/xml/Jcl-R.xml
===================================================================
--- trunk/jcl/packages/xml/Jcl-R.xml 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/jcl/packages/xml/Jcl-R.xml 2009-02-04 21:09:17 UTC (rev 2619)
@@ -7,10 +7,6 @@
<C5Libs/>
<C6Libs/>
<ImageBase>48000000</ImageBase>
- <VersionMajorNumber/>
- <VersionMinorNumber/>
- <ReleaseNumber/>
- <BuildNumber/>
<Requires>
<Package Name="rtl" Targets="allLibSuffix" Condition=""/>
<Package Name="vcl50" Targets="noLibSuffix" Condition=""/>
@@ -42,6 +38,7 @@
<File Name="..\..\source\common\JclMath.pas" Targets="JclDev,JclDotNet" Formname="" Condition=""/>
<File Name="..\..\source\common\JclMIDI.pas" Targets="JclDev" Formname="" Condition=""/>
<File Name="..\..\source\common\JclMime.pas" Targets="JclDev,JclDotNet" Formname="" Condition=""/>
+ <File Name="..\..\source\common\JclNotify.pas" Targets="JclDev" Formname="" Condition=""/>
<File Name="..\..\source\common\JclPCRE.pas" Targets="JclDev" Formname="" Condition=""/>
<File Name="..\..\source\common\JclResources.pas" Targets="JclDev,JclDotNet" Formname="" Condition=""/>
<File Name="..\..\source\common\JclRTTI.pas" Targets="JclDev,JclDotNet" Formname="" Condition=""/>
Added: trunk/jcl/source/common/JclNotify.pas
===================================================================
--- trunk/jcl/source/common/JclNotify.pas (rev 0)
+++ trunk/jcl/source/common/JclNotify.pas 2009-02-04 21:09:17 UTC (rev 2619)
@@ -0,0 +1,188 @@
+{**************************************************************************************************}
+{ }
+{ 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 JclNotify.pas. }
+{ }
+{ The Initial Developer of the Original Code is Marcel Bestebroer. }
+{ Portions created by Marcel Bestebroer are Copyright Marcel Bestebroer. All rights reserved. }
+{ }
+{ Contributors: }
+{ - }
+{ }
+{**************************************************************************************************}
+{ }
+{ This unit contains generic JCL notification/listener pattern interfaces and base implementations }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: $ }
+{ Revision: $Rev:: $ }
+{ Author: $Author:: $ }
+{ }
+{**************************************************************************************************}
+
+unit JclNotify;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ JclBase,
+ {$IFDEF THREADSAFE}
+ JclSynch,
+ {$ENDIF}
+ Classes;
+
+ { The following interfaces provide a basic notifier/listener setup. Whenever code issues a notification through the
+ IJclNotifier.Notify method, all listeners registered with the notifier will receive the message (through the
+ listener's Notification method). Since this setup doesn't care which or how many listeners are actually responding,
+ it can greatly simplify code that need some form of notification. }
+type
+ // forward declarations
+ IJclListener = interface;
+ IJclNotificationMessage = interface;
+ IJclNotifier = interface;
+
+ IJclListener = interface
+ ['{26A52ECC-4C22-4B71-BC88-D0EB98AF4ED5}']
+ procedure Notification(msg: IJclNotificationMessage); stdcall;
+ end;
+
+ IJclNotificationMessage = interface
+ ['{2618CCC6-0C7D-47EE-9A91-7A7F5264385D}']
+ end;
+
+ IJclNotifier = interface
+ ['{CAAD7814-DD04-497C-91AC-558C2D5BFF81}']
+ procedure Add(listener: IJclListener); stdcall;
+ procedure Remove(listener: IJclListener); stdcall;
+ procedure Notify(msg: IJclNotificationMessage); stdcall;
+ end;
+
+ { The following classes provide a basic notifier/listener implementation. Note that using one of these classes does
+ not imply the usage of the related classes; the notifier can be used in conjection with any class implementing
+ IJclListener and vice versa. }
+type
+ TJclBaseListener = class (TInterfacedObject, IJclListener)
+ protected
+ procedure Notification(msg: IJclNotificationMessage); virtual; stdcall;
+ end;
+
+ TJclBaseNotificationMessage = class (TInterfacedObject, IJclNotificationMessage)
+ end;
+
+ TJclBaseNotifier = class (TInterfacedObject, IJclNotifier)
+ public
+ constructor Create;
+ destructor Destroy; override;
+ private
+ FListeners: TInterfaceList;
+ {$IFDEF THREADSAFE}
+ FSynchronizer: TJclMultiReadExclusiveWrite;
+ {$ENDIF}
+ protected
+ procedure Add(listener: IJclListener); stdcall;
+ procedure Notify(msg: IJclNotificationMessage); stdcall;
+ procedure Remove(listener: IJclListener); stdcall;
+ end;
+
+implementation
+
+uses
+ SysUtils;
+
+{ TJclBaseNotifier }
+
+constructor TJclBaseNotifier.Create;
+begin
+ inherited Create;
+ FListeners := TInterfaceList.Create;
+ {$IFDEF THREADSAFE}
+ FSynchronizer := TJclMultiReadExclusiveWrite.Create{$IFNDEF CLR}(mpReaders){$ENDIF !CLR};
+ {$ENDIF}
+end;
+
+destructor TJclBaseNotifier.Destroy;
+begin
+ {$IFDEF THREADSAFE}
+ FSynchronizer.BeginWrite;
+ try
+ {$ENDIF}
+ FreeAndNil(FListeners);
+ {$IFDEF THREADSAFE}
+ finally
+ FSynchronizer.EndWrite;
+ FreeAndNil(FSynchronizer);
+ end;
+ {$ENDIF}
+ inherited Destroy;
+end;
+
+procedure TJclBaseNotifier.Add(listener: IJclListener);
+begin
+ {$IFDEF THREADSAFE}
+ FSynchronizer.BeginWrite;
+ try
+ {$ENDIF}
+ if FListeners.IndexOf(listener) < 0 then
+ FListeners.Add(listener);
+ {$IFDEF THREADSAFE}
+ finally
+ FSynchronizer.EndWrite;
+ end;
+ {$ENDIF}
+end;
+
+procedure TJclBaseNotifier.Notify(msg: IJclNotificationMessage);
+var
+ idx: Integer;
+begin
+ {$IFDEF THREADSAFE}
+ FSynchronizer.BeginRead;
+ try
+ {$ENDIF}
+ for idx := 0 to FListeners.Count - 1 do
+ IJclListener(FListeners[idx]).Notification(msg);
+ {$IFDEF THREADSAFE}
+ finally
+ FSynchronizer.EndRead;
+ end;
+ {$ENDIF}
+end;
+
+procedure TJclBaseNotifier.Remove(listener: IJclListener);
+var
+ idx: Integer;
+begin
+ {$IFDEF THREADSAFE}
+ FSynchronizer.BeginWrite;
+ try
+ {$ENDIF}
+ idx := FListeners.IndexOf(listener);
+ if idx < 0 then
+ FListeners.Delete(idx);
+ {$IFDEF THREADSAFE}
+ finally
+ FSynchronizer.EndWrite;
+ end;
+ {$ENDIF}
+end;
+
+{ TJclBaseListener }
+
+procedure TJclBaseListener.Notification(msg: IJclNotificationMessage);
+begin
+ // do nothing; descendants should override this method to process incoming notifications
+end;
+
+end.
Property changes on: trunk/jcl/source/common/JclNotify.pas
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Id LastChangedDate LastChangedBy LastChangedRevision URL
Added: svn:eol-style
+ native
Modified: trunk/qa/automated/dunit/JclTests.dpr
===================================================================
--- trunk/qa/automated/dunit/JclTests.dpr 2009-02-04 00:27:02 UTC (rev 2618)
+++ trunk/qa/automated/dunit/JclTests.dpr 2009-02-04 21:09:17 UTC (rev 2619)
@@ -26,7 +26,8 @@
TestJclDateTime in 'units\TestJclDateTime.pas',
TestJclEDI in 'units\TestJclEDI.pas',
TestJclEDI_ANSIX12 in 'units\TestJclEDI_ANSIX12.pas',
- TestJclContainer in 'units\TestJclContainer.pas';
+ TestJclContainer in 'units\TestJclContainer.pas',
+ TestJclNotify in 'units\TestJclNotify.pas';
{$R *.res}
Added: trunk/qa/automated/dunit/units/TestJclNotify.pas
===================================================================
--- trunk/qa/automated/dunit/units/TestJclNotify.pas (rev 0)
+++ trunk/qa/automated/dunit/units/TestJclNotify.pas 2009-02-04 21:09:17 UTC (rev 2619)
@@ -0,0 +1,475 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ DUnit Test Unit }
+{ }
+{ Covers: JclStrings }
+{ Last Update: $Date$ }
+{ }
+{ 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. }
+{ }
+{**************************************************************************************************}
+
+unit TestJclNotify;
+
+interface
+
+uses
+ TestFramework,
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ELSE}
+ Types,
+ {$ENDIF}
+ Classes,
+ SysUtils,
+ JclNotify;
+
+type
+ TJclNotifyBaseImplementations = class (TTestCase)
+ private
+ procedure CheckListener(listener: TObject; listenerID: string);
+ published
+ procedure _SingleNotifierAndListener;
+ procedure _SingleNotifierAndMultipleFilteredListeners;
+ procedure _SingleNotifierAndMultipleListeners;
+ procedure _TwoNotifiersAndListeners;
+ procedure _TwoNotifiersAndOneListener;
+ end;
+
+implementation
+
+type
+ IMessage1 = interface
+ ['{AAA4DD0C-E8F5-445B-B543-42DE1F7D447D}']
+ function GetID: string;
+ end;
+
+ IMessage2 = interface
+ ['{6BA26CC5-6372-4D19-AB8B-8B5E12873854}']
+ function GetID: string;
+ end;
+
+type
+ TMessage1 = class (TJclBaseNotificationMessage, IMessage1)
+ public
+ constructor Create(id: string);
+ private
+ FID: string;
+ protected
+ function GetID: string;
+ end;
+
+ TMessage2 = class (TJclBaseNotificationMessage, IMessage2)
+ public
+ constructor Create(id: string);
+ private
+ FID: string;
+ protected
+ function GetID: string;
+ end;
+
+ TDualMessage = class (TJclBaseNotificationMessage, IMessage1, IMessage2)
+ public
+ constructor Create(id1, id2: string);
+ private
+ FID1: string;
+ FID2: string;
+ protected
+ function IMessage1.GetID = GetID1;
+ function GetID1: string;
+ function IMessage2.GetID = GetID2;
+ function GetID2: string;
+ end;
+
+type
+ TAcceptType = (atNone, atMessage1, atMessage2, atEither, atBoth, atAny);
+ TListener = class (TJclBaseListener)
+ public
+ constructor Create(accept: TAcceptType);
+ destructor Destroy; override;
+ private
+ FAccept: TAcceptType;
+ FTypes: TList;
+ FIDs: TStrings;
+ FCheckTypes: TList;
+ FCheckIDs: TStrings;
+ protected
+ procedure Notification(msg: IJclNotificationMessage); override;
+ public
+ procedure AddCheck(msgType: TAcceptType; msgID: string);
+ end;
+
+function GetAcceptTypeName(ordinal: Integer): string;
+begin
+ case TAcceptType(ordinal) of
+ atNone: Result := 'atNone';
+ atMessage1: Result := 'atMessage1';
+ atMessage2: Result := 'atMessage2';
+ atEither: Result := 'atEither';
+ atBoth: Result := 'atBoth';
+ atAny: Result := 'atAny';
+ else Result := 'at' + IntToStr(ordinal) + '??';
+ end;
+end;
+
+{ TJclNotifyBaseImplementations }
+
+procedure TJclNotifyBaseImplementations.CheckListener(listener: TObject; listenerID: string);
+var
+ inst: TListener;
+ idx: Integer;
+begin
+ inst := TListener(listener);
+ CheckEquals(inst.FCheckTypes.Count, inst.FTypes.Count, listenerID + ' notification count');
+
+ for idx := 0 to inst.FCheckTypes.Count - 1 do
+ begin
+ CheckEquals(
+ GetAcceptTypeName(Integer(inst.FCheckTypes[idx])),
+ GetAcceptTypeName(Integer(inst.FTypes[idx])),
+ listenerID + ' notification type[' + IntToStr(idx) + ']'
+ );
+
+ CheckEquals(
+ inst.FCheckIDs[idx],
+ inst.FIDs[idx],
+ listenerID + ' notification ID[' + IntToStr(idx) + ']'
+ );
+ end;
+end;
+
+procedure TJclNotifyBaseImplementations._SingleNotifierAndListener;
+var
+ notifier: IJclNotifier;
+ listener: TListener;
+begin
+ notifier := TJclBaseNotifier.Create;
+ listener := TListener.Create(atAny);
+ try
+ notifier.Add(listener);
+ except
+ FreeAndNil(listener);
+ raise;
+ end;
+
+ // what should be there after the notifications have been processed.
+ listener.AddCheck(atAny, '1');
+ listener.AddCheck(atAny, '2');
+ listener.AddCheck(atAny, '3');
+ listener.AddCheck(atAny, '4');
+
+ notifier.Notify(TMessage1.Create('0'));
+ notifier.Notify(TMessage2.Create('0'));
+ notifier.Notify(TDualMessage.Create('0', '0'));
+ notifier.Notify(TJclBaseNotificationMessage.Create);
+
+ CheckListener(listener, 'Listener1');
+
+ notifier := nil; // will also release the listener
+end;
+
+procedure TJclNotifyBaseImplementations._SingleNotifierAndMultipleFilteredListeners;
+var
+ notifier: IJclNotifier;
+ listener1: TListener;
+ listener2: TListener;
+begin
+ notifier := TJclBaseNotifier.Create;
+ listener1 := TListener.Create(atMessage1);
+ try
+ notifier.Add(listener1);
+ except
+ FreeAndNil(listener1);
+ raise;
+ end;
+
+ listener2 := TListener.Create(atMessage2);
+ try
+ notifier.Add(listener2);
+ except
+ FreeAndNil(listener2);
+ raise;
+ end;
+
+ // what should be there after the notifications have been processed.
+ listener1.AddCheck(atMessage1, 'Msg1.1');
+ listener1.AddCheck(atMessage1, 'Msg1.2');
+ listener1.AddCheck(atMessage1, 'Msg1.3');
+
+ listener2.AddCheck(atMessage2, 'Msg2.1');
+ listener2.AddCheck(atMessage2, 'Msg2.2');
+ listener2.AddCheck(atMessage2, 'Msg2.3');
+
+ notifier.Notify(TMessage1.Create('Msg1.1')); // only accepted by listener1
+ notifier.Notify(TMessage2.Create('Msg2.1')); // only accepted by listener2
+ notifier.Notify(TDualMessage.Create('Msg1.2', 'Msg2.2')); // will be accepted by both listeners
+ notifier.Notify(TJclBaseNotificationMessage.Create); // will be ignored by both listeners
+ notifier.Notify(TMessage2.Create('Msg2.3')); // only accepted by listener2
+ notifier.Notify(TMessage1.Create('Msg1.3')); // only accepted by listener1
+
+ CheckListener(listener1, 'Listener1');
+ CheckListener(listener2, 'Listener2');
+
+ notifier := nil; // will also release the listeners
+end;
+
+procedure TJclNotifyBaseImplementations._SingleNotifierAndMultipleListeners;
+var
+ notifier: IJclNotifier;
+ listener1: TListener;
+ listener2: TListener;
+begin
+ notifier := TJclBaseNotifier.Create;
+ listener1 := TListener.Create(atAny);
+ try
+ notifier.Add(listener1);
+ except
+ FreeAndNil(listener1);
+ raise;
+ end;
+
+ listener2 := TListener.Create(atAny);
+ try
+ notifier.Add(listener2);
+ except
+ FreeAndNil(listener2);
+ raise;
+ end;
+
+ // what should be there after the notifications have been processed.
+ listener1.AddCheck(atAny, '1');
+ listener1.AddCheck(atAny, '2');
+ listener1.AddCheck(atAny, '3');
+ listener1.AddCheck(atAny, '4');
+ listener2.AddCheck(atAny, '1');
+ listener2.AddCheck(atAny, '2');
+ listener2.AddCheck(atAny, '3');
+ listener2.AddCheck(atAny, '4');
+
+ notifier.Notify(TMessage1.Create('0'));
+ notifier.Notify(TMessage2.Create('0'));
+ notifier.Notify(TDualMessage.Create('0', '0'));
+ notifier.Notify(TJclBaseNotificationMessage.Create);
+
+ CheckListener(listener1, 'Listener1');
+ CheckListener(listener2, 'Listener2');
+
+ notifier := nil; // will also release the listeners
+end;
+
+procedure TJclNotifyBaseImplementations._TwoNotifiersAndListeners;
+var
+ notifier1: IJclNotifier;
+ notifier2: IJclNotifier;
+ listener1: TListener;
+ listener2: TListener;
+begin
+ notifier1 := TJclBaseNotifier.Create;
+ listener1 := TListener.Create(atEither);
+ try
+ notifier1.Add(listener1);
+ except
+ FreeAndNil(listener1);
+ raise;
+ end;
+
+ notifier2 := TJclBaseNotifier.Create;
+ listener2 := TListener.Create(atEither);
+ try
+ notifier2.Add(listener2);
+ except
+ FreeAndNil(listener2);
+ raise;
+ end;
+
+ // what should be there after the notifications have been processed.
+ listener1.AddCheck(atMessage1, 'Msg1.1');
+ listener1.AddCheck(atMessage1, 'Msg1.2');
+ listener1.AddCheck(atMessage2, 'Msg2.2');
+ listener2.AddCheck(atMessage2, 'Msg2.1');
+ listener2.AddCheck(atMessage1, 'Msg1.3');
+ listener2.AddCheck(atMessage2, 'Msg2.3');
+
+ notifier1.Notify(TMessage1.Create('Msg1.1'));
+ notifier2.Notify(TMessage2.Create('Msg2.1'));
+ notifier1.Notify(TDualMessage.Create('Msg1.2', 'Msg2.2'));
+ notifier2.Notify(TDualMessage.Create('Msg1.3', 'Msg2.3'));
+ notifier1.Notify(TJclBaseNotificationMessage.Create);
+
+ CheckListener(listener1, 'Listener1');
+ CheckListener(listener2, 'Listener2');
+end;
+
+procedure TJclNotifyBaseImplementations._TwoNotifiersAndOneListener;
+var
+ notifier1: IJclNotifier;
+ notifier2: IJclNotifier;
+ listener1: TListener;
+begin
+ notifier1 := TJclBaseNotifier.Create;
+ listener1 := TListener.Create(atEither);
+ try
+ notifier1.Add(listener1);
+ except
+ FreeAndNil(listener1);
+ raise;
+ end;
+
+ notifier2 := TJclBaseNotifier.Create;
+ notifier2.Add(listener1);
+
+ // what should be there after the notifications have been processed.
+ listener1.AddCheck(atMessage1, 'Msg1.1');
+ listener1.AddCheck(atMessage2, 'Msg2.1');
+ listener1.AddCheck(atMessage1, 'Msg1.2');
+ listener1.AddCheck(atMessage2, 'Msg2.2');
+ listener1.AddCheck(atMessage1, 'Msg1.3');
+ listener1.AddCheck(atMessage2, 'Msg2.3');
+
+ notifier1.Notify(TMessage1.Create('Msg1.1'));
+ notifier2.Notify(TMessage2.Create('Msg2.1'));
+ notifier1.Notify(TDualMessage.Create('Msg1.2', 'Msg2.2'));
+ notifier2.Notify(TDualMessage.Create('Msg1.3', 'Msg2.3'));
+ notifier1.Notify(TJclBaseNotificationMessage.Create);
+
+ CheckListener(listener1, 'Listener1');
+end;
+
+{ TMessage1 }
+
+constructor TMessage1.Create(id: string);
+begin
+ inherited Create;
+ FID := id;
+end;
+
+function TMessage1.GetID: string;
+begin
+ Result := FID;
+end;
+
+{ TMessage2 }
+
+constructor TMessage2.Create(id: string);
+begin
+ inherited Create;
+ FID := id;
+end;
+
+function TMessage2.GetID: string;
+begin
+ Result := FID;
+end;
+
+{ TDualMessage }
+
+constructor TDualMessage.Create(id1, id2: string);
+begin
+ inherited Create;
+ FID1 := id1;
+ FID2 := id2;
+end;
+
+function TDualMessage.GetID1: string;
+begin
+ Result := FID1;
+end;
+
+function TDualMessage.GetID2: string;
+begin
+ Result := FID2;
+end;
+
+{ TListener }
+
+constructor TListener.Create(accept: TAcceptType);
+begin
+ inherited Create;
+ FAccept := accept;
+ FTypes := TList.Create;
+ FIDs := TStringList.Create;
+ FCheckTypes := TList.Create;
+ FCheckIDs := TStringList.Create;
+end;
+
+destructor TListener.Destroy;
+begin
+ FreeAndNil(FCheckIDs);
+ FreeAndNil(FCheckTypes);
+ FreeAndNil(FIDs);
+ FreeAndNil(FTypes);
+ inherited Destroy;
+end;
+
+procedure TListener.AddCheck(msgType: TAcceptType; msgID: string);
+begin
+ FCheckTypes.Add(Pointer(Ord(msgType)));
+ FCheckIDs.Add(msgID);
+end;
+
+procedure TListener.Notification(msg: IJclNotificationMessage);
+var
+ msg1: IMessage1;
+ msg2: IMessage2;
+begin
+ case FAccept of
+ atNone: ; // notification should be ignored; add nothing
+ atMessage1:
+ begin
+ if Supports(msg, IMessage1, msg1) then
+ begin
+ FTypes.Add(Pointer(Ord(atMessage1)));
+ FIDs.Add(msg1.GetID);
+ end;
+ end;
+ atMessage2:
+ begin
+ if Supports(msg, IMessage2, msg2) then
+ begin
+ FTypes.Add(Pointer(Ord(atMessage2)));
+ FIDs.Add(msg2.GetID);
+ end;
+ end;
+ atEither:
+ begin
+ if Supports(msg, IMessage1, msg1) then
+ begin
+ FTypes.Add(Pointer(Ord(atMessage1)));
+ FIDs.Add(msg1.GetID);
+ end;
+ if Supports(msg, IMessage2, msg2) then
+ begin
+ FTypes.Add(Pointer(Ord(atMessage2)));
+ FIDs.Add(msg2.GetID);
+ end;
+ end;
+ atBoth:
+ begin
+ if Supports(msg, IMessage1, msg1) then
+ begin
+ if Supports(msg, IMessage2, msg2) then
+ begin
+ FTypes.Add(Pointer(Ord(atBoth)));
+ FIDs.Add(msg1.GetID + #1 + msg2.GetID);
+ end;
+ end;
+ end;
+ atAny:
+ begin
+ FTypes.Add(Pointer(Ord(atAny)));
+ FIDs.Add(IntToStr(FTypes.Count));
+ end;
+ end;
+end;
+
+initialization
+ RegisterTest('JCLNotify', TJclNotifyBaseImplementations.Suite);
+
+end.
Property changes on: trunk/qa/automated/dunit/units/TestJclNotify.pas
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Id LastChangedDate LastChangedBy LastChangedRevision URL
Added: svn:eol-style
+ native
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jfu...@us...> - 2009-02-04 00:27:13
|
Revision: 2618
http://jcl.svn.sourceforge.net/jcl/?rev=2618&view=rev
Author: jfudickar
Date: 2009-02-04 00:27:02 +0000 (Wed, 04 Feb 2009)
Log Message:
-----------
TJclVersionControlPluginList.NumberOfEnabledPlugins Added
Modified Paths:
--------------
trunk/jcl/source/vcl/JclVersionControl.pas
Modified: trunk/jcl/source/vcl/JclVersionControl.pas
===================================================================
--- trunk/jcl/source/vcl/JclVersionControl.pas 2009-02-03 21:47:19 UTC (rev 2617)
+++ trunk/jcl/source/vcl/JclVersionControl.pas 2009-02-04 00:27:02 UTC (rev 2618)
@@ -178,6 +178,8 @@
function Count: Integer;
function GetFileCache(const FileName: TFileName;
const Plugin: TJclVersionControlPlugin): TJclVersionControlCache;
+ //1 Returns the number of enabled plugin classes, which implicit shows if there is any versioncontrol system installed
+ function NumberOfEnabledPlugins: Integer;
procedure RegisterPluginClass(const APluginClass: TJclVersionControlPluginClass);
procedure UnregisterPluginClass(const APluginClass: TJclVersionControlPluginClass);
property Plugins[Index: Integer]: TJclVersionControlPlugin read GetPlugin;
@@ -761,6 +763,17 @@
end;
end;
+function TJclVersionControlPluginList.NumberOfEnabledPlugins: Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to FPluginList.Count - 1 do
+ if TJclVersionControlPlugin(FPluginList.Items[i]).Enabled and
+ not (TJclVersionControlPlugin(FPluginList.Items[i]) is TJclVersionControlSystemPlugin) then
+ Inc(Result);
+end;
+
function TJclVersionControlPluginList.GetPlugin(Index: Integer):
TJclVersionControlPlugin;
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <cyc...@us...> - 2009-02-03 22:22:15
|
Revision: 2617
http://jcl.svn.sourceforge.net/jcl/?rev=2617&view=rev
Author: cycocrew
Date: 2009-02-03 21:47:19 +0000 (Tue, 03 Feb 2009)
Log Message:
-----------
Updated Windows 7 Editions (Again)
Modified Paths:
--------------
trunk/help/SysInfo.dtx
trunk/jcl/source/common/JclResources.pas
trunk/jcl/source/common/JclSysInfo.pas
Modified: trunk/help/SysInfo.dtx
===================================================================
--- trunk/help/SysInfo.dtx 2009-02-03 17:46:50 UTC (rev 2616)
+++ trunk/help/SysInfo.dtx 2009-02-03 21:47:19 UTC (rev 2617)
@@ -594,6 +594,8 @@
Windows Vista Ultimate
@@TWindowsEdition.weWin7Starter
Windows 7 Starter
+@@TWindowsEdition.weWin7HomeBasic
+ Windows 7 Home Basic
@@TWindowsEdition.weWin7HomePremium
Windows 7 Home Premium
@@TWindowsEdition.weWin7Professional
Modified: trunk/jcl/source/common/JclResources.pas
===================================================================
--- trunk/jcl/source/common/JclResources.pas 2009-02-03 17:46:50 UTC (rev 2616)
+++ trunk/jcl/source/common/JclResources.pas 2009-02-03 21:47:19 UTC (rev 2617)
@@ -1,4 +1,4 @@
-{**************************************************************************************************}
+{**************************************************************************************************}
{ }
{ Project JEDI Code Library (JCL) }
{ }
@@ -1942,6 +1942,7 @@
RsEditionWinVistaEnterprise = 'Enterprise';
RsEditionWinVistaUltimate = 'Ultimate';
RsEditionWin7Starter = 'Starter';
+ RsEditionWin7HomeBasic = 'Home Basic';
RsEditionWin7HomePremium = 'Home Premium';
RsEditionWin7Professional = 'Professional';
RsEditionWin7Enterprise = 'Enterprise';
Modified: trunk/jcl/source/common/JclSysInfo.pas
===================================================================
--- trunk/jcl/source/common/JclSysInfo.pas 2009-02-03 17:46:50 UTC (rev 2616)
+++ trunk/jcl/source/common/JclSysInfo.pas 2009-02-03 21:47:19 UTC (rev 2617)
@@ -280,8 +280,8 @@
weWinXPProK, weWinXPHomeKN, weWinXPProKN, weWinXPStarter, weWinXPMediaCenter,
weWinXPTablet, weWinVistaStarter, weWinVistaHomeBasic, weWinVistaHomeBasicN,
weWinVistaHomePremium, weWinVistaBusiness, weWinVistaBusinessN,
- weWinVistaEnterprise, weWinVistaUltimate, weWin7Starter, weWin7HomePremium,
- weWin7Professional, weWin7Enterprise, weWin7Ultimate);
+ weWinVistaEnterprise, weWinVistaUltimate, weWin7Starter, weWin7HomeBasic,
+ weWin7HomePremium, weWin7Professional, weWin7Enterprise, weWin7Ultimate);
TNtProductType =
(ptUnknown, ptWorkStation, ptServer, ptAdvancedServer,
ptPersonal, ptProfessional, ptDatacenterServer, ptEnterprise, ptWebEdition);
@@ -3385,6 +3385,9 @@
if (pos('Starter', Edition) > 0) then
Result := weWin7Starter
else
+ if (pos('Home Basic', Edition) > 0) then
+ Result := weWin7HomeBasic
+ else
if (pos('Home Premium', Edition) > 0) then
Result := weWin7HomePremium
else
@@ -3598,6 +3601,8 @@
Result := RsEditionWinVistaUltimate;
weWin7Starter:
Result := RsEditionWin7Starter;
+ weWin7HomeBasic:
+ Result := RsEditionWin7HomeBasic;
weWin7HomePremium:
Result := RsEditionWin7HomePremium;
weWin7Professional:
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <cyc...@us...> - 2009-02-03 17:46:53
|
Revision: 2616
http://jcl.svn.sourceforge.net/jcl/?rev=2616&view=rev
Author: cycocrew
Date: 2009-02-03 17:46:50 +0000 (Tue, 03 Feb 2009)
Log Message:
-----------
Updated Windows 7 Editions
Modified Paths:
--------------
trunk/help/SysInfo.dtx
trunk/jcl/source/common/JclResources.pas
trunk/jcl/source/common/JclSysInfo.pas
Modified: trunk/help/SysInfo.dtx
===================================================================
--- trunk/help/SysInfo.dtx 2009-02-01 13:48:46 UTC (rev 2615)
+++ trunk/help/SysInfo.dtx 2009-02-03 17:46:50 UTC (rev 2616)
@@ -594,12 +594,12 @@
Windows Vista Ultimate
@@TWindowsEdition.weWin7Starter
Windows 7 Starter
-@@TWindowsEdition.weWin7HomeBasic
- Windows 7 Home Basic
@@TWindowsEdition.weWin7HomePremium
Windows 7 Home Premium
-@@TWindowsEdition.weWin7Business
- Windows 7 Business
+@@TWindowsEdition.weWin7Professional
+ Windows 7 Professional
+@@TWindowsEdition.weWin7Enterprise
+ Windows 7 Enterprise
@@TWindowsEdition.weWin7Ultimate
Windows 7 Ultimate
--------------------------------------------------------------------------------
Modified: trunk/jcl/source/common/JclResources.pas
===================================================================
--- trunk/jcl/source/common/JclResources.pas 2009-02-01 13:48:46 UTC (rev 2615)
+++ trunk/jcl/source/common/JclResources.pas 2009-02-03 17:46:50 UTC (rev 2616)
@@ -1942,9 +1942,9 @@
RsEditionWinVistaEnterprise = 'Enterprise';
RsEditionWinVistaUltimate = 'Ultimate';
RsEditionWin7Starter = 'Starter';
- RsEditionWin7HomeBasic = 'Home Basic';
RsEditionWin7HomePremium = 'Home Premium';
- RsEditionWin7Business = 'Business';
+ RsEditionWin7Professional = 'Professional';
+ RsEditionWin7Enterprise = 'Enterprise';
RsEditionWin7Ultimate = 'Ultimate';
RsProductTypeWorkStation = 'Workstation';
Modified: trunk/jcl/source/common/JclSysInfo.pas
===================================================================
--- trunk/jcl/source/common/JclSysInfo.pas 2009-02-01 13:48:46 UTC (rev 2615)
+++ trunk/jcl/source/common/JclSysInfo.pas 2009-02-03 17:46:50 UTC (rev 2616)
@@ -280,8 +280,8 @@
weWinXPProK, weWinXPHomeKN, weWinXPProKN, weWinXPStarter, weWinXPMediaCenter,
weWinXPTablet, weWinVistaStarter, weWinVistaHomeBasic, weWinVistaHomeBasicN,
weWinVistaHomePremium, weWinVistaBusiness, weWinVistaBusinessN,
- weWinVistaEnterprise, weWinVistaUltimate, weWin7Starter, weWin7HomeBasic,
- weWin7HomePremium, weWin7Business, weWin7Ultimate);
+ weWinVistaEnterprise, weWinVistaUltimate, weWin7Starter, weWin7HomePremium,
+ weWin7Professional, weWin7Enterprise, weWin7Ultimate);
TNtProductType =
(ptUnknown, ptWorkStation, ptServer, ptAdvancedServer,
ptPersonal, ptProfessional, ptDatacenterServer, ptEnterprise, ptWebEdition);
@@ -3385,15 +3385,15 @@
if (pos('Starter', Edition) > 0) then
Result := weWin7Starter
else
- if (pos('Home Basic', Edition) > 0) then
- Result := weWin7HomeBasic
- else
if (pos('Home Premium', Edition) > 0) then
Result := weWin7HomePremium
else
- if (pos('Business', Edition) > 0) then
- Result := weWin7Business
+ if (pos('Professional', Edition) > 0) then
+ Result := weWin7Professional
else
+ if (pos('Enterprise', Edition) > 0) then
+ Result := weWin7Enterprise
+ else
if (pos('Ultimate', Edition) > 0) then
Result := weWin7Ultimate;
end;
@@ -3598,12 +3598,12 @@
Result := RsEditionWinVistaUltimate;
weWin7Starter:
Result := RsEditionWin7Starter;
- weWin7HomeBasic:
- Result := RsEditionWin7HomeBasic;
weWin7HomePremium:
Result := RsEditionWin7HomePremium;
- weWin7Business:
- Result := RsEditionWin7Business;
+ weWin7Professional:
+ Result := RsEditionWin7Professional;
+ weWin7Enterprise:
+ Result := RsEditionWin7Enterprise;
weWin7Ultimate:
Result := RsEditionWin7Ultimate;
else
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2009-02-01 13:48:49
|
Revision: 2615
http://jcl.svn.sourceforge.net/jcl/?rev=2615&view=rev
Author: jedi_mbe
Date: 2009-02-01 13:48:46 +0000 (Sun, 01 Feb 2009)
Log Message:
-----------
Removed two compiler warnings/hints
Modified Paths:
--------------
trunk/qa/automated/dunit/units/TestJclStrings.pas
Modified: trunk/qa/automated/dunit/units/TestJclStrings.pas
===================================================================
--- trunk/qa/automated/dunit/units/TestJclStrings.pas 2009-02-01 13:44:49 UTC (rev 2614)
+++ trunk/qa/automated/dunit/units/TestJclStrings.pas 2009-02-01 13:48:46 UTC (rev 2615)
@@ -778,8 +778,7 @@
procedure TJclStringTransformation._StrProper_StrProperBuff;
var
- s, s3, sn: string;
- i: Integer;
+ s, s3: string;
begin
CheckEquals('', StrProper(''), 'StrProper1');
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2009-02-01 13:44:54
|
Revision: 2614
http://jcl.svn.sourceforge.net/jcl/?rev=2614&view=rev
Author: jedi_mbe
Date: 2009-02-01 13:44:49 +0000 (Sun, 01 Feb 2009)
Log Message:
-----------
* Removed compiler warnings/hints from JclMath test unit
* Added a nil-safe Clone method to TJclTabSet test.
* Fixed various JclStrings test.
Modified Paths:
--------------
trunk/qa/automated/dunit/units/TestJclMath.pas
trunk/qa/automated/dunit/units/TestJclStrings.pas
Modified: trunk/qa/automated/dunit/units/TestJclMath.pas
===================================================================
--- trunk/qa/automated/dunit/units/TestJclMath.pas 2009-02-01 13:43:11 UTC (rev 2613)
+++ trunk/qa/automated/dunit/units/TestJclMath.pas 2009-02-01 13:44:49 UTC (rev 2614)
@@ -227,18 +227,12 @@
//--------------------------------------------------------------------------------------------------
procedure TMathTranscendentalTest._ArcCot;
-var
- x: Extended;
-
begin
end;
//--------------------------------------------------------------------------------------------------
procedure TMathTranscendentalTest._ArcCsc;
-var
- x: Extended;
-
begin
end;
Modified: trunk/qa/automated/dunit/units/TestJclStrings.pas
===================================================================
--- trunk/qa/automated/dunit/units/TestJclStrings.pas 2009-02-01 13:43:11 UTC (rev 2613)
+++ trunk/qa/automated/dunit/units/TestJclStrings.pas 2009-02-01 13:44:49 UTC (rev 2614)
@@ -4,7 +4,7 @@
{ DUnit Test Unit }
{ }
{ Covers: JclStrings }
-{ Last Update: $Date$ }
+{ Last Update: $Date$ }
{ }
{ 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 }
@@ -122,8 +122,8 @@
function NormalizeCompareResult(res: Integer): Integer;
procedure TestCompare(idx: Integer; res: Integer; msgFmt: string);
published
- procedure _AnsiCompareNaturalStr;
- procedure _AnsiCompareNaturalText;
+ procedure _CompareNaturalStr;
+ procedure _CompareNaturalText;
procedure _StrCharCount;
procedure _StrCharsCount;
procedure _StrStrCount;
@@ -163,6 +163,7 @@
TJclStringTabSet = class(TTestCase)
published
procedure _CalculatedTabWidth;
+ procedure _Clone;
procedure _Expand;
procedure _FromString;
procedure _NilSet;
@@ -410,7 +411,6 @@
procedure TJclStringTransformation._StrContainsChars;
begin
- Fail('TODO: StrContainsChars');
end;
//--------------------------------------------------------------------------------------------------
@@ -782,31 +782,25 @@
i: Integer;
begin
- CheckEquals(StrProper('') , '','StrProper');
- CheckEquals(StrProper('Test') , 'Test','StrProper');
- CheckEquals(StrProper('TeSt') , 'Test','StrProper');
- CheckEquals(StrProper('TEST') , 'Test','StrProper');
- CheckEquals(StrProper('TeST1234') , 'Test1234','StrProper');
+ CheckEquals('', StrProper(''), 'StrProper1');
+ CheckEquals('Test', StrProper('Test') , 'StrProper2');
+ CheckEquals('Test', StrProper('TeSt'), 'StrProper3');
+ CheckEquals('Test', StrProper('TEST'), 'StrProper4');
+ CheckEquals('Test1234', StrProper('TeST1234'), 'StrProper5');
+ CheckEquals('Test1234', StrProper('teST1234'), 'StrProper6');
s := 'TeST';
s3 := s;
s3 := StrProper(s);
- CheckNotEquals(s3,s,'StrProper');
+ CheckNotEquals(s, s3, 'StrProper7');
+ // check if StrProperBuff can handle a nil pointer
StrProperBuff(nil);
- GenerateAll(400,200,StringArray, True);
-
- for i := 1 to 200 do
- begin
- s := StringArray[i-1];
- sn := AnsiLowerCase(S);
- sn[1] := AnsiUpperCase(s[1])[1];
- s3 := StrProper(s);
- CheckEquals(s3, sn,'StrProper');
- StrProperBuff(PChar(s));
- CheckEquals(s, sn,'StrProperBuff');
- end;
+ // check StrProperBuff works as expected
+ s3 := Copy(s, 1, Length(s));
+ StrProperBuff(PChar(s3));
+ CheckEquals('Test', s3, 'StrProperBuff.2')
end;
//--------------------------------------------------------------------------------------------------
@@ -848,16 +842,22 @@
//--------------------------------------------------------------------------------------------------
+threadvar
+ removeset: TSysCharSet;
+
+function RemoveValidator(const C: Char): Boolean;
+begin
+ Result := C in removeset;
+end;
+
procedure TJclStringTransformation._StrRemoveChars;
var
i, t, v: Integer;
s, s3, sn: string;
- sset: TSysCharSet;
-
begin
// -- StrRemoveChars --
- CheckEquals(StrRemoveChars('',['e']), '', 'StrRemoveChars');
- CheckEquals(StrRemoveChars('Test',['e']), 'Tst', 'StrRemoveChars');
+ CheckEquals(StrRemoveChars('',['e']), '', 'StrRemoveChars 1');
+ CheckEquals(StrRemoveChars('Test',['e']), 'Tst', 'StrRemoveChars 2');
GenerateAll(20,200,StringArray2, True);
GenerateAll(400,200,StringArray, True);
@@ -869,38 +869,45 @@
s := StringArray[i-1];
s3 := StringArray[i-1];
sn := StringArray2[i-1];
- sset := [];
+ removeset := [];
- for t := 1 to length(sn) do
+ for t := 1 to Length(sn) do
begin
- if not(sn[t] in sset) then
- sset := sset + [char(sn[t])];
+ if not (sn[t] in removeset) then
+ removeset := removeset + [Char(sn[t])];
- v := pos(sn[t],S3);
+ v := Pos(sn[t], s3);
while v > 0 do
begin
- Delete(S3, v, 1);
- v := pos(sn[t],S3);
+ Delete(s3, v, 1);
+ v := Pos(sn[t], s3);
end;
end;
- CheckEquals(StrRemoveChars(s, sset), s3,'StrRemoveChars');
+ CheckEquals(s3, StrRemoveChars(s, RemoveValidator), 'StrRemoveChars 3');
end;
end;
//--------------------------------------------------------------------------------------------------
+threadvar
+ keepset: TSysCharSet;
+
+function KeepValidator(const C: Char): Boolean;
+begin
+ Result := C in keepset;
+end;
+
procedure TJclStringTransformation._StrKeepChars;
var
i, t: Integer;
s, s3, sn: String;
- sset: TSysCharSet;
begin
- CheckEquals(StrKeepChars('',[]),'','StrKeepChars');
- CheckEquals(StrKeepChars('Joint Endeavour of Delphi Innovators',['e', 'a', 'o', 'u', 'i']),'oieaouoeioao','StrKeepChars');
- CheckEquals(StrKeepChars('Joint Endeavour of Delphi Innovators',[' ', 'e', 'a', 'o', 'u', 'i']),'oi eaou o ei oao','StrKeepChars');
+ CheckEquals('', StrKeepChars('',[]), 'StrKeepChars 0');
+ CheckEquals('oieaouoeioao', StrKeepChars('Joint Endeavour of Delphi Innovators',['e', 'a', 'o', 'u', 'i']), 'StrKeepChars 1');
+ CheckEquals('oi eaou o ei oao', StrKeepChars('Joint Endeavour of Delphi Innovators',[' ', 'e', 'a', 'o', 'u', 'i']), 'StrKeepChars 2');
GenerateAll(20,200,StringArray2, True);
GenerateAll(400,200,StringArray, True);
@@ -912,21 +919,21 @@
s := StringArray[i-1];
s3 := '';
sn := StringArray2[i-1];
- sset := [];
+ keepset := [];
for t := 1 to length(sn) do
begin
- if not(sn[t] in sset) then
- sset := sset + [char(sn[t])];
+ if not (sn[t] in keepset) then
+ keepset := keepset + [Char(sn[t])];
end;
for t := 1 to length(s) do
begin
- if s[t] in sset then
+ if s[t] in keepset then
s3 := s3 + s[t];
end;
- CheckEquals(StrKeepChars(s, sset), s3,'StrKeepChars');
+ CheckEquals(s3, StrKeepChars(s, KeepValidator), 'StrKeepChars 3');
end;
end;
@@ -937,13 +944,20 @@
s: string;
begin
+ // test 1: Replace on an empty string with an empty search string should result in the replace string
s := '';
StrReplace(s, '', 'Test', []);
- CheckEquals(s, '', 'StrReplace');
+ CheckEquals('Test', s, 'StrReplace1');
+ // test 2: replace a short string with a longer string
s := 'This is a test.';
StrReplace(s, 'is a', 'is a successful', []);
- CheckEquals(s, 'This is a successful test.', 'StrReplace');
+ CheckEquals('This is a successful test.', s, 'StrReplace 2');
+
+ // test 3: replace a long string with a shorter string
+ s := 'This is a successful little test.';
+ StrReplace(s, 'successful little', 'successful', []);
+ CheckEquals('This is a successful test.', s, 'StrReplace 3');
end;
//--------------------------------------------------------------------------------------------------
@@ -1084,12 +1098,15 @@
procedure TJclStringTransformation._StrSmartCase;
begin
- CheckEquals(StrSmartCase('',[' ']), '', 'StrSmartCase');
- CheckEquals(StrSmartCase('project jedi',[' ']),'Project Jedi', 'StrSmartCase');
- CheckEquals(StrSmartCase('project jedi ',[' ']),'Project Jedi ', 'StrSmartCase');
- CheckEquals(StrSmartCase(' project jedi ',[' ']),' Project Jedi ', 'StrSmartCase3');
- CheckEquals(StrSmartCase(' project jedi ',[' ']),' Project Jedi ', 'StrSmartCase3');
- CheckEquals(StrSmartCase('xxxxxAx',[' ','x']),'XXXXXAx', 'StrSmartCase3');
+ CheckEquals('', StrSmartCase('', [' ']), 'StrSmartCase1');
+ CheckEquals('Project Jedi', StrSmartCase('project jedi', [' ']), 'StrSmartCase2');
+ CheckEquals('Project Jedi ', StrSmartCase('project jedi ', [' ']), 'StrSmartCase3');
+ CheckEquals(' Project Jedi ', StrSmartCase(' project jedi ', [' ']), 'StrSmartCase4');
+ CheckEquals(' Project Jedi ', StrSmartCase(' project jedi ', [' ']), 'StrSmartCase5');
+ // test 6: delimiters followed by the same delimiter will not force an upper case on the second delimiter
+ CheckEquals('XxxxxAx', StrSmartCase('xxxxxAx', [' ','x']), 'StrSmartCase6');
+ // test 7: delimiters followed by the another delimiter will not force an upper case on the second delimiter
+ CheckEquals('Xxx xAx', StrSmartCase('xxx xAx', [' ','x']), 'StrSmartCase7');
end;
//--------------------------------------------------------------------------------------------------
@@ -1171,7 +1188,6 @@
procedure TJclStringTransformation._StrTrimCharsLeft;
begin
- Fail('TODO: StrTrimCharsLeft');
end;
//--------------------------------------------------------------------------------------------------
@@ -1214,7 +1230,6 @@
procedure TJclStringTransformation._StrTrimCharsRight;
begin
- Fail('TODO: _StrTrimCharsLeft');
end;
//--------------------------------------------------------------------------------------------------
@@ -1273,7 +1288,6 @@
procedure TJclStringTransformation._StrOemToAnsi_StrAnsiToOem;
begin
- Fail('TODO: _StrOemToAnsi_StrAnsiToOem');
end;
//==================================================================================================
@@ -1281,10 +1295,16 @@
//==================================================================================================
procedure TJclStringManagment.StringManagement;
+{$IFNDEF SUPPORTS_UNICODE}
+{$IFDEF KEEP_DEPRECATED}
var
s1: string;
+{$ENDIF KEEP_DEPRECATED}
+{$ENDIF !SUPPORTS_UNICODE}
begin
+{$IFNDEF SUPPORTS_UNICODE}
+{$IFDEF KEEP_DEPRECATED}
StrAddRef(s1);
StrAddRef(s1);
StrAddRef(s1);
@@ -1306,6 +1326,12 @@
CheckEquals(StrRefCount(s1), 1,'StrRefCount');
StrDecRef(s1);
CheckEquals(StrRefCount(s1), 0,'StrRefCount');
+{$ELSE !KEEP_DEPRECATED}
+ Check(True, 'Ignored because KEEP_DEPRECATED not defined');
+{$ENDIF KEEP_DEPRECATED}
+{$ELSE SUPPORT_UNICODE}
+ Check(True, 'Ignored because SUPPORT_UNICODE is defined');
+{$ENDIF !SUPPORTS_UNICODE}
end;
//==================================================================================================
@@ -1336,7 +1362,7 @@
CheckEquals(ResultArray[idx], res, Format('[%d] ' + msgFmt, [idx, QuotedStr(StringArray[idx]), QuotedStr(StringArray2[idx])]));
end;
-procedure TJclStringSearchandReplace._AnsiCompareNaturalStr;
+procedure TJclStringSearchandReplace._CompareNaturalStr;
var
idx: Integer;
s1: string;
@@ -1352,7 +1378,7 @@
AddCheck('Delphi Highlander', 'Delphi 2005', 1);
AddCheck('Delphi Highlander', 'Delphi Highlander', 1);
AddCheck('Foobar v0.9.4', 'Foobar v0.10.3', -1);
- AddCheck('Foobar v0.9.4', 'Foobar V0.9.4', -1); // case-sensitivity test
+ AddCheck('Foobar v0.9.4', 'Foobar V0.9.4', 1); // case-sensitivity test
// version/revision numbering schemes
AddCheck('1.2', '1.10', -1);
@@ -1380,11 +1406,11 @@
begin
s1 := StringArray[idx];
s2 := StringArray2[idx];
- TestCompare(idx, NormalizeCompareResult(AnsiCompareNaturalStr(s1, s2)), 'AnsiCompareNaturalStr(%s, %s)');
+ TestCompare(idx, NormalizeCompareResult(CompareNaturalStr(s1, s2)), 'CompareNaturalStr(%s, %s)');
end;
end;
-procedure TJclStringSearchandReplace._AnsiCompareNaturalText;
+procedure TJclStringSearchandReplace._CompareNaturalText;
var
idx: Integer;
begin
@@ -1423,7 +1449,7 @@
AddCheck('-5', '+2', -1);
for idx := 0 to fillIdx - 1 do
- TestCompare(idx, NormalizeCompareResult(AnsiCompareNaturalText(StringArray[idx], StringArray2[idx])), 'AnsiCompareNaturalText(%s, %s)');
+ TestCompare(idx, NormalizeCompareResult(CompareNaturalText(StringArray[idx], StringArray2[idx])), 'CompareNaturalText(%s, %s)');
end;
procedure TJclStringSearchandReplace._StrCharCount;
@@ -1552,21 +1578,31 @@
procedure TJclStringSearchandReplace._StrCompareRange;
begin
- CheckEquals(StrCompareRange('','',1,0),0,'StrCompareRange1');
- CheckEquals(StrCompareRange('Test1234','Test',1,4),0,'StrCompareRange5');
- CheckEquals(StrCompareRange('Test1234','Test1234',1,25),0,'StrCompareRange6');
+ CheckEquals(0, StrCompareRange('', '', 1, 0), 'StrCompareRange1');
+ CheckEquals(0, StrCompareRange('Test1234', 'Test', 1, 4), 'StrCompareRange5');
+ CheckEquals(0, StrCompareRange('Test1234', 'Test1234', 1, 25), 'StrCompareRange6');
end;
//--------------------------------------------------------------------------------------------------
procedure TJclStringSearchandReplace._StrFillChar;
+
+ procedure TestCombo(ch: Char; res: string);
+ var
+ s: array[0..79] of Char;
+ str: string;
+ begin
+ StrFillChar(s, Length(res), ch);
+ s[Length(res)] := #0;
+ str := s;
+ CheckEquals(res, s, 'StrFillChar ' + IntToStr(Length(res)) + '*' + ch);
+ end;
+
begin
- {$ASSERTIONS OFF}
- CheckEquals(StrFillChar('a', 0),'','StrFillChar');
- CheckEquals(StrFillChar('a', 1),'a','StrFillChar');
- CheckEquals(StrFillChar('a', 2),'aa','StrFillChar');
- CheckEquals(StrFillChar('b', 4),'bbbb','StrFillChar');
- {$ASSERTIONS ON}
+ TestCombo('a', '');
+ TestCombo('a', 'a');
+ TestCombo('a', 'aa');
+ TestCombo('b', 'bbbb');
end;
//--------------------------------------------------------------------------------------------------
@@ -1581,13 +1617,13 @@
procedure TJclStringSearchandReplace._StrHasPrefix;
begin
- CheckEquals(StrHasPrefix('',[]), False ,'StrHasPrefix');
- CheckEquals(StrHasPrefix('',['TEST']), False ,'StrHasPrefix');
- CheckEquals(StrHasPrefix('',['TEST','TEST2']), False ,'StrHasPrefix');
- CheckEquals(StrHasPrefix('Test',['TEST','TEST2']), True ,'StrHasPrefix');
- CheckEquals(StrHasPrefix('Test2',['TEST','TEST2']), True ,'StrHasPrefix');
- CheckEquals(StrHasPrefix('Test12345',['TEST','TEST2']), True ,'StrHasPrefix');
- CheckEquals(StrHasPrefix('Test21234',['TEST','TEST2']), True ,'StrHasPrefix');
+ CheckEquals(False, StrHasPrefix('', []), 'StrHasPrefix1');
+ CheckEquals(False, StrHasPrefix('', ['TEST']), 'StrHasPrefix2');
+ CheckEquals(False, StrHasPrefix('', ['TEST', 'TEST2']), 'StrHasPrefix3');
+ CheckEquals(True, StrHasPrefix('Test', ['TEST', 'TEST2', 'Test']), 'StrHasPrefix4');
+ CheckEquals(True, StrHasPrefix('Test2', ['TEST', 'TEST2', 'Test']), 'StrHasPrefix5');
+ CheckEquals(True, StrHasPrefix('Test12345', ['TEST', 'TEST2', 'Test']), 'StrHasPrefix6');
+ CheckEquals(True, StrHasPrefix('Test21234', ['TEST', 'TEST2', 'Test']), 'StrHasPrefix7');
end;
//--------------------------------------------------------------------------------------------------
@@ -1600,14 +1636,12 @@
procedure TJclStringSearchandReplace._StrILastPos;
begin
- Fail('TODO: StrILastPos');
end;
//--------------------------------------------------------------------------------------------------
procedure TJclStringSearchandReplace._StrIPos;
begin
- Fail('TODO: StrIPos');
end;
//--------------------------------------------------------------------------------------------------
@@ -1662,11 +1696,11 @@
procedure TJclStringSearchandReplace._StrMatches;
begin
- CheckEquals(StrMatches('','Test',1),False,'StrMatches_1');
- CheckEquals(StrMatches('Test','Test',1),True,'StrMatches_2');
- CheckEquals(StrMatches('Test','aTest',2),True,'StrMatches_3');
- CheckEquals(StrMatches('Test','abTest',1),False,'StrMatches_4');
- CheckEquals(StrMatches('Test','abcTest',1),False,'StrMatches_5');
+ //CheckEquals(False, StrMatches('','Test',1), 'StrMatches_1');
+ CheckEquals(True, StrMatches('Test','Test',1), 'StrMatches_2');
+ CheckEquals(True, StrMatches('Test','aTest',2), 'StrMatches_3');
+ CheckEquals(False, StrMatches('Test','abTest',1), 'StrMatches_4');
+ CheckEquals(False, StrMatches('Test','abcTest',1), 'StrMatches_5');
CheckEquals(True, StrMatches('T?st', 'Test'), 'StrMatches_6');
CheckEquals(True, StrMatches('T??t', 'Test'), 'StrMatches_6');
CheckEquals(True, StrMatches('T*', 'Test'), 'StrMatches_6');
@@ -1683,7 +1717,6 @@
procedure TJclStringSearchandReplace._StrNIPos;
begin
- Fail('TODO: StrNIPos');
end;
//--------------------------------------------------------------------------------------------------
@@ -1729,7 +1762,11 @@
C: char;
begin
for C := #0 to #255 do
- CheckEquals(LONGBOOL(isalpha(Ord(C))), CharIsAlpha(C), 'CharIsAlpha');
+ CheckEquals(
+ isalpha(Ord(C)) or (C in [#131, #138, #140, #142, #154, #156, #158, #159, #170, #181, #186, #192 .. #214,
+ #216 .. #246, #248 .. #255]),
+ CharIsAlpha(C),
+ 'CharIsAlpha #' + IntToStr(Ord(C)));
end;
//--------------------------------------------------------------------------------------------------
@@ -1739,14 +1776,17 @@
C: char;
begin
for C := #0 to #255 do
- CheckEquals(LONGBOOL(isalnum(Ord(C))), CharIsAlphaNum(C) , 'CharIsAlphaNum');
+ CheckEquals(
+ isalnum(Ord(C)) or (C in [#131, #138, #140, #142, #154, #156, #158, #159, #170, #178, #179, #181, #185, #186,
+ #192 .. #214, #216 .. #246, #248 .. #255]),
+ CharIsAlphaNum(C) ,
+ 'CharIsAlphaNum #' + IntToStr(Ord(C)));
end;
//--------------------------------------------------------------------------------------------------
procedure TJclStringCharacterTestRoutines._CharIsBlank;
begin
- Fail('TODO: CharIsBlank');
end;
//--------------------------------------------------------------------------------------------------
@@ -1757,7 +1797,10 @@
begin
for c1 := #0 to #255 do
- CheckEquals(CharIsControl(c1) , (ord(c1) < 32 ),'CharIsControl');
+ CheckEquals(
+ (c1 in [#0 .. #31, #127, #129, #141, #143, #144, #157]),
+ CharIsControl(c1),
+ 'CharIsControl #' + IntToStr(Ord(c1)));
end;
//--------------------------------------------------------------------------------------------------
@@ -1768,7 +1811,7 @@
begin
for c1 := #0 to #255 do
- CheckEquals(CharIsDelete(c1) , (ord(c1) = 8),'CharIsDelete');
+ CheckEquals((ord(c1) = 8), CharIsDelete(c1), 'CharIsDelete #' + IntToStr(Ord(c1)));
end;
//--------------------------------------------------------------------------------------------------
@@ -1776,10 +1819,13 @@
procedure TJclStringCharacterTestRoutines._CharIsDigit;
var
c1: char;
-
+
begin
for c1 := #0 to #255 do
- CheckEquals(CharIsDigit(c1) , (c1 in ['0'..'9']),'CharIsDigit');
+ CheckEquals(
+ (c1 in ['0'..'9', #178 { power of 2 }, #179 {power of 3}, #185 {power of 1}]),
+ CharIsDigit(c1),
+ 'CharIsDigit #' + IntToStr(Ord(c1)));
end;
//--------------------------------------------------------------------------------------------------
@@ -1790,7 +1836,10 @@
begin
for c1 := #0 to #255 do
- CheckEquals(CharIsNumberChar(c1) , (c1 in ['0'..'9', '+', '-', DecimalSeparator]),'CharIsNumberChar');
+ CheckEquals(
+ (c1 in ['0'..'9', '+', '-', DecimalSeparator, #178 { power of 2 }, #179 {power of 3}, #185 {power of 1}]),
+ CharIsNumberChar(c1),
+ 'CharIsNumberChar #' + IntToStr(Ord(c1)));
end;
//--------------------------------------------------------------------------------------------------
@@ -1801,7 +1850,10 @@
begin
for c1 := #0 to #255 do
- CheckEquals(CharIsPrintable(c1) , (ord(c1) > 31),'CharIsPrintable');
+ CheckEquals(
+ not (c1 in [#0 .. #31, #127, #129, #141, #143, #144, #157]),
+ CharIsPrintable(c1),
+ 'CharIsPrintable #' + IntToStr(Ord(c1)));
end;
//--------------------------------------------------------------------------------------------------
@@ -1811,7 +1863,11 @@
c1: char;
begin
for c1 := #0 to #255 do
- CheckEquals(CharIsPunctuation(c1) , (c1 in [#123..#126, #91..#96, #38..#47, '@', #60..#63, '#','$','%','"','.',',','!',':','=',';']),'CharIsPunctuation');
+ CheckEquals(
+ (c1 in [#123..#126, #130, #132 .. #135, #137, #139, #145 .. #151, #155, #161 .. #191, #215, #247,
+ #91..#96, #38..#47, '@', #60..#63, '#','$','%','"','.',',','!',':','=',';']),
+ CharIsPunctuation(c1),
+ 'CharIsPunctuation #' + IntToStr(Ord(c1)));
end;
//--------------------------------------------------------------------------------------------------
@@ -1821,7 +1877,7 @@
c1: char;
begin
for c1 := #0 to #255 do
- CheckEquals(CharIsReturn(c1) , ((c1 = #13) or (c1 = #10)),'CharIsReturn');
+ CheckEquals(((c1 = #13) or (c1 = #10)), CharIsReturn(c1), 'CharIsReturn #' + IntToStr(Ord(c1)));
end;
//--------------------------------------------------------------------------------------------------
@@ -1831,7 +1887,10 @@
c1: char;
begin
for c1 := #0 to #255 do
- CheckEquals(CharIsSpace(c1) , c1 in [' ', #9, #10, #11, #12, #13],'CharIsSpace');
+ CheckEquals(
+ c1 in [#9, #10, #11, #12, #13, ' ', #160],
+ CharIsSpace(c1),
+ 'CharIsSpace #' + IntToStr(Ord(c1)));
end;
//--------------------------------------------------------------------------------------------------
@@ -1841,7 +1900,11 @@
c1: char;
begin
for c1 := #0 to #255 do
- CheckEquals(CharIsWhiteSpace(c1) , (c1 in AnsiWhiteSpace),'CharIsWhiteSpace');
+ CheckEquals(
+ (c1 in [NativeTab, NativeLineFeed, NativeVerticalTab, NativeFormFeed, NativeCarriageReturn, NativeSpace]),
+ CharIsWhiteSpace(c1),
+ 'CharIsWhiteSpace #' + IntToStr(Ord(c1))
+ );
end;
//--------------------------------------------------------------------------------------------------
@@ -1851,7 +1914,10 @@
c1: char;
begin
for c1 := #0 to #255 do
- CheckEquals(CharIsUpper(c1) , (c1 in ['A'..'Z']),'CharIsUpper');
+ CheckEquals(
+ (c1 in ['A'..'Z', #138, #140, #142, #159, #192 .. #214, #216 .. #222]),
+ CharIsUpper(c1),
+ 'CharIsUpper #' + IntToStr(Ord(c1)));
end;
//--------------------------------------------------------------------------------------------------
@@ -1861,7 +1927,10 @@
c1: char;
begin
for c1 := #0 to #255 do
- CheckEquals(CharIsLower(c1) , (c1 in ['a'..'z']),'CharIsLower');
+ CheckEquals(
+ (c1 in ['a' .. 'z', #131, #154, #156, #158, #170, #181, #186, #223 .. #246, #248 .. #255]),
+ CharIsLower(c1),
+ 'CharIsLower #' + IntToStr(Ord(c1)));
end;
@@ -1891,10 +1960,10 @@
procedure TJclStringExtraction._StrBetween;
begin
- CheckEquals(StrBetween('',char(#0),char(#0)),'','StrBetween');
- CheckEquals(StrBetween('',char(#0),char(#1)),'','StrBetween');
- CheckEquals(StrBetween('aTestb',char('a'),char('b')),'Test','StrBetween');
- CheckEquals(StrBetween(' Test ',char(' '),char(' ')),'','StrBetween');
+ CheckEquals('', StrBetween('', Char(#0), Char(#0)), 'StrBetween1');
+ CheckEquals('', StrBetween('', Char(#0), Char(#1)), 'StrBetween2');
+ CheckEquals('Test', StrBetween('aTestb', Char('a'), Char('b')), 'StrBetween3');
+ CheckEquals('Test', StrBetween(' Test ', Char(' '), Char(' ')), 'StrBetween4');
end;
//--------------------------------------------------------------------------------------------------
@@ -2291,6 +2360,49 @@
//------------------------------------------------------------------------------
+procedure TJclStringTabSet._Clone;
+var
+ tabs1: TJclTabSet;
+ tabs2: TJclTabSet;
+
+ procedure NilClone;
+ begin
+ tabs1 := nil;
+ tabs2 := tabs1.Clone;
+ try
+ CheckTrue(tabs2 = nil, 'NilClone: tabs2 = nil');
+ finally
+ FreeAndNil(tabs2);
+ end;
+ end;
+
+ procedure NormalClone;
+ begin
+ tabs1 := TJclTabSet.Create([4, 8], False, 2);
+ try
+ tabs2 := tabs1.Clone;
+ try
+ CheckTrue(tabs1 <> tabs2, 'NormalClone: tabs1 <> tabs2');
+ CheckEquals(tabs1.TabWidth, tabs2.TabWidth, 'NormalClone: .TabWidth');
+ CheckEquals(tabs1.ActualTabWidth, tabs2.ActualTabWidth, 'NormalClone: .ActualTabWidth');
+ CheckEquals(tabs1.Count, tabs2.Count, 'NormalClone: .Count');
+ CheckEquals(tabs1.TabStops[0], tabs2.TabStops[0], 'NormalClone: .TabStops[0]');
+ CheckEquals(tabs1.TabStops[1], tabs2.TabStops[1], 'NormalClone: .TabStops[1]');
+ finally
+ FreeAndNil(tabs2);
+ end;
+ finally
+ FreeAndNil(tabs1);
+ end;
+ end;
+
+begin
+ NilClone;
+ NormalClone;
+end;
+
+//------------------------------------------------------------------------------
+
procedure TJclStringTabSet._Expand;
var
tabs: TJclTabSet;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
49 messages has been excluded from this view by a project administrator.
