瀏覽代碼

* implemented HashSet and Map

master
bergmann 10 年之前
父節點
當前提交
4f43d5b548
共有 10 個檔案被更改,包括 2205 行新增 和 1225 行删除
  1. +21
    -1
      tests/tests.lpi
  2. +2
    -1
      tests/tests.lpr
  3. +209
    -91
      tests/tests.lps
  4. +122
    -0
      tests/uutlHashSetTests.pas
  5. +408
    -0
      tests/uutlInterfaces.pas
  6. +63
    -46
      tests/uutlLinkedListTests.pas
  7. +312
    -0
      tests/uutlMapTests.pas
  8. +70
    -2
      uutlAlgorithm.pas
  9. +4
    -457
      uutlCommon.pas
  10. +994
    -627
      uutlGenerics.pas

+ 21
- 1
tests/tests.lpi 查看文件

@@ -37,7 +37,7 @@
<PackageName Value="FCL"/>
</Item3>
</RequiredPackages>
<Units Count="7">
<Units Count="12">
<Unit0>
<Filename Value="tests.lpr"/>
<IsPartOfProject Value="True"/>
@@ -66,6 +66,26 @@
<Filename Value="uutlLinkedListTests.pas"/>
<IsPartOfProject Value="True"/>
</Unit6>
<Unit7>
<Filename Value="..\uutlGenerics.pas"/>
<IsPartOfProject Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\uutlCommon.pas"/>
<IsPartOfProject Value="True"/>
</Unit8>
<Unit9>
<Filename Value="uutlInterfaces.pas"/>
<IsPartOfProject Value="True"/>
</Unit9>
<Unit10>
<Filename Value="uutlHashSetTests.pas"/>
<IsPartOfProject Value="True"/>
</Unit10>
<Unit11>
<Filename Value="uutlMapTests.pas"/>
<IsPartOfProject Value="True"/>
</Unit11>
</Units>
</ProjectOptions>
<CompilerOptions>


+ 2
- 1
tests/tests.lpr 查看文件

@@ -3,7 +3,8 @@ program tests;
{$mode objfpc}{$H+}

uses
Interfaces, Forms, GUITestRunner, uutlQueueTests, uutlStackTests, uutlListTest, uutlAlgorithm, uutlLinkedListTests;
Interfaces, Forms, GUITestRunner,
uutlQueueTests, uutlStackTests, uutlListTest, uutlLinkedListTests, uutlHashSetTests, uutlMapTests;

{$R *.res}



+ 209
- 91
tests/tests.lps 查看文件

@@ -2,208 +2,326 @@
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="10"/>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="20">
<Units Count="26">
<Unit0>
<Filename Value="tests.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="2"/>
<CursorPos X="12" Y="11"/>
<UsageCount Value="29"/>
<Loaded Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos X="7" Y="6"/>
<UsageCount Value="39"/>
</Unit0>
<Unit1>
<Filename Value="uutlQueueTests.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="234"/>
<CursorPos X="14" Y="244"/>
<UsageCount Value="29"/>
<CursorPos Y="12"/>
<UsageCount Value="39"/>
</Unit1>
<Unit2>
<Filename Value="uTestHelper.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="60"/>
<CursorPos Y="69"/>
<UsageCount Value="29"/>
<CursorPos X="16" Y="12"/>
<UsageCount Value="39"/>
</Unit2>
<Unit3>
<Filename Value="uutlStackTests.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="23"/>
<CursorPos X="33" Y="38"/>
<UsageCount Value="29"/>
<CursorPos X="75" Y="17"/>
<UsageCount Value="39"/>
</Unit3>
<Unit4>
<Filename Value="uutlListTest.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="24"/>
<CursorPos X="6" Y="33"/>
<UsageCount Value="29"/>
<CursorPos X="27" Y="16"/>
<UsageCount Value="39"/>
</Unit4>
<Unit5>
<Filename Value="..\uutlAlgorithm.pas"/>
<IsPartOfProject Value="True"/>
<CursorPos X="72" Y="10"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="13"/>
<CursorPos X="68" Y="29"/>
<UsageCount Value="33"/>
</Unit5>
<Unit6>
<Filename Value="uutlLinkedListTests.pas"/>
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="249"/>
<CursorPos X="27" Y="259"/>
<UsageCount Value="22"/>
<EditorIndex Value="2"/>
<TopLine Value="267"/>
<CursorPos X="29" Y="284"/>
<UsageCount Value="32"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="..\uutlGenerics.pas"/>
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="1184"/>
<CursorPos Y="1199"/>
<UsageCount Value="15"/>
<TopLine Value="225"/>
<CursorPos X="26" Y="245"/>
<UsageCount Value="30"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\uutlCommon.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="21"/>
<CursorPos Y="41"/>
<UsageCount Value="28"/>
</Unit8>
<Unit9>
<Filename Value="uutlInterfaces.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="118"/>
<CursorPos X="28" Y="139"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
<Filename Value="uutlHashSetTests.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="90"/>
<CursorPos X="29" Y="115"/>
<UsageCount Value="27"/>
</Unit10>
<Unit11>
<Filename Value="..\test.lpr"/>
<EditorIndex Value="-1"/>
<TopLine Value="55"/>
<CursorPos Y="72"/>
<UsageCount Value="10"/>
</Unit8>
<Unit9>
<UsageCount Value="9"/>
</Unit11>
<Unit12>
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\TestFramework.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="427"/>
<CursorPos X="3" Y="394"/>
<UsageCount Value="14"/>
</Unit9>
<Unit10>
<UsageCount Value="13"/>
</Unit12>
<Unit13>
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\FPCUnitCompatibleInterface.inc"/>
<EditorIndex Value="-1"/>
<EditorIndex Value="3"/>
<TopLine Value="54"/>
<CursorPos Y="69"/>
<UsageCount Value="12"/>
</Unit10>
<Unit11>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
<Filename Value="G:\Eigene Datein\Projekte\Delphi\TotoStarRedesign\utils\uutlGenerics.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="105"/>
<CursorPos X="17" Y="109"/>
<UsageCount Value="10"/>
</Unit11>
<Unit12>
<TopLine Value="527"/>
<UsageCount Value="12"/>
</Unit14>
<Unit15>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\fgl.pp"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="544"/>
<CursorPos X="15" Y="562"/>
<UsageCount Value="15"/>
</Unit12>
<Unit13>
<UsageCount Value="14"/>
</Unit15>
<Unit16>
<Filename Value="G:\Eigene Datein\Projekte\Delphi\TotoStarRedesign\utils\uutlInterfaces.pas"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="59"/>
<CursorPos Y="17"/>
<UsageCount Value="15"/>
</Unit13>
<Unit14>
<TopLine Value="69"/>
<CursorPos Y="88"/>
<UsageCount Value="14"/>
</Unit16>
<Unit17>
<Filename Value="..\uutlExceptions.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<CursorPos X="3" Y="15"/>
<UsageCount Value="11"/>
</Unit14>
<Unit15>
<UsageCount Value="10"/>
</Unit17>
<Unit18>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\inc\objpash.inc"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="437"/>
<CursorPos X="5" Y="453"/>
<UsageCount Value="10"/>
</Unit15>
<Unit16>
<UsageCount Value="9"/>
</Unit18>
<Unit19>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\inc\objpas.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="999"/>
<CursorPos X="19" Y="1017"/>
<UsageCount Value="10"/>
</Unit16>
<Unit17>
<UsageCount Value="9"/>
</Unit19>
<Unit20>
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\TestFrameworkIfaces.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="36"/>
<CursorPos X="3" Y="51"/>
<UsageCount Value="10"/>
</Unit17>
<Unit18>
<UsageCount Value="9"/>
</Unit20>
<Unit21>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\intfh.inc"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="6"/>
<CursorPos X="26" Y="18"/>
<UsageCount Value="10"/>
</Unit18>
<Unit19>
<UsageCount Value="9"/>
</Unit21>
<Unit22>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\sysuintf.inc"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="15"/>
<CursorPos X="3" Y="17"/>
<UsageCount Value="9"/>
</Unit22>
<Unit23>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\inc\systemh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="770"/>
<CursorPos X="11" Y="785"/>
<UsageCount Value="11"/>
</Unit23>
<Unit24>
<Filename Value="G:\Eigene Datein\Projekte\Delphi\TotoStarRedesign\utils\uutlObservableGenerics.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="115"/>
<CursorPos X="32" Y="101"/>
<UsageCount Value="10"/>
</Unit19>
</Unit24>
<Unit25>
<Filename Value="uutlMapTests.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos X="9" Y="24"/>
<UsageCount Value="23"/>
</Unit25>
</Units>
<JumpHistory Count="10" HistoryIndex="9">
<JumpHistory Count="29" HistoryIndex="28">
<Position1>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="247" TopLine="235"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1485" TopLine="1470"/>
</Position1>
<Position2>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="251" TopLine="235"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1486" TopLine="1470"/>
</Position2>
<Position3>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="252" TopLine="235"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1487" TopLine="1470"/>
</Position3>
<Position4>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="253" TopLine="235"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1217" TopLine="1202"/>
</Position4>
<Position5>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="254" TopLine="235"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1219" TopLine="1202"/>
</Position5>
<Position6>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="255" TopLine="235"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1220" TopLine="1202"/>
</Position6>
<Position7>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="256" TopLine="235"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="1221" TopLine="1202"/>
</Position7>
<Position8>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="257" TopLine="235"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="478" Column="83" TopLine="464"/>
</Position8>
<Position9>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="258" TopLine="235"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="71" Column="25" TopLine="60"/>
</Position9>
<Position10>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="241" TopLine="235"/>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="97" Column="60" TopLine="74"/>
</Position10>
<Position11>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="93" Column="77" TopLine="74"/>
</Position11>
<Position12>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="73" Column="15" TopLine="69"/>
</Position12>
<Position13>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="123" Column="35" TopLine="105"/>
</Position13>
<Position14>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="641" Column="24" TopLine="618"/>
</Position14>
<Position15>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="130" Column="40" TopLine="111"/>
</Position15>
<Position16>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="138" Column="34" TopLine="111"/>
</Position16>
<Position17>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="265" Column="24" TopLine="241"/>
</Position17>
<Position18>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="171" Column="30" TopLine="150"/>
</Position18>
<Position19>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="188" Column="23" TopLine="173"/>
</Position19>
<Position20>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="194" Column="22" TopLine="173"/>
</Position20>
<Position21>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="266" Column="49" TopLine="247"/>
</Position21>
<Position22>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="39" Column="32" TopLine="24"/>
</Position22>
<Position23>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="282" Column="29" TopLine="259"/>
</Position23>
<Position24>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="96" Column="14" TopLine="81"/>
</Position24>
<Position25>
<Filename Value="..\uutlGenerics.pas"/>
<Caret Line="19" Column="5" TopLine="3"/>
</Position25>
<Position26>
<Filename Value="uutlInterfaces.pas"/>
<Caret Line="169" Column="35" TopLine="151"/>
</Position26>
<Position27>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="279" Column="78" TopLine="263"/>
</Position27>
<Position28>
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\FPCUnitCompatibleInterface.inc"/>
<Caret Line="69" TopLine="54"/>
</Position28>
<Position29>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="290" Column="27" TopLine="264"/>
</Position29>
</JumpHistory>
</ProjectSession>
<Debugging>


+ 122
- 0
tests/uutlHashSetTests.pas 查看文件

@@ -0,0 +1,122 @@
unit uutlHashSetTests;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, TestFramework,
uutlGenerics;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TIntSet = specialize TutlHastSet<Integer>;
TutlHastSetTests = class(TTestCase)
private
fIntSet: TIntSet;

protected
procedure SetUp; override;
procedure TearDown; override;

published
procedure Prop_Count;

procedure Meth_Add;
procedure Meth_Contains;
procedure Meth_IndexOf;
procedure Meth_Remove;
procedure Meth_Delete;
end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlHastSetTests//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHastSetTests.SetUp;
begin
fIntSet := TIntSet.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHastSetTests.TearDown;
begin
FreeAndNil(fIntSet);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHastSetTests.Prop_Count;
begin
AssertEquals(0, fIntSet.Count);
fIntSet.Add(123);
AssertEquals(1, fIntSet.Count);
fIntSet.Add(234);
AssertEquals(2, fIntSet.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHastSetTests.Meth_Add;
begin
AssertTrue (fIntSet.Add(123));
AssertFalse(fIntSet.Add(123));
AssertTrue (fIntSet.Add(234));
AssertFalse(fIntSet.Add(234));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHastSetTests.Meth_Contains;
begin
AssertFalse(fIntSet.Contains(123));
fIntSet.Add(123);
AssertTrue (fIntSet.Contains(123));

AssertFalse(fIntSet.Contains(234));
fIntSet.Add(234);
AssertTrue (fIntSet.Contains(234));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHastSetTests.Meth_IndexOf;
begin
AssertEquals(-1, fIntSet.IndexOf(234));
fIntSet.Add(234);
AssertEquals(0, fIntSet.IndexOf(234));

AssertEquals(-1, fIntSet.IndexOf(345));
fIntSet.Add(345);
AssertEquals(0, fIntSet.IndexOf(234));
AssertEquals(1, fIntSet.IndexOf(345));

AssertEquals(-1, fIntSet.IndexOf(123));
fIntSet.Add(123);
AssertEquals(0, fIntSet.IndexOf(123));
AssertEquals(1, fIntSet.IndexOf(234));
AssertEquals(2, fIntSet.IndexOf(345));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHastSetTests.Meth_Remove;
begin
AssertFalse(fIntSet.Remove(123));
fIntSet.Add(123);
AssertTrue(fIntSet.Remove(123));

AssertFalse(fIntSet.Remove(234));
fIntSet.Add(234);
AssertTrue(fIntSet.Remove(234));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlHastSetTests.Meth_Delete;
begin
fIntSet.Add(123);
fIntSet.Delete(0);
AssertTrue(fIntSet.IsEmpty);
end;

initialization
RegisterTest(TutlHastSetTests.Suite);

end.


+ 408
- 0
tests/uutlInterfaces.pas 查看文件

@@ -0,0 +1,408 @@
unit uutlInterfaces;

{$mode objfpc}{$H+}
{$modeswitch nestedprocvars}

interface

uses
Classes, SysUtils;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Container/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlEnumerator<T> = interface(specialize IEnumerator<T>)
['{134FAC2F-3F23-4BD8-88FB-4B3BD2253E03}']
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlEnumerable<T> = interface(specialize IEnumerable<T>)
['{B6B43A0E-754C-43D0-829A-6632F922A2DE}']
function GetUtlEnumerator: specialize IutlEnumerator<T>;

property Enumerator: specialize IutlEnumerator<T> read GetUtlEnumerator;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlReadOnlyIndexer<T> = interface(IUnknown)
['{9E502CF8-3223-4784-8DB7-614187FFFE68}']
function GetCount: Integer;
function GetItem(const aIndex: Integer): T;

property Count: Integer read GetCount;
property Items[const aIndex: Integer]: T read GetItem;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlIndexer<T> = interface(specialize IutlReadOnlyIndexer<T>)
['{4CA50BE2-A1DF-48BE-9E83-0C94015BA873}']
procedure SetItem(const aIndex: Integer; aItem: T);

property Items[const aIndex: Integer]: T read GetItem write SetItem;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Comparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlEqualityComparer<T> = interface(IUnknown)
['{C0FB90CC-D071-490F-BFEE-BAA5C94D1A5B}']
function EqualityCompare(constref i1, i2: T): Boolean;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlComparer<T> = interface(specialize IutlEqualityComparer<T>)
['{7D2EC014-2878-4F60-9E43-4CFB54268995}']
function Compare(constref i1, i2: T): Integer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlEqualityComparer<T> = class(TInterfacedObject, specialize IutlEqualityComparer<T>)
public
function EqualityCompare(constref i1, i2: T): Boolean;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlEqualityCompareEvent<T> = function(constref i1, i2: T): Boolean;
generic TutlEqualityCompareEventO<T> = function(constref i1, i2: T): Boolean of object;
generic TutlEqualityCompareEventN<T> = function(constref i1, i2: T): Boolean is nested;

generic TutlCalbackEqualityComparer<T> = class(TInterfacedObject, specialize IutlEqualityComparer<T>)
private type
TEqualityCompareEventType = (eetNormal, eetObject, eetNested);

public type
TCompareEvent = specialize TutlEqualityCompareEvent<T>;
TCompareEventO = specialize TutlEqualityCompareEventO<T>;
TCompareEventN = specialize TutlEqualityCompareEventN<T>;

strict private
fType: TEqualityCompareEventType;
fEvent: TCompareEvent;
fEventO: TCompareEventO;
fEventN: TCompareEventN;

public
function EqualityCompare(constref i1, i2: T): Boolean;

{ HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks }
constructor Create(const aEvent: TCompareEvent);
constructor Create(const aEvent: TCompareEventO);
constructor Create(const aEvent: TCompareEventN);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlComparer<T> = class(specialize TutlEqualityComparer<T>, specialize IutlComparer<T>)
public
function Compare(constref i1, i2: T): Integer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlCompareEvent<T> = function(constref i1, i2: T): Integer;
generic TutlCompareEventO<T> = function(constref i1, i2: T): Integer of object;
generic TutlCompareEventN<T> = function(constref i1, i2: T): Integer is nested;

generic TutlCallbackComparer<T> = class(TInterfacedObject, specialize IutlComparer<T>)
private type
TCompareEventType = (cetNormal, cetObject, cetNested);

public type
TCompareEvent = specialize TutlCompareEvent<T>;
TCompareEventO = specialize TutlCompareEventO<T>;
TCompareEventN = specialize TutlCompareEventN<T>;

strict private
fType: TCompareEventType;
fEvent: TCompareEvent;
fEventO: TCompareEventO;
fEventN: TCompareEventN;

public
function Compare(constref i1, i2: T): Integer;
function EqualityCompare(constref i1, i2: T): Boolean;

{ HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks }
constructor Create(const aEvent: TCompareEvent);
constructor Create(const aEvent: TCompareEventO);
constructor Create(const aEvent: TCompareEventN);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Iterators/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
IutlIterator = interface(IUnknown)
['{327E7628-C9D8-4C47-9630-E979D9C3293D}']
function MoveNext: Boolean;
function Clone: IutlIterator;
function Equals(const aOther: IutlIterator): Boolean;
function GetIsValid: Boolean;

property IsValid: Boolean read GetIsValid;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
IutlBidirectionalIterator = interface(IutlIterator)
['{31D1E828-52CC-467F-8254-2C1384B28DEE}']
function MovePrev: Boolean;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
IutlRandomAccessIterator = interface(IutlBidirectionalIterator)
['{AE06BAB6-BB17-4E46-AE88-583EB853233E}']
function Increment (const aCount: Integer): Boolean;
function Decrement (const aCount: Integer): Boolean;
function Compare (constref aOther: IutlRandomAccessIterator): Integer;
function GetDifference(constref aOther: IutlRandomAccessIterator): Integer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlInputIterator<T> = interface(IutlIterator)
['{BD4ED39B-2BBA-41F7-BDC7-E1B45F41AA84}']
function GetItem: T;

property Item: T read GetItem;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlOutputIterator<T> = interface(IutlIterator)
['{132642C1-5235-4450-8956-2092D3F2F83D}']
procedure SetItem(aValue: T);

property Item: T write SetItem;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlInputOutputIterator<T> = interface(IutlIterator)
['{5367DA1F-F98C-4EE7-A454-E8978E2A9B46}']
function GetItem: T;
procedure SetItem(aValue: T);

property Item: T read GetItem write SetItem;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlBidirectionalInputIterator<T> = interface(IutlBidirectionalIterator)
['{B2423828-F187-4620-8DA2-9C4EF68B81E3}']
function GetItem: T;

property Item: T read GetItem;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlBidirectionalOutputIterator<T> = interface(IutlBidirectionalIterator)
['{1A13E581-200B-41E7-BC7D-9AD5192DEF0F}']
procedure SetItem(aValue: T);

property Item: T write SetItem;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlBidirectionalInputOutputIterator<T> = interface(IutlBidirectionalIterator)
['{BD8A6D08-7980-45D1-86A6-838402F5CBA6}']
function GetItem: T;
procedure SetItem(aItem: T);

property Item: T read GetItem write SetItem;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlRandomAccessInputIterator<T> = interface(IutlRandomAccessIterator)
['{47880DCC-49D4-45C7-90CB-D8E915B7CB0D}']
function GetItem: T;
function GetItems(const aIndex: Integer): T;

property Item: T read GetItem;
property Items[const aIndex: Integer]: T read GetItems;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlRandomAccessOutputIterator<T> = interface(IutlRandomAccessIterator)
['{E768DA58-E666-47F1-B7D8-61EB6C33C379}']
procedure SetItem(aValue: T);
procedure SetItems(const aIndex: Integer; aValue: T);

property Item: T write SetItem;
property Items[const aIndex: Integer]: T write SetItems;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlRandomAccessInputOutputIterator<T> = interface(IutlRandomAccessIterator)
['{3A8D3C5D-1085-4073-B1D4-DF1886827B6A}']
function GetItem: T;
function GetItems(const aIndex: Integer): T;

procedure SetItem (const aValue: T);
procedure SetItems(const aIndex: Integer; aValue: T);

property Item: T read GetItem write SetItem;
property Items[const aIndex: Integer]: T read GetItems write SetItems;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function IncIt(aIterator: IutlIterator): Boolean; overload;
function DecIt(aIterator: IutlBidirectionalIterator): Boolean; overload;
function IncIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean; overload;
function DecIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean; overload;
operator +(aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator;
operator -(aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator;
operator < (const i1, i2: TObject): Boolean; inline;
operator > (const i1, i2: TObject): Boolean; inline;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function IncIt(aIterator: IutlIterator): Boolean;
begin
result := aIterator.MoveNext;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function DecIt(aIterator: IutlBidirectionalIterator): Boolean;
begin
result := aIterator.MovePrev;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function IncIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean;
begin
result := aIterator.Increment(a);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function DecIt(aIterator: IutlRandomAccessIterator; const a: Integer): Boolean;
begin
result := aIterator.Decrement(a);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator + (aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator;
begin
result := IutlRandomAccessIterator(aIterator.Clone);
result.Increment(a);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator - (aIterator: IutlRandomAccessIterator; const a: Integer): IutlRandomAccessIterator;
begin
result := IutlRandomAccessIterator(aIterator.Clone);
result.Decrement(a);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator < (const i1, i2: TObject): Boolean;
begin
result := Pointer(i1) < Pointer(i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
operator > (const i1, i2: TObject): Boolean;
begin
result := Pointer(i1) > Pointer(i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEqualityComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
begin
result := (i1 = i2);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCalbackEqualityComparer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCalbackEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
begin
case fType of
eetNormal: result := fEvent (i1, i2);
eetObject: result := fEventO(i1, i2);
eetNested: result := fEventN(i1, i2);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEvent);
begin
inherited Create;
fType := eetNormal;
fEvent := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEventO);
begin
inherited Create;
fType := eetObject;
fEventO := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCalbackEqualityComparer.Create(const aEvent: TCompareEventN);
begin
inherited Create;
fType := eetNested;
fEventN := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlComparer.Compare(constref i1, i2: T): Integer;
begin
if (i1 < i2) then
result := -1
else if (i1 > i2) then
result := 1
else
result := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCallbackComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCallbackComparer.Compare(constref i1, i2: T): Integer;
begin
case fType of
cetNormal: result := fEvent (i1, i2);
cetObject: result := fEventO(i1, i2);
cetNested: result := fEventN(i1, i2);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCallbackComparer.EqualityCompare(constref i1, i2: T): Boolean;
begin
result := (Compare(i1, i2) = 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackComparer.Create(const aEvent: TCompareEvent);
begin
inherited Create;
fType := cetNormal;
fEvent := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackComparer.Create(const aEvent: TCompareEventO);
begin
inherited Create;
fType := cetObject;
fEventO := aEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackComparer.Create(const aEvent: TCompareEventN);
begin
inherited Create;
fType := cetNested;
fEventN := aEvent;
end;

end.


+ 63
- 46
tests/uutlLinkedListTests.pas 查看文件

@@ -6,7 +6,7 @@ interface

uses
Classes, SysUtils, TestFramework,
uTestHelper, uutlGenerics, uutlExceptions;
uutlGenerics, uutlExceptions;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -36,6 +36,7 @@ type
procedure Meth_Clear;

procedure Iterator;
procedure CompleteIteration;
end;

implementation
@@ -92,46 +93,40 @@ end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Prop_First;
var
i: TIntList.Iterator;
begin
AssertException('empty list does not raise exception when accessing First property', EutlInvalidOperation, @AccessPropFirst);
fIntList.PushLast(123);
fIntList.PushLast(234);
i := fIntList.First;
AssertEquals(123, i.Value);
AssertEquals(123, fIntList.First);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Prop_Last;
var
i: TIntList.Iterator;
begin
AssertException('empty list does not raise exception when accessing First property', EutlInvalidOperation, @AccessPropLast);
fIntList.PushLast(123);
fIntList.PushLast(234);
i := fIntList.Last;
AssertEquals(234, i.Value);
AssertEquals(234, fIntList.Last);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Meth_PushFirst_PopFirst;
begin
fIntList.PushFirst(123);
AssertEquals(123, fIntList.First.Value);
AssertEquals(123, fIntList.First);
fIntList.PushFirst(234);
AssertEquals(234, fIntList.First.Value);
AssertEquals(234, fIntList.First);
fIntList.PushFirst(345);
AssertEquals(345, fIntList.First.Value);
AssertEquals(345, fIntList.First);
fIntList.PushFirst(456);
AssertEquals(456, fIntList.First.Value);
AssertEquals(456, fIntList.First);

AssertEquals(456, fIntList.PopFirst(false));
AssertEquals(345, fIntList.First.Value);
AssertEquals(345, fIntList.First);
AssertEquals( 0, fIntList.PopFirst(true));
AssertEquals(234, fIntList.First.Value);
AssertEquals(234, fIntList.First);
AssertEquals(234, fIntList.PopFirst(false));
AssertEquals(123, fIntList.First.Value);
AssertEquals(123, fIntList.First);
AssertEquals( 0, fIntList.PopFirst(true));
end;

@@ -139,20 +134,20 @@ end;
procedure TutlLinkedListTests.Meth_PushLast_PopLast;
begin
fIntList.PushLast(123);
AssertEquals(123, fIntList.Last.Value);
AssertEquals(123, fIntList.Last);
fIntList.PushLast(234);
AssertEquals(234, fIntList.Last.Value);
AssertEquals(234, fIntList.Last);
fIntList.PushLast(345);
AssertEquals(345, fIntList.Last.Value);
AssertEquals(345, fIntList.Last);
fIntList.PushLast(456);
AssertEquals(456, fIntList.Last.Value);
AssertEquals(456, fIntList.Last);

AssertEquals(456, fIntList.PopLast(false));
AssertEquals(345, fIntList.Last.Value);
AssertEquals(345, fIntList.Last);
AssertEquals( 0, fIntList.PopLast(true));
AssertEquals(234, fIntList.Last.Value);
AssertEquals(234, fIntList.Last);
AssertEquals(234, fIntList.PopLast(false));
AssertEquals(123, fIntList.Last.Value);
AssertEquals(123, fIntList.Last);
AssertEquals( 0, fIntList.PopLast(true));
end;

@@ -166,16 +161,16 @@ begin
fIntList.PushLast(345);
fIntList.PushLast(456);

it := fIntList.First;
it := fIntList.FirstIterator;
fIntList.InsertBefore(it, 999);
AssertTrue(it.MovePrev);
AssertEquals(999, it.Value);
AssertEquals(999, it.Item);
AssertEquals(5, fIntList.Count);

it := fIntList.Last;
it := fIntList.LastIterator;
fIntList.InsertBefore(it, 888);
AssertTrue(it.MovePrev);
AssertEquals(888, it.Value);
AssertEquals(888, it.Item);
AssertEquals(6, fIntList.Count);
end;

@@ -189,16 +184,16 @@ begin
fIntList.PushLast(345);
fIntList.PushLast(456);

it := fIntList.First;
it := fIntList.FirstIterator;
fIntList.InsertAfter(it, 999);
AssertTrue(it.MoveNext);
AssertEquals(999, it.Value);
AssertEquals(999, it.Item);
AssertEquals(5, fIntList.Count);

it := fIntList.Last;
it := fIntList.LastIterator;
fIntList.InsertAfter(it, 888);
AssertTrue(it.MoveNext);
AssertEquals(888, it.Value);
AssertEquals(888, it.Item);
AssertEquals(6, fIntList.Count);
end;

@@ -212,12 +207,12 @@ begin
fIntList.PushLast(345);
fIntList.PushLast(456);

it := fIntList.First;
it := fIntList.FirstIterator;
it.MoveNext;
fIntList.Remove(it);

AssertEquals(3, fIntList.Count);
AssertEquals(123, fIntList.First.Value);
AssertEquals(123, fIntList.First);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -244,35 +239,57 @@ begin
fIntList.PushLast(345);
fIntList.PushLast(456);

it1 := fIntList.First;
AssertEquals(123, it1.Value);
it1 := fIntList.FirstIterator;
AssertEquals(123, it1.Item);
AssertTrue (it1.IsValid);
AssertTrue (it1.Equals(fIntList.First));
AssertTrue (it1.Equals(fIntList.FirstIterator));
AssertTrue (it1.MoveNext);
AssertEquals(234, it1.Value);
AssertEquals(234, it1.Item);
AssertTrue (it1.MoveNext);
AssertEquals(345, it1.Value);
AssertEquals(345, it1.Item);
AssertTrue (it1.MoveNext);
AssertEquals(456, it1.Value);
AssertTrue (it1.Equals(fIntList.Last));
AssertEquals(456, it1.Item);
AssertTrue (it1.Equals(fIntList.LastIterator));
AssertFalse (it1.MoveNext);
fIntList.PopLast;
AssertFalse (it1.IsValid);

it1 := fIntList.Last;
AssertEquals(345, it1.Value);
it1 := fIntList.LastIterator;
AssertEquals(345, it1.Item);
AssertTrue (it1.IsValid);
AssertTrue (it1.Equals(fIntList.Last));
AssertTrue (it1.Equals(fIntList.LastIterator));
AssertTrue (it1.MovePrev);
AssertEquals(234, it1.Value);
AssertEquals(234, it1.Item);
AssertTrue (it1.MovePrev);
AssertEquals(123, it1.Value);
AssertTrue (it1.Equals(fIntList.First));
AssertEquals(123, it1.Item);
AssertTrue (it1.Equals(fIntList.FirstIterator));
AssertFalse (it1.MovePrev);
fIntList.PopFirst;
AssertFalse (it1.IsValid);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.CompleteIteration;
var
i: Integer;
it, itEnd: TIntList.Iterator;
begin
for i := 0 to 10 do
fIntList.PushLast(i);

i := 0;
it := fIntList.FirstIterator;
itEnd := fIntList.LastIterator;
AssertTrue(itEnd.MovePrev);
repeat
AssertEquals(i, it.Item);
inc(i);
until not it.MoveNext or it.Equals(itEnd);

AssertTrue(it.MoveNext);
AssertEquals(10, it.Item);
end;

initialization
RegisterTest(TutlLinkedListTests.Suite);



+ 312
- 0
tests/uutlMapTests.pas 查看文件

@@ -0,0 +1,312 @@
unit uutlMapTests;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, TestFramework,
uTestHelper, uutlGenerics;

type
TIntMap = specialize TutlMap<Integer, Integer>;
TObjMap = specialize TutlMap<TIntfObj, TIntfObj>;
TutlMapTests = class(TIntfObjOwner)
private
fIntMap: TIntMap;
fObjMap: TObjMap;

procedure AssignNonExistsingItem;

protected
procedure SetUp; override;
procedure TearDown; override;

published
procedure Prop_Values;
procedure Prop_ValuesAt;
procedure Prop_Keys;
procedure Prop_KeyValuePairs;

procedure Prop_Count;
procedure Prop_IsEmpty;
procedure Prop_Capacity;
procedure Prop_CanShrink;
procedure Prop_CanExpand;
procedure Prop_OwnsKeys;
procedure Prop_OwnsValues;
procedure Prop_AutoCreate;

procedure Meth_Add;
procedure Meth_TryGetValue;
procedure Meth_IndexOf;
procedure Meth_Contains;
procedure Meth_Delete;
procedure Meth_DeleteAt;
procedure Meth_Clear;
end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMapTests//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.AssignNonExistsingItem;
begin
fIntMap[999] := 123;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.SetUp;
begin
inherited SetUp;
fIntMap := TIntMap.Create(true, true);
fObjMap := TObjMap.Create(true, true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.TearDown;
begin
FreeAndNil(fIntMap);
FreeAndNil(fObjMap);
inherited TearDown;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_Values;
begin
fIntMap.Add(123, 987);
fIntMap.Add(234, 876);
AssertEquals(987, fIntMap[123]);
AssertEquals(876, fIntMap[234]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_ValuesAt;
begin
fIntMap.Add(123, 987);
fIntMap.Add(234, 876);
AssertEquals(987, fIntMap.ValueAt[0]);
AssertEquals(876, fIntMap.ValueAt[1]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_Keys;
begin
fIntMap.Add(123, 987);
fIntMap.Add(234, 876);
AssertEquals(2, fIntMap.Keys.Count);
AssertEquals(123, fIntMap.Keys[0]);
AssertEquals(234, fIntMap.Keys[1]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_KeyValuePairs;
begin
fIntMap.Add(123, 987);
fIntMap.Add(234, 876);
AssertEquals(2, fIntMap.KeyValuePairs.Count);
AssertEquals(123, fIntMap.KeyValuePairs[0].Key);
AssertEquals(987, fIntMap.KeyValuePairs[0].Value);
AssertEquals(234, fIntMap.KeyValuePairs[1].Key);
AssertEquals(876, fIntMap.KeyValuePairs[1].Value);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_Count;
begin
AssertEquals(0, fIntMap.Count);
fIntMap.Add(123, 987);
AssertEquals(1, fIntMap.Count);
fIntMap.Add(234, 876);
AssertEquals(2, fIntMap.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_IsEmpty;
begin
AssertTrue(fIntMap.IsEmpty);
fIntMap.Add(123, 987);
AssertFalse(fIntMap.IsEmpty);
fIntMap.Add(234, 876);
AssertFalse(fIntMap.IsEmpty);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_Capacity;
begin
AssertEquals(0, fIntMap.Capacity);
fIntMap.Capacity := 10;
AssertEquals(10, fIntMap.Capacity);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_CanShrink;
begin
AssertTrue(fIntMap.CanShrink);
fIntMap.CanShrink := false;
AssertFalse(fIntMap.CanShrink);
fIntMap.CanShrink := true;
AssertTrue(fIntMap.CanShrink);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_CanExpand;
begin
AssertTrue(fIntMap.CanExpand);
fIntMap.CanExpand := false;
AssertFalse(fIntMap.CanExpand);
fIntMap.CanExpand := true;
AssertTrue(fIntMap.CanExpand);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_OwnsKeys;
var
obj: TIntfObj;
begin
AssertTrue(fObjMap.OwnsKeys);
fObjMap.OwnsKeys := false;
AssertFalse(fObjMap.OwnsKeys);

obj := TIntfObj.Create(self);
fObjMap.Add(obj, nil);
fObjMap.Delete(obj);
AssertEquals(1, IntfObjCounter);
FreeAndNil(obj);
AssertEquals(0, IntfObjCounter);

fObjMap.OwnsKeys := true;
AssertTrue(fObjMap.OwnsKeys);

obj := TIntfObj.Create(self);
fObjMap.Add(obj, nil);
fObjMap.Delete(obj);
AssertEquals(0, IntfObjCounter);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_OwnsValues;
var
key: TIntfObj;
obj: TIntfObj;
begin
key := TIntfObj.Create(self);

AssertTrue(fObjMap.OwnsValues);
fObjMap.OwnsValues := false;
AssertFalse(fObjMap.OwnsValues);

obj := TIntfObj.Create(self);
fObjMap.Add(key, obj);
fObjMap.Delete(key);
AssertEquals(1, IntfObjCounter);
FreeAndNil(obj);
AssertEquals(0, IntfObjCounter);

fObjMap.OwnsValues := true;
AssertTrue(fObjMap.OwnsValues);

key := TIntfObj.Create(self);
obj := TIntfObj.Create(self);
fObjMap.Add(key, obj);
fObjMap.Delete(key);
AssertEquals(0, IntfObjCounter);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Prop_AutoCreate;
begin
AssertException('autocreate false does not throw exception', EutlMap, @AssignNonExistsingItem);
fIntMap.AutoCreate := true;
AssignNonExistsingItem;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Meth_Add;
begin
fIntMap.Add(123, 987);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Meth_TryGetValue;
var
i: Integer;
begin
fIntMap.Add(123, 987);
fIntMap.Add(234, 876);
fIntMap.Add(345, 765);
AssertFalse (fIntMap.TryGetValue(999, i));
AssertTrue (fIntMap.TryGetValue(234, i));
AssertEquals(876, i);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Meth_IndexOf;
begin
fIntMap.Add(123, 987);
fIntMap.Add(234, 876);
fIntMap.Add(345, 765);
AssertEquals( 0, fIntMap.IndexOf(123));
AssertEquals( 1, fIntMap.IndexOf(234));
AssertEquals( 2, fIntMap.IndexOf(345));
AssertEquals(-1, fIntMap.IndexOf(999));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Meth_Contains;
begin
fIntMap.Add(123, 987);
fIntMap.Add(234, 876);
fIntMap.Add(345, 765);
AssertTrue (fIntMap.Contains(123));
AssertTrue (fIntMap.Contains(234));
AssertTrue (fIntMap.Contains(345));
AssertFalse(fIntMap.Contains(999));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Meth_Delete;
begin
fIntMap.Add(123, 987);
fIntMap.Add(234, 876);
fIntMap.Add(345, 765);
AssertEquals(3, fIntMap.Count);
fIntMap.Delete(123);
AssertEquals(2, fIntMap.Count);
fIntMap.Delete(234);
AssertEquals(1, fIntMap.Count);
fIntMap.Delete(345);
AssertEquals(0, fIntMap.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Meth_DeleteAt;
begin
fIntMap.Add(123, 987);
fIntMap.Add(234, 876);
fIntMap.Add(345, 765);
AssertEquals(3, fIntMap.Count);
fIntMap.DeleteAt(2);
AssertEquals(2, fIntMap.Count);
fIntMap.DeleteAt(1);
AssertEquals(1, fIntMap.Count);
fIntMap.DeleteAt(0);
AssertEquals(0, fIntMap.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMapTests.Meth_Clear;
begin
fIntMap.Add(123, 987);
fIntMap.Add(234, 876);
fIntMap.Add(345, 765);
fIntMap.Clear;
AssertEquals(0, fIntMap.Count);
end;

initialization
RegisterTest(TutlMapTests.Suite);

end.


+ 70
- 2
uutlAlgorithm.pas 查看文件

@@ -5,14 +5,43 @@ unit uutlAlgorithm;
interface

uses
Classes, SysUtils;
Classes, SysUtils,
uutlInterfaces;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlBinarySearch<T> = class(TObject)
public type
IReadOnlyIndexer = specialize IutlReadOnlyIndexer<T>;
IComparer = specialize IutlComparer<T>;

private
class function DoSearch(
constref aIndexer: IReadOnlyIndexer;
constref aComparer: IComparer;
const aMin: Integer;
const aMax: Integer;
constref aItem: T;
out aIndex: Integer): Boolean;

public
// search aItem in aIndexer using aComparer
// aIndex is the index the item was found or should be inserted
// returns TRUE when found, FALSE otherwise
class function Search(
constref aIndexer: IReadOnlyIndexer;
constref aComparer: IComparer;
constref aItem: T;
out aIndex: Integer): Boolean;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function Supports(const aInstance: TObject; const aClass: TClass; out aObj): Boolean; overload;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function Supports(const aInstance: TObject; const aClass: TClass; out aObj): Boolean;
begin
@@ -23,5 +52,44 @@ begin
TObject(aObj) := nil;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlBinarySearch//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlBinarySearch.DoSearch(
constref aIndexer: IReadOnlyIndexer;
constref aComparer: IComparer;
const aMin: Integer;
const aMax: Integer;
constref aItem: T;
out aIndex: Integer): Boolean;
var
i, cmp: Integer;
begin
if (aMin <= aMax) then begin
i := aMin + Trunc((aMax - aMin) / 2);
cmp := aComparer.Compare(aItem, aIndexer.Items[i]);
if (cmp = 0) then begin
result := true;
aIndex := i;
end else if (cmp < 0) then
result := DoSearch(aIndexer, aComparer, aMin, i-1, aItem, aIndex)
else if (cmp > 0) then
result := DoSearch(aIndexer, aComparer, i+1, aMax, aItem, aIndex);
end else begin
result := false;
aIndex := aMin;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlBinarySearch.Search(
constref aIndexer: IReadOnlyIndexer;
constref aComparer: IComparer;
constref aItem: T;
out aIndex: Integer): Boolean;
begin
result := DoSearch(aIndexer, aComparer, 0, aIndexer.Count-1, aItem, aIndex);
end;

end.


+ 4
- 457
uutlCommon.pas 查看文件

@@ -1,158 +1,29 @@
unit uutlCommon;

{ Package: Utils
Prefix: utl - UTiLs
Beschreibung: diese Unit implementiert allgemein nützliche nicht-generische Klassen }

{$mode objfpc}{$H+}
{$modeswitch nestedprocvars}

interface

uses
Classes, SysUtils, syncobjs, versionresource, versiontypes, typinfo, uutlGenerics
{$IFDEF UNIX}, unixtype, pthreads {$ENDIF};
Classes, SysUtils;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlStringStack = class(TStringList)
public
procedure Push(const aStr: String);
function Pop: String;
function Seek: String;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlInterfaceNoRefCount = class(TObject, IUnknown)
protected
fRefCount : longint;
fRefCount: longint;

{ implement methods of IUnknown }
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual;
function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual;
public
property RefCount: LongInt read fRefCount;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlCSVList = class(TStringList)
private
FSkipDelims: boolean;
function GetStrictDelText: string;
procedure SetStrictDelText(const Value: string);
public
property StrictDelimitedText: string read GetStrictDelText write SetStrictDelText;
// Skip repeated delims instead of reading empty lines?
property SkipDelims: boolean read FSkipDelims write FSkipDelims;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlCheckSynchronizeEvent = class(TObject)
private
fEvent: TEvent;
function WaitMainThread(const aTimeout: Cardinal): TWaitResult;
public const
MAIN_WAIT_GRANULARITY = 10;
public
procedure SetEvent;
procedure ResetEvent;
function WaitFor(const aTimeout: Cardinal): TWaitResult;

constructor Create(const aEventAttributes: syncobjs.PSecurityAttributes;
const aManualReset, aInitialState: Boolean; const aName: string);
destructor Destroy; override;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlBaseEventList = specialize TutlList<TutlCheckSynchronizeEvent>;
TutlEventList = class(TutlBaseEventList)
public
function AddEvent(const aEventAttributes: syncobjs.PSecurityAttributes; const aManualReset,
aInitialState: Boolean; const aName : string): TutlCheckSynchronizeEvent;
function AddDefaultEvent: TutlCheckSynchronizeEvent;
function WaitAll(const aTimeout: Cardinal): TWaitResult;

constructor Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlVersionInfo = class(TObject)
private
fVersionRes: TVersionResource;
function GetFixedInfo: TVersionFixedInfo;
function GetStringFileInfo: TVersionStringFileInfo;
function GetVarFileInfo: TVersionVarFileInfo;
public
property FixedInfo: TVersionFixedInfo read GetFixedInfo;
property StringFileInfo: TVersionStringFileInfo read GetStringFileInfo;
property VarFileInfo: TVersionVarFileInfo read GetVarFileInfo;

function Load(const aInstance: THandle): Boolean;

constructor Create;
destructor Destroy; override;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
IutlFilterBuilder = interface['{BC5039C7-42E7-428F-A3E7-DDF7757B1907}']
function Add(aDescr, aMask: string; const aAppendFilterToDesc: boolean = true): IutlFilterBuilder;
function AddFilter(aFilter: string): IutlFilterBuilder;
function Compose(const aIncludeAllSupported: String = ''; const aIncludeAllFiles: String = ''): string;
property RefCount: LongInt read fRefCount;
end;


function utlEventEqual(const aEvent1, aEvent2): Boolean;
function utlFilterBuilder: IutlFilterBuilder;

implementation

uses
{uutlTiming needs to be included after Windows because of GetTickCount64}
uutlLogger{$IFDEF WINDOWS},Windows{$ENDIF}, uutlTiming;

{$IFNDEF WINDOWS}
function CharNext(const C: PChar): PChar;
begin
//TODO: prüfen ob das für UnicodeString auch stimmt
Result:= C;
if Result^>#0 then
inc(Result);
end;
{$IFEND}

function utlEventEqual(const aEvent1, aEvent2): Boolean;
begin
result :=
(TMethod(aEvent1).Code = TMethod(aEvent2).Code) and
(TMethod(aEvent1).Data = TMethod(aEvent2).Data);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlStringStack//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStringStack.Push(const aStr: String);
begin
Insert(0, aStr);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStringStack.Pop: String;
begin
result := '';
if Count > 0 then begin
result := Strings[0];
Delete(0);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStringStack.Seek: String;
begin
result := '';
if Count > 0 then
result := Strings[0];
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlInterfaceNoRefCount///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -176,329 +47,5 @@ begin
result := InterLockedDecrement(fRefCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCSVList///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCSVList.GetStrictDelText: string;
var
S: string;
I, J, Cnt: Integer;
q: boolean;
LDelimiters: TSysCharSet;
begin
Cnt := GetCount;
if (Cnt = 1) and (Get(0) = '') then
Result := QuoteChar + QuoteChar
else
begin
Result := '';
LDelimiters := [QuoteChar, Delimiter];
for I := 0 to Cnt - 1 do
begin
S := Get(I);
q:= false;
if S>'' then begin
for J:= 1 to length(S) do
if S[J] in LDelimiters then begin
q:= true;
break;
end;
if q then S := AnsiQuotedStr(S, QuoteChar);
end else
S := AnsiQuotedStr(S, QuoteChar);
Result := Result + S + Delimiter;
end;
System.Delete(Result, Length(Result), 1);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCSVList.SetStrictDelText(const Value: string);
var
S: String;
P, P1: PChar;
begin
BeginUpdate;
try
Clear;
P:= PChar(Value);
if FSkipDelims then begin
while (P^<>#0) and (P^=Delimiter) do begin
P:= CharNext(P);
end;
end;
while (P^<>#0) do begin
if (P^ = QuoteChar) then begin
S:= AnsiExtractQuotedStr(P, QuoteChar);
end else begin
P1:= P;
while (P^<>#0) and (P^<>Delimiter) do begin
P:= CharNext(P);
end;
SetString(S, P1, P - P1);
end;
Add(S);
while (P^<>#0) and (P^<>Delimiter) do begin
P:= CharNext(P);
end;
if (P^<>#0) then
P:= CharNext(P);
if FSkipDelims then begin
while (P^<>#0) and (P^=Delimiter) do begin
P:= CharNext(P);
end;
end;
end;
finally
EndUpdate;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCheckSynchronizeEvent/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCheckSynchronizeEvent.WaitMainThread(const aTimeout: Cardinal): TWaitResult;
var
timeout: qword;
begin
timeout:= GetTickCount64 + aTimeout;
repeat
result := fEvent.WaitFor(TutlCheckSynchronizeEvent.MAIN_WAIT_GRANULARITY);
CheckSynchronize();
until (result <> wrTimeout) or ((GetTickCount64 > timeout) and (aTimeout <> INFINITE));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCheckSynchronizeEvent.SetEvent;
begin
fEvent.SetEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCheckSynchronizeEvent.ResetEvent;
begin
fEvent.ResetEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCheckSynchronizeEvent.WaitFor(const aTimeout: Cardinal): TWaitResult;
begin
if (GetCurrentThreadId = MainThreadID) then
result := WaitMainThread(aTimeout)
else
result := fEvent.WaitFor(aTimeout);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCheckSynchronizeEvent.Create(const aEventAttributes: syncobjs.PSecurityAttributes;
const aManualReset, aInitialState: Boolean; const aName: string);
begin
inherited Create;
fEvent := TEvent.Create(aEventAttributes, aManualReset, aInitialState, aName);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCheckSynchronizeEvent.Destroy;
begin
FreeAndNil(fEvent);
inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventList/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventList.AddEvent(const aEventAttributes: syncobjs.PSecurityAttributes; const aManualReset,
aInitialState: Boolean; const aName: string): TutlCheckSynchronizeEvent;
begin
result := TutlCheckSynchronizeEvent.Create(aEventAttributes, aManualReset, aInitialState, aName);
Add(result);
end;

function TutlEventList.AddDefaultEvent: TutlCheckSynchronizeEvent;
begin
result := AddEvent(nil, true, false, '');
result.ResetEvent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventList.WaitAll(const aTimeout: Cardinal): TWaitResult;
var
i: integer;
timeout, tick: qword;
begin
timeout := GetTickCount64 + aTimeout;
for i := 0 to Count-1 do begin
if (aTimeout <> INFINITE) then begin
tick := GetTickCount64;
if (tick >= timeout) then begin
result := wrTimeout;
exit;
end else
result := Items[i].WaitFor(timeout - tick);
end else
result := Items[i].WaitFor(INFINITE);
if result <> wrSignaled then
exit;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventList.Create;
begin
inherited Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlVersionInfo///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlVersionInfo.GetFixedInfo: TVersionFixedInfo;
begin
result := fVersionRes.FixedInfo;
end;

function TutlVersionInfo.GetStringFileInfo: TVersionStringFileInfo;
begin
result := fVersionRes.StringFileInfo;
end;

function TutlVersionInfo.GetVarFileInfo: TVersionVarFileInfo;
begin
result := fVersionRes.VarFileInfo;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlVersionInfo.Load(const aInstance: THandle): Boolean;
var
Stream: TResourceStream;
begin
result := false;
if (FindResource(aInstance, PChar(PtrInt(1)), PChar(RT_VERSION)) = 0) then
exit;
Stream := TResourceStream.CreateFromID(aInstance, 1, PChar(RT_VERSION));
try
fVersionRes.SetCustomRawDataStream(Stream);
fVersionRes.FixedInfo;// access some property to force load from the stream
fVersionRes.SetCustomRawDataStream(nil);
finally
Stream.Free;
end;
result := true;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlVersionInfo.Create;
begin
inherited Create;
fVersionRes := TVersionResource.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlVersionInfo.Destroy;
begin
FreeAndNil(fVersionRes);
inherited Destroy;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//IutlFilterBuilder///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
type
TFilterBuilderImpl = class(TInterfacedObject, IutlFilterBuilder)
private type
TFilterEntry = class
Descr,
Filter: String;
end;
TFilterList = specialize TutlList<TFilterEntry>;
private
fFilters: TFilterList;
public
constructor Create;
destructor Destroy; override;
function Add(aDescr, aMask: string; const aAppendFilterToDesc: boolean): IutlFilterBuilder;
function AddFilter(aFilter: string): IutlFilterBuilder;
function Compose(const aIncludeAllSupported: String = ''; const aIncludeAllFiles: String = ''): string;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TFilterBuilderImpl.Create;
begin
inherited Create;
fFilters:= TFilterList.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TFilterBuilderImpl.Destroy;
begin
FreeAndNil(fFilters);
inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TFilterBuilderImpl.Compose(const aIncludeAllSupported: String;
const aIncludeAllFiles: String): string;
var
s: String;
e: TFilterEntry;
begin
Result:= '';
if (aIncludeAllSupported>'') and (fFilters.Count > 0) then begin
s:= '';
for e in fFilters do begin
if s>'' then
s += ';';
s += e.Filter;
end;
Result+= Format('%s|%s', [aIncludeAllSupported, s, s]);
end;

for e in fFilters do begin
if Result>'' then
Result += '|';
Result+= Format('%s|%s', [e.Descr, e.Filter]);
end;

if aIncludeAllFiles > '' then begin
if Result>'' then
Result += '|';
Result+= Format('%s|%s', [aIncludeAllFiles, '*.*']);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TFilterBuilderImpl.Add(aDescr, aMask: string;
const aAppendFilterToDesc: boolean): IutlFilterBuilder;
var
e: TFilterEntry;
begin
Result:= Self;
e:= TFilterEntry.Create;
if aAppendFilterToDesc then
e.Descr:= Format('%s (%s)', [aDescr, aMask])
else
e.Descr:= aDescr;
e.Filter:= aMask;
fFilters.Add(e);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TFilterBuilderImpl.AddFilter(aFilter: string): IutlFilterBuilder;
var
c: integer;
begin
c:= Pos('|', aFilter);
if c > 0 then
Result:= (Self as IutlFilterBuilder).Add(Copy(aFilter, 1, c-1), Copy(aFilter, c+1, Maxint))
else
Result:= (Self as IutlFilterBuilder).Add(aFilter, aFilter, false);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function utlFilterBuilder: IutlFilterBuilder;
begin
Result:= TFilterBuilderImpl.Create;
end;

end.


+ 994
- 627
uutlGenerics.pas
文件差異過大導致無法顯示
查看文件


Loading…
取消
儲存