paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 05:59:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ 83/84-key keyboard support added to unit crt

Browse Source 
git-svn-id: trunk@25445 -
This commit is contained in:
nickysn 2013-09-09 20:55:08 +00:00
parent 766b7745bd
commit 76cbda0983
1 changed files with 19 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
rtl/msdos/crt.pp
View File

@ -348,9 +348,24 @@ End;
*************************************************************************} *************************************************************************}
var var
keyboard_type: byte; { 0=83/84-key keyboard, $10=101/102+ keyboard }
is_last : boolean; is_last : boolean;
last : char; last : char;
procedure DetectKeyboard;
var
regs: registers;
begin
keyboard_type:=0;
if (Mem[$40:$96] and $10)<>0 then
begin
regs.ax:=$1200;
intr($16,regs);
if regs.ax<>$1200 then
keyboard_type:=$10;
end;
end;
function readkey : char; function readkey : char;
var var
char2 : char; char2 : char;
@ -364,7 +379,7 @@ begin
end end
else else
begin begin
regs.ah:=$10; regs.ah:=keyboard_type;
intr($16,regs); intr($16,regs);
if (regs.al=$e0) and (regs.ah<>0) then if (regs.al=$e0) and (regs.ah<>0) then
regs.al:=0; regs.al:=0;
@ -391,7 +406,7 @@ begin
end end
else else
begin begin
regs.ah:=$11; regs.ah:=keyboard_type+1;
intr($16,regs); intr($16,regs);
keypressed:=((regs.flags and fZero) = 0); keypressed:=((regs.flags and fZero) = 0);
end; end;
@ -780,6 +795,8 @@ end;
var var
x,y : longint; x,y : longint;
begin begin
{ Detect keyboard type }
DetectKeyboard;
{ Load startup values } { Load startup values }
ScreenWidth:=GetScreenWidth; ScreenWidth:=GetScreenWidth;
ScreenHeight:=GetScreenHeight; ScreenHeight:=GetScreenHeight;