|
- unit uutlComparer;
-
- {$mode objfpc}{$H+}
- {$IFDEF UTL_NESTED_PROCVARS}
- {$modeswitch nestedprocvars}
- {$ENDIF}
-
- interface
-
- uses
- Classes, SysUtils,
- uutlInterfaces;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- 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;
- {$IFDEF UTL_NESTED_PROCVARS}
- generic TutlEqualityCompareEventN<T> = function(constref i1, i2: T): Boolean is nested;
- {$ENDIF}
-
- generic TutlCallbackEqualityComparer<T> = class(
- TInterfacedObject,
- specialize IutlEqualityComparer<T>)
-
- private type
- TEqualityCompareEventType = (eetNormal, eetObject, eetNested);
-
- public type
- TCompareEvent = specialize TutlEqualityCompareEvent<T>;
- TCompareEventO = specialize TutlEqualityCompareEventO<T>;
- {$IFDEF UTL_NESTED_PROCVARS}
- TCompareEventN = specialize TutlEqualityCompareEventN<T>;
- {$ENDIF}
-
- strict private
- fType: TEqualityCompareEventType;
- fEvent: TCompareEvent;
- fEventO: TCompareEventO;
- {$IFDEF UTL_NESTED_PROCVARS}
- fEventN: TCompareEventN;
- {$ENDIF}
-
- public
- function EqualityCompare(constref i1, i2: T): Boolean;
-
- constructor Create(const aEvent: TCompareEvent); overload;
- constructor Create(const aEvent: TCompareEventO); overload;
- {$IFDEF UTL_NESTED_PROCVARS}
- constructor Create(const aEvent: TCompareEventN); overload;
- {$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlComparer<T> = class(
- specialize TutlEqualityComparer<T>,
- specialize IutlEqualityComparer<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;
- {$IFDEF UTL_NESTED_PROCVARS}
- generic TutlCompareEventN<T> = function(constref i1, i2: T): Integer is nested;
- {$ENDIF}
-
- generic TutlCallbackComparer<T> = class(
- TInterfacedObject,
- specialize IutlEqualityComparer<T>,
- specialize IutlComparer<T>)
-
- private type
- TCompareEventType = (cetNormal, cetObject, cetNested);
-
- public type
- TCompareEvent = specialize TutlCompareEvent<T>;
- TCompareEventO = specialize TutlCompareEventO<T>;
- {$IFDEF UTL_NESTED_PROCVARS}
- TCompareEventN = specialize TutlCompareEventN<T>;
- {$ENDIF}
-
- strict private
- fType: TCompareEventType;
- fEvent: TCompareEvent;
- fEventO: TCompareEventO;
- {$IFDEF UTL_NESTED_PROCVARS}
- fEventN: TCompareEventN;
- {$ENDIF}
-
- public
- function Compare(constref i1, i2: T): Integer;
- function EqualityCompare(constref i1, i2: T): Boolean;
-
- constructor Create(const aEvent: TCompareEvent); overload;
- constructor Create(const aEvent: TCompareEventO); overload;
- {$IFDEF UTL_NESTED_PROCVARS}
- constructor Create(const aEvent: TCompareEventN); overload;
- {$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlReverseComparer<T> = class(
- TInterfacedObject,
- specialize IutlEqualityComparer<T>,
- specialize IutlComparer<T>)
-
- public type
- IComparer = specialize IutlComparer<T>;
-
- private
- fComparer: IComparer;
-
- public
- function EqualityCompare(constref i1, i2: T): Boolean;
- function Compare(constref i1, i2: T): Integer;
-
- constructor Create(aComparer: IComparer);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- operator <(const i1, i2: TObject): Boolean; inline;
- operator >(const i1, i2: TObject): Boolean; inline;
-
- implementation
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Helper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- operator <(const i1, i2: TObject): Boolean; inline;
- begin
- result := Pointer(i1) < Pointer(i2);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- operator >(const i1, i2: TObject): Boolean; inline;
- begin
- result := Pointer(i1) > Pointer(i2);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlEqualityComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
- begin
- result := (i1 = i2);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlCallbackEqualityComparer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlCallbackEqualityComparer.EqualityCompare(constref i1, i2: T): Boolean;
- begin
- result := false;
- case fType of
- eetNormal: result := fEvent (i1, i2);
- eetObject: result := fEventO(i1, i2);
- {$IFDEF UTL_NESTED_PROCVARS}
- eetNested: result := fEventN(i1, i2);
- {$ENDIF}
- else
- raise Exception.Create('invalid or unknown callback type');
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlCallbackEqualityComparer.Create(const aEvent: TCompareEvent);
- begin
- inherited Create;
- fType := eetNormal;
- fEvent := aEvent;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlCallbackEqualityComparer.Create(const aEvent: TCompareEventO);
- begin
- inherited Create;
- fType := eetObject;
- fEventO := aEvent;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- {$IFDEF UTL_NESTED_PROCVARS}
- constructor TutlCallbackEqualityComparer.Create(const aEvent: TCompareEventN);
- begin
- inherited Create;
- fType := eetNested;
- fEventN := aEvent;
- end;
- {$ENDIF}
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //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
- result := 0;
- case fType of
- cetNormal: result := fEvent (i1, i2);
- cetObject: result := fEventO(i1, i2);
- {$IFDEF UTL_NESTED_PROCVARS}
- cetNested: result := fEventN(i1, i2);
- {$ENDIF}
- else
- raise Exception.Create('invalid or unknown callback type');
- 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;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- {$IFDEF UTL_NESTED_PROCVARS}
- constructor TutlCallbackComparer.Create(const aEvent: TCompareEventN);
- begin
- inherited Create;
- fType := cetNested;
- fEventN := aEvent;
- end;
- {$ENDIF}
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlReverseComparer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlReverseComparer.EqualityCompare(constref i1, i2: T): Boolean;
- begin
- Result:= fComparer.EqualityCompare(i1, i2);
- end;
-
- function TutlReverseComparer.Compare(constref i1, i2: T): Integer;
- begin
- Result:= - fComparer.Compare(i1, i2);
- end;
-
- constructor TutlReverseComparer.Create(aComparer: IComparer);
- begin
- inherited Create;
- fComparer:= aComparer;
- end;
-
- end.
|