From f5850af7406da01e2555fed12567d42c6cc19bdd Mon Sep 17 00:00:00 2001 From: Bergmann89 Date: Mon, 20 Jun 2016 18:29:06 +0200 Subject: [PATCH] * implemented uutlAlgorithm --- uutlAlgorithm.pas | 132 +++++++ uutlEvent.pas | 2 +- uutlEventManager.pas | 733 ++++++++++++++----------------------- uutlGenerics.pas | 167 +-------- uutlInterfaces.pas | 190 ++++++++++ uutlObservableGenerics.pas | 2 +- 6 files changed, 610 insertions(+), 616 deletions(-) create mode 100644 uutlAlgorithm.pas create mode 100644 uutlInterfaces.pas diff --git a/uutlAlgorithm.pas b/uutlAlgorithm.pas new file mode 100644 index 0000000..ea3cbd5 --- /dev/null +++ b/uutlAlgorithm.pas @@ -0,0 +1,132 @@ +unit uutlAlgorithm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + uutlInterfaces; + +type +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlQuickSort = class(TObject) + public type + IList = specialize IutlList; + IComparer = specialize IutlComparer; + + private + class procedure DoSort( + aList: IList; + aComparer: IComparer; + aLow: Integer; + aHigh: Integer); + + public + class procedure Sort( + aList: IList; + aComparer: IComparer); + end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlBinarySearch = class(TObject) + public type + IList = specialize IutlReadOnlyList; + IComparer = specialize IutlComparer; + + private + class function DoSearch( + aList: IList; + aComparer: IComparer; + const aMin: Integer; + const aMax: Integer; + constref aItem: T; + out aIndex: Integer): Boolean; + + public + class function Search( + aList: IList; + aComparer: IComparer; + constref aItem: T; + out aIndex: Integer): Boolean; + end; + +implementation + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlQuickSort////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlQuickSort.DoSort(aList: IList; aComparer: IComparer; aLow: Integer; aHigh: Integer); +var + lo, hi: Integer; + p, tmp: T; +begin + repeat + lo := aLow; + hi := aHigh; + p := aList.GetItem((aLow + aHigh) div 2); + repeat + while (aComparer.Compare(p, aList.GetItem(lo)) > 0) do + lo := lo + 1; + while (aComparer.Compare(p, aList.GetItem(hi)) < 0) do + hi := hi - 1; + if (lo <= hi) then begin + tmp := aList.GetItem(lo); + aList.SetItem(lo, aList.GetItem(hi)); + aList.SetItem(hi, tmp); + lo := lo + 1; + hi := hi - 1; + end; + until (lo > hi); + + if (hi - aLow < aHigh - lo) then begin + if (aLow < hi) then + DoSort(aList, aComparer, aLow, hi); + aLow := lo; + end else begin + if (lo < aHigh) then + DoSort(aList, aComparer, lo, aHigh); + aHigh := hi; + end; + until (aLow >= aHigh); +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class procedure TutlQuickSort.Sort(aList: IList; aComparer: IComparer); +begin + DoSort(aList, aComparer, 0, aList.GetCount-1); +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlBinarySearch/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlBinarySearch.DoSearch(aList: IList; 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, aList.GetItem(i)); + if (cmp = 0) then begin + result := true; + aIndex := i; + end else if (cmp < 0) then + result := DoSearch(aList, aComparer, aMin, i-1, aItem, aIndex) + else if (cmp > 0) then + result := DoSearch(aList, aComparer, i+1, aMax, aItem, aIndex); + end else begin + result := false; + aIndex := aMin; + end; +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlBinarySearch.Search(aList: IList; aComparer: IComparer; constref aItem: T; + out aIndex: Integer): Boolean; +begin + result := DoSearch(aList, aComparer, 0, aList.GetCount-1, aItem, aIndex); +end; + +end. + diff --git a/uutlEvent.pas b/uutlEvent.pas index b5f1b77..fd772d3 100644 --- a/uutlEvent.pas +++ b/uutlEvent.pas @@ -54,7 +54,7 @@ type public property Empty: Boolean read GetEmpty; - procedure DispatchEvent(const aEvent: IutlEvent); + procedure DispatchEvent(const aEvent: IutlEvent); virtual; function RegisterListener(const aListener: IutlEventListener): Boolean; function UnregisterListener(const aListener: IutlEventListener): Boolean; diff --git a/uutlEventManager.pas b/uutlEventManager.pas index c09a619..d845386 100644 --- a/uutlEventManager.pas +++ b/uutlEventManager.pas @@ -9,170 +9,162 @@ unit uutlEventManager; interface uses - Classes, SysUtils, syncobjs, Controls, - uutlGenerics; + Classes, SysUtils, Controls, + uutlEvent; type ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// - TutlEventManager = class(TObject) - public type - TEventType = 0..63; - TEventTypeMask = UInt64; - - //////////////////////////////////////////////////////////////////////////// - TEvent = class - public - EventType: TEventType; - Timestamp: QWord; - - function Clone: TEvent; - procedure Assign(const aEvent: TEvent); virtual; - constructor Create; virtual; - end; - TEventClass = class of TEvent; - TEventList = specialize TutlList; - - //////////////////////////////////////////////////////////////////////////// - TEventListener = class(TObject) - public - function DispatchEvent(const aEvent: TEvent): Boolean; virtual; - end; - TEventListenerSet = specialize TutlHashSet; - - //////////////////////////////////////////////////////////////////////////// - TEventHandlerCallback = procedure(aSender: TObject; aEvent: TEvent) of object; - TCallbackEventListener = class(TEventListener) - public - Callback: TEventHandlerCallback; - Filter: TEventTypeMask; - function DispatchEvent(const aEvent: TEvent): Boolean; override; - end; - + TutlMouseButtons = set of TMouseButton; + TutlWinControlEvent = class(TutlEvent) private - fEventQueue: TEventList; - fEventQueueLock: TCriticalSection; - fEventListener: TEventListenerSet; - - procedure DispatchEvent(const aEvent: TEvent); - protected - procedure PushEvent(const aEvent: TEvent); virtual; - procedure RecordEvent(const aEvent: TEvent); virtual; + fSender: TControl; public - procedure RegisterListener(const aEventMask: TEventTypeMask; const aCallback: TEventHandlerCallback); - procedure RegisterListener(const aListener: TEventListener); + property Sender: TControl read fSender; + constructor Create( + const aEventType: TutlEventType; + const aSender: TControl); + end; - procedure UnregisterListener(const aHandler: TEventHandlerCallback); - procedure UnregisterListener(const aListener: TEventListener); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlMouseEvent = class(TutlWinControlEvent) + private + fButtons: TutlMouseButtons; + fClientPos: TPoint; + fScreenPos: TPoint; - procedure DispatchEvents; + public + property Buttons: TutlMouseButtons read fButtons; + property ClientPos: TPoint read fClientPos; + property ScreenPos: TPoint read fScreenPos; + + constructor Create( + const aEventType: TutlEventType; + const aSender: TControl; + const aButtons: TutlMouseButtons; + const aClientPos: TPoint); + end; - constructor Create; - destructor Destroy; override; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlMouseWheelEvent = class(TutlWinControlEvent) + private + fWheelDelta: Integer; + fClientPos: TPoint; + fScreenPos: TPoint; public - class function MakeMask (const aTypes: array of TEventType): TEventTypeMask; - class function CombineMasks(const aMasks: array of TEventTypeMask): TEventTypeMask; - class function MaskHasType (const aMask: TEventTypeMask; const aType: TEventType): Boolean; inline; + property WheelDelta: Integer read fWheelDelta; + property ClientPos: TPoint read fClientPos; + property ScreenPos: TPoint read fScreenPos; + + constructor Create( + const aSender: TControl; + const aWheelDelta: Integer; + const aClientPos: TPoint); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// - TutlWinControlEventManager = class(TutlEventManager) - public type - //////////////////////////////////////////////////////////////////////////// - TMouseEvent = class(TEvent) - public - Button: TMouseButton; - ClientPos: TPoint; - ScreenPos: TPoint; - procedure Assign(const aEvent: TEvent); override; - end; + TutlKeyEvent = class(TutlWinControlEvent) + private + fCharCode: WideChar; + fKeyCode: Word; - //////////////////////////////////////////////////////////////////////////// - TMouseWheelEvent = class(TEvent) - public - WheelDelta: Integer; - ClientPos: TPoint; - ScreenPos: TPoint; - procedure Assign(const aEvent: TEvent); override; - end; + public + property CharCode: WideChar read fCharCode; + property KeyCode: Word read fKeyCode; + + constructor Create( + const aEventType: TutlEventType; + const aSender: TControl; + const aCharCode: WideChar; + const aKeyCode: Word); + end; - //////////////////////////////////////////////////////////////////////////// - TKeyEvent = class(TEvent) - public - CharCode: WideChar; - KeyCode: Word; - procedure Assign(const aEvent: TEvent); override; - end; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlWindowEvent = class(TutlWinControlEvent) + private + fScreenRect: TRect; + fClientWidth: Cardinal; + fClientHeight: Cardinal; - //////////////////////////////////////////////////////////////////////////// - TWindowEvent = class(TEvent) - public - ScreenRect: TRect; - ClientWidth: Cardinal; - ClientHeight: Cardinal; - procedure Assign(const aEvent: TEvent); override; - end; + public + property ScreenRect: TRect read fScreenRect; + property ClientWidth: Cardinal read fClientWidth; + property ClientHeight: Cardinal read fClientHeight; + + constructor Create( + const aEventType: TutlEventType; + const aSender: TControl; + const aScreenRect: TRect; + const aClientWidth: Cardinal; + const aClientHeight: Cardinal); + end; - //////////////////////////////////////////////////////////////////////////// - TMouseButtons = set of TMouseButton; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlWinControlEventManager = class(TutlEventListenerSet) + public const + EVENT_MOUSE_DOWN = 0; + EVENT_MOUSE_UP = 1; + EVENT_MOUSE_WHEEL_UP = 2; + EVENT_MOUSE_WHEEL_DOWN = 3; + EVENT_MOUSE_MOVE = 4; + EVENT_MOUSE_ENTER = 5; + EVENT_MOUSE_LEAVE = 6; + EVENT_MOUSE_CLICK = 7; + EVENT_MOUSE_DBL_CLICK = 8; + + EVENT_KEY_DOWN = 10; + EVENT_KEY_REPEAT = 11; + EVENT_KEY_UP = 12; + + EVENT_WINDOW_RESIZE = 15; + EVENT_WINDOW_ACTIVATE = 16; + EVENT_WINDOW_DEACTIVATE = 17; + + EVENTS_MOUSE: TutlEventTypes = [ + EVENT_MOUSE_DOWN, + EVENT_MOUSE_UP, + EVENT_MOUSE_WHEEL_UP, + EVENT_MOUSE_WHEEL_DOWN, + EVENT_MOUSE_MOVE, + EVENT_MOUSE_ENTER, + EVENT_MOUSE_LEAVE, + EVENT_MOUSE_CLICK, + EVENT_MOUSE_DBL_CLICK + ]; + EVENTS_KEYBOARD: TutlEventTypes = [ + EVENT_KEY_DOWN, + EVENT_KEY_REPEAT, + EVENT_KEY_UP + ]; + EVENTS_WINDOW: TutlEventTypes = [ + EVENT_WINDOW_RESIZE, + EVENT_WINDOW_ACTIVATE, + EVENT_WINDOW_DEACTIVATE + ]; + + private type TKeyboardState = record Modifiers: TShiftState; KeyState: array[Byte] of Boolean; end; + TMouseState = record - ScreenPos, ClientPos: TPoint; - Buttons: TMouseButtons; + ScreenPos: TPoint; + ClientPos: TPoint; + Buttons: TutlMouseButtons; end; + TWindowState = record - Active: boolean; + Active: Boolean; ScreenRect: TRect; ClientWidth: Integer; ClientHeight: Integer; end; - - public const - MOUSE_DOWN = 0; - MOUSE_UP = 1; - MOUSE_WHEEL_UP = 2; - MOUSE_WHEEL_DOWN = 3; - MOUSE_MOVE = 4; - MOUSE_ENTER = 5; - MOUSE_LEAVE = 6; - MOUSE_CLICK = 7; - MOUSE_DBL_CLICK = 8; - - KEY_DOWN = 10; - KEY_REPEAT = 11; - KEY_UP = 12; - - WINDOW_RESIZE = 15; - WINDOW_ACTIVATE = 16; - WINDOW_DEACTIVATE = 17; - - EVENTS_MOUSE: TEventTypeMask = - (1 shl MOUSE_DOWN) or - (1 shl MOUSE_UP) or - (1 shl MOUSE_WHEEL_UP) or - (1 shl MOUSE_WHEEL_DOWN) or - (1 shl MOUSE_MOVE) or - (1 shl MOUSE_ENTER) or - (1 shl MOUSE_LEAVE) or - (1 shl MOUSE_CLICK) or - (1 shl MOUSE_DBL_CLICK); - EVENTS_KEYBOARD: TEventTypeMask = - (1 shl KEY_DOWN) or - (1 shl KEY_REPEAT) or - (1 shl KEY_UP); - EVENTS_WINDOW: TEventTypeMask = - (1 shl WINDOW_RESIZE) or - (1 shl WINDOW_ACTIVATE) or - (1 shl WINDOW_DEACTIVATE); private fKeyboard: TKeyboardState; fMouse: TMouseState; fWindow: TWindowState; - private procedure HandlerMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure HandlerMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure HandlerMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); @@ -190,27 +182,41 @@ type procedure HandlerDeactivate (Sender: TObject); protected - procedure RecordEvent(const aEvent: TEvent); override; + procedure RecordEvent(const aEvent: IutlEvent); virtual; - protected - function CreateMouseEvent (aEvent: TMouseEvent; aType: TEventType; aButton: TMouseButton; aClientPos, aScreenPos: TPoint): TMouseEvent; virtual; - function CreateMouseWheelEvent(aEvent: TMouseWheelEvent; aSender: TWinControl; aDelta: Integer; aClientPos: TPoint): TMouseWheelEvent; virtual; - function CreateKeyEvent (aEvent: TKeyEvent; aType: TEventType; aKey: Word): TKeyEvent; virtual; - function CreateWindowEvent (aEvent: TWindowEvent; aType: TEventType; aSender: TControl): TWindowEvent; virtual; + function CreateMouseEvent( + aSender: TObject; + aType: TutlEventType; + aButtons: TutlMouseButtons; + aClientPos: TPoint): TutlMouseEvent; virtual; + + function CreateMouseWheelEvent( + aSender: TObject; + aDelta: Integer; + aClientPos: TPoint): TutlMouseWheelEvent; virtual; + + function CreateKeyEvent( + aSender: TObject; aType: TutlEventType; + aKey: Word): TutlKeyEvent; virtual; + + function CreateWindowEvent( + aSender: TObject; + aType: TutlEventType): TutlWindowEvent; virtual; public property Keyboard: TKeyboardState read fKeyboard; property Mouse: TMouseState read fMouse; property Window: TWindowState read fWindow; - procedure AttachEvents(const aControl: TWinControl; const aMask: TEventTypeMask); + procedure DispatchEvent(const aEvent: IutlEvent); override; + procedure AttachEvents(const aControl: TWinControl; const aTypes: TutlEventTypes); end; implementation uses LCLIntf, Forms, - uutlTiming, uutlConversion, uutlKeyCodes; + uutlKeyCodes; type TWinControlVisibilityClass = class(TWinControl) @@ -232,339 +238,167 @@ type end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlEventManager.TEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlEventManager.TEvent.Clone: TEvent; -begin - result := TEventClass(ClassType).Create; - result.Assign(self); -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlEventManager.TEvent.Assign(const aEvent: TEvent); -begin - Timestamp := aEvent.Timestamp; -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlEventManager.TEvent.Create; -begin - inherited Create; - Timestamp := GetMicroTime; -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlEventManager.TEventListener//////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlEventManager.TEventListener.DispatchEvent(const aEvent: TEvent): Boolean; -begin - result := false; -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlEventManager.TCallbackEventListener//////////////////////////////////////////////////////////////////////////////////////////////////////////// -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlEventManager.TCallbackEventListener.DispatchEvent(const aEvent: TEvent): Boolean; -begin - result := inherited DispatchEvent(aEvent); - if TutlEventManager.MaskHasType(Filter, aEvent.EventType) then - Callback(self, aEvent); -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlEventManager/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlEventManager.DispatchEvent(const aEvent: TEvent); -var - l: TEventListener; -begin - for l in fEventListener do begin - if l.DispatchEvent(aEvent) then - break; - end; -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlEventManager.PushEvent(const aEvent: TEvent); -begin - fEventQueueLock.Enter; - try - if Assigned(fEventQueue) then - fEventQueue.Add(aEvent) - else if Assigned(aEvent) then - aEvent.Free; - finally - fEventQueueLock.Leave; - end; -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlEventManager.RecordEvent(const aEvent: TEvent); -begin - // DUMMY -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlEventManager.RegisterListener(const aEventMask: TEventTypeMask; const aCallback: TEventHandlerCallback); -var - l: TCallbackEventListener; -begin - UnregisterListener(aCallback); - l := TCallbackEventListener.Create; - try - l.Filter := aEventMask; - l.Callback := aCallback; - RegisterListener(l); - except - FreeAndNil(l); - end; -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlEventManager.RegisterListener(const aListener: TEventListener); -begin - fEventListener.Add(aListener); -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlEventManager.UnregisterListener(const aHandler: TEventHandlerCallback); -var - i: Integer; - m1, m2: TMethod; - cel: TCallbackEventListener; -begin - m1 := TMethod(aHandler); - for i := fEventListener.Count-1 downto 0 do - if Supports(fEventListener[i], TCallbackEventListener, cel) then begin - m2 := TMethod(cel.Callback); - if (m1.Data = m2.Data) and - (m1.Code = m2.Code) then - fEventListener.Delete(i); - end; -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlEventManager.UnregisterListener(const aListener: TEventListener); -begin - fEventListener.Remove(aListener); -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlEventManager.DispatchEvents; -var - e: TEvent; -begin - fEventQueueLock.Acquire; - try - if Assigned(fEventQueue) then begin - for e in fEventQueue do begin - DispatchEvent(e); - RecordEvent(e); - end; - fEventQueue.Clear; - end; - finally - fEventQueueLock.Release; - end; -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlEventManager.Create; -begin - inherited Create; - fEventListener := TEventListenerSet.Create(true); - fEventQueue := TEventList.Create(true); - fEventQueueLock := TCriticalSection.Create; -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -destructor TutlEventManager.Destroy; -begin - fEventQueueLock.Enter; - try - FreeAndNil(fEventQueue); - finally - fEventQueueLock.Leave; - end; - FreeAndNil(fEventQueueLock); - FreeAndNil(fEventListener); - inherited Destroy; -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlEventManager.MakeMask(const aTypes: array of TEventType): TEventTypeMask; -var - e: TEventType; -begin - result := 0; - for e in aTypes do - result := result or (1 shl e); -end; - -///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlEventManager.CombineMasks(const aMasks: array of TEventTypeMask): TEventTypeMask; -var - m: TEventTypeMask; -begin - result := 0; - for m in aMasks do - result := result or m; -end; - +//TutlWinControlEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -class function TutlEventManager.MaskHasType(const aMask: TEventTypeMask; const aType: TEventType): Boolean; +constructor TutlWinControlEvent.Create(const aEventType: TutlEventType; const aSender: TControl); begin - result := ((aMask and (1 shl aType)) <> 0); + inherited Create(aEventType); + fSender := aSender; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlWinControlEventManager.TMouseEvent///////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlMouseEvent///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlWinControlEventManager.TMouseEvent.Assign(const aEvent: TEvent); -var - me: TMouseEvent; +constructor TutlMouseEvent.Create( + const aEventType: TutlEventType; + const aSender: TControl; + const aButtons: TutlMouseButtons; + const aClientPos: TPoint); begin - inherited Assign(aEvent); - if Supports(aEvent, TMouseEvent, me) then begin - Button := me.Button; - ClientPos := me.ClientPos; - ScreenPos := me.ScreenPos; - end; + inherited Create(aEventType, aSender); + fButtons := aButtons; + fClientPos := aClientPos; + fScreenPos := fSender.ClientToScreen(fClientPos); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlWinControlEventManager.TMouseWheelEvent//////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlMouseWheelEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlWinControlEventManager.TMouseWheelEvent.Assign(const aEvent: TEvent); -var - mwe: TMouseWheelEvent; +constructor TutlMouseWheelEvent.Create( + const aSender: TControl; + const aWheelDelta: Integer; + const aClientPos: TPoint); begin - inherited Assign(aEvent); - if Supports(aEvent, TMouseWheelEvent, mwe) then begin - WheelDelta := mwe.WheelDelta; - ClientPos := mwe.ClientPos; - ScreenPos := mwe.ScreenPos; - end; + if (aWheelDelta < 0) + then inherited Create(TutlWinControlEventManager.EVENT_MOUSE_WHEEL_DOWN, aSender) + else inherited Create(TutlWinControlEventManager.EVENT_MOUSE_WHEEL_UP, aSender); + fWheelDelta := aWheelDelta; + fClientPos := aClientPos; + fScreenPos := fSender.ClientToScreen(fClientPos); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlWinControlEventManager.TKeyEvent/////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlKeyEvent/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlWinControlEventManager.TKeyEvent.Assign(const aEvent: TEvent); -var - ke: TKeyEvent; +constructor TutlKeyEvent.Create( + const aEventType: TutlEventType; + const aSender: TControl; + const aCharCode: WideChar; + const aKeyCode: Word); begin - inherited Assign(aEvent); - if Supports(aEvent, TKeyEvent, ke) then begin - CharCode := ke.CharCode; - KeyCode := ke.KeyCode; - end; + inherited Create(aEventType, aSender); + fCharCode := aCharCode; + fKeyCode := aKeyCode; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlWinControlEventManager.TWindowEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlWindowEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlWinControlEventManager.TWindowEvent.Assign(const aEvent: TEvent); -var - we: TWindowEvent; +constructor TutlWindowEvent.Create( + const aEventType: TutlEventType; + const aSender: TControl; + const aScreenRect: TRect; + const aClientWidth: Cardinal; + const aClientHeight: Cardinal); begin - inherited Assign(aEvent); - if Supports(aEvent, TWindowEvent, we) then begin - ScreenRect := we.ScreenRect; - ClientWidth := we.ClientWidth; - ClientHeight := we.ClientHeight; - end; + inherited Create(aEventType, aSender); + fScreenRect := aScreenRect; + fClientWidth := aClientWidth; + fClientHeight := aClientHeight; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlWinControlEventManager///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlWinControlEventManager.HandlerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +procedure TutlWinControlEventManager.HandlerMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); begin - PushEvent(CreateMouseEvent(nil, MOUSE_DOWN, Button, Point(X, Y), TWinControl(Sender).ClientToScreen(Point(X, Y)))); + DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_DOWN, [ Button ], Point(X, Y))); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlWinControlEventManager.HandlerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +procedure TutlWinControlEventManager.HandlerMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); begin - PushEvent(CreateMouseEvent(nil, MOUSE_UP, Button, Point(X, Y), TWinControl(Sender).ClientToScreen(Point(X, Y)))); + DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_UP, [Button], Point(X, Y))); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlWinControlEventManager.HandlerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin - PushEvent(CreateMouseEvent(nil, MOUSE_MOVE, mbLeft, Point(X, Y), TWinControl(Sender).ClientToScreen(Point(X, Y)))); + DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_MOVE, [], Point(X, Y))); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlWinControlEventManager.HandlerMouseEnter(Sender: TObject); begin - PushEvent(CreateMouseEvent(nil, MOUSE_ENTER, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos)); + DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_ENTER, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos))); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlWinControlEventManager.HandlerMouseLeave(Sender: TObject); begin - PushEvent(CreateMouseEvent(nil, MOUSE_LEAVE, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos)); + DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_LEAVE, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos))); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlWinControlEventManager.HandlerClick(Sender: TObject); begin - PushEvent(CreateMouseEvent(nil, MOUSE_CLICK, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos)); + DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_CLICK, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos))); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlWinControlEventManager.HandlerDblClick(Sender: TObject); begin - PushEvent(CreateMouseEvent(nil, MOUSE_DBL_CLICK, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos)); + DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_DBL_CLICK, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos))); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlWinControlEventManager.HandlerMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +procedure TutlWinControlEventManager.HandlerMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); begin - PushEvent(CreateMouseWheelEvent(nil, TWinControl(Sender), WheelDelta, MousePos)); + DispatchEvent(CreateMouseWheelEvent(Sender, WheelDelta, MousePos)); Handled := false; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlWinControlEventManager.HandlerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin - PushEvent(CreateKeyEvent(nil, KEY_DOWN, Key)); + DispatchEvent(CreateKeyEvent(Sender, EVENT_KEY_DOWN, Key)); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlWinControlEventManager.HandlerKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin - PushEvent(CreateKeyEvent(nil, KEY_UP, Key)); + DispatchEvent(CreateKeyEvent(Sender, EVENT_KEY_UP, Key)); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlWinControlEventManager.HandlerResize(Sender: TObject); begin - PushEvent(CreateWindowEvent(nil, WINDOW_RESIZE, TControl(Sender))); + DispatchEvent(CreateWindowEvent(Sender, EVENT_WINDOW_RESIZE)); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlWinControlEventManager.HandlerActivate(Sender: TObject); begin - PushEvent(CreateWindowEvent(nil, WINDOW_ACTIVATE, TControl(Sender))); + DispatchEvent(CreateWindowEvent(Sender, EVENT_WINDOW_ACTIVATE)); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlWinControlEventManager.HandlerDeactivate(Sender: TObject); begin - PushEvent(CreateWindowEvent(nil, WINDOW_DEACTIVATE, TControl(Sender))); + DispatchEvent(CreateWindowEvent(Sender, EVENT_WINDOW_DEACTIVATE)); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlWinControlEventManager.RecordEvent(const aEvent: TEvent); +procedure TutlWinControlEventManager.RecordEvent(const aEvent: IutlEvent); var - me: TMouseEvent; - ke: TKeyEvent; - we: TWindowEvent; + me: TutlMouseEvent; + ke: TutlKeyEvent; + we: TutlWindowEvent; - function GetPressedButtons: TMouseButtons; + function GetPressedButtons: TutlMouseButtons; begin result := []; if (GetKeyState(VK_LBUTTON) < 0) then @@ -580,26 +414,24 @@ var end; begin - inherited RecordEvent(aEvent); - - if Supports(aEvent, TMouseEvent, me) then begin + if Supports(aEvent, TutlMouseEvent, me) then begin fMouse.ClientPos := me.ClientPos; fMouse.ScreenPos := me.ScreenPos; case me.EventType of - MOUSE_DOWN: - Include(fMouse.Buttons, me.Button); - MOUSE_UP: - Exclude(fMouse.Buttons, me.Button); - MOUSE_LEAVE: + EVENT_MOUSE_DOWN: + fMouse.Buttons := fMouse.Buttons + me.Buttons; + EVENT_MOUSE_UP: + fMouse.Buttons := fMouse.Buttons - me.Buttons; + EVENT_MOUSE_LEAVE: fMouse.Buttons := []; - MOUSE_ENTER: + EVENT_MOUSE_ENTER: fMouse.Buttons := GetPressedButtons; end; - end else if Supports(aEvent, TKeyEvent, ke) then begin + end else if Supports(aEvent, TutlKeyEvent, ke) then begin case ke.EventType of - KEY_DOWN, - KEY_REPEAT: begin + EVENT_KEY_DOWN, + EVENT_KEY_REPEAT: begin fKeyboard.KeyState[ke.KeyCode and $FF] := true; case ke.KeyCode of VK_SHIFT: Include(fKeyboard.Modifiers, ssShift); @@ -607,7 +439,7 @@ begin VK_CONTROL: Include(fKeyboard.Modifiers, ssCtrl); end; end; - KEY_UP: begin + EVENT_KEY_UP: begin fKeyboard.KeyState[ke.KeyCode and $FF] := false; case ke.KeyCode of VK_SHIFT: Exclude(fKeyboard.Modifiers, ssShift); @@ -620,13 +452,13 @@ begin then include(fKeyboard.Modifiers, ssAltGr) else exclude(fKeyboard.Modifiers, ssAltGr); - end else if Supports(aEvent, TWindowEvent, we) then begin + end else if Supports(aEvent, TutlWindowEvent, we) then begin case we.EventType of - WINDOW_ACTIVATE: + EVENT_WINDOW_ACTIVATE: fWindow.Active := true; - WINDOW_DEACTIVATE: + EVENT_WINDOW_DEACTIVATE: fWindow.Active := false; - WINDOW_RESIZE: begin + EVENT_WINDOW_RESIZE: begin fWindow.ScreenRect := we.ScreenRect; fWindow.ClientWidth := we.ClientWidth; fWindow.ClientHeight := we.ClientHeight; @@ -636,61 +468,64 @@ begin end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlWinControlEventManager.CreateMouseEvent(aEvent: TMouseEvent; aType: TEventType; aButton: TMouseButton; aClientPos, aScreenPos: TPoint): TMouseEvent; +function TutlWinControlEventManager.CreateMouseEvent(aSender: TObject; aType: TutlEventType; + aButtons: TutlMouseButtons; aClientPos: TPoint): TutlMouseEvent; begin - result := aEvent; - if not Assigned(result) then - result := TMouseEvent.Create; - result.EventType := aType; - result.Button := aButton; - result.ClientPos := aClientPos; - result.ScreenPos := aScreenPos; + result := TutlMouseEvent.Create( + aType, + (aSender as TControl), + aButtons, + aClientPos); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlWinControlEventManager.CreateMouseWheelEvent(aEvent: TMouseWheelEvent; aSender: TWinControl; aDelta: Integer; aClientPos: TPoint): TMouseWheelEvent; +function TutlWinControlEventManager.CreateMouseWheelEvent(aSender: TObject; aDelta: Integer; + aClientPos: TPoint): TutlMouseWheelEvent; begin - result := aEvent; - if not Assigned(result) then - result := TMouseWheelEvent.Create; - result.ClientPos := aClientPos; - result.ScreenPos := aSender.ClientToScreen(aClientPos); - result.WheelDelta := aDelta; - if (aDelta < 0) - then result.EventType := MOUSE_WHEEL_DOWN - else result.EventType := MOUSE_WHEEL_UP; + result := TutlMouseWheelEvent.Create( + (aSender as TControl), + aDelta, + aClientPos); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlWinControlEventManager.CreateKeyEvent(aEvent: TKeyEvent; aType: TEventType; aKey: Word): TKeyEvent; +function TutlWinControlEventManager.CreateKeyEvent(aSender: TObject; aType: TutlEventType; aKey: Word): TutlKeyEvent; begin - result := aEvent; - if not Assigned(result) then - result := TKeyEvent.Create; - result.EventType := aType; - if (aType = KEY_DOWN) and fKeyboard.KeyState[aKey and $FF] then - result.EventType := KEY_REPEAT; - result.KeyCode := aKey; - result.CharCode := VKCodeToCharCode(aKey, fKeyboard.Modifiers); + if (aType = EVENT_KEY_DOWN) and fKeyboard.KeyState[aKey and $FF] then + aType := EVENT_KEY_REPEAT; + result := TutlKeyEvent.Create( + aType, + (aSender as TControl), + VKCodeToCharCode(aKey, fKeyboard.Modifiers), + aKey); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlWinControlEventManager.CreateWindowEvent(aEvent: TWindowEvent; aType: TEventType; aSender: TControl): TWindowEvent; +function TutlWinControlEventManager.CreateWindowEvent(aSender: TObject; aType: TutlEventType): TutlWindowEvent; var - p: TPoint; + p0, p1: TPoint; +begin + with TControl(aSender) do begin + p0 := ClientToScreen(Point(0, 0)); + p1 := ClientToScreen(Point(Width, Height)); + end; + result := TutlWindowEvent.Create( + aType, + (aSender as TControl), + Rect(p0.x, p0.y, p1.x, p1.y), + (aSender as TWinControl).ClientWidth, + (aSender as TWinControl).ClientHeight); +end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.DispatchEvent(const aEvent: IutlEvent); begin - p := aSender.ScreenToClient(Point(0, 0)); - result := aEvent; - if not Assigned(result) then - result := TWindowEvent.Create; - result.EventType := aType; - result.ClientWidth := aSender.ClientWidth; - result.ClientHeight := aSender.ClientHeight; - result.ScreenRect := Rect(p.x, p.y, p.x + result.ClientWidth, p.y + result.ClientHeight); + RecordEvent(aEvent); + inherited DispatchEvent(aEvent); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -procedure TutlWinControlEventManager.AttachEvents(const aControl: TWinControl; const aMask: TEventTypeMask); +procedure TutlWinControlEventManager.AttachEvents(const aControl: TWinControl; const aTypes: TutlEventTypes); var ctl: TWinControlVisibilityClass; frm: TCustomFormVisibilityClass; @@ -698,22 +533,22 @@ begin ctl := TWinControlVisibilityClass(aControl); // mouse events - if MaskHasType(aMask, MOUSE_DOWN) then ctl.OnMouseDown := @HandlerMouseDown; - if MaskHasType(aMask, MOUSE_UP) then ctl.OnMouseUp := @HandlerMouseUp; - if MaskHasType(aMask, MOUSE_MOVE) then ctl.OnMouseMove := @HandlerMouseMove; - if MaskHasType(aMask, MOUSE_ENTER) then ctl.OnMouseEnter := @HandlerMouseEnter; - if MaskHasType(aMask, MOUSE_LEAVE) then ctl.OnMouseLeave := @HandlerMouseLeave; - if MaskHasType(aMask, MOUSE_CLICK) then ctl.OnClick := @HandlerClick; - if MaskHasType(aMask, MOUSE_DBL_CLICK) then ctl.OnDblClick := @HandlerDblClick; - if MaskHasType(aMask, MOUSE_WHEEL_DOWN) or - MaskHasType(aMask, MOUSE_WHEEL_UP) then ctl.OnMouseWheel := @HandlerMouseWheel; + if (EVENT_MOUSE_DOWN in aTypes) then ctl.OnMouseDown := @HandlerMouseDown; + if (EVENT_MOUSE_UP in aTypes) then ctl.OnMouseUp := @HandlerMouseUp; + if (EVENT_MOUSE_MOVE in aTypes) then ctl.OnMouseMove := @HandlerMouseMove; + if (EVENT_MOUSE_ENTER in aTypes) then ctl.OnMouseEnter := @HandlerMouseEnter; + if (EVENT_MOUSE_LEAVE in aTypes) then ctl.OnMouseLeave := @HandlerMouseLeave; + if (EVENT_MOUSE_CLICK in aTypes) then ctl.OnClick := @HandlerClick; + if (EVENT_MOUSE_DBL_CLICK in aTypes) then ctl.OnDblClick := @HandlerDblClick; + if (EVENT_MOUSE_WHEEL_DOWN in aTypes) or + (EVENT_MOUSE_WHEEL_UP in aTypes) then ctl.OnMouseWheel := @HandlerMouseWheel; // key events - if MaskHasType(aMask, KEY_DOWN) then ctl.OnKeyDown := @HandlerKeyDown; - if MaskHasType(aMask, KEY_UP) then ctl.OnKeyUp := @HandlerKeyUp; + if (EVENT_KEY_DOWN in aTypes) then ctl.OnKeyDown := @HandlerKeyDown; + if (EVENT_KEY_UP in aTypes) then ctl.OnKeyUp := @HandlerKeyUp; // window events - if MaskHasType(aMask, WINDOW_RESIZE) then begin + if (EVENT_WINDOW_RESIZE in aTypes) then begin ctl.OnResize := @HandlerResize; fWindow.ClientWidth := ctl.ClientWidth; fWindow.ClientHeight := ctl.ClientHeight; @@ -721,8 +556,8 @@ begin if (aControl is TCustomForm) then begin frm := TCustomFormVisibilityClass(aControl); frm.KeyPreview := true; - if MaskHasType(aMask, WINDOW_ACTIVATE) then frm.OnActivate := @HandlerActivate; - if MaskHasType(aMask, WINDOW_DEACTIVATE) then frm.OnDeactivate := @HandlerDeactivate; + if (EVENT_WINDOW_ACTIVATE in aTypes) then frm.OnActivate := @HandlerActivate; + if (EVENT_WINDOW_DEACTIVATE in aTypes) then frm.OnDeactivate := @HandlerDeactivate; end; end; diff --git a/uutlGenerics.pas b/uutlGenerics.pas index 4ab03d1..f6f35d0 100644 --- a/uutlGenerics.pas +++ b/uutlGenerics.pas @@ -10,69 +10,10 @@ unit uutlGenerics; interface uses - Classes, SysUtils, typinfo, uutlSyncObjs; + Classes, SysUtils, typinfo, + uutlSyncObjs, uutlInterfaces; type -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// - generic IutlEqualityComparer = interface - function EqualityCompare(const i1, i2: T): Boolean; - end; - - generic TutlEqualityComparer = class(TInterfacedObject, specialize IutlEqualityComparer) - public - function EqualityCompare(const i1, i2: T): Boolean; - end; - - generic TutlEventEqualityComparer = class(TInterfacedObject, specialize IutlEqualityComparer) - public type - TEqualityEvent = function(const i1, i2: T): Boolean; - TEqualityEventO = function(const i1, i2: T): Boolean of object; - TEqualityEventN = function(const i1, i2: T): Boolean is nested; - private type - TEqualityEventType = (eetNormal, eetObject, eetNested); - private - fEvent: TEqualityEvent; - fEventO: TEqualityEventO; - fEventN: TEqualityEventN; - fEventType: TEqualityEventType; - public - function EqualityCompare(const i1, i2: T): Boolean; - constructor Create(const aEvent: TEqualityEvent); overload; - constructor Create(const aEvent: TEqualityEventO); overload; - constructor Create(const aEvent: TEqualityEventN); overload; - { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks } - end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// - generic IutlComparer = interface - function Compare(const i1, i2: T): Integer; - end; - - generic TutlComparer = class(TInterfacedObject, specialize IutlComparer) - public - function Compare(const i1, i2: T): Integer; - end; - - generic TutlEventComparer = class(TInterfacedObject, specialize IutlComparer) - public type - TEvent = function(const i1, i2: T): Integer; - TEventO = function(const i1, i2: T): Integer of object; - TEventN = function(const i1, i2: T): Integer is nested; - private type - TEventType = (etNormal, etObject, etNested); - private - fEvent: TEvent; - fEventO: TEventO; - fEventN: TEventN; - fEventType: TEventType; - public - function Compare(const i1, i2: T): Integer; - constructor Create(const aEvent: TEvent); overload; - constructor Create(const aEvent: TEventO); overload; - constructor Create(const aEvent: TEventN); overload; - { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks } - end; - //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlListBase = class(TObject) private type @@ -584,9 +525,6 @@ type function utlFreeOrFinalize(var obj; const aTypeInfo: PTypeInfo; const aFreeObj: Boolean = true): Boolean; -operator < (const i1, i2: TObject): Boolean; inline; -operator > (const i1, i2: TObject): Boolean; inline; - implementation uses @@ -594,18 +532,6 @@ uses //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -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; - //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function utlFreeOrFinalize(var obj; const aTypeInfo: PTypeInfo; const aFreeObj: Boolean = true): Boolean; var @@ -679,95 +605,6 @@ begin inherited Create('key already exists'); end; -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlEqualityComparer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlEqualityComparer.EqualityCompare(const i1, i2: T): Boolean; -begin - result := (i1 = i2); -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlEventEqualityComparer.EqualityCompare(const i1, i2: T): Boolean; -begin - case fEventType of - eetNormal: result := fEvent(i1, i2); - eetObject: result := fEventO(i1, i2); - eetNested: result := fEventN(i1, i2); - end; -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEvent); -begin - inherited Create; - fEvent := aEvent; - fEventType := eetNormal; -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEventO); -begin - inherited Create; - fEventO := aEvent; - fEventType := eetObject; -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEventN); -begin - inherited Create; - fEventN := aEvent; - fEventType := eetNested; -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//TutlComparer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlComparer.Compare(const i1, i2: T): Integer; -begin - if (i1 < i2) then - result := -1 - else if (i1 > i2) then - result := 1 - else - result := 0; -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -function TutlEventComparer.Compare(const i1, i2: T): Integer; -begin - case fEventType of - etNormal: result := fEvent(i1, i2); - etObject: result := fEventO(i1, i2); - etNested: result := fEventN(i1, i2); - end; -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlEventComparer.Create(const aEvent: TEvent); -begin - inherited Create; - fEvent := aEvent; - fEventType := etNormal; -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlEventComparer.Create(const aEvent: TEventO); -begin - inherited Create; - fEventO := aEvent; - fEventType := etObject; -end; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TutlEventComparer.Create(const aEvent: TEventN); -begin - inherited Create; - fEventN := aEvent; - fEventType := etNested; -end; - //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlListBase////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// diff --git a/uutlInterfaces.pas b/uutlInterfaces.pas new file mode 100644 index 0000000..78d8907 --- /dev/null +++ b/uutlInterfaces.pas @@ -0,0 +1,190 @@ +unit uutlInterfaces; + +{$mode objfpc}{$H+} +{$modeswitch nestedprocvars} + +interface + +uses + Classes, SysUtils; + +type +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic IutlEqualityComparer = interface + function EqualityCompare(const i1, i2: T): Boolean; + end; + + generic TutlEqualityComparer = class(TInterfacedObject, specialize IutlEqualityComparer) + public + function EqualityCompare(const i1, i2: T): Boolean; + end; + + generic TutlEventEqualityComparer = class(TInterfacedObject, specialize IutlEqualityComparer) + public type + TEqualityEvent = function(const i1, i2: T): Boolean; + TEqualityEventO = function(const i1, i2: T): Boolean of object; + TEqualityEventN = function(const i1, i2: T): Boolean is nested; + private type + TEqualityEventType = (eetNormal, eetObject, eetNested); + private + fEvent: TEqualityEvent; + fEventO: TEqualityEventO; + fEventN: TEqualityEventN; + fEventType: TEqualityEventType; + public + function EqualityCompare(const i1, i2: T): Boolean; + constructor Create(const aEvent: TEqualityEvent); overload; + constructor Create(const aEvent: TEqualityEventO); overload; + constructor Create(const aEvent: TEqualityEventN); overload; + { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks } + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic IutlComparer = interface + function Compare(const i1, i2: T): Integer; + end; + + generic TutlComparer = class(TInterfacedObject, specialize IutlComparer) + public + function Compare(const i1, i2: T): Integer; + end; + + generic TutlEventComparer = class(TInterfacedObject, specialize IutlComparer) + public type + TEvent = function(const i1, i2: T): Integer; + TEventO = function(const i1, i2: T): Integer of object; + TEventN = function(const i1, i2: T): Integer is nested; + private type + TEventType = (etNormal, etObject, etNested); + private + fEvent: TEvent; + fEventO: TEventO; + fEventN: TEventN; + fEventType: TEventType; + public + function Compare(const i1, i2: T): Integer; + constructor Create(const aEvent: TEvent); overload; + constructor Create(const aEvent: TEventO); overload; + constructor Create(const aEvent: TEventN); overload; + { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks } + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic IutlReadOnlyList = interface(IUnknown) + function GetCount: Integer; + function GetItem(const aIndex: Integer): T; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic IutlList = interface(specialize IutlReadOnlyList) + procedure SetItem(const aIndex: Integer; const aItem: T); + end; + +operator < (const i1, i2: TObject): Boolean; inline; +operator > (const i1, i2: TObject): Boolean; inline; + +implementation + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +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(const i1, i2: T): Boolean; +begin + result := (i1 = i2); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventEqualityComparer.EqualityCompare(const i1, i2: T): Boolean; +begin + case fEventType of + eetNormal: result := fEvent(i1, i2); + eetObject: result := fEventO(i1, i2); + eetNested: result := fEventN(i1, i2); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEvent); +begin + inherited Create; + fEvent := aEvent; + fEventType := eetNormal; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEventO); +begin + inherited Create; + fEventO := aEvent; + fEventType := eetObject; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEventN); +begin + inherited Create; + fEventN := aEvent; + fEventType := eetNested; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlComparer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlComparer.Compare(const i1, i2: T): Integer; +begin + if (i1 < i2) then + result := -1 + else if (i1 > i2) then + result := 1 + else + result := 0; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventComparer.Compare(const i1, i2: T): Integer; +begin + case fEventType of + etNormal: result := fEvent(i1, i2); + etObject: result := fEventO(i1, i2); + etNested: result := fEventN(i1, i2); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventComparer.Create(const aEvent: TEvent); +begin + inherited Create; + fEvent := aEvent; + fEventType := etNormal; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventComparer.Create(const aEvent: TEventO); +begin + inherited Create; + fEventO := aEvent; + fEventType := etObject; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventComparer.Create(const aEvent: TEventN); +begin + inherited Create; + fEventN := aEvent; + fEventType := etNested; +end; + +end. + diff --git a/uutlObservableGenerics.pas b/uutlObservableGenerics.pas index c4ad489..f89ea03 100644 --- a/uutlObservableGenerics.pas +++ b/uutlObservableGenerics.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, - uutlGenerics; + uutlGenerics, uutlInterfaces; type ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////