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

application dump stack only if no AppNoExceptionMessages is set

Browse Source 
git-svn-id: trunk@9261 -
This commit is contained in:
mattias 2006-05-13 08:20:31 +00:00
parent e0bb1797fc
commit 003ec5d0f6
3 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
ideintf/helpintf.pas
View File

@ -530,8 +530,6 @@ type
{ THelpDatabases
Class for storing all registered THelpDatabase }
{ THelpDatabases }
THelpDatabases = class
private
FItems: TList;
@ -597,6 +595,7 @@ type
function GetNodesForMessage(const AMessage: string; MessageParts: TStrings;
var ListOfNodes: THelpNodeQueryList;
var ErrMsg: string): TShowHelpResult; virtual;
// Show the help selector
function ShowHelpSelector(Query: THelpQuery; Nodes: THelpNodeQueryList;
var ErrMsg: string;
var Selection: THelpNodeQuery

2
lcl/forms.pp
View File

@ -927,6 +927,7 @@ type
procedure IconChanged(Sender: TObject);
function InvokeHelp(Command: Word; Data: Longint): Boolean;
function GetControlAtMouse: TControl;
procedure SetFlags(const AValue: TApplicationFlags);
procedure SetNavigation(const AValue: TApplicationNavigationOptions);
procedure UpdateMouseControl(NewMouseControl: TControl);
procedure MouseIdle(const CurrentControl: TControl);
@ -1035,6 +1036,7 @@ type
write SetCaptureExceptions;
property FindGlobalComponentEnabled: boolean read FFindGlobalComponentEnabled
write FFindGlobalComponentEnabled;
property Flags: TApplicationFlags read FFlags write SetFlags;
//property HelpSystem : IHelpSystem read FHelpSystem;
property Hint: string read FHint write SetHint;
property HintColor: TColor read FHintColor write SetHintColor;

20
lcl/include/application.inc
View File

@ -424,6 +424,12 @@ begin
end;
end;
procedure TApplication.SetFlags(const AValue: TApplicationFlags);
begin
{ Only allow AppNoExceptionMessages to be changed }
FFlags := Flags - [AppNoExceptionMessages] + AValue*[AppNoExceptionMessages];
end;
procedure TApplication.SetNavigation(const AValue: TApplicationNavigationOptions
);
begin
@ -876,13 +882,15 @@ begin
Include(FFlags,AppHandlingException);
if StopOnException then
inherited Terminate;
// before we do anything, write it down
if ExceptObject is Exception then begin
DebugLn('TApplication.HandleException ',Exception(ExceptObject).Message);
end else begin
DebugLn('TApplication.HandleException Strange Exception ');
if not (AppNoExceptionMessages in FFlags) then begin
// before we do anything, write it down
if ExceptObject is Exception then begin
DebugLn('TApplication.HandleException ',Exception(ExceptObject).Message);
end else begin
DebugLn('TApplication.HandleException Strange Exception ');
end;
DumpExceptionBackTrace;
end;
DumpExceptionBackTrace;
// release capture and hide all forms with stay on top, so that
// a message can be shown
if GetCapture <> 0 then SendMessage(GetCapture, LM_CANCELMODE, 0, 0);