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

LCL: fixed TApplication.ReleaseComponent

Browse Source 
git-svn-id: trunk@11232 -
This commit is contained in:
mattias 2007-05-30 23:10:09 +00:00
parent 6b008b956d
commit 06efcb6461
2 changed files with 44 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lcl/forms.pp
View File

@ -37,9 +37,10 @@ interface
{$DEFINE HasDefaultValues}
uses
Classes, SysUtils, TypInfo, Math, LCLStrConsts, LCLType, LCLProc, LCLIntf,
Classes, SysUtils, TypInfo, Math,
AvgLvlTree, Maps, LCLStrConsts, LCLType, LCLProc, LCLIntf,
InterfaceBase, LResources, GraphType, Graphics, Menus, LMessages, CustomTimer,
ActnList, ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls, maps;
ActnList, ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls;
type
TProcedure = procedure;
@ -890,6 +891,7 @@ type
FApplicationHandlers: array[TApplicationHandlerType] of TMethodList;
FApplicationType: TApplicationType;
FCaptureExceptions: boolean;
FComponentsToRelease: TAvgLvlTree;
FCreatingForm: TForm;// currently created form (CreateForm), candidate for MainForm
FFindGlobalComponentEnabled: boolean;
FFlags: TApplicationFlags;
@ -992,7 +994,7 @@ type
procedure BringToFront;
procedure CreateForm(InstanceClass: TComponentClass; out Reference);
procedure UpdateMainForm(AForm: TForm);
procedure QueueAsyncCall(AMethod: TDataEvent; Data: PtrInt);
procedure QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt);
procedure ReleaseComponent(AComponent: TComponent);
function ExecuteAction(ExeAction: TBasicAction): Boolean; override;
function UpdateAction(TheAction: TBasicAction): Boolean; override;

48
lcl/include/application.inc
View File

@ -143,14 +143,17 @@ begin
UnregisterFindGlobalComponentProc(@FindApplicationComponent);
DebugLn(['TApplication.Destroy AAA6']);
inherited Destroy;
Include(FFlags,AppDoNotCallAsyncQueue);
DebugLn(['TApplication.Destroy AAA7']);
ProcessAsyncCallQueue;
// restore exception handling
CaptureExceptions:=false;
LCLProc.SendApplicationMessageFunction:=nil;
DebugLn(['TApplication.Destroy END']);
end;
{------------------------------------------------------------------------------
@ -193,21 +196,22 @@ procedure TApplication.Notification(AComponent : TComponent;
begin
if Operation = opRemove then begin
FLastMouseControlValid:=false;
if AComponent=FMouseControl then FMouseControl:=nil;
if AComponent=FCreatingForm then begin
if AComponent=FMouseControl then
FMouseControl:=nil;
if AComponent=FCreatingForm then
FCreatingForm:=nil;
end;
if AComponent=FHintWindow then begin
if AComponent=FHintWindow then
FHintWindow:=nil;
end;
if AComponent=FHintTimer then begin
if AComponent=FHintTimer then
FHintTimer:=nil;
end;
if FComponentsToRelease<>nil then
FComponentsToRelease.Remove(AComponent);
if AComponent = MainForm then begin
FMainForm:= nil;
Terminate;
end;
end;
inherited Notification(AComponent,Operation);
end;
{------------------------------------------------------------------------------
@ -1611,7 +1615,7 @@ begin
FMainForm := AForm;
end;
procedure TApplication.QueueAsyncCall(AMethod: TDataEvent; Data: PtrInt);
procedure TApplication.QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt);
var
lItem: PAsyncCallQueueItem;
begin
@ -1629,13 +1633,39 @@ begin
end;
procedure TApplication.FreeComponent(Data: PtrInt);
var
OldComponents: TAvgLvlTree;
begin
TComponent(Data).Free;
if FComponentsToRelease<>nil then begin
OldComponents:=FComponentsToRelease;
FComponentsToRelease:=nil;
OldComponents.FreeAndClear;
OldComponents.Free;
end;
end;
procedure TApplication.ReleaseComponent(AComponent: TComponent);
var
IsFirstItem: Boolean;
begin
QueueAsyncCall(@FreeComponent, PtrInt(AComponent));
if csDestroying in AComponent.ComponentState then exit;
if AppDestroying in FFlags then begin
// free immediately
AComponent.Free;
end else begin
// free later
// => add to the FComponentsToRelease
IsFirstItem:=FComponentsToRelease=nil;
if IsFirstItem then
FComponentsToRelease:=TAvgLvlTree.Create(@ComparePointers)
else if FComponentsToRelease.Find(AComponent)<>nil then
exit;
FComponentsToRelease.Add(AComponent);
AComponent.FreeNotification(Self);
if IsFirstItem then
QueueAsyncCall(@FreeComponent, 0);
end;
end;
function TApplication.ExecuteAction(ExeAction: TBasicAction): Boolean;