paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 01:38:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

* introduce AbortRun

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-05-12 13:54:29 +02:00
parent 1fa83a91ab
commit ecbebca07f
1 changed files with 10 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
packages/fcl-base/src/custapp.pp
View File

@ -47,6 +47,7 @@ Type
FCaseSensitiveOptions : Boolean;
FStopOnException : Boolean;
FExceptionExitCode : Integer;
FRunAborted:Boolean;
function GetEnvironmentVar(const VarName : String): String;
function GetExeName: string;
Function GetLocation : String;
@ -59,6 +60,8 @@ Type
procedure SetTitle(const AValue: string); Virtual;
Function GetConsoleApplication : boolean; Virtual;
Procedure DoRun; Virtual;
// Descendants can use this to stop the run loop without setting terminated.
procedure AbortRun; virtual;
Function GetParams(Index : Integer) : String;virtual;
function GetParamCount: Integer;Virtual;
Procedure DoLog(EventType : TEventType; const Msg : String); virtual;
@ -273,6 +276,11 @@ begin
// Override in descendent classes.
end;
procedure TCustomApplication.AbortRun;
begin
FRunAborted:=True;
end;
procedure TCustomApplication.DoLog(EventType: TEventType; const Msg: String);
begin
@ -353,7 +361,8 @@ begin
except
HandleException(Self);
end;
Until FTerminated;
Writeln('Main needs to terminate: ',FTerminated,' or ',FRunAborted);
Until FTerminated or FRunAborted;
end;
procedure TCustomApplication.SetSingleInstanceClass(