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

LCL: Fix ReleaseComponents hang with modal window. Issue #0021451

Browse Source 
git-svn-id: trunk@64435 -
This commit is contained in:
martin 2021-01-29 18:53:45 +00:00
parent b269bcc49f
commit 6fc365af0b
2 changed files with 58 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/forms.pp
View File

@ -1356,6 +1356,8 @@ type
FCaptureExceptions: boolean;
FComponentsToRelease: TFPList;
FComponentsReleasing: TFPList;
FComponentsToReleaseSavedByModal: TFPList;
FComponentsReleasingSavedByModal: TFPList;
FCreatingForm: TForm;// currently created form (CreateForm), candidate for MainForm
FDoubleBuffered: TApplicationDoubleBuffered;
FExceptionDialog: TApplicationExceptionDlg;

56
lcl/include/application.inc
View File

@ -257,6 +257,8 @@ end;
------------------------------------------------------------------------------}
procedure TApplication.Notification(AComponent : TComponent;
Operation : TOperation);
var
l: TFPList;
begin
if Operation = opRemove then begin
FLastMouseControlValid:=false;
@ -270,8 +272,16 @@ begin
FHintTimer:=nil;
if FComponentsToRelease<>nil then
FComponentsToRelease.Remove(AComponent);
if FComponentsToReleaseSavedByModal<>nil then
for Pointer(l) in FComponentsToReleaseSavedByModal do
if l <> nil then
l.Remove(AComponent);
if FComponentsReleasing<>nil then
FComponentsReleasing.Remove(AComponent);
if FComponentsReleasingSavedByModal<>nil then
for Pointer(l) in FComponentsReleasingSavedByModal do
if l <> nil then
l.Remove(AComponent);
if AComponent = MainForm then begin
FMainForm:= nil;
Terminate;
@ -317,6 +327,15 @@ end;
procedure TApplication.ModalStarted;
begin
inc(FModalLevel);
if FComponentsToReleaseSavedByModal = nil then
FComponentsToReleaseSavedByModal := TFPList.Create;
FComponentsToReleaseSavedByModal.Add(FComponentsToRelease);
FComponentsToRelease := nil;
(* If a component calls ShowModal while being destroyed by ReleaseComponents then FComponentsReleasing may be <> nil *)
if FComponentsReleasingSavedByModal = nil then
FComponentsReleasingSavedByModal := TFPList.Create;
FComponentsReleasingSavedByModal.Add(FComponentsReleasing);
FComponentsReleasing := nil;
if (FModalLevel = 1) then
begin
if Assigned(FOnModalBegin) then
@ -327,6 +346,9 @@ begin
end;
procedure TApplication.ModalFinished;
var
l: TFPList;
c: Pointer;
begin
dec(FModalLevel);
RestoreStayOnTop(True);
@ -336,6 +358,40 @@ begin
FOnModalEnd(Self);
FApplicationHandlers[ahtModalEnd].CallNotifyEvents(Self);
end;
// Cannot leave modal, while in ReleaseComponents
assert(FComponentsReleasing = nil, 'TApplication.ModalFinished: FComponentsReleasing = nil');
assert(FComponentsToReleaseSavedByModal.Count > 0, 'TApplication.ModalFinished: FComponentsToReleaseSavedByModal.Count > 0');
if FComponentsToReleaseSavedByModal.Count > 0 then begin
l := TFPList(FComponentsToReleaseSavedByModal[FComponentsToReleaseSavedByModal.Count - 1]);
FComponentsToReleaseSavedByModal.Delete(FComponentsToReleaseSavedByModal.Count - 1);
if l <> nil then begin
if FComponentsToRelease <> nil then begin
for c in FComponentsToRelease do
l.Add(c);
FComponentsToRelease.Free;
end;
FComponentsToRelease := l;
end;
if FComponentsToRelease <> nil then
QueueAsyncCall(@FreeComponent, 0);
l := TFPList(FComponentsReleasingSavedByModal[FComponentsReleasingSavedByModal.Count - 1]);
FComponentsReleasingSavedByModal.Delete(FComponentsReleasingSavedByModal.Count - 1);
if l <> nil then begin
if FComponentsReleasing <> nil then begin
for c in FComponentsReleasing do
l.Add(c);
FComponentsReleasing.Free;
end;
FComponentsReleasing := l;
end;
end;
if (FModalLevel = 0) then
begin
assert(FComponentsToReleaseSavedByModal.Count = 0, 'TApplication.ModalFinished: FComponentsToReleaseSavedByModal.Count = 0');
FreeAndNil(FComponentsToReleaseSavedByModal);
FreeAndNil(FComponentsReleasingSavedByModal);
end;
end;
{------------------------------------------------------------------------------