Browse Source

* [uutlGenerics] fixed interaface reference count bug

* [uutlSyncObjs] extended lock object functions
* added all files to lazarus package
master
bergmann 7 years ago
parent
commit
2027bb6552
8 changed files with 341 additions and 112 deletions
  1. +135
    -0
      bitSpaceUtils.lpk
  2. +24
    -0
      bitSpaceUtils.pas
  3. +2
    -2
      uutlEvent.pas
  4. +73
    -79
      uutlEventManager.pas
  5. +2
    -1
      uutlListBase.pas
  6. +3
    -4
      uutlMCF.pas
  7. +12
    -12
      uutlObservable.pas
  8. +90
    -14
      uutlSyncObjs.pas

+ 135
- 0
bitSpaceUtils.lpk View File

@@ -0,0 +1,135 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="bitSpaceUtils"/>
<Type Value="RunAndDesignTime"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Files Count="26">
<Item1>
<Filename Value="uutlAlgorithm.pas"/>
<UnitName Value="uutlAlgorithm"/>
</Item1>
<Item2>
<Filename Value="uutlArrayContainer.pas"/>
<UnitName Value="uutlArrayContainer"/>
</Item2>
<Item3>
<Filename Value="uutlCommon.pas"/>
<UnitName Value="uutlCommon"/>
</Item3>
<Item4>
<Filename Value="uutlComparer.pas"/>
<UnitName Value="uutlComparer"/>
</Item4>
<Item5>
<Filename Value="uutlCompression.pas"/>
<UnitName Value="uutlCompression"/>
</Item5>
<Item6>
<Filename Value="uutlEmbeddedProfiler.inc"/>
<Type Value="Include"/>
</Item6>
<Item7>
<Filename Value="uutlEmbeddedProfiler.pas"/>
<UnitName Value="uutlEmbeddedProfiler"/>
</Item7>
<Item8>
<Filename Value="uutlEnumerator.pas"/>
<UnitName Value="uutlEnumerator"/>
</Item8>
<Item9>
<Filename Value="uutlEvent.pas"/>
<UnitName Value="uutlEvent"/>
</Item9>
<Item10>
<Filename Value="uutlEventManager.pas"/>
<UnitName Value="uutlEventManager"/>
</Item10>
<Item11>
<Filename Value="uutlFilter.pas"/>
<UnitName Value="uutlFilter"/>
</Item11>
<Item12>
<Filename Value="uutlGenerics.pas"/>
<UnitName Value="uutlGenerics"/>
</Item12>
<Item13>
<Filename Value="uutlInterfaces.pas"/>
<UnitName Value="uutlInterfaces"/>
</Item13>
<Item14>
<Filename Value="uutlKeyCodes.pas"/>
<UnitName Value="uutlKeyCodes"/>
</Item14>
<Item15>
<Filename Value="uutlLinq.pas"/>
<UnitName Value="uutlLinq"/>
</Item15>
<Item16>
<Filename Value="uutlListBase.pas"/>
<UnitName Value="uutlListBase"/>
</Item16>
<Item17>
<Filename Value="uutlLogger.pas"/>
<UnitName Value="uutlLogger"/>
</Item17>
<Item18>
<Filename Value="uutlMCF.pas"/>
<UnitName Value="uutlMCF"/>
</Item18>
<Item19>
<Filename Value="uutlObservable.pas"/>
<UnitName Value="uutlObservable"/>
</Item19>
<Item20>
<Filename Value="uutlProfilerBinaryFmt.inc"/>
<Type Value="Include"/>
</Item20>
<Item21>
<Filename Value="uutlSScanf.pas"/>
<UnitName Value="uutlSScanf"/>
</Item21>
<Item22>
<Filename Value="uutlStreamHelper.pas"/>
<UnitName Value="uutlStreamHelper"/>
</Item22>
<Item23>
<Filename Value="uutlSyncObjs.pas"/>
<UnitName Value="uutlSyncObjs"/>
</Item23>
<Item24>
<Filename Value="uutlThreads.pas"/>
<UnitName Value="uutlThreads"/>
</Item24>
<Item25>
<Filename Value="uutlTypes.pas"/>
<UnitName Value="uutlTypes"/>
</Item25>
<Item26>
<Filename Value="uutlXmlHelper.pas"/>
<UnitName Value="uutlXmlHelper"/>
</Item26>
</Files>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

+ 24
- 0
bitSpaceUtils.pas View File

@@ -0,0 +1,24 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}

unit bitSpaceUtils;

{$warn 5023 off : no warning about unused units}
interface

uses
uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlCompression, uutlEmbeddedProfiler, uutlEnumerator,
uutlEvent, uutlEventManager, uutlFilter, uutlGenerics, uutlInterfaces, uutlKeyCodes, uutlLinq, uutlListBase,
uutlLogger, uutlMCF, uutlObservable, uutlSScanf, uutlStreamHelper, uutlSyncObjs, uutlThreads, uutlTypes,
uutlXmlHelper, LazarusPackageIntf;

implementation

procedure Register;
begin
end;

initialization
RegisterPackage('bitSpaceUtils', @Register);
end.

+ 2
- 2
uutlEvent.pas View File

@@ -27,8 +27,8 @@ type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
IutlObservable = interface(IUnknown)
['{C54BD844-8273-4ACF-90C5-05DACF4359AF}']
procedure RegisterEventListener (const aListener: IutlEventListener);
procedure UnregisterEventListener(const aListener: IutlEventListener);
procedure RegisterEventListener (constref aListener: IutlEventListener);
procedure UnregisterEventListener(constref aListener: IutlEventListener);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////


+ 73
- 79
uutlEventManager.pas View File

@@ -19,7 +19,7 @@ type
TutlMouseButtons = set of TMouseButton;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlWinControlEvent = class(TutlEventArgs)
TutlWinControlEventArgs = class(TutlEventArgs)
private
fControl: TControl;
fEventType: TutlEventType;
@@ -36,7 +36,7 @@ type
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlMouseEvent = class(TutlWinControlEvent)
TutlMouseEventArgs = class(TutlWinControlEventArgs)
private
fButtons: TutlMouseButtons;
fClientPos: TPoint;
@@ -55,7 +55,7 @@ type
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlMouseWheelEvent = class(TutlWinControlEvent)
TutlMouseWheelEventArgs = class(TutlWinControlEventArgs)
private
fWheelDelta: Integer;
fClientPos: TPoint;
@@ -73,7 +73,7 @@ type
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlKeyEvent = class(TutlWinControlEvent)
TutlKeyEventArgs = class(TutlWinControlEventArgs)
private
fCharCode: WideChar;
fKeyCode: Word;
@@ -90,7 +90,7 @@ type
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlWindowEvent = class(TutlWinControlEvent)
TutlWindowEventArgs = class(TutlWinControlEventArgs)
private
fScreenRect: TRect;
fClientWidth: Cardinal;
@@ -192,34 +192,34 @@ type
procedure HandlerDeactivate (Sender: TObject);

protected
procedure RecordEvent(const aEvent: IutlEventArgs); virtual;
procedure RecordEvent(constref aEventArgs: IutlEventArgs); virtual;

function CreateMouseEvent(
function CreateMouseEventArgs(
aSender: TObject;
aType: TutlEventType;
aButtons: TutlMouseButtons;
aClientPos: TPoint): TutlMouseEvent; virtual;
aClientPos: TPoint): TutlMouseEventArgs; virtual;

function CreateMouseWheelEvent(
function CreateMouseWheelEventArgs(
aSender: TObject;
aDelta: Integer;
aClientPos: TPoint): TutlMouseWheelEvent; virtual;
aClientPos: TPoint): TutlMouseWheelEventArgs; virtual;

function CreateKeyEvent(
function CreateKeyEventArgs(
aSender: TObject; aType: TutlEventType;
aKey: Word): TutlKeyEvent; virtual;
aKey: Word): TutlKeyEventArgs; virtual;

function CreateWindowEvent(
function CreateWindowEventArgs(
aSender: TObject;
aType: TutlEventType): TutlWindowEvent; virtual;
aType: TutlEventType): TutlWindowEventArgs; virtual;

public
property Keyboard: TKeyboardState read fKeyboard;
property Mouse: TMouseState read fMouse;
property Window: TWindowState read fWindow;

procedure DispatchEvent(aEvent: IutlEventArgs); override;
procedure AttachEvents(const aControl: TWinControl; const aTypes: TutlEventTypes);
procedure DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
procedure AttachEvents (const aControl: TWinControl; const aTypes: TutlEventTypes);
end;

implementation
@@ -248,15 +248,9 @@ type
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlWinControlEvent////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlWinControlEventArgs////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWinControlEvent.GetControl: TControl;
begin
result := (Sender as TControl);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlWinControlEvent.Create(const aControl: TControl; const aEventType: TutlEventType);
constructor TutlWinControlEventArgs.Create(const aControl: TControl; const aEventType: TutlEventType);
begin
inherited Create;
fControl := aControl;
@@ -265,9 +259,9 @@ begin
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMouseEvent/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMouseEventArgs/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMouseEvent.Create(
constructor TutlMouseEventArgs.Create(
const aSender: TControl;
const aEventType: TutlEventType;
const aButtons: TutlMouseButtons;
@@ -280,9 +274,9 @@ begin
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMouseWheelEvent////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMouseWheelEventArgs////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMouseWheelEvent.Create(
constructor TutlMouseWheelEventArgs.Create(
const aSender: TControl;
const aWheelDelta: Integer;
const aClientPos: TPoint);
@@ -296,9 +290,9 @@ begin
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlKeyEvent///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlKeyEventArgs///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlKeyEvent.Create(
constructor TutlKeyEventArgs.Create(
const aSender: TControl;
const aEventType: TutlEventType;
const aCharCode: WideChar;
@@ -310,9 +304,9 @@ begin
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlWindowEvent////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlWindowEventArgs////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlWindowEvent.Create(
constructor TutlWindowEventArgs.Create(
const aSender: TControl;
const aEventType: TutlEventType;
const aScreenRect: TRect;
@@ -331,90 +325,90 @@ end;
procedure TutlWinControlEventManager.HandlerMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_DOWN, [ Button ], Point(X, Y)));
DispatchEvent(self, CreateMouseEventArgs(Sender, EVENT_MOUSE_DOWN, [ Button ], Point(X, Y)));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_UP, [Button], Point(X, Y)));
DispatchEvent(self, CreateMouseEventArgs(Sender, EVENT_MOUSE_UP, [Button], Point(X, Y)));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_MOVE, [], Point(X, Y)));
DispatchEvent(self, CreateMouseEventArgs(Sender, EVENT_MOUSE_MOVE, [], Point(X, Y)));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerMouseEnter(Sender: TObject);
begin
DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_ENTER, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
DispatchEvent(self, CreateMouseEventArgs(Sender, EVENT_MOUSE_ENTER, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerMouseLeave(Sender: TObject);
begin
DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_LEAVE, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
DispatchEvent(self, CreateMouseEventArgs(Sender, EVENT_MOUSE_LEAVE, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerClick(Sender: TObject);
begin
DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_CLICK, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
DispatchEvent(self, CreateMouseEventArgs(Sender, EVENT_MOUSE_CLICK, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerDblClick(Sender: TObject);
begin
DispatchEvent(CreateMouseEvent(Sender, EVENT_MOUSE_DBL_CLICK, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
DispatchEvent(self, CreateMouseEventArgs(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);
begin
DispatchEvent(CreateMouseWheelEvent(Sender, WheelDelta, MousePos));
DispatchEvent(self, CreateMouseWheelEventArgs(Sender, WheelDelta, MousePos));
Handled := false;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
DispatchEvent(CreateKeyEvent(Sender, EVENT_KEY_DOWN, Key));
DispatchEvent(self, CreateKeyEventArgs(Sender, EVENT_KEY_DOWN, Key));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
DispatchEvent(CreateKeyEvent(Sender, EVENT_KEY_UP, Key));
DispatchEvent(self, CreateKeyEventArgs(Sender, EVENT_KEY_UP, Key));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerResize(Sender: TObject);
begin
DispatchEvent(CreateWindowEvent(Sender, EVENT_WINDOW_RESIZE));
DispatchEvent(self, CreateWindowEventArgs(Sender, EVENT_WINDOW_RESIZE));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerActivate(Sender: TObject);
begin
DispatchEvent(CreateWindowEvent(Sender, EVENT_WINDOW_ACTIVATE));
DispatchEvent(self, CreateWindowEventArgs(Sender, EVENT_WINDOW_ACTIVATE));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerDeactivate(Sender: TObject);
begin
DispatchEvent(CreateWindowEvent(Sender, EVENT_WINDOW_DEACTIVATE));
DispatchEvent(self, CreateWindowEventArgs(Sender, EVENT_WINDOW_DEACTIVATE));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.RecordEvent(const aEvent: IutlEventArgs);
procedure TutlWinControlEventManager.RecordEvent(constref aEventArgs: IutlEventArgs);
var
me: TutlMouseEvent;
ke: TutlKeyEvent;
we: TutlWindowEvent;
mea: TutlMouseEventArgs;
kea: TutlKeyEventArgs;
wea: TutlWindowEventArgs;

function GetPressedButtons: TutlMouseButtons;
begin
@@ -432,34 +426,34 @@ var
end;

begin
if Supports(aEvent, TutlMouseEvent, me) then begin
fMouse.ClientPos := me.ClientPos;
fMouse.ScreenPos := me.ScreenPos;
case me.EventType of
if Supports(aEventArgs, TutlMouseEventArgs, mea) then begin
fMouse.ClientPos := mea.ClientPos;
fMouse.ScreenPos := mea.ScreenPos;
case mea.EventType of
EVENT_MOUSE_DOWN:
fMouse.Buttons := fMouse.Buttons + me.Buttons;
fMouse.Buttons := fMouse.Buttons + mea.Buttons;
EVENT_MOUSE_UP:
fMouse.Buttons := fMouse.Buttons - me.Buttons;
fMouse.Buttons := fMouse.Buttons - mea.Buttons;
EVENT_MOUSE_LEAVE:
fMouse.Buttons := [];
EVENT_MOUSE_ENTER:
fMouse.Buttons := GetPressedButtons;
end;

end else if Supports(aEvent, TutlKeyEvent, ke) then begin
case ke.EventType of
end else if Supports(aEventArgs, TutlKeyEventArgs, kea) then begin
case kea.EventType of
EVENT_KEY_DOWN,
EVENT_KEY_REPEAT: begin
fKeyboard.KeyState[ke.KeyCode and $FF] := true;
case ke.KeyCode of
fKeyboard.KeyState[kea.KeyCode and $FF] := true;
case kea.KeyCode of
VK_SHIFT: Include(fKeyboard.Modifiers, ssShift);
VK_MENU: Include(fKeyboard.Modifiers, ssAlt);
VK_CONTROL: Include(fKeyboard.Modifiers, ssCtrl);
end;
end;
EVENT_KEY_UP: begin
fKeyboard.KeyState[ke.KeyCode and $FF] := false;
case ke.KeyCode of
fKeyboard.KeyState[kea.KeyCode and $FF] := false;
case kea.KeyCode of
VK_SHIFT: Exclude(fKeyboard.Modifiers, ssShift);
VK_MENU: Exclude(fKeyboard.Modifiers, ssAlt);
VK_CONTROL: Exclude(fKeyboard.Modifiers, ssCtrl);
@@ -470,26 +464,26 @@ begin
then include(fKeyboard.Modifiers, ssAltGr)
else exclude(fKeyboard.Modifiers, ssAltGr);

end else if Supports(aEvent, TutlWindowEvent, we) then begin
case we.EventType of
end else if Supports(aEventArgs, TutlWindowEventArgs, wea) then begin
case wea.EventType of
EVENT_WINDOW_ACTIVATE:
fWindow.Active := true;
EVENT_WINDOW_DEACTIVATE:
fWindow.Active := false;
EVENT_WINDOW_RESIZE: begin
fWindow.ScreenRect := we.ScreenRect;
fWindow.ClientWidth := we.ClientWidth;
fWindow.ClientHeight := we.ClientHeight;
fWindow.ScreenRect := wea.ScreenRect;
fWindow.ClientWidth := wea.ClientWidth;
fWindow.ClientHeight := wea.ClientHeight;
end;
end;
end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWinControlEventManager.CreateMouseEvent(aSender: TObject; aType: TutlEventType;
aButtons: TutlMouseButtons; aClientPos: TPoint): TutlMouseEvent;
function TutlWinControlEventManager.CreateMouseEventArgs(aSender: TObject; aType: TutlEventType;
aButtons: TutlMouseButtons; aClientPos: TPoint): TutlMouseEventArgs;
begin
result := TutlMouseEvent.Create(
result := TutlMouseEventArgs.Create(
(aSender as TControl),
aType,
aButtons,
@@ -497,21 +491,21 @@ begin
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWinControlEventManager.CreateMouseWheelEvent(aSender: TObject; aDelta: Integer;
aClientPos: TPoint): TutlMouseWheelEvent;
function TutlWinControlEventManager.CreateMouseWheelEventArgs(aSender: TObject; aDelta: Integer;
aClientPos: TPoint): TutlMouseWheelEventArgs;
begin
result := TutlMouseWheelEvent.Create(
result := TutlMouseWheelEventArgs.Create(
(aSender as TControl),
aDelta,
aClientPos);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWinControlEventManager.CreateKeyEvent(aSender: TObject; aType: TutlEventType; aKey: Word): TutlKeyEvent;
function TutlWinControlEventManager.CreateKeyEventArgs(aSender: TObject; aType: TutlEventType; aKey: Word): TutlKeyEventArgs;
begin
if (aType = EVENT_KEY_DOWN) and fKeyboard.KeyState[aKey and $FF] then
aType := EVENT_KEY_REPEAT;
result := TutlKeyEvent.Create(
result := TutlKeyEventArgs.Create(
(aSender as TControl),
aType,
VKCodeToCharCode(aKey, fKeyboard.Modifiers),
@@ -519,7 +513,7 @@ begin
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWinControlEventManager.CreateWindowEvent(aSender: TObject; aType: TutlEventType): TutlWindowEvent;
function TutlWinControlEventManager.CreateWindowEventArgs(aSender: TObject; aType: TutlEventType): TutlWindowEventArgs;
var
p0, p1: TPoint;
begin
@@ -527,7 +521,7 @@ begin
p0 := ClientToScreen(Point(0, 0));
p1 := ClientToScreen(Point(Width, Height));
end;
result := TutlWindowEvent.Create(
result := TutlWindowEventArgs.Create(
(aSender as TControl),
aType,
Rect(p0.x, p0.y, p1.x, p1.y),
@@ -536,10 +530,10 @@ begin
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.DispatchEvent(aEvent: IutlEventArgs);
procedure TutlWinControlEventManager.DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
begin
RecordEvent(aEvent);
inherited DispatchEvent(aEvent);
RecordEvent(aEventArgs);
inherited DispatchEvent(aSender, aEventArgs);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////


+ 2
- 1
uutlListBase.pas View File

@@ -36,7 +36,7 @@ type
fNext: TEnumerator;
fPrev: TEnumerator;

protected { IEnumerator }
public { IEnumerator }
function GetCurrent: T; override;
function InternalMoveNext: Boolean; override;
procedure InternalReset; override;
@@ -261,6 +261,7 @@ begin
p := GetInternalItem(aIndex);
if (aIndex < fCount) then
System.Move(p^, (p+1)^, (fCount - aIndex) * SizeOf(T));
FillByte(p^, SizeOf(T), 0); // zero new item (to suppress _release call if it's an interface)
p^ := aValue;
inc(fCount);
UpdateEnumerator(aIndex, eaAdded);


+ 3
- 4
uutlMCF.pas View File

@@ -559,7 +559,7 @@ var
se: TutlMCFSection;
va: TutlMCFValue;
begin
reader:= TutlStreamReader.Create(Data);
reader:= TutlStreamReader.Create(Data, false);
try
repeat
l:= reader.ReadLine;
@@ -611,8 +611,7 @@ begin
end;
end;

procedure TutlMCFSection.SaveData(Stream: TStream; Indent: string;
LineEnds: TutlMCFLineEndMarkerMode);
procedure TutlMCFSection.SaveData(Stream: TStream; Indent: string; LineEnds: TutlMCFLineEndMarkerMode);
var
writer: TutlStreamWriter;
i: integer;
@@ -622,7 +621,7 @@ begin
ele:= sLineEndMarker
else
ele:= '';
writer:= TutlStreamWriter.Create(Stream);
writer:= TutlStreamWriter.Create(Stream, false);
try
for i:= 0 to FValues.Count - 1 do begin
s:= Indent + FValues[i] + ' ' + sValueDelim + ' ' + TutlMCFValue(FValues.Objects[i]).SaveData + ele;


+ 12
- 12
uutlObservable.pas View File

@@ -86,8 +86,8 @@ type
procedure DoClear (); virtual;

public { IutlObservable }
procedure RegisterEventListener(const aListener: IutlEventListener);
procedure UnregisterEventListener(const aListener: IutlEventListener);
procedure RegisterEventListener (constref aListener: IutlEventListener);
procedure UnregisterEventListener(constref aListener: IutlEventListener);

protected
procedure SetItem(const aIndex: Integer; aValue: T); override;
@@ -146,8 +146,8 @@ type
procedure DoClear (); virtual;

public { IutlObservable }
procedure RegisterEventListener(const aListener: IutlEventListener);
procedure UnregisterEventListener(const aListener: IutlEventListener);
procedure RegisterEventListener (constref aListener: IutlEventListener);
procedure UnregisterEventListener(constref aListener: IutlEventListener);

public
procedure Clear; override;
@@ -213,8 +213,8 @@ type
procedure DoClear (); virtual;

public { IutlObservable }
procedure RegisterEventListener(const aListener: IutlEventListener);
procedure UnregisterEventListener(const aListener: IutlEventListener);
procedure RegisterEventListener (constref aListener: IutlEventListener);
procedure UnregisterEventListener(constref aListener: IutlEventListener);

public
constructor Create(const aHashSet: TObservableHashSet; const aOwnsKeys: Boolean; const aOwnsValues: Boolean); reintroduce;
@@ -334,13 +334,13 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlObservableCustomList.RegisterEventListener(const aListener: IutlEventListener);
procedure TutlObservableCustomList.RegisterEventListener(constref aListener: IutlEventListener);
begin
fEventListener.Add(aListener);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlObservableCustomList.UnregisterEventListener(const aListener: IutlEventListener);
procedure TutlObservableCustomList.UnregisterEventListener(constref aListener: IutlEventListener);
begin
fEventListener.Remove(aListener);
end;
@@ -458,13 +458,13 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlObservableCustomHashSet.RegisterEventListener(const aListener: IutlEventListener);
procedure TutlObservableCustomHashSet.RegisterEventListener(constref aListener: IutlEventListener);
begin
fEventListener.Add(aListener);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlObservableCustomHashSet.UnregisterEventListener(const aListener: IutlEventListener);
procedure TutlObservableCustomHashSet.UnregisterEventListener(constref aListener: IutlEventListener);
begin
fEventListener.Remove(aListener);
end;
@@ -610,13 +610,13 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlObservableCustomMap.RegisterEventListener(const aListener: IutlEventListener);
procedure TutlObservableCustomMap.RegisterEventListener(constref aListener: IutlEventListener);
begin
fEventListener.Add(aListener);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlObservableCustomMap.UnregisterEventListener(const aListener: IutlEventListener);
procedure TutlObservableCustomMap.UnregisterEventListener(constref aListener: IutlEventListener);
begin
fEventListener.Remove(aListener);
end;


+ 90
- 14
uutlSyncObjs.pas View File

@@ -6,16 +6,9 @@ interface

uses
Classes, SysUtils, syncobjs,
uutlGenerics;
uutlGenerics, uutlCommon;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
IutlLockable = interface(IUnknown)
['{CF01F747-D6A9-405B-8A8D-AC148FA9DABB}']
procedure Lock;
procedure Unlock;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlCheckSynchronizeEvent = class(TObject)
private
@@ -62,7 +55,17 @@ type
TutlAutoResetEvent = TAutoResetEvent;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlSpinLock = class
IutlLockable = interface(IUnknown)
['{CF01F747-D6A9-405B-8A8D-AC148FA9DABB}']
procedure Lock;
procedure Unlock;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlSpinLock = class(
TutlInterfacedObject
, IutlLockable)

private
fLock: DWord;
fLockReused: integer;
@@ -70,11 +73,35 @@ type
public
procedure Enter;
procedure Leave;
procedure Lock; inline;
procedure Unlock; inline;

constructor Create;
destructor Destroy; override;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TutlCriticalSection = class(
TCriticalSection
, IutlLockable)

strict private
fRefCount: Integer;
fAutoFree: Boolean;

public
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};
function _Release: longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};

public
property RefCount: Integer read fRefCount;
property AutoFree: Boolean read fAutoFree write fAutoFree;

procedure Lock; inline;
procedure Unlock; inline;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic IutlLock<T> = interface(IUnknown)
function LockedObject: T;
@@ -84,14 +111,15 @@ type
generic TutlLock<T> = class(
TInterfacedObject,
specialize IutlLock<T>)

private
fLock: TCriticalSection;
fLock: IutlLockable;
fObject: T;

public
function LockedObject: T; inline;

constructor Create(const aLock: TCriticalSection; const aObject: T);
constructor Create(constref aLock: IutlLockable; constref aObject: T);
destructor Destroy; override;
end;

@@ -242,6 +270,18 @@ begin
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSpinLock.Lock;
begin
Enter;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSpinLock.Unlock;
begin
Leave;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlSpinLock.Create;
begin
@@ -257,6 +297,42 @@ begin
inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCriticalSection///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCriticalSection.QueryInterface(constref iid: tguid; out obj): longint; stdcall;
begin
if GetInterface(iid,obj)
then result := S_OK
else result := longint(E_NOINTERFACE);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCriticalSection._AddRef: longint; stdcall;
begin
result := InterLockedIncrement(fRefCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCriticalSection._Release: longint; stdcall;
begin
result := InterLockedDecrement(fRefCount);
if (result <= 0) and fAutoFree then
Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCriticalSection.Lock;
begin
Enter;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCriticalSection.Unlock;
begin
Leave;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlLock//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -266,20 +342,20 @@ begin
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlLock.Create(const aLock: TCriticalSection; const aObject: T);
constructor TutlLock.Create(constref aLock: IutlLockable; constref aObject: T);
begin
inherited Create;
if not Assigned(aLock) then
raise EArgumentNilException.Create('aLock');
fObject := aObject;
fLock := aLock;
fLock.Enter;
fLock.Lock;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlLock.Destroy;
begin
fLock.Leave;
fLock.Unlock;
inherited Destroy;
end;



Loading…
Cancel
Save