diff --git a/Demos/Cromis.AnyArrray/SpeedMain.dpr b/Demos/Cromis.AnyArrray/SpeedMain.dpr
new file mode 100644
index 0000000..6a34c0f
--- /dev/null
+++ b/Demos/Cromis.AnyArrray/SpeedMain.dpr
@@ -0,0 +1,14 @@
+program SpeedMain;
+
+uses
+ Forms,
+ SpeedTest.Main in 'SpeedTest.Main.pas' {fMain};
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.MainFormOnTaskbar := True;
+ Application.CreateForm(TfMain, fMain);
+ Application.Run;
+end.
diff --git a/Demos/Cromis.AnyArrray/SpeedMain.dproj b/Demos/Cromis.AnyArrray/SpeedMain.dproj
new file mode 100644
index 0000000..50b7b8b
--- /dev/null
+++ b/Demos/Cromis.AnyArrray/SpeedMain.dproj
@@ -0,0 +1,107 @@
+
+
+ {167764AB-1C0E-47C6-94DC-5BC94C3D582C}
+ 12.0
+ SpeedMain.dpr
+ Debug
+ DCC32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ SpeedMain.exe
+ 00400000
+ WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)
+ x86
+ false
+ false
+ false
+ false
+ false
+
+
+ false
+ RELEASE;$(DCC_Define)
+ 0
+ false
+
+
+ DEBUG;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+
+
+ Base
+
+
+ Cfg_2
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+
+ Delphi.Personality.12
+
+
+
+
+ SpeedMain.dpr
+
+
+ False
+ True
+ False
+
+
+ False
+ False
+ 1
+ 0
+ 0
+ 0
+ False
+ False
+ False
+ False
+ False
+ 1060
+ 1250
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+ 1.0.0.0
+
+
+
+
+ 12
+
+
diff --git a/Demos/Cromis.AnyArrray/SpeedMain.res b/Demos/Cromis.AnyArrray/SpeedMain.res
new file mode 100644
index 0000000..8b378d7
Binary files /dev/null and b/Demos/Cromis.AnyArrray/SpeedMain.res differ
diff --git a/Demos/Cromis.AnyArrray/SpeedTest.Main.dfm b/Demos/Cromis.AnyArrray/SpeedTest.Main.dfm
new file mode 100644
index 0000000..a859b26
--- /dev/null
+++ b/Demos/Cromis.AnyArrray/SpeedTest.Main.dfm
@@ -0,0 +1,125 @@
+object fMain: TfMain
+ Left = 0
+ Top = 0
+ Caption = 'Dynamic array implementations comparison'
+ ClientHeight = 562
+ ClientWidth = 784
+ Color = clBtnFace
+ Constraints.MinHeight = 600
+ Constraints.MinWidth = 800
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ PixelsPerInch = 96
+ TextHeight = 13
+ object lbSpeedResults: TListBox
+ AlignWithMargins = True
+ Left = 3
+ Top = 3
+ Width = 473
+ Height = 484
+ Align = alLeft
+ ItemHeight = 13
+ TabOrder = 0
+ end
+ object lbSliceData: TListBox
+ AlignWithMargins = True
+ Left = 482
+ Top = 3
+ Width = 299
+ Height = 484
+ Align = alClient
+ ItemHeight = 13
+ TabOrder = 1
+ end
+ object sbSpeedTest: TStatusBar
+ AlignWithMargins = True
+ Left = 3
+ Top = 540
+ Width = 778
+ Height = 19
+ Panels = <>
+ end
+ object pnCommands: TPanel
+ AlignWithMargins = True
+ Left = 3
+ Top = 493
+ Width = 778
+ Height = 41
+ Align = alBottom
+ TabOrder = 3
+ object lbSliceBufferMpl: TLabel
+ Left = 629
+ Top = 11
+ Width = 71
+ Height = 13
+ Caption = 'SliceBufferMpl:'
+ end
+ object lbSliceSize: TLabel
+ Left = 503
+ Top = 11
+ Width = 44
+ Height = 13
+ Caption = 'SliceSize:'
+ end
+ object btnTestLargeSize: TButton
+ Left = 6
+ Top = 6
+ Width = 99
+ Height = 25
+ Caption = 'Test large size'
+ TabOrder = 0
+ OnClick = btnTestLargeSizeClick
+ end
+ object btnTestSmallSize: TButton
+ Left = 111
+ Top = 6
+ Width = 99
+ Height = 25
+ Caption = 'Test small size'
+ TabOrder = 1
+ OnClick = btnTestSmallSizeClick
+ end
+ object cbDynamicArray: TRadioButton
+ Left = 232
+ Top = 10
+ Width = 113
+ Height = 17
+ Caption = 'amDynamicArray'
+ TabOrder = 2
+ end
+ object cbSlicedArray: TRadioButton
+ Left = 343
+ Top = 10
+ Width = 113
+ Height = 17
+ Caption = 'amSlicedArray'
+ Checked = True
+ TabOrder = 3
+ TabStop = True
+ end
+ object eSliceSize: TEdit
+ Left = 554
+ Top = 8
+ Width = 65
+ Height = 21
+ TabOrder = 4
+ Text = '10000'
+ end
+ object eSliceBufferMpl: TEdit
+ Left = 704
+ Top = 8
+ Width = 65
+ Height = 21
+ TabOrder = 5
+ Text = '1.1'
+ end
+ end
+ object XPManifest: TXPManifest
+ Left = 696
+ Top = 40
+ end
+end
diff --git a/Demos/Cromis.AnyArrray/SpeedTest.Main.pas b/Demos/Cromis.AnyArrray/SpeedTest.Main.pas
new file mode 100644
index 0000000..92e35bd
--- /dev/null
+++ b/Demos/Cromis.AnyArrray/SpeedTest.Main.pas
@@ -0,0 +1,664 @@
+unit SpeedTest.Main;
+
+interface
+
+uses
+ Windows, SysUtils, Variants, Classes, Controls, Forms, StdCtrls, ComCtrls, XPMan, ExtCtrls,
+
+ // additional units
+ Math, RTTI, diagnostics,
+
+ // generics units
+ Generics.Collections, Generics.Defaults,
+
+ // cromis units
+ Cromis.AnyValue;
+
+type
+ TfMain = class(TForm)
+ lbSpeedResults: TListBox;
+ lbSliceData: TListBox;
+ sbSpeedTest: TStatusBar;
+ XPManifest: TXPManifest;
+ pnCommands: TPanel;
+ btnTestLargeSize: TButton;
+ btnTestSmallSize: TButton;
+ cbDynamicArray: TRadioButton;
+ cbSlicedArray: TRadioButton;
+ eSliceSize: TEdit;
+ eSliceBufferMpl: TEdit;
+ lbSliceBufferMpl: TLabel;
+ lbSliceSize: TLabel;
+ procedure btnTestLargeSizeClick(Sender: TObject);
+ procedure btnTestSmallSizeClick(Sender: TObject);
+ private
+ procedure WriteToLog(const Msg: string);
+ procedure WriteSlicesInfo(const AnyArray: IAnyArray);
+ end;
+
+{ Declare a new custom comparer. }
+ TAnyValueComparer = class(TComparer)
+ public
+ function Compare(const Left, Right: TAnyValue): Integer; override;
+ end;
+
+var
+ fMain: TfMain;
+
+implementation
+
+{$R *.dfm}
+
+procedure TfMain.btnTestLargeSizeClick(Sender: TObject);
+var
+ I: Integer;
+ EnumValue: TAnyValue;
+ EnumTValue: TValue;
+ EnumVariant: Variant;
+ EnumPointer: PAnyValue;
+ TempValueA: Integer;
+ TempValueB: Integer;
+ StopWatch: TStopWatch;
+ TValueList: TList;
+ AnyArrayList: IAnyArray;
+ AnyValueList: TList;
+ VariantsList: TList;
+begin
+ Randomize;
+ lbSliceData.Clear;
+ lbSpeedResults.Clear;
+ // set decimal separator
+ {$IF CompilerVersion >= 22}Formatsettings.{$IFEND}DecimalSeparator := '.';
+
+ AnyArrayList := CreateAnyArray;
+ try
+ if cbDynamicArray.Checked then
+ begin
+ AnyArrayList.ArrayMode := amDynamicArray;
+ end
+ else
+ begin
+ AnyArrayList.ArrayMode := amSlicedArray;
+ AnyArrayList.SliceBufferMpl := StrToFloat(eSliceBufferMpl.Text);
+ AnyArrayList.SliceSize := StrToInt(eSliceSize.Text);
+ end;
+
+ WriteToLog('********************* BEGIN AnyArrayList *********************');
+ TempValueB := 0;
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ AnyArrayList.Push(Random(1000000));
+ StopWatch.Stop;
+ WriteToLog(Format('IAnyArray, add 1000000: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ AnyArrayList.Sort
+ (
+ function(Item1, Item2: PAnyValue): Integer
+ begin
+ Result := Item1.AsInteger - Item2.AsInteger;
+ end
+ );
+ StopWatch.Stop;
+ WriteToLog(Format('IAnyArray, sort ASC: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 5000 - 1 do
+ AnyArrayList.DeleteIndex(Random(AnyArrayList.Count - 1));
+ StopWatch.Stop;
+ WriteToLog(Format('IAnyArray, delete 5000 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 5000 - 1 do
+ AnyArrayList.Insert(Random(AnyArrayList.Count - 1), I);
+ StopWatch.Stop;
+ WriteToLog(Format('IAnyArray, insert 5000 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := AnyArrayList.Item[Random(AnyArrayList.Count - 1)].AsInteger;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('IAnyArray, 1000000 random access by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := AnyArrayList.RawItem(Random(AnyArrayList.Count - 1))^;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('IAnyArray, 1000000 raw random access by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := AnyArrayList.Item[I].AsInteger;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('IAnyArray, 1000000 iterations by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := AnyArrayList.RawItem(I)^;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('IAnyArray, 1000000 raw iterations by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for EnumPointer in AnyArrayList.Enum.Forward do
+ TempValueB := EnumPointer.AsInteger;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('IAnyArray, pointers enumeration: %d', [stopwatch.ElapsedMilliseconds]));
+ WriteToLog('********************* END AnyArrayList *********************');
+ // write current slice info to list
+ WriteSlicesInfo(AnyArrayList);
+ finally
+ AnyArrayList := nil;
+ end;
+
+
+ AnyValueList := TList.Create;
+ try
+ WriteToLog('********************* BEGIN TList *********************');
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ AnyValueList.Add(Random(1000000));
+ StopWatch.Stop;
+ WriteToLog(Format('TList, add 1000000: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ AnyValueList.Sort
+ (
+ TDelegatedComparer.Create
+ (
+ function(const Left, Right: TAnyValue): Integer
+ begin
+ Result := Left.AsInteger - Right.AsInteger;
+ end
+ )
+ );
+ StopWatch.Stop;
+ WriteToLog(Format('TList, sort ASC: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 5000 - 1 do
+ AnyValueList.Delete(Random(AnyValueList.Count - 1));
+ StopWatch.Stop;
+ WriteToLog(Format('TList, delete 5000 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 5000 - 1 do
+ AnyValueList.Insert(Random(AnyValueList.Count - 1), I);
+ StopWatch.Stop;
+ WriteToLog(Format('TList, insert 5000 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := AnyValueList[Random(AnyValueList.Count - 1)];
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('TList, 1000000 random access by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to AnyValueList.Count - 1 do
+ TempValueB := AnyValueList[I];
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('TList, 1000000 iteration by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for EnumValue in AnyValueList do
+ TempValueB := EnumValue.AsInteger;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('TList, values enumeration: %d', [stopwatch.ElapsedMilliseconds]));
+ WriteToLog('********************* END TList *********************');
+ finally
+ AnyValueList.Free;
+ end;
+
+ VariantsList := TList.Create;
+ try
+ WriteToLog('********************* BEGIN TList *********************');
+ StopWatch := TStopWatch.StartNew;
+ //for I := 0 to 1000000 - 1 do
+ // VariantsList.Add(I);
+ for I := 0 to 1000000 - 1 do
+ VariantsList.Add(Random(1000000));
+ StopWatch.Stop;
+ WriteToLog(Format('TList, add 1000000: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ VariantsList.Sort
+ (
+ TDelegatedComparer.Create
+ (
+ function(const Left, Right: Variant): Integer
+ begin
+ Result := Left - Right;
+ end
+ )
+ );
+ for I := 0 to 5000 - 1 do
+ VariantsList.Delete(Random(VariantsList.Count - 1));
+ StopWatch.Stop;
+ WriteToLog(Format('TList, delete 5000 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 5000 - 1 do
+ VariantsList.Insert(Random(VariantsList.Count - 1), I);
+ StopWatch.Stop;
+ WriteToLog(Format('TList, insert 5000 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := VariantsList[Random(VariantsList.Count - 1)];
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('TList, 1000000 random access by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to VariantsList.Count - 1 do
+ TempValueB := VariantsList[I];
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('TList, 1000000 iteration by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for EnumVariant in VariantsList do
+ TempValueB := EnumVariant;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('TList, values enumeration: %d', [stopwatch.ElapsedMilliseconds]));
+ WriteToLog('********************* END TList *********************');
+ finally
+ VariantsList.Free;
+ end;
+
+ TValueList := TList.Create;
+ try
+ WriteToLog('********************* BEGIN TList *********************');
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TValueList.Add(I);
+ for I := 0 to 1000000 - 1 do
+ TValueList.Add(1000000);
+ StopWatch.Stop;
+ WriteToLog(Format('TList, add 1000000: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ TValueList.Sort
+ (
+ TDelegatedComparer.Create
+ (
+ function(const Left, Right: TValue): Integer
+ begin
+ Result := Left.AsInteger - Right.AsInteger;
+ end
+ )
+ );
+ for I := 0 to 5000 - 1 do
+ TValueList.Delete(Random(TValueList.Count - 1));
+ StopWatch.Stop;
+ WriteToLog(Format('TList, delete 5000 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 5000 - 1 do
+ TValueList.Insert(Random(TValueList.Count - 1), I);
+ StopWatch.Stop;
+ WriteToLog(Format('TList, insert 5000 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := TValueList[Random(TValueList.Count - 1)].AsInteger;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('TList, 1000000 random access by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to TValueList.Count - 1 do
+ TempValueB := TValueList[I].AsInteger;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('TList, 1000000 iteration by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for EnumTValue in TValueList do
+ TempValueB := EnumTValue.AsInteger;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('TList, values enumeration: %d', [stopwatch.ElapsedMilliseconds]));
+ WriteToLog('********************* END TList *********************');
+ finally
+ TValueList.Free;
+ end;
+end;
+
+procedure TfMain.btnTestSmallSizeClick(Sender: TObject);
+var
+ I, K: Integer;
+ EnumValue: TAnyValue;
+ EnumTValue: TValue;
+ EnumVariant: Variant;
+ EnumPointer: PAnyValue;
+ TempValueA: Integer;
+ TempValueB: Integer;
+ StopWatch: TStopWatch;
+ TValueList: TList;
+ AnyArrayList: IAnyArray;
+ AnyValueList: TList;
+ VariantsList: TList;
+begin
+ Randomize;
+ lbSliceData.Clear;
+ lbSpeedResults.Clear;
+ // set decimal separator
+ {$IF CompilerVersion >= 22}Formatsettings.{$IFEND}DecimalSeparator := '.';
+
+ AnyArrayList := CreateAnyArray;
+ try
+ if cbDynamicArray.Checked then
+ begin
+ AnyArrayList.ArrayMode := amDynamicArray;
+ end
+ else
+ begin
+ AnyArrayList.ArrayMode := amSlicedArray;
+ AnyArrayList.SliceBufferMpl := StrToFloat(eSliceBufferMpl.Text);
+ AnyArrayList.SliceSize := StrToInt(eSliceSize.Text);
+ end;
+
+ WriteToLog('********************* BEGIN AnyArrayList *********************');
+ TempValueB := 0;
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ AnyArrayList.Clear;
+ for I := 0 to 5000 - 1 do
+ AnyArrayList.Push(I);
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('IAnyArray, add 5000 X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 10 do
+ begin
+ for I := 0 to 1000 - 1 do
+ AnyArrayList.DeleteIndex(Random(AnyArrayList.Count - 1));
+ for I := 0 to 1000 - 1 do
+ AnyArrayList.Push(I);
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('IAnyArray, delete 1000 X 10 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 10 do
+ begin
+ for I := 0 to 1000 - 1 do
+ AnyArrayList.Insert(Random(AnyArrayList.Count - 1), I);
+ for I := 0 to 1000 - 1 do
+ AnyArrayList.DeleteIndex(Random(AnyArrayList.Count - 1));
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('IAnyArray, insert 1000 X 10 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := AnyArrayList.Item[Random(AnyArrayList.Count - 1)].AsInteger;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('IAnyArray, 1000000 random access by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := AnyArrayList.RawItem(Random(AnyArrayList.Count - 1)).AsInteger;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('IAnyArray, 1000000 random raw access by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ for I := 0 to AnyArrayList.Count - 1 do
+ TempValueB := AnyArrayList[I].AsInteger;
+ end;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('IAnyArray, 1000000 iterations by index X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ for I := 0 to AnyArrayList.Count - 1 do
+ TempValueB := AnyArrayList.RawItem(I).AsInteger;
+ end;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('IAnyArray, 1000000 raw iterations by index X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ for EnumPointer in AnyArrayList.Enum.Forward do
+ TempValueB := EnumPointer^.AsInteger;
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('IAnyArray, pointers enumeration X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ WriteToLog('********************* END AnyArrayList *********************');
+
+ // write current slice info to list
+ WriteSlicesInfo(AnyArrayList);
+ finally
+ AnyArrayList := nil;
+ end;
+
+ AnyValueList := TList.Create;
+ try
+ WriteToLog('********************* BEGIN TList *********************');
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ AnyValueList.Clear;
+ for I := 0 to 5000 - 1 do
+ AnyValueList.Add(I);
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('TList, add 5000 X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 10 do
+ begin
+ for I := 0 to 1000 - 1 do
+ AnyValueList.Delete(Random(AnyValueList.Count - 1));
+ for I := 0 to 1000 - 1 do
+ AnyValueList.Add(I);
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('TList, delete 1000 X 10 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 10 do
+ begin
+ for I := 0 to 1000 - 1 do
+ AnyValueList.Insert(Random(AnyValueList.Count - 1), I);
+ for I := 0 to 1000 - 1 do
+ AnyValueList.Delete(Random(AnyValueList.Count - 1));
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('TList, insert 1000 X 10 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := AnyValueList[Random(AnyValueList.Count - 1)];
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('TList, 1000000 random access by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ for I := 0 to AnyValueList.Count - 1 do
+ TempValueB := AnyValueList[I].AsInteger;
+ end;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('TList, 1000000 iterations by index X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ for I := 0 to AnyValueList.Count - 1 do
+ TempValueB := AnyValueList[I];
+ end;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('TList, enumeration X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ WriteToLog('********************* END TList *********************');
+ finally
+ AnyValueList.Free;
+ end;
+
+ VariantsList := TList.Create;
+ try
+ WriteToLog('********************* BEGIN TList *********************');
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ VariantsList.Clear;
+ for I := 0 to 5000 - 1 do
+ VariantsList.Add(I);
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('TList, add 5000 X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 10 do
+ begin
+ for I := 0 to 1000 - 1 do
+ VariantsList.Delete(Random(VariantsList.Count - 1));
+ for I := 0 to 1000 - 1 do
+ VariantsList.Add(I);
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('TList, delete 1000 X 10 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 10 do
+ begin
+ for I := 0 to 1000 - 1 do
+ VariantsList.Insert(Random(VariantsList.Count - 1), I);
+ for I := 0 to 1000 - 1 do
+ VariantsList.Delete(Random(VariantsList.Count - 1));
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('TList, insert 1000 X 10 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := VariantsList[Random(VariantsList.Count - 1)];
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('TList, 1000000 random access by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ for I := 0 to VariantsList.Count - 1 do
+ TempValueB := VariantsList[I];
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('TList, 5000 iterantions by index X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ for EnumVariant in VariantsList do
+ TempValueB := EnumVariant;
+ end;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('TList, enumeration X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ WriteToLog('********************* END TList *********************');
+ finally
+ VariantsList.Free;
+ end;
+
+ TValueList := TList.Create;
+ try
+ WriteToLog('********************* BEGIN TList *********************');
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ TValueList.Clear;
+ for I := 0 to 5000 - 1 do
+ TValueList.Add(I);
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('TList, add 5000 X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 10 do
+ begin
+ for I := 0 to 1000 - 1 do
+ TValueList.Delete(Random(TValueList.Count - 1));
+ for I := 0 to 1000 - 1 do
+ TValueList.Add(I);
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('TList, delete 1000 X 10 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 10 do
+ begin
+ for I := 0 to 1000 - 1 do
+ TValueList.Insert(Random(TValueList.Count - 1), I);
+ for I := 0 to 1000 - 1 do
+ TValueList.Delete(Random(TValueList.Count - 1));
+ end;
+ StopWatch.Stop;
+ WriteToLog(Format('TList, insert 1000 X 10 by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for I := 0 to 1000000 - 1 do
+ TempValueA := TValueList[Random(TValueList.Count - 1)].AsInteger;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueA));
+ WriteToLog(Format('TList, 1000000 random access by index: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ for I := 0 to TValueList.Count - 1 do
+ TempValueB := TValueList[I].AsInteger;
+ end;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('TList, 5000 iterantions by index X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ StopWatch := TStopWatch.StartNew;
+ for K := 1 to 200 do
+ begin
+ for EnumTValue in TValueList do
+ TempValueB := EnumTValue.AsInteger;
+ end;
+ StopWatch.Stop;
+ // use TempValue;
+ Sleep(Min(0, TempValueB));
+ WriteToLog(Format('TList, enumeration X 200: %d', [stopwatch.ElapsedMilliseconds]));
+ WriteToLog('********************* END TList *********************');
+ finally
+ TValueList.Free;
+ end;
+end;
+
+procedure TfMain.WriteSlicesInfo(const AnyArray: IAnyArray);
+var
+ I: Integer;
+ ItemCount: Integer;
+ CurrentSlice: PArraySlice;
+begin
+ lbSliceData.Clear;
+
+ for I := 0 to AnyArray.SliceCount - 1 do
+ begin
+ CurrentSlice := AnyArray.RawData^[I];
+ ItemCount := CurrentSlice.Last - CurrentSlice.Start;
+ lbSliceData.Items.Add(Format('Slice %d: %d - %d [%d]', [CurrentSlice.Index,
+ CurrentSlice.Start,
+ CurrentSlice.Last,
+ ItemCount]));
+ end;
+end;
+
+procedure TfMain.WriteToLog(const Msg: string);
+begin
+ lbSpeedResults.Items.Add(Msg);
+ Application.ProcessMessages;
+end;
+
+{ TAnyValueComparer }
+
+function TAnyValueComparer.Compare(const Left, Right: TAnyValue): Integer;
+begin
+ Result := Left.AsInteger - Right.AsInteger;
+end;
+
+end.
diff --git a/Demos/Cromis.AnyArrray/StressTest.Main.dfm b/Demos/Cromis.AnyArrray/StressTest.Main.dfm
new file mode 100644
index 0000000..4b1564b
--- /dev/null
+++ b/Demos/Cromis.AnyArrray/StressTest.Main.dfm
@@ -0,0 +1,117 @@
+object fMain: TfMain
+ Left = 0
+ Top = 0
+ BorderStyle = bsDialog
+ Caption = 'IAnyArray stress test'
+ ClientHeight = 490
+ ClientWidth = 747
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poScreenCenter
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ PixelsPerInch = 96
+ TextHeight = 13
+ object lbRunningText: TLabel
+ Left = 446
+ Top = 41
+ Width = 60
+ Height = 13
+ Caption = 'Running for:'
+ end
+ object lbRunningValue: TLabel
+ Left = 523
+ Top = 41
+ Width = 64
+ Height = 13
+ Caption = 'Running Time'
+ end
+ object lbNumSlicesText: TLabel
+ Left = 446
+ Top = 62
+ Width = 58
+ Height = 13
+ Caption = 'Num. Slices:'
+ end
+ object lbNumSlicesValue: TLabel
+ Left = 523
+ Top = 62
+ Width = 65
+ Height = 13
+ Caption = 'Number slices'
+ end
+ object lbArrayActions: TListBox
+ AlignWithMargins = True
+ Left = 3
+ Top = 3
+ Width = 433
+ Height = 461
+ Align = alLeft
+ ItemHeight = 13
+ TabOrder = 0
+ end
+ object btnStart: TButton
+ Left = 442
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Start'
+ TabOrder = 1
+ OnClick = btnStartClick
+ end
+ object btnStop: TButton
+ Left = 523
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Stop'
+ TabOrder = 2
+ OnClick = btnStopClick
+ end
+ object lbSliceData: TListBox
+ Left = 442
+ Top = 88
+ Width = 301
+ Height = 376
+ ItemHeight = 13
+ TabOrder = 3
+ end
+ object btnReplay: TButton
+ Left = 664
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Replay'
+ TabOrder = 4
+ OnClick = btnReplayClick
+ end
+ object pbReplayProgress: TProgressBar
+ AlignWithMargins = True
+ Left = 3
+ Top = 470
+ Width = 741
+ Height = 17
+ Align = alBottom
+ TabOrder = 5
+ end
+ object btnSimulate: TButton
+ Left = 664
+ Top = 36
+ Width = 75
+ Height = 25
+ Caption = 'Simulate'
+ TabOrder = 6
+ OnClick = btnSimulateClick
+ end
+ object tmCurrentTime: TTimer
+ Enabled = False
+ OnTimer = tmCurrentTimeTimer
+ Left = 680
+ Top = 112
+ end
+end
diff --git a/Demos/Cromis.AnyArrray/StressTest.Main.pas b/Demos/Cromis.AnyArrray/StressTest.Main.pas
new file mode 100644
index 0000000..b7fcefc
--- /dev/null
+++ b/Demos/Cromis.AnyArrray/StressTest.Main.pas
@@ -0,0 +1,793 @@
+unit StressTest.Main;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
+ DateUtils, ExtCtrls, TypInfo, ComCtrls,
+
+ // generics units
+ Generics.Collections, Generics.Defaults,
+
+ // cromis units
+ Cromis.Threading, Cromis.AnyValue, Cromis.StringUtils;
+
+type
+ PControlData = ^TControlData;
+ TControlData = record
+ Task: ITask;
+ Counter: Integer;
+ AnyArray: IAnyArray;
+ ReplayData: TStringList;
+ ControlList: TList;
+ end;
+
+ TfMain = class(TForm)
+ lbArrayActions: TListBox;
+ btnStart: TButton;
+ btnStop: TButton;
+ tmCurrentTime: TTimer;
+ lbRunningText: TLabel;
+ lbRunningValue: TLabel;
+ lbSliceData: TListBox;
+ lbNumSlicesText: TLabel;
+ lbNumSlicesValue: TLabel;
+ btnReplay: TButton;
+ pbReplayProgress: TProgressBar;
+ btnSimulate: TButton;
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure btnStartClick(Sender: TObject);
+ procedure btnStopClick(Sender: TObject);
+ procedure tmCurrentTimeTimer(Sender: TObject);
+ procedure btnReplayClick(Sender: TObject);
+ procedure btnSimulateClick(Sender: TObject);
+ private
+ FTaskPool: TTaskPool;
+ FStartTime: TDateTime;
+ FSimulateTask: ITask;
+ FStressTask: ITask;
+ FReplayTask: ITask;
+
+ function DoPopElements(const Data: PControlData; const Elements: Integer): Boolean;
+ function DoPushElements(const Data: PControlData; const Elements: Integer): Boolean;
+ function DoInsertElements(const Data: PControlData; const Elements: Integer): Boolean;
+ function DoDeleteElements(const Data: PControlData; const Elements: Integer): Boolean;
+
+ procedure OnArrayStressTest(const Task: ITask);
+ procedure OnArrayReplayAction(const Task: ITask);
+ procedure OnSimulateTaskAction(const Task: ITask);
+ procedure DoLoadReplayData(const Data: PControlData);
+ procedure OnStressTestMessage(const Msg: ITaskMessage);
+ procedure WriteListsToHardDrive(const Data: PControlData);
+ procedure SendSliceStructureData(const Data: PControlData);
+ procedure WriteDataToHardDrive(const Data: PControlData; const Action: string; const Replay, Error: Boolean);
+ function CheckDataConsistency(const Data: PControlData; const Action: string; const Replay: Boolean): Boolean;
+ procedure DoSendMessage(const Task: ITask; const Name, Value: string; const LoopCount: Integer);
+ public
+ end;
+
+var
+ fMain: TfMain;
+
+implementation
+
+const
+ cFileReplayList = 'Data\ReplayList.txt';
+ cFileControlList = 'Data\ControlList.txt';
+ cFileAnyArrayData = 'Data\AnyArrayData.txt';
+ cFileAnyArrayConf = 'Data\AnyArrayCont.txt';
+ cFileControlTextList = 'Data\ControlTextList.txt';
+ cFileAnyArrayTextList = 'Data\AnyArrayTextList.txt';
+
+{$R *.dfm}
+
+procedure TfMain.btnReplayClick(Sender: TObject);
+begin
+ FReplayTask := FTaskPool.AcquireTask(OnArrayReplayAction, 'ReplayTask');
+ FReplayTask.Run;
+end;
+
+procedure TfMain.btnSimulateClick(Sender: TObject);
+begin
+ FSimulateTask := FTaskPool.AcquireTask(OnSimulateTaskAction, 'SimulateTask');
+ FSimulateTask.Run;
+end;
+
+procedure TfMain.btnStartClick(Sender: TObject);
+begin
+ tmCurrentTime.Enabled := True;
+ btnStart.Enabled := False;
+ btnStop.Enabled := True;
+ FStartTime := Now;
+
+ FStressTask := FTaskPool.AcquireTask(OnArrayStressTest, 'StressTest');
+ FStressTask.Run;
+end;
+
+procedure TfMain.btnStopClick(Sender: TObject);
+begin
+ FStressTask.Terminate;
+
+ btnStop.Enabled := False;
+ btnStart.Enabled := True;
+ tmCurrentTime.Enabled := False;
+end;
+
+function TfMain.CheckDataConsistency(const Data: PControlData; const Action: string; const Replay: Boolean): Boolean;
+var
+ I, K: Integer;
+begin
+ Result := True;
+ try
+ for I := 0 to Data.ControlList.Count - 1 do
+ begin
+ if not Data.AnyArray.Item[I].Equal(Data.ControlList.Items[I]) then
+ begin
+ DoSendMessage(Data.Task, 'Message', 'Found inconsistency!!!', I);
+ SendSliceStructureData(Data);
+ WriteListsToHardDrive(Data);
+ Data.Task.Terminate;
+ Result := False;
+ Exit;
+ end;
+ end;
+ finally
+ WriteDataToHardDrive(Data, Action, Replay, not Result);
+ end;
+end;
+
+function TfMain.DoDeleteElements(const Data: PControlData; const Elements: Integer): Boolean;
+var
+ I: Integer;
+ Index: Integer;
+begin
+ for I := 1 to (Elements div 2) + (Random(Elements)) do
+ begin
+ if Data.ControlList.Count = 0 then
+ Break;
+
+ Index := Random(Data.AnyArray.Count - 1);
+ Data.ReplayData.Add(IntToStr(Index));
+ Data.AnyArray.DeleteIndex(Index);
+ Data.ControlList.Delete(Index);
+ end;
+
+ // check for consistency
+ Result := CheckDataConsistency(Data, 'Delete', False);
+end;
+
+function TfMain.DoInsertElements(const Data: PControlData; const Elements: Integer): Boolean;
+var
+ I: Integer;
+ Index: Integer;
+ Value: TAnyValue;
+begin
+ if Data.ControlList.Count = 0 then
+ begin
+ Value := Random(1000000);
+ Data.AnyArray.Push(Value);
+ Data.ControlList.Add(Value);
+ Data.ReplayData.Add(Format('%d,%d', [0, Value.AsInteger]));
+ end;
+
+ for I := 1 to (Elements div 2) + (Random(Elements)) do
+ begin
+ Index := Random(Data.AnyArray.Count - 1);
+ Value := Random(1000000);
+
+ Data.ReplayData.Add(Format('%d,%d', [Index, Value.AsInteger]));
+ Data.ControlList.Insert(Index, Value);
+ Data.AnyArray.Insert(Index, Value);
+ end;
+
+ // check for consistency
+ Result := CheckDataConsistency(Data, 'Insert', False);
+end;
+
+procedure TfMain.DoLoadReplayData(const Data: PControlData);
+var
+ I, K: Integer;
+ Value: Integer;
+ RootDir: string;
+ Elements: Integer;
+ ListData: TStringList;
+ ArrayData: TFileStream;
+begin
+ ListData := TStringList.Create;
+ try
+ RootDir := ExtractFilePath(ParamStr(0));
+ ListData.LoadFromFile(RootDir + cFileAnyArrayConf);
+
+ Data.ReplayData.LoadFromFile(RootDir + cFileReplayList);
+ Data.AnyArray.SliceBufferMpl := StrToFloat(ListData.Values['SliceBufferMpl']);
+ Data.AnyArray.SliceSize := StrToInt(ListData.Values['SliceSize']);
+ Data.AnyArray.SliceCount := StrToInt(ListData.Values['SliceCount']);
+
+ // trick that lets the last slice intact from deletion
+ Inc(Data.AnyArray.RawData^[Data.AnyArray.SliceCount - 1].Last);
+
+ ArrayData := TFileStream.Create(RootDir + cFileAnyArrayData, fmOpenRead);
+ try
+ for I := 0 to Data.AnyArray.SliceCount - 1 do
+ begin
+ ArrayData.Read(Value, SizeOf(Integer));
+ Data.AnyArray.RawData^[I].Index := Value;
+ ArrayData.Read(Value, SizeOf(Integer));
+ Data.AnyArray.RawData^[I].Start := Value;
+ ArrayData.Read(Value, SizeOf(Integer));
+ Data.AnyArray.RawData^[I].Last := Value;
+ Elements := Data.AnyArray.RawData^[I].Last -
+ Data.AnyArray.RawData^[I].Start;
+ Data.AnyArray.RawData^[I].Last := Data.AnyArray.RawData^[I].Start;
+
+ for K := 0 to Elements - 1 do
+ begin
+ ArrayData.Read(Value, SizeOf(Integer));
+ Data.AnyArray.Insert(Data.AnyArray.Count, Value);
+ end;
+ end;
+ finally
+ ArrayData.Free;
+ end;
+
+ ListData.LoadFromFile(RootDir + cFileControlList);
+ for I := 0 to ListData.Count - 1 do
+ Data.ControlList.Add(StrToInt(ListData[I]));
+ finally
+ ListData.Free;
+ end;
+end;
+
+function TfMain.DoPopElements(const Data: PControlData; const Elements: Integer): Boolean;
+var
+ I: Integer;
+ Value: TAnyValue;
+begin
+ for I := 1 to (3 * (Elements div 4)) + (Random(Elements div 2)) do
+ begin
+ Data.ControlList.Delete(Data.ControlList.Count - 1);
+
+ Value := Data.AnyArray.Pop;
+ Data.ReplayData.Add(Value.AsString);
+ end;
+
+ // check for consistency
+ Result := CheckDataConsistency(Data, 'Pop', False);
+end;
+
+function TfMain.DoPushElements(const Data: PControlData; const Elements: Integer): Boolean;
+var
+ I: Integer;
+ Value: TAnyValue;
+begin
+ for I := 1 to (3 * (Elements div 4)) + (Random(Elements div 2)) do
+ begin
+ Value := Random(1000000);
+ Data.ReplayData.Add(Value.AsString);
+ Data.ControlList.Add(Value);
+ Data.AnyArray.Push(Value);
+ end;
+
+ // check for consistency
+ Result := CheckDataConsistency(Data, 'Push', False);
+end;
+
+procedure TfMain.DoSendMessage(const Task: ITask; const Name, Value: string; const LoopCount: Integer);
+begin
+ if Name = 'Message' then
+ Task.Message.Ensure(Name).AsString := Value + Format(' [%d]', [LoopCount])
+ else
+ Task.Message.Ensure(Name).AsString := Value;
+ Task.SendMessageAsync;
+end;
+
+procedure TfMain.FormCreate(Sender: TObject);
+begin
+ FTaskPool := TTaskPool.Create(5);
+ FTaskPool.OnTaskMessage := OnStressTestMessage;
+
+ lbNumSlicesValue.Caption := '';
+ lbRunningValue.Caption := '';
+ btnStop.Enabled := False;
+end;
+
+procedure TfMain.FormDestroy(Sender: TObject);
+begin
+ FreeAndNil(FTaskPool);
+end;
+
+procedure TfMain.OnArrayReplayAction(const Task: ITask);
+var
+ I: Integer;
+ Index: Integer;
+ Value: Integer;
+ RootDir: string;
+ ListData: TStringList;
+ ControlData: TControlData;
+ ActionType: string;
+begin
+ ListData := TStringList.Create;
+ try
+ RootDir := ExtractFilePath(ParamStr(0));
+ ListData.LoadFromFile(RootDir + cFileAnyArrayConf);
+ ActionType := ListData.Values['ActionType'];
+
+ ControlData.ControlList := TList.Create;
+ try
+ ControlData.ReplayData := TStringList.Create;
+ try
+ DoSendMessage(Task, 'Message', 'Started replaying data...', 0);
+ ControlData.AnyArray := CreateAnyArray;
+ DoLoadReplayData(@ControlData);
+ ControlData.Counter := 0;
+ ControlData.Task := Task;
+ Randomize;
+
+ if not CheckDataConsistency(@ControlData, ActionType, True) then
+ begin
+ DoSendMessage(Task, 'Message', 'Error replaying data', 0);
+ Exit;
+ end;
+
+ if ActionType = 'Pop' then
+ begin
+ for I := 0 to ControlData.ReplayData.Count - 1 do
+ begin
+ ControlData.AnyArray.Pop;
+ ControlData.ControlList.Delete(ControlData.ControlList.Count - 1);
+
+ if not CheckDataConsistency(@ControlData, ActionType, True) then
+ begin
+ DoSendMessage(Task, 'Message', 'Error replaying data', I);
+ Exit;
+ end;
+ end;
+ end
+ else if ActionType = 'Push' then
+ begin
+ for I := 0 to ControlData.ReplayData.Count - 1 do
+ begin
+ ControlData.AnyArray.Push(StrToInt(ControlData.ReplayData[I]));
+ ControlData.ControlList.Add(StrToInt(ControlData.ReplayData[I]));
+
+ if not CheckDataConsistency(@ControlData, ActionType, True) then
+ begin
+ DoSendMessage(Task, 'Message', 'Error replaying data', I);
+ Exit;
+ end;
+ end;
+ end
+ else if ActionType = 'Delete' then
+ begin
+ for I := 0 to ControlData.ReplayData.Count - 1 do
+ begin
+ ControlData.AnyArray.DeleteIndex(StrToInt(ControlData.ReplayData[I]));
+ ControlData.ControlList.Delete(StrToInt(ControlData.ReplayData[I]));
+
+ if not CheckDataConsistency(@ControlData, ActionType, True) then
+ begin
+ DoSendMessage(Task, 'Message', 'Error replaying data', I);
+ Exit;
+ end;
+ end;
+ end
+ else if ActionType = 'Insert' then
+ begin
+ for I := 0 to ControlData.ReplayData.Count - 1 do
+ begin
+ if ControlData.ControlList.Count = 0 then
+ begin
+ Value := StrToInt(StrAfter(',', ControlData.ReplayData[I]));
+ ControlData.ControlList.Add(Value);
+ ControlData.AnyArray.Push(Value);
+ Continue;
+ end;
+
+ Index := StrToInt(StrBefore(',', ControlData.ReplayData[I]));
+ Value := StrToInt(StrAfter(',', ControlData.ReplayData[I]));
+ ControlData.ControlList.Insert(Index, Value);
+ ControlData.AnyArray.Insert(Index, Value);
+
+ if not CheckDataConsistency(@ControlData, ActionType, True) then
+ begin
+ DoSendMessage(Task, 'Message', 'Error replaying data', I);
+ Exit;
+ end;
+ end;
+ end;
+
+ // we finished without any errors
+ DoSendMessage(Task, 'Message', 'Finished replaying data. No errors.', 0);
+ finally
+ ControlData.ReplayData.Free;
+ end;
+ finally
+ ControlData.ControlList.Free;
+ end;
+ finally
+ ListData.Free;
+ end;
+end;
+
+procedure TfMain.OnArrayStressTest(const Task: ITask);
+var
+ LogMessage: string;
+ ControlData: TControlData;
+begin
+ try
+ ControlData.ControlList := TList.Create;
+ try
+ ControlData.ReplayData := TStringList.Create;
+ try
+ DoSendMessage(Task, 'Message', 'Adding 1.000.000 items to begin with', 0);
+
+ ControlData.AnyArray := CreateAnyArray;
+ ControlData.AnyArray.SliceSize := 5000;
+ ControlData.Counter := 1;
+ ControlData.Task := Task;
+ Randomize;
+
+ // add 200.000 integers
+ if not DoPushElements(@ControlData, 200000) then
+ Exit;
+
+ while not Task.Terminated do
+ begin
+ DoSendMessage(Task, 'Message', 'Beginning 5 loop cycle of tests', 0);
+
+ while ControlData.Counter mod 5 <> 0 do
+ begin
+ DoSendMessage(Task, 'Message', 'Deleting random items...', ControlData.Counter);
+
+ // Delete 20.000 elements
+ if not DoDeleteElements(@ControlData, 30000) then
+ Exit;
+
+ DoSendMessage(Task, 'Message', 'Inserting random items...', ControlData.Counter);
+ SendSliceStructureData(@ControlData);
+
+ // Insert 20.000 elements
+ if not DoInsertElements(@ControlData, 30000) then
+ Exit;
+
+ DoSendMessage(Task, 'Message', 'Poping last items...', ControlData.Counter);
+ SendSliceStructureData(@ControlData);
+
+ // pop 20.000 items
+ if not DoPopElements(@ControlData, 30000) then
+ Exit;
+
+ DoSendMessage(Task, 'Message', 'Adding new items...', ControlData.Counter);
+ SendSliceStructureData(@ControlData);
+
+ // add 20.000 integers
+ if not DoPushElements(@ControlData, 30000) then
+ Exit;
+
+ LogMessage := Format('Test loop number %d compeleted', [ControlData.Counter]);
+ DoSendMessage(Task, 'Message', LogMessage, ControlData.Counter);
+ Inc(ControlData.Counter);
+
+ LogMessage := Format('Control List has %d Elements', [ControlData.ControlList.Count]);
+ DoSendMessage(Task, 'Message', LogMessage, ControlData.Counter);
+ LogMessage := Format('Any Array has %d Elements', [ControlData.AnyArray.Count]);
+ DoSendMessage(Task, 'Message', LogMessage, ControlData.Counter);
+ SendSliceStructureData(@ControlData);
+ end;
+
+ // finalize the 5 loop cycle and then begin new one
+ DoSendMessage(Task, 'Message', 'Finalizing 5 loop cycle of tests', ControlData.Counter);
+ DoSendMessage(Task, 'Message', 'Deleting all elements', ControlData.Counter);
+
+ // delete random items
+ while ControlData.ControlList.Count > 0 do
+ begin
+ // Delete 20.000 elements
+ if not DoDeleteElements(@ControlData, 20000) then
+ Exit;
+
+ LogMessage := Format('%d elements left', [ControlData.ControlList.Count]);
+ DoSendMessage(Task, 'Message', LogMessage, ControlData.Counter);
+ LogMessage := Format('AnyArray has %d elements', [ControlData.AnyArray.Count]);
+ DoSendMessage(Task, 'Message', LogMessage, ControlData.Counter);
+ end;
+
+ DoSendMessage(Task, 'Message', 'Inserting 200000 elements', ControlData.Counter);
+
+ // Insert 200.000 elements
+ while ControlData.ControlList.Count < 200000 do
+ begin
+ // Insert 20.000 elements
+ if not DoInsertElements(@ControlData, 20000) then
+ Exit;
+
+ LogMessage := Format('%d elements inserted', [ControlData.ControlList.Count]);
+ DoSendMessage(Task, 'Message', LogMessage, ControlData.Counter);
+ LogMessage := Format('AnyArray has %d elements', [ControlData.AnyArray.Count]);
+ DoSendMessage(Task, 'Message', LogMessage, ControlData.Counter);
+ end;
+
+ Inc(ControlData.Counter);
+ end;
+ finally
+ ControlData.ReplayData.Free;
+ end;
+ finally
+ ControlData.ControlList.Free;
+ end;
+ except
+ on E: Exception do
+ DoSendMessage(Task, 'Message', Format('Worker Thread error: %s', [E.Message]), -1);
+ end;
+end;
+
+procedure TfMain.OnSimulateTaskAction(const Task: ITask);
+var
+ I: Integer;
+ Index: Integer;
+ Value: Integer;
+ ControlData: TControlData;
+
+ function CheckReplayDataConsistency(const Data: PControlData): Boolean;
+ var
+ K: Integer;
+ begin
+ Result := True;
+
+ for K := 0 to Data.ControlList.Count - 1 do
+ begin
+ if not Data.AnyArray.Item[K].Equal(Data.ControlList.Items[K]) then
+ begin
+ DoSendMessage(Task, 'Message', 'Data is not consistent after Insert!!', Data.Counter);
+ Result := False;
+ Exit;
+ end;
+ end;
+ end;
+
+begin
+ try
+ ControlData.ControlList := TList.Create;
+ try
+ ControlData.ReplayData := TStringList.Create;
+ try
+ DoSendMessage(Task, 'Message', 'Simulating small push, delete and insert...', 0);
+
+ ControlData.AnyArray := CreateAnyArray;
+ ControlData.AnyArray.SliceSize := 5000;
+ ControlData.Counter := 1;
+ ControlData.Task := Task;
+ Randomize;
+
+ DoSendMessage(Task, 'Message', 'Adding 200.000 items...', ControlData.Counter);
+ SendSliceStructureData(@ControlData);
+
+ // add 200.000 integers
+ if not DoPushElements(@ControlData, 200000) then
+ Exit;
+
+ DoSendMessage(Task, 'Message', 'Deleting random items...', ControlData.Counter);
+ SendSliceStructureData(@ControlData);
+
+ // Delete 20.000 elements
+ if not DoDeleteElements(@ControlData, 30000) then
+ Exit;
+
+ DoSendMessage(Task, 'Message', 'Inserting random items...', ControlData.Counter);
+ SendSliceStructureData(@ControlData);
+ ControlData.ReplayData.Clear;
+
+ // Insert 20.000 elements
+ for I := 1 to (30000 div 2) + (Random(30000)) do
+ begin
+ if ControlData.ControlList.Count = 0 then
+ begin
+ Value := Random(1000000);
+ ControlData.AnyArray.Push(Value);
+ ControlData.ControlList.Add(Value);
+ ControlData.ReplayData.Add(Format('%d,%d', [0, Value]));
+ Continue;
+ end;
+
+ Index := Random(ControlData.AnyArray.Count - 1);
+ Value := Random(1000000);
+
+ ControlData.ReplayData.Add(Format('%d,%d', [Index, Value]));
+ ControlData.ControlList.Insert(Index, Value);
+ ControlData.AnyArray.Insert(Index, Value);
+ end;
+
+ // simulate that error occured durring an insert action
+ WriteDataToHardDrive(@ControlData, 'Insert', False, True);
+
+ // now reload the data to do the simulation
+ ControlData.ControlList.Clear;
+ ControlData.ReplayData.Clear;
+ ControlData.AnyArray.Clear;
+
+ // load the data from hard disk
+ DoLoadReplayData(@ControlData);
+
+ if not CheckReplayDataConsistency(@ControlData) then
+ Exit;
+
+ for I := 0 to ControlData.ReplayData.Count - 1 do
+ begin
+ if ControlData.ControlList.Count = 0 then
+ begin
+ Value := StrToInt(StrAfter(',', ControlData.ReplayData[I]));
+ ControlData.ControlList.Add(Value);
+ ControlData.AnyArray.Push(Value);
+ Continue;
+ end;
+
+ Index := StrToInt(StrBefore(',', ControlData.ReplayData[I]));
+ Value := StrToInt(StrAfter(',', ControlData.ReplayData[I]));
+ ControlData.ControlList.Insert(Index, Value);
+ ControlData.AnyArray.Insert(Index, Value);
+ end;
+
+ if not CheckReplayDataConsistency(@ControlData) then
+ Exit;
+
+ // all is ok, data is correct and consistent
+ DoSendMessage(Task, 'Message', 'Data is consistent on simulation.', ControlData.Counter);
+ finally
+ ControlData.ReplayData.Free;
+ end;
+ finally
+ ControlData.ControlList.Free;
+ end;
+ except
+ on E: Exception do
+ DoSendMessage(Task, 'Message', Format('Worker Thread error: %s', [E.Message]), -1);
+ end;
+end;
+
+procedure TfMain.OnStressTestMessage(const Msg: ITaskMessage);
+begin
+ if Msg.Values.Exists('Message') then
+ begin
+ lbArrayActions.Items.BeginUpdate;
+ try
+ lbArrayActions.Items.Add(Msg.Values.Get('Message').AsString);
+ lbArrayActions.ItemIndex := lbArrayActions.Count - 1;
+ Application.ProcessMessages;
+ finally
+ lbArrayActions.Items.EndUpdate;
+ end;
+ end
+ else if Msg.Values.Exists('SliceStructure') then
+ begin
+ lbSliceData.Items.BeginUpdate;
+ try
+ lbSliceData.Items.Text := Msg.Values.Get('SliceStructure').AsString;
+ lbNumSlicesValue.Caption := IntToStr(lbSliceData.Count);
+ Application.ProcessMessages;
+ finally
+ lbSliceData.Items.EndUpdate;
+ end;
+ end;
+end;
+
+procedure TfMain.SendSliceStructureData(const Data: PControlData);
+var
+ I: Integer;
+ ItemCount: Integer;
+ CurrentSlice: PArraySlice;
+ SliceDataList: TStringList;
+begin
+ SliceDataList := TStringList.Create;
+ try
+ for I := 0 to Data.AnyArray.SliceCount - 1 do
+ begin
+ CurrentSlice := Data.AnyArray.RawData^[I];
+ ItemCount := CurrentSlice.Last - CurrentSlice.Start;
+ SliceDataList.Add(Format('Slice %d: %d - %d [%d]', [CurrentSlice.Index,
+ CurrentSlice.Start,
+ CurrentSlice.Last,
+ ItemCount]));
+ end;
+
+ DoSendMessage(Data.Task, 'SliceStructure', SliceDataList.Text, 0);
+ finally
+ SliceDataList.Free;
+ end;
+end;
+
+procedure TfMain.tmCurrentTimeTimer(Sender: TObject);
+var
+ DeltaTime: TDateTime;
+begin
+ DeltaTime := Now - FStartTime;
+ lbRunningValue.Caption := FormatDateTime('hh:nn:ss', DeltaTime);
+end;
+
+procedure TfMain.WriteDataToHardDrive(const Data: PControlData; const Action: string; const Replay, Error: Boolean);
+var
+ K, I: Integer;
+ Value: Integer;
+ RootDir: string;
+ ListData: TStringList;
+ ArrayData: TFileStream;
+begin
+ ListData := TStringList.Create;
+ try
+ RootDir := ExtractFilePath(ParamStr(0));
+ ForceDirectories(RootDir + 'Data');
+
+ if (not Replay) and (not Error) then
+ begin
+ // save any array raw data
+ ArrayData := TFileStream.Create(RootDir + cFileAnyArrayData, fmCreate);
+ try
+ for K := 0 to Data.AnyArray.SliceCount - 1 do
+ begin
+ ArrayData.Write(Data.AnyArray.RawData^[K].Index, SizeOf(Integer));
+ ArrayData.Write(Data.AnyArray.RawData^[K].Start, SizeOf(Integer));
+ ArrayData.Write(Data.AnyArray.RawData^[K].Last, SizeOf(Integer));
+
+ for I := Data.AnyArray.RawData^[K].Start to Data.AnyArray.RawData^[K].Last - 1 do
+ begin
+ Value := Data.AnyArray.RawData^[K].Data[I].AsInteger;
+ ArrayData.Write(Value, SizeOf(Integer));
+ end;
+ end;
+ finally
+ ArrayData.Free;
+ end;
+
+ // save any array configuration
+ ListData.Values['SliceBufferMpl'] := FloatToStr(Data.AnyArray.SliceBufferMpl);
+ ListData.Values['SliceCount'] := IntToStr(Data.AnyArray.SliceCount);
+ ListData.Values['SliceSize'] := IntToStr(Data.AnyArray.SliceSize);
+ ListData.Values['ActionType'] := Action;
+ ListData.SaveToFile(cFileAnyArrayConf);
+ ListData.Clear;
+
+ for K := 0 to Data.ControlList.Count - 1 do
+ ListData.Add(IntToStr(Data.ControlList[K]));
+
+ ListData.SaveToFile(RootDir + cFileControlList);
+ ListData.Clear;
+ end;
+
+ if Error and not Replay then
+ Data.ReplayData.SaveToFile(RootDir + cFileReplayList);
+
+ if not Replay then
+ Data.ReplayData.Clear;
+ finally
+ ListData.Free;
+ end;
+end;
+
+procedure TfMain.WriteListsToHardDrive(const Data: PControlData);
+var
+ I: Integer;
+ RootDir: string;
+ ListData: TStringList;
+begin
+ ListData := TStringList.Create;
+ try
+ RootDir := ExtractFilePath(ParamStr(0));
+ ForceDirectories(RootDir + 'Data');
+
+ for I := 0 to Data.AnyArray.Count - 1 do
+ ListData.Add(Data.AnyArray[I].AsString);
+
+ ListData.SaveToFile(RootDir + cFileAnyArrayTextList);
+ ListData.Clear;
+
+ for I := 0 to Data.ControlList.Count - 1 do
+ ListData.Add(IntToStr(Data.ControlList[I]));
+
+ ListData.SaveToFile(RootDir + cFileControlTextList);
+ ListData.Clear;
+ finally
+ ListData.Free;
+ end;
+end;
+
+end.
diff --git a/Demos/Cromis.AnyArrray/StressTest.dpr b/Demos/Cromis.AnyArrray/StressTest.dpr
new file mode 100644
index 0000000..3007f48
--- /dev/null
+++ b/Demos/Cromis.AnyArrray/StressTest.dpr
@@ -0,0 +1,14 @@
+program StressTest;
+
+uses
+ Forms,
+ StressTest.Main in 'StressTest.Main.pas' {fMain};
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.MainFormOnTaskbar := True;
+ Application.CreateForm(TfMain, fMain);
+ Application.Run;
+end.
diff --git a/Demos/Cromis.AnyArrray/StressTest.dproj b/Demos/Cromis.AnyArrray/StressTest.dproj
new file mode 100644
index 0000000..3613f67
--- /dev/null
+++ b/Demos/Cromis.AnyArrray/StressTest.dproj
@@ -0,0 +1,106 @@
+
+
+ {13F1D1F9-3CDC-49AA-A558-751162DB3B6C}
+ 12.0
+ StressTest.dpr
+ Debug
+ DCC32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ StressTest.exe
+ 00400000
+ WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)
+ x86
+ false
+ false
+ false
+ false
+ false
+
+
+ false
+ RELEASE;$(DCC_Define)
+ 0
+ false
+
+
+ DEBUG;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+
+
+ Base
+
+
+ Cfg_2
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+
+ Delphi.Personality.12
+
+
+
+
+ StressTest.dpr
+
+
+ False
+ True
+ False
+
+
+ False
+ False
+ 1
+ 0
+ 0
+ 0
+ False
+ False
+ False
+ False
+ False
+ 1060
+ 1250
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+ 1.0.0.0
+
+
+
+
+ 12
+
+
diff --git a/Demos/Cromis.AnyArrray/StressTest.res b/Demos/Cromis.AnyArrray/StressTest.res
new file mode 100644
index 0000000..8b378d7
Binary files /dev/null and b/Demos/Cromis.AnyArrray/StressTest.res differ
diff --git a/Demos/Cromis.AnyValue/AnyValueDemo.bdsproj b/Demos/Cromis.AnyValue/AnyValueDemo.bdsproj
new file mode 100644
index 0000000..90ca7f3
--- /dev/null
+++ b/Demos/Cromis.AnyValue/AnyValueDemo.bdsproj
@@ -0,0 +1,175 @@
+
+
+
+
+
+
+
+
+
+
+
+ AnyValueDemo.dpr
+
+
+ 7.0
+
+
+ 8
+ 0
+ 1
+ 1
+ 0
+ 0
+ 1
+ 1
+ 1
+ 0
+ 0
+ 1
+ 0
+ 1
+ 1
+ 1
+ 0
+ 0
+ 0
+ 0
+ 0
+ 1
+ 0
+ 1
+ 1
+ 1
+ True
+ True
+ WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+
+ False
+
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ False
+ False
+ False
+ True
+ True
+ True
+ True
+ True
+ True
+
+
+
+ 0
+ 0
+ False
+ 1
+ False
+ False
+ False
+ 16384
+ 1048576
+ 4194304
+
+
+
+
+
+
+
+
+
+ AnyValue_HookingOff
+
+ False
+
+
+
+
+
+ False
+
+
+ True
+ False
+
+
+
+ $00000000
+
+
+
+ False
+ False
+ 1
+ 0
+ 0
+ 0
+ False
+ False
+ False
+ False
+ False
+ 1060
+ 1250
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+ 1.0.0.0
+
+
+
+
diff --git a/Demos/Cromis.AnyValue/AnyValueDemo.dpr b/Demos/Cromis.AnyValue/AnyValueDemo.dpr
new file mode 100644
index 0000000..e4ffc8c
--- /dev/null
+++ b/Demos/Cromis.AnyValue/AnyValueDemo.dpr
@@ -0,0 +1,13 @@
+program AnyValueDemo;
+
+uses
+ Forms,
+ MainForm in 'MainForm.pas' {fMain};
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TfMain, fMain);
+ Application.Run;
+end.
diff --git a/Demos/Cromis.AnyValue/AnyValueDemo.dproj b/Demos/Cromis.AnyValue/AnyValueDemo.dproj
new file mode 100644
index 0000000..d930904
--- /dev/null
+++ b/Demos/Cromis.AnyValue/AnyValueDemo.dproj
@@ -0,0 +1,108 @@
+
+
+ {F1FAE6DF-0CCF-405E-949C-2C235BF71097}
+ 12.0
+ AnyValueDemo.dpr
+ Debug
+ DCC32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ true
+ AnyValueDemo.exe
+ 00400000
+ WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)
+ x86
+ false
+ false
+ false
+ false
+ false
+
+
+ false
+ RELEASE;$(DCC_Define)
+ 0
+ false
+
+
+ DEBUG;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+
+
+ Base
+
+
+ Cfg_2
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+
+ Delphi.Personality.12
+
+
+
+
+ AnyValueDemo.dpr
+
+
+ False
+ True
+ False
+
+
+ False
+ False
+ 1
+ 0
+ 0
+ 0
+ False
+ False
+ False
+ False
+ False
+ 1060
+ 1250
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+ 1.0.0.0
+
+
+
+
+ 12
+
+
diff --git a/Demos/Cromis.AnyValue/AnyValueDemo.res b/Demos/Cromis.AnyValue/AnyValueDemo.res
new file mode 100644
index 0000000..8b378d7
Binary files /dev/null and b/Demos/Cromis.AnyValue/AnyValueDemo.res differ
diff --git a/Demos/Cromis.AnyValue/MainForm.dfm b/Demos/Cromis.AnyValue/MainForm.dfm
new file mode 100644
index 0000000..3218e81
--- /dev/null
+++ b/Demos/Cromis.AnyValue/MainForm.dfm
@@ -0,0 +1,372 @@
+object fMain: TfMain
+ Left = 0
+ Top = 0
+ BorderIcons = [biSystemMenu]
+ BorderStyle = bsSingle
+ Caption = 'fMain'
+ ClientHeight = 672
+ ClientWidth = 994
+ Color = clBtnFace
+ Constraints.MinHeight = 700
+ Constraints.MinWidth = 1000
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ PixelsPerInch = 96
+ TextHeight = 13
+ object pcAnyValue: TPageControl
+ Left = 0
+ Top = 0
+ Width = 994
+ Height = 672
+ ActivePage = tsAnyArrayDemo
+ Align = alClient
+ TabOrder = 0
+ object tsAnyValueDemo: TTabSheet
+ Caption = 'tsAnyValueDemo'
+ object lbTestAnyValue: TListBox
+ Left = 288
+ Top = 4
+ Width = 693
+ Height = 637
+ ItemHeight = 13
+ TabOrder = 0
+ end
+ object btnTestAnyValue: TButton
+ Left = 72
+ Top = 24
+ Width = 105
+ Height = 41
+ Caption = 'Test AnyValue'
+ TabOrder = 1
+ OnClick = btnTestAnyValueClick
+ end
+ end
+ object tsAnyArrayDemo: TTabSheet
+ Caption = 'tsAnyArrayDemo'
+ ImageIndex = 1
+ object lbAnyValue: TListBox
+ Left = 263
+ Top = 3
+ Width = 570
+ Height = 475
+ ItemHeight = 13
+ TabOrder = 0
+ end
+ object gbAnyArray: TGroupBox
+ Left = 6
+ Top = 4
+ Width = 251
+ Height = 635
+ Caption = 'Any Array'
+ TabOrder = 1
+ object btnCreateArray: TButton
+ Left = 16
+ Top = 24
+ Width = 105
+ Height = 25
+ Caption = 'Create Array'
+ TabOrder = 0
+ OnClick = btnCreateArrayClick
+ end
+ object btnPushItems: TButton
+ Left = 16
+ Top = 54
+ Width = 105
+ Height = 25
+ Caption = 'Push Items'
+ Enabled = False
+ TabOrder = 1
+ OnClick = btnPushItemsClick
+ end
+ object btnPopItem: TButton
+ Left = 16
+ Top = 114
+ Width = 105
+ Height = 25
+ Caption = 'Pop Item'
+ Enabled = False
+ TabOrder = 2
+ OnClick = btnPopItemClick
+ end
+ object btnSliceArray: TButton
+ Left = 16
+ Top = 144
+ Width = 105
+ Height = 25
+ Caption = 'Slice Array'
+ Enabled = False
+ TabOrder = 3
+ OnClick = btnSliceArrayClick
+ end
+ object btnIndexOf: TButton
+ Left = 16
+ Top = 174
+ Width = 105
+ Height = 25
+ Caption = 'IndexOf'
+ Enabled = False
+ TabOrder = 4
+ OnClick = btnIndexOfClick
+ end
+ object btnContains: TButton
+ Left = 16
+ Top = 204
+ Width = 105
+ Height = 25
+ Caption = 'Contains'
+ Enabled = False
+ TabOrder = 5
+ OnClick = btnContainsClick
+ end
+ object eCreateArray: TEdit
+ Left = 144
+ Top = 26
+ Width = 45
+ Height = 21
+ TabOrder = 6
+ Text = '1,5,3,8'
+ end
+ object ePushItems: TEdit
+ Left = 144
+ Top = 57
+ Width = 91
+ Height = 21
+ TabOrder = 7
+ Text = '2,5,9'
+ end
+ object eSliceArray: TEdit
+ Left = 144
+ Top = 146
+ Width = 91
+ Height = 21
+ TabOrder = 8
+ Text = '2,6'
+ end
+ object eIndexOf: TEdit
+ Left = 144
+ Top = 176
+ Width = 91
+ Height = 21
+ TabOrder = 9
+ Text = '5'
+ end
+ object eContains: TEdit
+ Left = 144
+ Top = 206
+ Width = 91
+ Height = 21
+ TabOrder = 10
+ Text = '5'
+ end
+ object btnReverseItems: TButton
+ Left = 16
+ Top = 84
+ Width = 105
+ Height = 25
+ Caption = 'Reverse Items'
+ Enabled = False
+ TabOrder = 11
+ OnClick = btnReverseItemsClick
+ end
+ object btnSortASC: TButton
+ Left = 16
+ Top = 234
+ Width = 105
+ Height = 25
+ Caption = 'Sort ASC'
+ Enabled = False
+ TabOrder = 12
+ OnClick = btnSortASCClick
+ end
+ object btnSortDSC: TButton
+ Left = 16
+ Top = 264
+ Width = 105
+ Height = 25
+ Caption = 'Sort DSC'
+ Enabled = False
+ TabOrder = 13
+ OnClick = btnSortDSCClick
+ end
+ object btnClone: TButton
+ Left = 16
+ Top = 294
+ Width = 105
+ Height = 25
+ Caption = 'Clone Array'
+ Enabled = False
+ TabOrder = 14
+ OnClick = btnCloneClick
+ end
+ object btnDeleteItem: TButton
+ Left = 16
+ Top = 324
+ Width = 105
+ Height = 25
+ Caption = 'Delete item'
+ Enabled = False
+ TabOrder = 15
+ OnClick = btnDeleteItemClick
+ end
+ object eDeleteItem: TEdit
+ Left = 144
+ Top = 326
+ Width = 91
+ Height = 21
+ TabOrder = 16
+ Text = '5'
+ end
+ object btnClear: TButton
+ Left = 16
+ Top = 354
+ Width = 105
+ Height = 25
+ Caption = 'Clear Array'
+ Enabled = False
+ TabOrder = 17
+ OnClick = btnClearClick
+ end
+ object btnStreamOps: TButton
+ Left = 16
+ Top = 414
+ Width = 105
+ Height = 25
+ Caption = 'Stream ops'
+ Enabled = False
+ TabOrder = 18
+ OnClick = btnStreamOpsClick
+ end
+ object btnAddArrays: TButton
+ Left = 16
+ Top = 384
+ Width = 105
+ Height = 25
+ Caption = 'Add Arrays'
+ Enabled = False
+ TabOrder = 19
+ OnClick = btnAddArraysClick
+ end
+ object btnAddNamedValue: TButton
+ Left = 16
+ Top = 444
+ Width = 105
+ Height = 25
+ Caption = 'Add Named Val.'
+ Enabled = False
+ TabOrder = 20
+ OnClick = btnAddNamedValueClick
+ end
+ object eAddNamedValue: TEdit
+ Left = 144
+ Top = 446
+ Width = 91
+ Height = 21
+ TabOrder = 21
+ Text = 'Delphi,XE3'
+ end
+ object btnFindNamedValue: TButton
+ Left = 16
+ Top = 474
+ Width = 105
+ Height = 25
+ Caption = 'Find Named Val.'
+ Enabled = False
+ TabOrder = 22
+ OnClick = btnFindNamedValueClick
+ end
+ object eFindNamedValue: TEdit
+ Left = 144
+ Top = 476
+ Width = 91
+ Height = 21
+ TabOrder = 23
+ Text = 'Delphi'
+ end
+ object btnInsert: TButton
+ Left = 16
+ Top = 504
+ Width = 105
+ Height = 25
+ Caption = 'Insert Items'
+ Enabled = False
+ TabOrder = 24
+ OnClick = btnInsertClick
+ end
+ object eInsertItems: TEdit
+ Left = 144
+ Top = 506
+ Width = 91
+ Height = 21
+ TabOrder = 25
+ Text = '2,7,3'
+ end
+ object eSliceSize: TEdit
+ Left = 193
+ Top = 26
+ Width = 42
+ Height = 21
+ TabOrder = 26
+ Text = '10'
+ end
+ object btnUnshiftItems: TButton
+ Left = 16
+ Top = 534
+ Width = 105
+ Height = 25
+ Caption = 'Unshift Items'
+ Enabled = False
+ TabOrder = 27
+ OnClick = btnUnshiftItemsClick
+ end
+ object btnShiftItem: TButton
+ Left = 16
+ Top = 564
+ Width = 105
+ Height = 25
+ Caption = 'Shift Item'
+ Enabled = False
+ TabOrder = 28
+ OnClick = btnShiftItemClick
+ end
+ object eUnshiftItems: TEdit
+ Left = 144
+ Top = 536
+ Width = 91
+ Height = 21
+ TabOrder = 29
+ Text = '6,8,1'
+ end
+ object btnEnumerate: TButton
+ Left = 16
+ Top = 594
+ Width = 105
+ Height = 25
+ Caption = 'Enumerate'
+ Enabled = False
+ TabOrder = 30
+ OnClick = btnEnumerateClick
+ end
+ end
+ object lbSliceInfo: TListBox
+ Left = 836
+ Top = 3
+ Width = 147
+ Height = 475
+ ItemHeight = 13
+ TabOrder = 2
+ end
+ object lbSliceData: TListBox
+ Left = 263
+ Top = 484
+ Width = 720
+ Height = 155
+ ItemHeight = 13
+ TabOrder = 3
+ end
+ end
+ end
+end
diff --git a/Demos/Cromis.AnyValue/MainForm.pas b/Demos/Cromis.AnyValue/MainForm.pas
new file mode 100644
index 0000000..dba2622
--- /dev/null
+++ b/Demos/Cromis.AnyValue/MainForm.pas
@@ -0,0 +1,381 @@
+unit MainForm;
+
+interface
+
+uses
+ Windows, SysUtils, Variants, Classes, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Math,
+
+ // cromis units
+ Cromis.AnyValue, Cromis.StringUtils;
+
+type
+ TfMain = class(TForm)
+ pcAnyValue: TPageControl;
+ tsAnyValueDemo: TTabSheet;
+ tsAnyArrayDemo: TTabSheet;
+ lbAnyValue: TListBox;
+ gbAnyArray: TGroupBox;
+ btnCreateArray: TButton;
+ btnPushItems: TButton;
+ btnPopItem: TButton;
+ btnSliceArray: TButton;
+ btnIndexOf: TButton;
+ btnContains: TButton;
+ eCreateArray: TEdit;
+ ePushItems: TEdit;
+ eSliceArray: TEdit;
+ eIndexOf: TEdit;
+ eContains: TEdit;
+ btnReverseItems: TButton;
+ btnSortASC: TButton;
+ btnSortDSC: TButton;
+ btnClone: TButton;
+ btnDeleteItem: TButton;
+ eDeleteItem: TEdit;
+ btnClear: TButton;
+ btnStreamOps: TButton;
+ btnAddArrays: TButton;
+ btnAddNamedValue: TButton;
+ eAddNamedValue: TEdit;
+ btnFindNamedValue: TButton;
+ eFindNamedValue: TEdit;
+ lbTestAnyValue: TListBox;
+ btnTestAnyValue: TButton;
+ btnInsert: TButton;
+ eInsertItems: TEdit;
+ eSliceSize: TEdit;
+ lbSliceInfo: TListBox;
+ lbSliceData: TListBox;
+ btnUnshiftItems: TButton;
+ btnShiftItem: TButton;
+ eUnshiftItems: TEdit;
+ btnEnumerate: TButton;
+ procedure btnCreateArrayClick(Sender: TObject);
+ procedure btnPushItemsClick(Sender: TObject);
+ procedure btnPopItemClick(Sender: TObject);
+ procedure btnSliceArrayClick(Sender: TObject);
+ procedure btnIndexOfClick(Sender: TObject);
+ procedure btnContainsClick(Sender: TObject);
+ procedure btnSortDSCClick(Sender: TObject);
+ procedure btnSortASCClick(Sender: TObject);
+ procedure btnReverseItemsClick(Sender: TObject);
+ procedure btnCloneClick(Sender: TObject);
+ procedure btnDeleteItemClick(Sender: TObject);
+ procedure btnClearClick(Sender: TObject);
+ procedure btnStreamOpsClick(Sender: TObject);
+ procedure btnAddArraysClick(Sender: TObject);
+ procedure btnAddNamedValueClick(Sender: TObject);
+ procedure btnFindNamedValueClick(Sender: TObject);
+ procedure btnTestAnyValueClick(Sender: TObject);
+ procedure btnInsertClick(Sender: TObject);
+ procedure btnUnshiftItemsClick(Sender: TObject);
+ procedure btnShiftItemClick(Sender: TObject);
+ procedure btnEnumerateClick(Sender: TObject);
+ private
+ FAnyArray: IAnyArray;
+ procedure UpdateArrayInfo(const AnyArray: IAnyArray);
+ end;
+
+var
+ fMain: TfMain;
+
+implementation
+
+{$R *.dfm}
+
+procedure TfMain.btnCloneClick(Sender: TObject);
+begin
+ lbAnyValue.Items.Add(FAnyArray.Clone.GetAsString);
+end;
+
+procedure TfMain.btnContainsClick(Sender: TObject);
+begin
+ lbAnyValue.Items.Add(BoolToStr(FAnyArray.Contains(eIndexOf.Text), True));
+end;
+
+procedure TfMain.btnCreateArrayClick(Sender: TObject);
+var
+ I: Integer;
+begin
+ FAnyArray := CreateAnyArray(StrToInt(eSliceSize.Text));
+ FAnyArray.ArrayMode := amSlicedArray;
+ FAnyArray.SliceBufferMpl := 1.5;
+
+ FAnyArray.Push(eCreateArray.Text, ',');
+ UpdateArrayInfo(FAnyArray);
+
+ for I := 0 to fMain.ComponentCount - 1 do
+ if fMain.Components[I].ClassType = TButton then
+ TButton(fMain.Components[I]).Enabled := True;
+end;
+
+procedure TfMain.btnDeleteItemClick(Sender: TObject);
+begin
+ FAnyArray.DeleteValue(eDeleteItem.Text);
+ UpdateArrayInfo(FAnyArray);
+end;
+
+procedure TfMain.btnEnumerateClick(Sender: TObject);
+var
+ Element: PAnyValue;
+ TempList: TStringList;
+begin
+ TempList := TStringList.Create;
+ try
+ for Element in FAnyArray.Enum.Forward do
+ TempList.Add(Element.AsString);
+ lbAnyValue.Items.Add(TempList.CommaText);
+ TempList.Clear;
+
+ for Element in FAnyArray.Enum.Reverse do
+ TempList.Add(Element.AsString);
+ lbAnyValue.Items.Add(TempList.CommaText);
+ TempList.Clear;
+ finally
+ TempList.Free;
+ end;
+end;
+
+procedure TfMain.btnFindNamedValueClick(Sender: TObject);
+var
+ Value: TAnyValue;
+begin
+ Value := FAnyArray.FindNamed(eFindNamedValue.Text);
+ lbAnyValue.Items.Add(Value.AsString);
+end;
+
+procedure TfMain.btnIndexOfClick(Sender: TObject);
+begin
+ lbAnyValue.Items.Add(IntToStr(FAnyArray.IndexOf(eIndexOf.Text)));
+end;
+
+procedure TfMain.btnInsertClick(Sender: TObject);
+begin
+ FAnyArray.Insert(2, eInsertItems.Text, ',');
+ UpdateArrayInfo(FAnyArray);
+end;
+
+procedure TfMain.btnPopItemClick(Sender: TObject);
+begin
+ FAnyArray.Pop;
+ UpdateArrayInfo(FAnyArray);
+end;
+
+procedure TfMain.btnPushItemsClick(Sender: TObject);
+begin
+ FAnyArray.Push(ePushItems.Text, ',');
+ UpdateArrayInfo(FAnyArray);
+end;
+
+procedure TfMain.btnReverseItemsClick(Sender: TObject);
+begin
+ FAnyArray.Reverse;
+ UpdateArrayInfo(FAnyArray);
+end;
+
+procedure TfMain.btnShiftItemClick(Sender: TObject);
+begin
+ FAnyArray.Shift;
+ UpdateArrayInfo(FAnyArray);
+end;
+
+procedure TfMain.btnSliceArrayClick(Sender: TObject);
+var
+ SlicedArray: IAnyArray;
+begin
+ SlicedArray := FAnyArray.Slice(StrToInt(StrBefore(',', eSliceArray.Text)),
+ StrToInt(StrAfter(',', eSliceArray.Text)));
+ UpdateArrayInfo(SlicedArray);
+end;
+
+{$IF CompilerVersion < 20}
+function SortASC(Item1, Item2: PAnyValue): Integer;
+begin
+ Result := StrToInt64Def(Item1.AsString, -1) - StrToInt64Def(Item2.AsString, -1);
+end;
+
+function SortDSC(Item1, Item2: PAnyValue): Integer;
+begin
+ Result := StrToInt64Def(Item2.AsString, -1) - StrToInt64Def(Item1.AsString, -1);
+end;
+{$IFEND}
+
+procedure TfMain.btnSortASCClick(Sender: TObject);
+begin
+{$IF CompilerVersion >= 20}
+ FAnyArray.Sort
+ (
+ function(Item1, Item2: PAnyValue): Integer
+ begin
+ Result := StrToInt64Def(Item1.AsString, -1) - StrToInt64Def(Item2.AsString, -1);
+ end
+ );
+ UpdateArrayInfo(FAnyArray);
+{$ELSE}
+ FAnyArray.Sort(SortASC);
+{$IFEND}
+end;
+
+procedure TfMain.btnSortDSCClick(Sender: TObject);
+begin
+{$IF CompilerVersion >= 20}
+ FAnyArray.Sort
+ (
+ function(Item1, Item2: PAnyValue): Integer
+ begin
+ Result := StrToInt64Def(Item2.AsString, -1) - StrToInt64Def(Item1.AsString, -1);
+ end
+ );
+ UpdateArrayInfo(FAnyArray);
+{$ELSE}
+ FAnyArray.Sort(SortDSC);
+{$IFEND}
+end;
+
+procedure TfMain.btnStreamOpsClick(Sender: TObject);
+var
+ MS: TMemoryStream;
+ SecondArray: IAnyArray;
+begin
+ MS := TMemoryStream.Create;
+ try
+ FAnyArray.SaveToStream(MS);
+ MS.Seek(0, soFromBeginning);
+ SecondArray := CreateAnyArray;
+ SecondArray.LoadFromStream(MS);
+ UpdateArrayInfo(SecondArray);
+ finally
+ MS.Free;
+ end;
+end;
+
+procedure TfMain.btnTestAnyValueClick(Sender: TObject);
+var
+ AnyValue: TAnyValue;
+ DummyValue: TAnyValue;
+ TestVariant: Variant;
+begin
+ lbTestAnyValue.Clear;
+ AnyValue.AsInteger := High(Integer);
+ DummyValue.AsInteger := AnyValue.AsInteger;
+ lbTestAnyValue.Items.Add(Format('AnyValue as Integer: %s', [DummyValue.AsString]));
+ AnyValue.AsFloat := MaxExtended;
+ DummyValue.AsFloat := AnyValue.AsFloat;
+ lbTestAnyValue.Items.Add(Format('AnyValue as Float: %s', [DummyValue.AsString]));
+ AnyValue.AsDouble := MaxDouble;
+ DummyValue.AsDouble := AnyValue.AsDouble;
+ lbTestAnyValue.Items.Add(Format('AnyValue as Double: %s',[DummyValue.AsString]));
+ AnyValue.AsString := 'string';
+ DummyValue.AsString := AnyValue.AsString;
+ lbTestAnyValue.Items.Add(Format('AnyValue as string: %s', [DummyValue.AsString]));
+{$IFDEF UNICODE}
+ AnyValue.AsAnsiString := 'AnsiString';
+ DummyValue.AsAnsiString := AnyValue.AsAnsiString;
+ lbTestAnyValue.Items.Add(Format('AnyValue as AnsiString: %s', [DummyValue.AsString]));
+{$ENDIF}
+ AnyValue.AsWideString := 'WideString';
+ DummyValue.AsWideString := AnyValue.AsWideString;
+ lbTestAnyValue.Items.Add(Format('AnyValue as WideString: %s', [DummyValue.AsString]));
+ AnyValue.AsDateTime := Now;
+ DummyValue.AsDateTime := AnyValue.AsDateTime;
+ lbTestAnyValue.Items.Add(Format('AnyValue as DateTime: %s', [DummyValue.AsString]));
+ AnyValue.AsInt64 := High(Int64);
+ DummyValue.AsInt64 := AnyValue.AsInt64;
+ lbTestAnyValue.Items.Add(Format('AnyValue as Int64: %s', [DummyValue.AsString]));
+ AnyValue.AsBoolean := True;
+ DummyValue.AsBoolean := AnyValue.AsBoolean;
+ lbTestAnyValue.Items.Add(Format('AnyValue as Boolean: %s', [DummyValue.AsString]));
+ AnyValue.AsCardinal := High(Cardinal);
+ DummyValue.AsCardinal := AnyValue.AsCardinal;
+ lbTestAnyValue.Items.Add(Format('AnyValue as Cardinal: %s', [DummyValue.AsString]));
+ AnyValue.AsPointer := btnTestAnyValue;
+ DummyValue.AsPointer := AnyValue.AsPointer;
+ lbTestAnyValue.Items.Add(Format('AnyValue as Pointer: %s', [DummyValue.AsString]));
+ AnyValue.AsObject := btnTestAnyValue;
+ DummyValue.AsObject := AnyValue.AsObject;
+ lbTestAnyValue.Items.Add(Format('AnyValue as Object: %s', [DummyValue.AsString]));
+ TestVariant := High(Integer);
+ AnyValue.AsVariant := TestVariant;
+ DummyValue.AsVariant := AnyValue.AsVariant;
+ lbTestAnyValue.Items.Add(Format('AnyValue as Variant: %s', [DummyValue.AsString]));
+{$IF CompilerVersion >= 20}
+ AnyValue.EnsureAsArray.Push([5, 1.3, Now]);
+{$ELSE}
+ AnyValue.EnsureAsArray.Push([5, 1.3, DateTimeToStr(Now)]);
+{$IFEND}
+ DummyValue.EnsureAsArray.Assign(AnyValue.GetAsArray);
+ lbTestAnyValue.Items.Add(Format('AnyValue as Array: %s', [DummyValue.AsString]));
+ AnyValue.EnsureAsArray.Clear;
+ AnyValue['Name'] := 'Value';
+ DummyValue.EnsureAsArray.Assign(AnyValue.GetAsArray);
+ lbTestAnyValue.Items.Add(Format('AnyValue as NamedValue: %s', [DummyValue.AsString]));
+end;
+
+procedure TfMain.btnUnshiftItemsClick(Sender: TObject);
+begin
+ FAnyArray.Unshift(eUnshiftItems.Text, ',');
+ UpdateArrayInfo(FAnyArray);
+end;
+
+procedure TfMain.UpdateArrayInfo(const AnyArray: IAnyArray);
+var
+ I, K: Integer;
+ SliceData: TStringList;
+ CurrentSlice: PArraySlice;
+begin
+ lbAnyValue.Items.Add(AnyArray.GetAsString);
+
+ lbSliceInfo.Clear;
+ lbSliceData.Clear;
+
+ SliceData := TStringList.Create;
+ try
+ lbSliceInfo.Items.Add(Format('Count %d:', [FAnyArray.Count]));
+
+ for I := 0 to FAnyArray.SliceCount - 1 do
+ begin
+ CurrentSlice := FAnyArray.RawData^[I];
+ lbSliceInfo.Items.Add(Format('Slice %d: %d - %d', [CurrentSlice.Index,
+ CurrentSlice.Start,
+ CurrentSlice.Last]));
+ SliceData.Clear;
+
+ for K := 0 to Length(CurrentSlice.Data) - 1 do
+ begin
+ case CurrentSlice.Data[K].GetValueType of
+ avtNone: SliceData.Add('NA');
+ else
+ SliceData.Add(CurrentSlice.Data[K].AsString);
+ end;
+ end;
+
+ lbSliceData.Items.Add(SliceData.CommaText);
+ end;
+ finally
+ SliceData.Free;
+ end;
+
+ Application.ProcessMessages;
+end;
+
+procedure TfMain.btnAddArraysClick(Sender: TObject);
+begin
+ FAnyArray.Push([5, '4.5', AnyValues([7, '5', 3, AnyValues([1.2, 3, '5'])])]);
+ UpdateArrayInfo(FAnyArray);
+end;
+
+procedure TfMain.btnAddNamedValueClick(Sender: TObject);
+begin
+ FAnyArray.AddNamed(StrBefore(',', eAddNamedValue.Text), StrAfter(',', eAddNamedValue.Text));
+ UpdateArrayInfo(FAnyArray);
+end;
+
+procedure TfMain.btnClearClick(Sender: TObject);
+begin
+ FAnyArray.Clear;
+ lbAnyValue.Clear;
+ lbSliceInfo.Clear;
+ lbSliceData.Clear;
+end;
+
+end.
diff --git a/Demos/Cromis.DirectoryWatch/DirectoryWatch.bdsproj b/Demos/Cromis.DirectoryWatch/DirectoryWatch.bdsproj
new file mode 100644
index 0000000..430ec43
--- /dev/null
+++ b/Demos/Cromis.DirectoryWatch/DirectoryWatch.bdsproj
@@ -0,0 +1,175 @@
+
+
+
+
+
+
+
+
+
+
+
+ DirectoryWatch.dpr
+
+
+ 7.0
+
+
+ 8
+ 0
+ 1
+ 1
+ 0
+ 0
+ 1
+ 1
+ 1
+ 0
+ 0
+ 1
+ 0
+ 1
+ 1
+ 1
+ 0
+ 0
+ 0
+ 0
+ 0
+ 1
+ 0
+ 1
+ 1
+ 1
+ True
+ True
+ WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+
+ False
+
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ False
+ False
+ False
+ True
+ True
+ True
+ True
+ True
+ True
+
+
+
+ 0
+ 0
+ False
+ 1
+ False
+ False
+ False
+ 16384
+ 1048576
+ 4194304
+
+
+
+
+
+
+
+
+
+
+
+ False
+
+
+
+
+
+ False
+
+
+ True
+ False
+
+
+
+ $00000000
+
+
+
+ False
+ False
+ 1
+ 0
+ 0
+ 0
+ False
+ False
+ False
+ False
+ False
+ 1060
+ 1250
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+ 1.0.0.0
+
+
+
+
diff --git a/Demos/Cromis.DirectoryWatch/DirectoryWatch.dpr b/Demos/Cromis.DirectoryWatch/DirectoryWatch.dpr
new file mode 100644
index 0000000..167aef4
--- /dev/null
+++ b/Demos/Cromis.DirectoryWatch/DirectoryWatch.dpr
@@ -0,0 +1,13 @@
+program DirectoryWatch;
+
+uses
+ Forms,
+ f_Main in 'f_Main.pas' {fMain};
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TfMain, fMain);
+ Application.Run;
+end.
diff --git a/Demos/Cromis.DirectoryWatch/DirectoryWatch.dproj b/Demos/Cromis.DirectoryWatch/DirectoryWatch.dproj
new file mode 100644
index 0000000..5fc1ddf
--- /dev/null
+++ b/Demos/Cromis.DirectoryWatch/DirectoryWatch.dproj
@@ -0,0 +1,105 @@
+
+
+ {0509AD44-44A2-4AD7-B632-BA255E8C6498}
+ 12.0
+ DirectoryWatch.dpr
+ Debug
+ DCC32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)
+ DirectoryWatch.exe
+ 00400000
+ x86
+
+
+ false
+ RELEASE;$(DCC_Define)
+ 0
+ false
+
+
+ DEBUG;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+
+
+ Base
+
+
+ Cfg_2
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+
+ Delphi.Personality.12
+
+
+
+
+ DirectoryWatch.dpr
+
+
+ False
+ True
+ False
+
+
+ False
+ False
+ 1
+ 0
+ 0
+ 0
+ False
+ False
+ False
+ False
+ False
+ 1060
+ 1250
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+ 1.0.0.0
+
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ 12
+
+
diff --git a/Demos/Cromis.DirectoryWatch/DirectoryWatch.res b/Demos/Cromis.DirectoryWatch/DirectoryWatch.res
new file mode 100644
index 0000000..c0cdd1a
Binary files /dev/null and b/Demos/Cromis.DirectoryWatch/DirectoryWatch.res differ
diff --git a/Demos/Cromis.DirectoryWatch/DirectoryWatch_Icon.ico b/Demos/Cromis.DirectoryWatch/DirectoryWatch_Icon.ico
new file mode 100644
index 0000000..379ec80
Binary files /dev/null and b/Demos/Cromis.DirectoryWatch/DirectoryWatch_Icon.ico differ
diff --git a/Demos/Cromis.DirectoryWatch/f_Main.dfm b/Demos/Cromis.DirectoryWatch/f_Main.dfm
new file mode 100644
index 0000000..b457039
--- /dev/null
+++ b/Demos/Cromis.DirectoryWatch/f_Main.dfm
@@ -0,0 +1,98 @@
+object fMain: TfMain
+ Left = 0
+ Top = 0
+ BorderStyle = bsDialog
+ Caption = 'fMain'
+ ClientHeight = 453
+ ClientWidth = 629
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poScreenCenter
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ PixelsPerInch = 96
+ TextHeight = 13
+ object lvWatchActions: TListView
+ AlignWithMargins = True
+ Left = 3
+ Top = 3
+ Width = 623
+ Height = 400
+ Margins.Bottom = 1
+ Align = alClient
+ Columns = <
+ item
+ Caption = 'Type'
+ Width = 150
+ end
+ item
+ Caption = 'FileName'
+ Width = 450
+ end>
+ TabOrder = 0
+ ViewStyle = vsReport
+ end
+ object pnBottom: TPanel
+ AlignWithMargins = True
+ Left = 3
+ Top = 407
+ Width = 623
+ Height = 43
+ Align = alBottom
+ BevelOuter = bvNone
+ BorderStyle = bsSingle
+ Color = clWhite
+ Ctl3D = False
+ ParentBackground = False
+ ParentCtl3D = False
+ TabOrder = 1
+ object sbSelectDirectory: TSpeedButton
+ Left = 327
+ Top = 10
+ Width = 23
+ Height = 21
+ Caption = '...'
+ OnClick = sbSelectDirectoryClick
+ end
+ object eDirectoryName: TEdit
+ Left = 7
+ Top = 11
+ Width = 314
+ Height = 19
+ TabOrder = 0
+ OnDblClick = eDirectoryNameDblClick
+ end
+ object cbWatchSubdirectories: TCheckBox
+ Left = 364
+ Top = 12
+ Width = 122
+ Height = 17
+ Caption = 'Watch Subdirectories'
+ TabOrder = 1
+ end
+ object btnStop: TButton
+ Left = 557
+ Top = 8
+ Width = 60
+ Height = 25
+ Caption = 'Stop'
+ Enabled = False
+ TabOrder = 2
+ OnClick = btnStopClick
+ end
+ object btnStart: TButton
+ Left = 494
+ Top = 8
+ Width = 61
+ Height = 25
+ Caption = 'Start'
+ TabOrder = 3
+ OnClick = btnStartClick
+ end
+ end
+end
diff --git a/Demos/Cromis.DirectoryWatch/f_Main.pas b/Demos/Cromis.DirectoryWatch/f_Main.pas
new file mode 100644
index 0000000..1b3b6d0
--- /dev/null
+++ b/Demos/Cromis.DirectoryWatch/f_Main.pas
@@ -0,0 +1,114 @@
+unit f_Main;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, ComCtrls, ExtCtrls, Buttons, StdCtrls, FileCtrl, TypInfo,
+
+ // cromis units
+ Cromis.DirectoryWatch, Cromis.Unicode;
+
+type
+ TfMain = class(TForm)
+ lvWatchActions: TListView;
+ pnBottom: TPanel;
+ eDirectoryName: TEdit;
+ sbSelectDirectory: TSpeedButton;
+ cbWatchSubdirectories: TCheckBox;
+ btnStop: TButton;
+ btnStart: TButton;
+ procedure sbSelectDirectoryClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure btnStopClick(Sender: TObject);
+ procedure btnStartClick(Sender: TObject);
+ procedure eDirectoryNameDblClick(Sender: TObject);
+ private
+ FDirectoryWatch: TDirectoryWatch;
+ procedure SelectWatchDirectory;
+ procedure OnError(const Sender: TObject;
+ const ErrorCode: Integer;
+ const ErrorMessage: ustring);
+ procedure OnNotify(const Sender: TObject;
+ const Action: TWatchAction;
+ const FileName: ustring);
+ end;
+
+var
+ fMain: TfMain;
+
+implementation
+
+{$R *.dfm}
+
+procedure TfMain.btnStartClick(Sender: TObject);
+begin
+ FDirectoryWatch.WatchSubTree := cbWatchSubdirectories.Checked;
+ FDirectoryWatch.Directory := eDirectoryName.Text;
+ FDirectoryWatch.Start;
+
+ btnStart.Enabled := False;
+ btnStop.Enabled := True;
+end;
+
+procedure TfMain.btnStopClick(Sender: TObject);
+begin
+ FDirectoryWatch.Stop;
+
+ btnStart.Enabled := True;
+ btnStop.Enabled := False;
+end;
+
+procedure TfMain.eDirectoryNameDblClick(Sender: TObject);
+begin
+ SelectWatchDirectory;
+end;
+
+procedure TfMain.FormCreate(Sender: TObject);
+begin
+ FDirectoryWatch := TDirectoryWatch.Create;
+ FDirectoryWatch.OnNotify := OnNotify;
+ FDirectoryWatch.OnError := OnError;
+end;
+
+procedure TfMain.FormDestroy(Sender: TObject);
+begin
+ FreeAndNil(FDirectoryWatch);
+end;
+
+procedure TfMain.OnError(const Sender: TObject; const ErrorCode: Integer; const ErrorMessage: ustring);
+begin
+ ShowMessage(Format('Error with code %d and description: %s', [ErrorCode, ErrorMessage]));
+end;
+
+procedure TfMain.OnNotify(const Sender: TObject;
+ const Action: TWatchAction;
+ const FileName: ustring);
+var
+ ListItem: TListItem;
+begin
+ lvWatchActions.Items.BeginUpdate;
+ try
+ ListItem := lvWatchActions.Items.Add;
+ ListItem.Caption := GetEnumName(TypeInfo(TWatchAction), Integer(Action)) ;
+ ListItem.SubItems.Add(FileName);
+ finally
+ lvWatchActions.Items.EndUpdate;
+ end;
+end;
+
+procedure TfMain.sbSelectDirectoryClick(Sender: TObject);
+begin
+ SelectWatchDirectory;
+end;
+
+procedure TfMain.SelectWatchDirectory;
+var
+ Dir: String;
+begin
+ SelectDirectory('Select a directory to monitor', '', Dir);
+ eDirectoryName.Text := Dir;
+end;
+
+end.