|
- unit uutlFilter;
-
- {$mode objfpc}{$H+}
- {$IFDEF UTL_NESTED_PROCVARS}
- {$modeswitch nestedprocvars}
- {$ENDIF}
-
- interface
-
- uses
- Classes, SysUtils,
- uutlInterfaces;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlFilterEvent<T> = function(constref i: T): Boolean;
- generic TutlFilterEventO<T> = function(constref i: T): Boolean of object;
- {$IFDEF UTL_NESTED_PROCVARS}
- generic TutlFilterEventN<T> = function(constref i: T): Boolean is nested;
- {$ENDIF}
-
- generic TutlCallbackFilter<T> = class(
- TInterfacedObject,
- specialize IutlFilter<T>)
-
- private type
- TFilterEventType = (fetNormal, fetObject, fetNested);
-
- public type
- TFilterEvent = specialize TutlFilterEvent<T>;
- TFilterEventO = specialize TutlFilterEventO<T>;
- {$IFDEF UTL_NESTED_PROCVARS}
- TFilterEventN = specialize TutlFilterEventN<T>;
- {$ENDIF}
-
- strict private
- fType: TFilterEventType;
- fEvent: TFilterEvent;
- fEventO: TFilterEventO;
- {$IFDEF UTL_NESTED_PROCVARS}
- fEventN: TFilterEventN;
- {$ENDIF}
-
- public
- function Filter(constref i: T): Boolean;
-
- constructor Create(constref aEvent: TFilterEvent); overload;
- constructor Create(constref aEvent: TFilterEventO); overload;
- {$IFDEF UTL_NESTED_PROCVARS}
- constructor Create(constref aEvent: TFilterEventN); overload;
- {$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlSelectEvent <Tin, Tout> = function(constref i: Tin): Tout;
- generic TutlSelectEventO<Tin, Tout> = function(constref i: Tin): Tout of object;
- {$IFDEF UTL_NESTED_PROCVARS}
- generic TutlSelectEventN<Tin, Tout> = function(constref i: Tin): Tout is nested;
- {$ENDIF}
-
- generic TutlCallbackSelector<Tin, Tout> = class(
- TInterfacedObject,
- specialize IutlSelector<Tin, Tout>)
-
- private type
- TSelectEventType = (setNormal, setObject, setNested);
-
- public type
- TSelectEvent = specialize TutlSelectEvent <Tin, Tout>;
- TSelectEventO = specialize TutlSelectEventO<Tin, Tout>;
- {$IFDEF UTL_NESTED_PROCVARS}
- TSelectEventN = specialize TutlSelectEventN<Tin, Tout>;
- {$ENDIF}
-
- strict private
- fType: TSelectEventType;
- fEvent: TSelectEvent;
- fEventO: TSelectEventO;
- {$IFDEF UTL_NESTED_PROCVARS}
- fEventN: TSelectEventN;
- {$ENDIF}
-
- public
- function Select(constref i: Tin): Tout;
-
- constructor Create(constref aEvent: TSelectEvent); overload;
- constructor Create(constref aEvent: TSelectEventO); overload;
- {$IFDEF UTL_NESTED_PROCVARS}
- constructor Create(constref aEvent: TSelectEventN); overload;
- {$ENDIF}
- end;
-
- implementation
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlCallbackFilter/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlCallbackFilter.Filter(constref i: T): Boolean;
- begin
- result := false;
- case fType of
- fetNormal: result := fEvent (i);
- fetObject: result := fEventO(i);
- {$IFDEF UTL_NESTED_PROCVARS}
- fetNested: result := fEventN(i);
- {$ENDIF}
- else
- raise Exception.Create('invalid or unknown callback type');
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlCallbackFilter.Create(constref aEvent: TFilterEvent);
- begin
- inherited Create;
- fType := fetNormal;
- fEvent := aEvent;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlCallbackFilter.Create(constref aEvent: TFilterEventO);
- begin
- inherited Create;
- fType := fetObject;
- fEventO := aEvent;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- {$IFDEF UTL_NESTED_PROCVARS}
- constructor TutlCallbackFilter.Create(constref aEvent: TFilterEventN);
- begin
- inherited Create;
- fType := fetNested;
- fEventN := aEvent;
- end;
- {$ENDIF}
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlCallbackSelector///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlCallbackSelector.Select(constref i: Tin): Tout;
- begin
- case fType of
- setNormal: result := fEvent (i);
- setObject: result := fEventO(i);
- {$IFDEF UTL_NESTED_PROCVARS}
- setNested: result := fEventN(i);
- {$ENDIF}
- else
- raise Exception.Create('invalid or unknown callback type');
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlCallbackSelector.Create(constref aEvent: TSelectEvent);
- begin
- inherited Create;
- fType := setNormal;
- fEvent := aEvent;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlCallbackSelector.Create(constref aEvent: TSelectEventO);
- begin
- inherited Create;
- fType := setObject;
- fEventO := aEvent;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- {$IFDEF UTL_NESTED_PROCVARS}
- constructor TutlCallbackSelector.Create(constref aEvent: TSelectEventN);
- begin
- inherited Create;
- fType := setNested;
- fEventN := aEvent;
- end;
- {$ENDIF}
-
- end.
|