mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-09 19:08:03 +02:00
disabling idle handler during TApplication error handling
git-svn-id: trunk@6793 -
This commit is contained in:
parent
8d74a139b2
commit
9ed4753dc8
@ -860,6 +860,8 @@ type
|
||||
ahtUserInput
|
||||
);
|
||||
|
||||
{ TApplication }
|
||||
|
||||
TApplication = class(TCustomApplication)
|
||||
private
|
||||
FApplicationHandlers: array[TApplicationHandlerType] of TMethodList;
|
||||
@ -877,6 +879,7 @@ type
|
||||
FHintTimerType: TAppHintTimerType;
|
||||
FHintWindow: THintWindow;
|
||||
FIcon: TIcon;
|
||||
FIdleLockCount: Integer;
|
||||
FFormList: TList;
|
||||
FMainForm : TForm;
|
||||
FMouseControl: TControl;
|
||||
@ -962,6 +965,8 @@ type
|
||||
procedure Run;
|
||||
procedure ShowException(E: Exception); override;
|
||||
procedure Terminate; override;
|
||||
procedure DisableIdleHandler;
|
||||
procedure EnableIdleHandler;
|
||||
procedure NotifyUserInputHandler(Msg: Cardinal);
|
||||
procedure NotifyKeyDownBeforeHandler(Sender: TObject;
|
||||
var Key: Word; Shift: TShiftState);
|
||||
|
@ -303,19 +303,22 @@ procedure TApplication.Idle;
|
||||
var
|
||||
Done: Boolean;
|
||||
begin
|
||||
DoFreeReleaseComponents;
|
||||
if FIdleLockCount=0 then
|
||||
DoFreeReleaseComponents;
|
||||
MouseIdle(GetControlAtMouse);
|
||||
|
||||
Done := True;
|
||||
if Assigned(FOnIdle) then FOnIdle(Self, Done);
|
||||
if (FIdleLockCount=0) and Assigned(FOnIdle) then FOnIdle(Self, Done);
|
||||
NotifyIdleHandler;
|
||||
if Done then begin
|
||||
// wait till something happens
|
||||
DoIdleActions;
|
||||
if (FIdleLockCount=0) then
|
||||
DoIdleActions;
|
||||
Include(FFlags,AppWaiting);
|
||||
Exclude(FFlags,AppIdleEndSent);
|
||||
InterfaceObject.WaitMessage;
|
||||
DoOnIdleEnd;
|
||||
if (FIdleLockCount=0) then
|
||||
DoOnIdleEnd;
|
||||
Exclude(FFlags,AppWaiting);
|
||||
end;
|
||||
end;
|
||||
@ -1063,9 +1066,14 @@ begin
|
||||
if (Msg <> '') and (Msg[length(Msg)] <> '.') then Msg := Msg + '.';
|
||||
if (not Terminated)
|
||||
and (Self<>nil) then begin
|
||||
MsgResult:=MessageBox(PChar(Msg+#13#13'Press Ok to ignore.'
|
||||
+#13'Press Cancel to stop the program.'),PChar(GetTitle),
|
||||
MB_OKCANCEL + MB_ICONERROR);
|
||||
DisableIdleHandler;
|
||||
try
|
||||
MsgResult:=MessageBox(PChar(Msg+#13#13'Press Ok to ignore.'
|
||||
+#13'Press Cancel to stop the program.'),PChar(GetTitle),
|
||||
MB_OKCANCEL + MB_ICONERROR);
|
||||
finally
|
||||
EnableIdleHandler;
|
||||
end;
|
||||
if MsgResult<>mrOk then begin
|
||||
Include(FFlags,AppNoExceptionMessages);
|
||||
HaltingProgram:=true;
|
||||
@ -1085,6 +1093,18 @@ begin
|
||||
InterfaceObject.AppTerminate;
|
||||
end;
|
||||
|
||||
procedure TApplication.DisableIdleHandler;
|
||||
begin
|
||||
inc(FIdleLockCount);
|
||||
end;
|
||||
|
||||
procedure TApplication.EnableIdleHandler;
|
||||
begin
|
||||
if FIdleLockCount<=0 then
|
||||
RaiseGDBException('TApplication.EnableIdleHandler');
|
||||
dec(FIdleLockCount);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
procedure TApplication.NotifyUserInputHandler;
|
||||
|
||||
@ -1357,6 +1377,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.99 2005/02/17 18:54:04 mattias
|
||||
disabling idle handler during TApplication error handling
|
||||
|
||||
Revision 1.98 2005/02/17 18:48:24 mattias
|
||||
extented error message of TApplication
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user