paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-11 04:19:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

cocoa: moved post event object collection to the proper unit

Browse Source 
git-svn-id: trunk@61387 -
This commit is contained in:
dmitry 2019-06-14 13:47:19 +00:00
parent 55d93d4cfb
commit 9d37096ca3
2 changed files with 80 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
lcl/interfaces/cocoa/cocoaint.pas
View File

@ -709,6 +709,86 @@ begin
Result := Assigned(Modals) and (Modals.Count > 0);
end;
type
{ TToCollectItem }
TToCollectItem = class(TObject)
// reference count is needed, in case the event processing
// goes into a recursion (i.e. a modal window)
// Thus the object added at the start of event, should not be released
// until its "event loop" is actually finishing
refCount: Integer;
obj: TObject;
constructor Create(aobj: TObject);
destructor Destroy; override;
end;
{ TToCollectItem }
constructor TToCollectItem.Create(aobj: TObject);
begin
inherited Create;
obj := aobj;
refCount := 1;
end;
destructor TToCollectItem.Destroy;
begin
obj.Free;
inherited;
end;
procedure TCocoaWidgetSet.AddToCollect(obj: TObject);
var
i : integer;
begin
// let's try to find an object. Do not add a duplicate
for i := 0 to ToCollect.Count - 1 do
if TToCollectItem(ToCollect[i]).obj=obj then
Exit;
ToCollect.Add(TToCollectItem.Create(obj));
end;
procedure TCocoaWidgetSet.RetainToCollect;
var
i : Integer;
cl : TToCollectItem;
begin
for i := 0 to ToCollect.Count - 1 do
begin
cl := TToCollectItem(ToCollect[i]);
inc(cl.refCount);
end;
end;
procedure TCocoaWidgetSet.ReleaseToCollect;
var
cl : TToCollectItem;
i : integer;
begin
for i := 0 to ToCollect.Count - 1 do
begin
cl := TToCollectItem(ToCollect[i]);
dec(cl.refCount);
if cl.refCount = 0 then
begin
cl.Free;
ToCollect[i] := nil;
end;
end;
ToCollect.Pack;
end;
procedure TCocoaWidgetSet.ReleaseAllToCollect;
var
i : integer;
begin
for i := 0 to ToCollect.Count - 1 do
TToCollectItem(ToCollect[i]).Free;
ToCollect.Clear;
end;
initialization
// {$I Cocoaimages.lrs}
InternalInit;

79
lcl/interfaces/cocoa/cocoalclintf.inc
View File

@ -735,85 +735,6 @@ begin
Result := True;
end;
type
{ TToCollectItem }
TToCollectItem = class(TObject)
// reference count is needed, in case the event processing
// goes into a recursion (i.e. a modal window)
// Thus the object added at the start of event, should not be released
// until its "event loop" is actually finishing
refCount: Integer;
obj: TObject;
constructor Create(aobj: TObject);
destructor Destroy; override;
end;
{ TToCollectItem }
constructor TToCollectItem.Create(aobj: TObject);
begin
inherited Create;
obj := aobj;
refCount := 1;
end;
destructor TToCollectItem.Destroy;
begin
obj.Free;
inherited;
end;
procedure TCocoaWidgetSet.AddToCollect(obj: TObject);
var
i : integer;
begin
// let's try to find an object. Do not add a duplicate
for i := 0 to ToCollect.Count - 1 do
if TToCollectItem(ToCollect[i]).obj=obj then
Exit;
ToCollect.Add(TToCollectItem.Create(obj));
end;
procedure TCocoaWidgetSet.RetainToCollect;
var
i : Integer;
cl : TToCollectItem;
begin
for i := 0 to ToCollect.Count - 1 do
begin
cl := TToCollectItem(ToCollect[i]);
inc(cl.refCount);
end;
end;
procedure TCocoaWidgetSet.ReleaseToCollect;
var
cl : TToCollectItem;
i : integer;
begin
for i := 0 to ToCollect.Count - 1 do
begin
cl := TToCollectItem(ToCollect[i]);
dec(cl.refCount);
if cl.refCount = 0 then
begin
cl.Free;
ToCollect[i] := nil;
end;
end;
ToCollect.Pack;
end;
procedure TCocoaWidgetSet.ReleaseAllToCollect;
var
i : integer;
begin
for i := 0 to ToCollect.Count - 1 do
TToCollectItem(ToCollect[i]).Free;
ToCollect.Clear;
end;
{------------------------------------------------------------------------------
Function: RawImage_QueryDescription