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

TApplication now uses ExitProc to free itself before all finaizations

Browse Source 
git-svn-id: trunk@6852 -
This commit is contained in:
mattias 2005-02-26 20:43:54 +00:00
parent 75695b098e
commit 5baf8a8fef
2 changed files with 24 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lcl/forms.pp
View File

@ -890,8 +890,10 @@ type
FMouseControl: TControl; FMouseControl: TControl;
FNavigation: TApplicationNavigationOptions; FNavigation: TApplicationNavigationOptions;
FOldExceptProc: TExceptProc; FOldExceptProc: TExceptProc;
FOldExitProc: Pointer;
FOnActionExecute: TActionEvent; FOnActionExecute: TActionEvent;
FOnActionUpdate: TActionEvent; FOnActionUpdate: TActionEvent;
FOnDestroy: TNotifyEvent;
FOnHelp: THelpEvent; FOnHelp: THelpEvent;
FOnHint: TNotifyEvent; FOnHint: TNotifyEvent;
FOnIdle: TIdleEvent; FOnIdle: TIdleEvent;
@ -1020,6 +1022,7 @@ type
property OnShortcut: TShortcutEvent read FOnShortcut write FOnShortcut; property OnShortcut: TShortcutEvent read FOnShortcut write FOnShortcut;
property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint; property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint;
property OnUserInput: TOnUserInputEvent read FOnUserInput write FOnUserInput; property OnUserInput: TOnUserInputEvent read FOnUserInput write FOnUserInput;
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
property ShowHint: Boolean read FShowHint write SetShowHint; property ShowHint: Boolean read FShowHint write SetShowHint;
property Title: String read GetTitle write SetTitle; property Title: String read GetTitle write SetTitle;
end; end;
@ -1252,7 +1255,8 @@ end;
{$IFDEF ExceptionHasNoFrames} {$IFDEF ExceptionHasNoFrames}
procedure ExceptionOccurred(Sender: TObject; Addr,Frame: Pointer); procedure ExceptionOccurred(Sender: TObject; Addr,Frame: Pointer);
{$ELSE} {$ELSE}
procedure ExceptionOccurred(Sender: TObject; Addr:Pointer; FrameCount:Longint; Frames: PPointer); procedure ExceptionOccurred(Sender: TObject; Addr:Pointer; FrameCount: Longint;
Frames: PPointer);
var var
FrameNumber: integer; FrameNumber: integer;
{$ENDIF} {$ENDIF}
@ -1277,6 +1281,12 @@ Begin
HandlingException:=false; HandlingException:=false;
end; end;
procedure BeforeFinalization;
// This is our ExitProc handler.
begin
FreeInterfaceObject;
end;
//------------------------------------------------------------------------------ //------------------------------------------------------------------------------
// The focus state is just the focus count for now. To save having to allocate // The focus state is just the focus count for now. To save having to allocate
// anything, I just map the Integer to the TFocusState. // anything, I just map the Integer to the TFocusState.
@ -1430,6 +1440,7 @@ end;
procedure FreeInterfaceObject; procedure FreeInterfaceObject;
begin begin
//debugln('FreeInterfaceObject'); //debugln('FreeInterfaceObject');
if Application=nil then exit;
Application.Free; Application.Free;
Application:=nil; Application:=nil;
FreeAllClipBoards; FreeAllClipBoards;

12
lcl/include/application.inc
View File

@ -96,6 +96,8 @@ begin
inherited Create(AOwner); inherited Create(AOwner);
CaptureExceptions:=true; CaptureExceptions:=true;
FOldExitProc:=ExitProc;
ExitProc:=@BeforeFinalization;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -105,7 +107,14 @@ destructor TApplication.Destroy;
var var
HandlerType: TApplicationHandlerType; HandlerType: TApplicationHandlerType;
begin begin
if Self=nil then
RaiseGDBException('TApplication.Destroy Self=nil');
Include(FFlags,AppDestroying); Include(FFlags,AppDestroying);
if Assigned(FOnDestroy) then FOnDestroy(Self);
ExitProc:=FOldExitProc;
DoFreeReleaseComponents; DoFreeReleaseComponents;
if OnMenuPopupHandler=@MenuPopupHandler then if OnMenuPopupHandler=@MenuPopupHandler then
OnMenuPopupHandler:=nil; OnMenuPopupHandler:=nil;
@ -1409,6 +1418,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.104 2005/02/26 20:43:54 mattias
TApplication now uses ExitProc to free itself before all finaizations
Revision 1.103 2005/02/26 20:26:03 mattias Revision 1.103 2005/02/26 20:26:03 mattias
fixed hint size and activate fixed hint size and activate