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

LCL: added Application.RemoveAsyncQueue(Object)

Browse Source 
git-svn-id: trunk@25671 -
This commit is contained in:
martin 2010-05-26 22:12:31 +00:00
parent 9590345c0c
commit cc7d32817b
2 changed files with 37 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/forms.pp
View File

@ -1288,6 +1288,7 @@ type
procedure CreateForm(InstanceClass: TComponentClass; out Reference);
procedure UpdateMainForm(AForm: TForm);
procedure QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt);
procedure RemoveAsyncCalls(const AnObject: TObject);
procedure ReleaseComponent(AComponent: TComponent);
function ExecuteAction(ExeAction: TBasicAction): Boolean; override;
function UpdateAction(TheAction: TBasicAction): Boolean; override;

36
lcl/include/application.inc
View File

@ -2131,6 +2131,42 @@ begin
end;
end;
procedure TApplication.RemoveAsyncCalls(const AnObject: TObject);
procedure DoRemoveAsyncCalls(var AQueue: TAsyncCallQueue);
var
lItem, lItem2: PAsyncCallQueueItem;
begin
lItem := AQueue.Last;
while lItem <> nil do begin
if TMethod(lItem^.Method).Data = Pointer(AnObject) then begin
if lItem^.NextItem <> nil then
lItem^.NextItem^.PrevItem := lItem^.PrevItem;
if lItem^.PrevItem <> nil then
lItem^.PrevItem^.NextItem := lItem^.NextItem;
if lItem = AQueue.Last then
AQueue.Last := lItem^.PrevItem;
if lItem = AQueue.Top then
AQueue.Top := lItem^.NextItem;
lItem2 := lItem;
lItem := lItem^.PrevItem;
Dispose(lItem2);
end
else
lItem := lItem^.PrevItem;
end;
end;
begin
if AppDoNotCallAsyncQueue in FFlags then
raise Exception.Create('TApplication.QueueAsyncCall already shut down');
DoRemoveAsyncCalls(FAsyncCall.Cur);
DoRemoveAsyncCalls(FAsyncCall.Next);
end;
procedure TApplication.FreeComponent(Data: PtrInt);
begin
if Data<>0 then