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

* fixed left crt bugs

Browse Source
This commit is contained in:
peter 1999-05-19 16:22:02 +00:00
parent 41e4095cfa
commit 26284d4013
2 changed files with 82 additions and 209 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

284
rtl/win32/crt.pp
View File

@ -103,8 +103,6 @@ uses
var OutHandle : THandle; var OutHandle : THandle;
InputHandle : THandle; InputHandle : THandle;
UsingAttr : Longint;
CursorSaveX : Longint; CursorSaveX : Longint;
CursorSaveY : Longint; CursorSaveY : Longint;
@ -116,59 +114,7 @@ var OutHandle : THandle;
{ {
definition of textrec is in textrec.inc definition of textrec is in textrec.inc
} }
{$ifdef FPC} {$i textrec.inc}
{$i textrec.inc}
{$endif}
Const
NO_EVENT = 0;
KEY_EVENT_IN_PROGRESS = $100;
_MOUSE_EVENT_IN_PROGRESS = $200;
type
PInputBuffer = ^TInputBuffer;
TInputBuffer = array[0..1200] of TInputRecord;
Function KeyPressed: boolean;
var
hConsoleInput: THandle;
pInput: pInputBuffer;
lpNumberOfEvents: dword;
lpNumberRead: integer;
i: word;
const
KeysToSkip: set of byte =
[VK_SHIFT, VK_CONTROL, VK_MENU, VK_CAPITAL, VK_NUMLOCK, VK_SCROLL];
begin
hConsoleInput := GetStdHandle(STD_INPUT_HANDLE);
GetNumberOfConsoleInputEvents(hConsoleInput, lpNumberOfEvents);
Result := FALSE;
if lpNumberOfEvents > 0 then
try
GetMem(pInput, lpNumberOfEvents * SizeOf(TInputRecord));
PeekConsoleInput(hConsoleInput, pInput^[0], lpNumberOfEvents, lpNumberRead);
i := 0;
repeat
with pInput^[i] do begin
if EventType = KEY_EVENT then
Result := (KeyEvent.bKeyDown = false) and
not (KeyEvent.wVirtualKeyCode in KeysToSkip);
end;
inc(i);
until (Result = TRUE) or (i >= lpNumberOfEvents);
finally
{$IFDEF VER0_99_11}
FreeMem(pInput, lpNumberOfEvents * SizeOf(TInputRecord));
{$ELSE}
FreeMem(pInput);
{$ENDIF}
end;
end;
{**************************************************************************** {****************************************************************************
Low level Routines Low level Routines
@ -177,8 +123,8 @@ end;
function GetScreenHeight : longint; function GetScreenHeight : longint;
var ConsoleInfo: TConsoleScreenBufferinfo; var ConsoleInfo: TConsoleScreenBufferinfo;
begin begin
FillChar(ConsoleInfo, SizeOf(ConsoleInfo), 0);
GetConsoleScreenBufferInfo(OutHandle, ConsoleInfo); GetConsoleScreenBufferInfo(OutHandle, ConsoleInfo);
Result := ConsoleInfo.SrWindow.Bottom + 1; Result := ConsoleInfo.SrWindow.Bottom + 1;
end; end;
@ -186,6 +132,7 @@ end;
function GetScreenWidth : longint; function GetScreenWidth : longint;
var ConsoleInfo: TConsoleScreenBufferInfo; var ConsoleInfo: TConsoleScreenBufferInfo;
begin begin
FillChar(ConsoleInfo, SizeOf(ConsoleInfo), 0);
GetConsoleScreenBufferInfo(OutHandle, ConsoleInfo); GetConsoleScreenBufferInfo(OutHandle, ConsoleInfo);
Result := ConsoleInfo.SrWindow.Right + 1; Result := ConsoleInfo.SrWindow.Right + 1;
@ -357,34 +304,26 @@ Begin
End; End;
Procedure ClrScr; procedure ClrScr;
{ var Temp : Dword;
Clear the current window, and set the cursor on 1,1 CharInfo: Char;
} Coord : TCoord;
var
ClipRect: TSmallRect;
SrcRect: TSmallRect;
DestCoor: TCoord;
CharInfo: TCharInfo;
begin begin
CharInfo.UnicodeChar := 32; Coord.X := 0;
CharInfo.Attributes := TextAttr; Coord.Y := 0;
SrcRect.Left := WinMinX; Temp := 00;
SrcRect.Top := WinMinY; Charinfo := #32;
SrcRect.Right := WinMaxX;
SrcRect.Bottom := WinMaxY;
ClipRect := SrcRect;
DestCoor.X := WinMinX - 1; FillConsoleOutputCharacter(OutHandle, CharInfo, WinMaxX * WinMaxY, Coord, @Temp);
DestCoor.Y := WinMinY - 1;
ScrollConsoleScreenBuffer(OutHandle, SrcRect, ClipRect, DestCoor, CharInfo); Temp := 07; { We don't use black because that will disable the cursor under NT4 }
FillConsoleOutputAttribute(OutHandle, Temp, WinMaxX * WinMaxY, Coord, @Temp);
Gotoxy(1,1); Gotoxy(1,1);
end; end; { proc. ClrScr }
Procedure ClrEol; procedure ClrEol;
{ {
Clear from current position to end of line. Clear from current position to end of line.
} }
@ -392,7 +331,7 @@ var Temp: Dword;
CharInfo: Char; CharInfo: Char;
Coord: TCoord; Coord: TCoord;
X,Y: Longint; X,Y: Longint;
Begin begin
GetScreenCursor(x,y); GetScreenCursor(x,y);
CharInfo := #32; CharInfo := #32;
@ -433,63 +372,14 @@ End;
KeyBoard KeyBoard
*************************************************************************} *************************************************************************}
Function InputEvent: word;
var var
hConsoleInput: THandle; ScanCode : char;
pInput: pInputBuffer; SpecialKey : boolean;
lpNumberOfEvents: dword;
lpNumberRead: integer;
i: word;
const
KeysToSkip: set of byte =
[VK_SHIFT, VK_CONTROL, VK_MENU, VK_CAPITAL, VK_NUMLOCK, VK_SCROLL];
begin
hConsoleInput := GetStdHandle(STD_INPUT_HANDLE);
GetNumberOfConsoleInputEvents(hConsoleInput, lpNumberOfEvents);
Result := NO_EVENT;
if lpNumberOfEvents > 0 then
try
GetMem(pInput, lpNumberOfEvents * SizeOf(TInputRecord));
PeekConsoleInput(hConsoleInput, pInput^[0], lpNumberOfEvents, lpNumberRead);
i := 0;
repeat
with pInput^[i] do begin
case EventType of
KEY_EVENT:
if (KeyEvent.bKeyDown = false) and
not (KeyEvent.wVirtualKeyCode in KeysToSkip) then
Result := EventType
else
Result := KEY_EVENT_IN_PROGRESS;
_MOUSE_EVENT:
if (MouseEvent.dwEventFlags <> MOUSE_MOVED) then
Result := EventType
else
Result := _MOUSE_EVENT_IN_PROGRESS;
else
Result := EventType;
end;
end;
inc(i);
until (Result <> NO_EVENT) or (i >= lpNumberOfEvents);
finally
{$IFDEF VER0_99_11}
FreeMem(pInput, lpNumberOfEvents * SizeOf(TInputRecord));
{$ELSE}
FreeMem(pInput);
{$ENDIF}
end;
end;
Function RemapScanCode (ScanCode: byte; CtrlKeyState: byte): byte; Function RemapScanCode (ScanCode: byte; CtrlKeyState: byte): byte;
{ Several remappings of scancodes are necessary to comply with what { Several remappings of scancodes are necessary to comply with what
we get with MSDOS. Special Windows keys, as Alt-Tab, Ctrl-Esc etc. we get with MSDOS. Special Windows keys, as Alt-Tab, Ctrl-Esc etc.
are excluded } are excluded }
var var
AltKey, CtrlKey, ShiftKey: boolean; AltKey, CtrlKey, ShiftKey: boolean;
const const
@ -562,86 +452,56 @@ begin
end; end;
function KeyPressed : boolean;
Function ReadKey: char;
var var
hConsoleInput: THandle; nevents, nread, i: longint;
pInput: pInputRecord; buf : TINPUTRECORD;
lpcRead: integer;
AltKey, CtrlKey, ShiftKey: boolean;
const
ExtendedChar: boolean = false;
Scancode: byte = 0;
{
Scancodes to skip:
$1D - Ctrl keys
$2A - left Shift key
$36 - right Shift key
$38 - Alt keys
$3A - Caps lock key
$45 - Num lock key
$46 - Scroll lock key
}
ScanCodesToSkip: set of 0..255 =
[$1D, $2A, $36, $38, $3A, $45, $46];
begin begin
if not ExtendedChar then begin KeyPressed := FALSE;
hConsoleInput := GetStdHandle(STD_INPUT_HANDLE); if ScanCode <> #0 then
try KeyPressed := TRUE
New(pInput); else
with pInput^.KeyEvent do begin begin
Repeat nevents:=0;
ReadConsoleInput(hConsoleInput, pInput^, 1, lpcRead); GetNumberOfConsoleInputEvents(TextRec(input).Handle,nevents);
until (pInput^.EventType = KEY_EVENT) For i := 1 to nevents do
and (bKeyDown = false) begin
and not (wVirtualScanCode in ScanCodesToSkip); ReadConsoleInputA(TextRec(input).Handle,buf,1,nread);
if buf.EventType = KEY_EVENT then
{ Get state of control keys } if buf.KeyEvent.bKeyDown then
begin
AltKey := ((dwControlKeyState AND KeyPressed := TRUE;
(RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0); if ord(buf.KeyEvent.AsciiChar) = 0 then
CtrlKey := ((dwControlKeyState AND begin
(RIGHT_CTRL_PRESSED OR LEFT_CTRL_PRESSED)) > 0); SpecialKey := TRUE;
ShiftKey := ((dwControlKeyState AND SHIFT_PRESSED) > 0); ScanCode := Chr(RemapScanCode(Buf.KeyEvent.wVirtualScanCode, Buf.KeyEvent.dwControlKeyState));
end
{ Get key value, making some corrections to comply with MSDOS} else
begin
if AltKey then SpecialKey := FALSE;
Result := #0 ScanCode := Chr(Ord(buf.KeyEvent.AsciiChar));
else begin end;
Result := AsciiChar; break;
if CtrlKey then end;
case wVirtualScanCode of
$07: Result := #$1E; // ^_6 (Win32 gives ASCII = 0)
$0C: Result := #$1F; // ^_- (Win32 gives ASCII = 0)
end
else if ShiftKey then
case wVirtualScanCode of
$01: Result := #$1B; // Shift Esc (Win32 gives ASCII = 0)
$0F: Result := #0; // Shift Tab (Win32 gives ASCII = 9)
end;
end;
{Save scancode of non-ASCII keys for second call}
if (Result = #0) then begin
ExtendedChar := true;
ScanCode := RemapScanCode(wVirtualScanCode, dwControlKeyState);
end;
end; end;
finally end;
Dispose(pInput); end;
end;
function ReadKey: char;
begin
repeat until KeyPressed;
if SpecialKey then begin
ReadKey := #0;
SpecialKey := FALSE;
end end
else begin else begin
Result := char(ScanCode); ReadKey := ScanCode;
ExtendedChar := false; ScanCode := #0;
end; end;
end; end;
{************************************************************************* {*************************************************************************
Delay Delay
*************************************************************************} *************************************************************************}
@ -959,25 +819,33 @@ begin
TextRec(F).OpenFunc:=@CrtOpen; TextRec(F).OpenFunc:=@CrtOpen;
end; end;
var CursorInfo: TConsoleCursorInfo;
var CursorInfo : TConsoleCursorInfo;
ConsoleInfo: TConsoleScreenBufferinfo;
begin begin
{ Initialize the output handles } { Initialize the output handles }
OutHandle := GetStdHandle(STD_OUTPUT_HANDLE); OutHandle := GetStdHandle(STD_OUTPUT_HANDLE);
InputHandle := GetStdHandle(STD_INPUT_HANDLE); InputHandle := GetStdHandle(STD_INPUT_HANDLE);
UsingAttr := 07;
LastMode := 3; LastMode := 3;
{--------------------- Get the cursor information -------------------------} {--------------------- Get the cursor size and such -----------------------}
FillChar(CursorInfo, SizeOf(CursorInfo), 00);
GetConsoleCursorInfo(OutHandle, CursorInfo); GetConsoleCursorInfo(OutHandle, CursorInfo);
SaveCursorSize := CursorInfo.dwSize; SaveCursorSize := CursorInfo.dwSize;
{------------------ Get the current cursor position and attr --------------}
FillChar(ConsoleInfo, SizeOf(ConsoleInfo), 0);
GetConsoleScreenBufferInfo(OutHandle, ConsoleInfo);
CursorSaveX := ConsoleInfo.dwCursorPosition.X;
CursorSaveY := ConsoleInfo.dwCursorPosition.Y;
TextAttr := ConsoleInfo.wAttributes;
{ Load startup values } { Load startup values }
ScreenWidth := GetScreenWidth; ScreenWidth := GetScreenWidth;
ScreenHeight := GetScreenHeight; ScreenHeight := GetScreenHeight;
WindMax := (ScreenWidth - 1) OR ((ScreenHeight - 1) SHL 8); WindMax := (ScreenWidth - 1) OR ((ScreenHeight - 1) SHL 8);
{ Redirect the standard output } { Redirect the standard output }
AssignCrt(Output); AssignCrt(Output);
Rewrite(Output); Rewrite(Output);
@ -989,7 +857,10 @@ begin
end. { unit Crt } end. { unit Crt }
{ {
$Log$ $Log$
Revision 1.5 1999-05-01 13:18:26 peter Revision 1.6 1999-05-19 16:22:02 peter
* fixed left crt bugs
Revision 1.5 1999/05/01 13:18:26 peter
* changed back fixes * changed back fixes
Revision 1.4 1999/04/30 11:34:27 michael Revision 1.4 1999/04/30 11:34:27 michael
@ -1002,4 +873,3 @@ end. { unit Crt }
+ crt unit that compiles + crt unit that compiles
} }

7
rtl/win32/struct.pp
View File

@ -991,7 +991,7 @@ unit struct;
TSMALL_RECT = SMALL_RECT; TSMALL_RECT = SMALL_RECT;
PSMALL_RECT = ^SMALL_RECT; PSMALL_RECT = ^SMALL_RECT;
CONSOLE_SCREEN_BUFFER_INFO = record CONSOLE_SCREEN_BUFFER_INFO = packed record
dwSize : COORD; dwSize : COORD;
dwCursorPosition : COORD; dwCursorPosition : COORD;
wAttributes : WORD; wAttributes : WORD;
@ -6931,7 +6931,10 @@ end.
{$endif not windows_include_files} {$endif not windows_include_files}
{ {
$Log$ $Log$
Revision 1.8 1999-04-20 11:36:17 peter Revision 1.9 1999-05-19 16:22:03 peter
* fixed left crt bugs
Revision 1.8 1999/04/20 11:36:17 peter
* compatibility fixes * compatibility fixes
Revision 1.7 1999/03/22 22:12:52 florian Revision 1.7 1999/03/22 22:12:52 florian