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

lcl: application: add handlers to exception circle.

Browse Source 
git-svn-id: trunk@52713 -
This commit is contained in:
ondrej 2016-07-19 06:10:56 +00:00
parent c13e223026
commit 6fb78bd5f9
3 changed files with 37 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
docs/xml/lcl/forms.xml
View File

@ -5841,6 +5841,8 @@
<notes><note>?</note><note>application/taskbar window?</note><note>purpose?</note><note>what's the purpose for *not* returning MainForm.Handle???</note>
</notes>
</element>
<element name="TApplicationHandlerType.ahtExceptionCircle"><short>Handler invoked when there is an exception circle before killing the app with Halt</short>
</element>
<!-- pointer type Visibility: default -->
<element name="PAsyncCallQueueItem" link="TAsyncCallQueueItem">
<short>A queued asynchronous callback request node.</short>
@ -9317,6 +9319,14 @@ Before 0.9.31 there was no exception. Therefore some resourceless forms might us
<errors/>
<seealso/>
</element>
<element name="TApplication.OnExceptionCircle"><short>Handler invoked when there is an exception circle before killing the app with Halt</short>
</element>
<element name="TApplication.AddOnExceptionCircleHandler"><short>Adds an application exception circle handler.</short><seealso><link id="TApplicationHandlerType.ahtExceptionCircle"/>
</seealso>
</element>
<element name="TApplication.RemoveOnExceptionCircleHandler"><short>Removes an application exception circle handler.</short><seealso><link id="TApplicationHandlerType.ahtExceptionCircle"/>
</seealso>
</element>
</module>
<!-- Forms -->
</package>

7
lcl/forms.pp
View File

@ -1218,7 +1218,8 @@ type
ahtHelp,
ahtHint,
ahtShowHint,
ahtGetMainFormHandle
ahtGetMainFormHandle,
ahtExceptionCircle
);
PAsyncCallQueueItem = ^TAsyncCallQueueItem;
@ -1300,6 +1301,7 @@ type
FMainFormOnTaskBar: Boolean;
FModalLevel: Integer;
FMoveFormFocusToChildren: Boolean;
FOnExceptionCircle: TExceptionEvent;
FOnGetMainFormHandle: TGetHandleEvent;
FOnMessageDialogFinished: TModalDialogFinished;
FOnModalBegin: TNotifyEvent;
@ -1466,6 +1468,8 @@ type
procedure RemoveOnDeactivateHandler(Handler: TNotifyEvent);
procedure AddOnExceptionHandler(Handler: TExceptionEvent; AsFirst: Boolean=true);
procedure RemoveOnExceptionHandler(Handler: TExceptionEvent);
procedure AddOnExceptionCircleHandler(Handler: TExceptionEvent; AsFirst: Boolean=true);
procedure RemoveOnExceptionCircleHandler(Handler: TExceptionEvent);
procedure AddOnEndSessionHandler(Handler: TNotifyEvent; AsFirst: Boolean=true);
procedure RemoveOnEndSessionHandler(Handler: TNotifyEvent);
procedure AddOnQueryEndSessionHandler(Handler: TQueryEndSessionEvent; AsFirst: Boolean=true);
@ -1562,6 +1566,7 @@ type
property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint;
property OnUserInput: TOnUserInputEvent read FOnUserInput write FOnUserInput;
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
property OnExceptionCircle: TExceptionEvent read FOnExceptionCircle write FOnExceptionCircle;
property ShowButtonGlyphs: TApplicationShowGlyphs read FShowButtonGlyphs write SetShowButtonGlyphs default sbgAlways;
property ShowMenuGlyphs: TApplicationShowGlyphs read FShowMenuGlyphs write SetShowMenuGlyphs default sbgAlways;
property ShowHint: Boolean read FShowHint write SetShowHint;

21
lcl/include/application.inc
View File

@ -1194,6 +1194,16 @@ begin
// there was an exception during showing the exception -> break the circle
DebugLn('TApplication.HandleException: ',
'there was another exception during showing the first exception');
if (ExceptObject is Exception) then
begin
if Assigned(OnExceptionCircle) then
OnExceptionCircle(Sender, Exception(ExceptObject));
i := FApplicationHandlers[ahtExceptionCircle].Count;
while FApplicationHandlers[ahtException].NextDownIndex(i) do
TExceptionEvent(FApplicationHandlers[ahtExceptionCircle][i])(Sender, Exception(ExceptObject));
end;
HaltingProgram:=true;
DumpExceptionBackTrace;
Halt;
@ -1803,11 +1813,22 @@ begin
AddHandler(ahtEndSession,TMethod(Handler),AsFirst);
end;
procedure TApplication.AddOnExceptionCircleHandler(Handler: TExceptionEvent;
AsFirst: Boolean);
begin
AddHandler(ahtExceptionCircle,TMethod(Handler),AsFirst);
end;
procedure TApplication.RemoveOnEndSessionHandler(Handler: TNotifyEvent);
begin
RemoveHandler(ahtEndSession,TMethod(Handler));
end;
procedure TApplication.RemoveOnExceptionCircleHandler(Handler: TExceptionEvent);
begin
RemoveHandler(ahtExceptionCircle,TMethod(Handler));
end;
procedure TApplication.AddOnQueryEndSessionHandler(
Handler: TQueryEndSessionEvent; AsFirst: Boolean);
begin