paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-07 19:10:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

sinclairql: for setting the exit message of the default console, use a helper function instead.

Browse Source 
git-svn-id: trunk@49365 -
This commit is contained in:
Károly Balogh 2021-05-14 17:32:40 +00:00
parent 6fbf4dfd90
commit 13f3cd2ae3
1 changed files with 11 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
rtl/sinclairql/system.pp
View File

@ -84,6 +84,7 @@ function SetQLJobName(const s: string): longint;
function GetQLJobName: string;
function GetQLJobNamePtr: pointer;
procedure SetQLDefaultConExitMessage(const msg: PChar);
implementation
@ -275,10 +276,17 @@ begin
end;
end;
const
QLDefaultConExitMessage: PChar = 'Press any key to exit';
procedure SetQLDefaultConExitMessage(const msg: PChar);
begin
QLDefaultConExitMessage:=msg;
end;
function QLOpenCon(var console: QLConHandle): boolean; weakexternal name 'QLOpenCon';
procedure QLCloseCon(var console: QLConHandle); weakexternal name 'QLCloseCon';
function QLDefaultConExitMessage: PChar; weakexternal name 'QLDefaultConExitMessage';
function DefaultQLOpenCon(var console: QLConHandle): boolean;
var
@ -307,21 +315,12 @@ begin
end;
procedure DefaultQLCloseCon(var console: QLConHandle);
const
anyKey: pchar = 'Press any key to exit';
var
msg: pchar;
begin
with console do
begin
if assigned(@QLDefaultConExitMessage) then
msg:=QLDefaultConExitMessage
else
msg:=anyKey;
if assigned(msg) then
if assigned(QLDefaultConExitMessage) and (length(QLDefaultConExitMessage) > 0) then
begin
io_sstrg(outputHandle, -1, msg, length(msg));
io_sstrg(outputHandle, -1, QLDefaultConExitMessage, length(QLDefaultConExitMessage));
io_fbyte(inputHandle, -1);
end;
end;