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

* SysGetShiftState fixed

Browse Source
This commit is contained in:
Tomas Hajny 2004-12-27 22:26:43 +00:00
parent 1215d90528
commit 0839541501
1 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
rtl/os2/keyboard.pp
View File

@ -36,11 +36,12 @@ var
begin begin
if KbdGetFocus (IO_Wait, DefaultKeyboard) = No_Error then if KbdGetFocus (IO_Wait, DefaultKeyboard) = No_Error then
begin begin
if KbdOpen (Handle) <> No_Error then Handle := DefaultKeyboard; if KbdOpen (Handle) <> No_Error then
Handle := DefaultKeyboard;
KbdFlushBuffer (Handle); KbdFlushBuffer (Handle);
KbdFreeFocus (DefaultKeyboard); KbdFreeFocus (DefaultKeyboard);
KbdGetFocus (IO_Wait, Handle); KbdGetFocus (IO_Wait, Handle);
K.cb := 10; K.cb := SizeOf (K);
KbdGetStatus (K, Handle); KbdGetStatus (K, Handle);
K.fsMask := $14; K.fsMask := $14;
KbdSetStatus (K, Handle); KbdSetStatus (K, Handle);
@ -68,8 +69,8 @@ begin
DosSleep (5); DosSleep (5);
with K do with K do
begin begin
if (byte (chChar) = $E0) and (fbStatus and 2 <> 0) then chChar := #0; if (byte (chChar) = $E0) and (fbStatus and 2 <> 0) then chChar := #0;
SysGetKeyEvent := cardinal ($0300 or fsState and $F) shl 16 or SysGetKeyEvent := cardinal ($0300 or fsState and $F) shl 16 or
cardinal (byte (chScan)) shl 8 or byte (chChar); cardinal (byte (chScan)) shl 8 or byte (chChar);
end; end;
end; end;
@ -102,10 +103,14 @@ function SysGetShiftState: Byte;
var var
K: TKbdInfo; K: TKbdInfo;
L: cardinal;
begin begin
KbdGetFocus (IO_NoWait, Handle); KbdGetFocus (IO_NoWait, Handle);
KbdGetStatus (K, Handle); K.cb := SizeOf (K);
SysGetShiftState:=(K.fsState and $F); if KbdGetStatus (K, Handle) = No_Error then
SysGetShiftState := (K.fsState and $F)
else
SysGetShiftState := 0;
end; end;
Const Const
@ -125,7 +130,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.5 2002-09-07 16:01:24 peter Revision 1.6 2004-12-27 22:26:43 hajny
* SysGetShiftState fixed
Revision 1.5 2002/09/07 16:01:24 peter
* old logs removed and tabs fixed * old logs removed and tabs fixed
Revision 1.4 2002/03/03 21:08:33 hajny Revision 1.4 2002/03/03 21:08:33 hajny