mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-23 10:29:23 +02:00
+ Initial implementation, donated by Hans Lunsing
This commit is contained in:
parent
9330b0e700
commit
59456d7671
580
rtl/win32/crt.pp
Normal file
580
rtl/win32/crt.pp
Normal file
@ -0,0 +1,580 @@
|
||||
unit WinCrt;
|
||||
|
||||
interface
|
||||
|
||||
Uses Windows;
|
||||
|
||||
type
|
||||
WinReadKeyRecord = record
|
||||
KeyStatus: byte;
|
||||
AsciiChar: char;
|
||||
KeyCode: word;
|
||||
end;
|
||||
|
||||
const
|
||||
|
||||
// Foreground color constants
|
||||
|
||||
fBlack = 0;
|
||||
fBlue = FOREGROUND_BLUE;
|
||||
fGreen = FOREGROUND_GREEN;
|
||||
fCyan = FOREGROUND_BLUE OR FOREGROUND_GREEN;
|
||||
fRed = FOREGROUND_RED;
|
||||
fMagenta = FOREGROUND_BLUE OR FOREGROUND_RED;
|
||||
fBrown = FOREGROUND_GREEN OR FOREGROUND_RED;
|
||||
fLightGray = FOREGROUND_BLUE OR FOREGROUND_GREEN OR FOREGROUND_RED;
|
||||
fDarkGray = fBlack OR FOREGROUND_INTENSITY;
|
||||
fLightBlue = fBlue OR FOREGROUND_INTENSITY;
|
||||
fLightGreen = fGreen OR FOREGROUND_INTENSITY;
|
||||
fLightCyan = fCyan OR FOREGROUND_INTENSITY;
|
||||
fLightRed = fRed OR FOREGROUND_INTENSITY;
|
||||
fLightMagenta = fMagenta OR FOREGROUND_INTENSITY;
|
||||
fYellow = fBrown OR FOREGROUND_INTENSITY;
|
||||
fWhite = fLightGray OR FOREGROUND_INTENSITY;
|
||||
|
||||
// Background color constants
|
||||
|
||||
bBlack = 0;
|
||||
bBlue = BACKGROUND_BLUE;
|
||||
bGreen = BACKGROUND_GREEN;
|
||||
bCyan = BACKGROUND_BLUE OR BACKGROUND_GREEN;
|
||||
bRed = BACKGROUND_RED;
|
||||
bMagenta = BACKGROUND_BLUE OR BACKGROUND_RED;
|
||||
bBrown = BACKGROUND_GREEN OR BACKGROUND_RED;
|
||||
bLightGray = BACKGROUND_BLUE OR BACKGROUND_GREEN OR BACKGROUND_RED;
|
||||
bDarkGray = bBlack OR BACKGROUND_INTENSITY;
|
||||
bLightBlue = bBlue OR BACKGROUND_INTENSITY;
|
||||
bLightGreen = bGreen OR BACKGROUND_INTENSITY;
|
||||
bLightCyan = bCyan OR BACKGROUND_INTENSITY;
|
||||
bLightRed = bRed OR BACKGROUND_INTENSITY;
|
||||
bLightMagenta = bMagenta OR BACKGROUND_INTENSITY;
|
||||
bYellow = bBrown OR BACKGROUND_INTENSITY;
|
||||
bWhite = bLightGray OR BACKGROUND_INTENSITY;
|
||||
|
||||
// Constants designating input events
|
||||
|
||||
NO_EVENT = 0;
|
||||
KEY_EVENT_IN_PROGRESS = $100;
|
||||
_MOUSE_EVENT_IN_PROGRESS = $200;
|
||||
|
||||
procedure ClrEol;
|
||||
{ Clears all characters from cursor position to end of line without
|
||||
moving the cursor by filling character cells with blanks
|
||||
and attribute cells with the current screen buffer attribute.
|
||||
}
|
||||
procedure ClrScr;
|
||||
{ Clears screen buffer by filling character cells with blanks
|
||||
and attribute cells with the current screen buffer attribute.
|
||||
The cursor is positioned in the top left corner of the screen
|
||||
buffer
|
||||
}
|
||||
procedure FlushInputBuffer;
|
||||
function GetTextBackground: byte;
|
||||
function GetTextColor: byte;
|
||||
Procedure GotoXY(X, Y: integer);
|
||||
Procedure HighVideo;
|
||||
Procedure HighVideoBackground;
|
||||
Function InputEvent: word;
|
||||
{ Returns
|
||||
NO_EVENT if input buffer is empty ;
|
||||
KEY_EVENT if there is a pending key event with
|
||||
key released again,
|
||||
and key is not one of the control keys;
|
||||
KEY_EVENT_IN_PROGRESS if there is another pending key event;
|
||||
_MOUSE_EVENT if there is a pending mouse event
|
||||
without moving the mouse;
|
||||
_MOUSE_EVENT_IN_PROGRESS if there is another pending mouse event;
|
||||
WINDOW_BUFFER_SIZE_EVENT is the user resized the screen buffer
|
||||
and window input is enabled (default mode disabled).
|
||||
}
|
||||
function KeyPressed: boolean;
|
||||
{ Returns
|
||||
TRUE if there is a pending key event with
|
||||
key released again,
|
||||
and key is not one of the control keys;
|
||||
FALSE otherwise.
|
||||
}
|
||||
Procedure LowVideo;
|
||||
Procedure LowVideoBackground;
|
||||
Procedure NormVideo;
|
||||
Procedure NormVideoBackground;
|
||||
Function ReadKey: char;
|
||||
Procedure TextBackground (Color: Byte);
|
||||
Procedure TextColor (Color: Byte);
|
||||
Function WhereX: integer;
|
||||
Function WhereY: integer;
|
||||
Function WinReadKey: WinReadKeyRecord;
|
||||
{ Return value in KeyStatus element:
|
||||
- bit 0: shift key pressed
|
||||
- bit 1: ctrl key pressed
|
||||
- bit 2: alt key pressed
|
||||
The KeyCode element has the virtual key code.
|
||||
|
||||
N.B. nog regelen: extended ASCII via Alt-keypad toetsen.
|
||||
}
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
PInputBuffer = ^TInputBuffer;
|
||||
TInputBuffer = array[word] of TInputRecord;
|
||||
|
||||
var
|
||||
StartTextIntensity, StartBackgroundIntensity: byte;
|
||||
pCsbi: PConsoleScreenBufferInfo;
|
||||
|
||||
function GetScreenInfo: TConsoleScreenBufferInfo; forward;
|
||||
Function RemapScanCode (ScanCode: byte; CtrlKeyState: byte): byte; forward;
|
||||
|
||||
procedure ClrEol;
|
||||
var
|
||||
hConsoleOutput: THandle;
|
||||
cCharacter: Char;
|
||||
wAttribute: word;
|
||||
nLength: dword;
|
||||
dwWriteCoord: TCoord;
|
||||
lpWritten: dword;
|
||||
begin
|
||||
hConsoleOutput := GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
cCharacter := ' ';
|
||||
New(pCsbi);
|
||||
GetConsoleScreenBufferInfo(hConsoleOutput, pCsbi^);
|
||||
wAttribute := pCsbi^.wAttributes;
|
||||
nLength := pCsbi^.dwSize.X - pCsbi^.dwCursorPosition.X + 1;
|
||||
dwWriteCoord.X := pCsbi^.dwCursorPosition.X;
|
||||
dwWriteCoord.Y := pCsbi^.dwCursorPosition.Y;
|
||||
Dispose(pCsbi);
|
||||
FillConsoleOutputCharacter(hConsoleOutput, cCharacter, nLength,
|
||||
dwWriteCoord, lpWritten);
|
||||
FillConsoleOutputAttribute(hConsoleOutput, wAttribute, nLength,
|
||||
dwWriteCoord, lpWritten);
|
||||
end;
|
||||
|
||||
procedure ClrScr;
|
||||
var
|
||||
hConsoleOutput: THandle;
|
||||
cCharacter: Char;
|
||||
wAttribute: word;
|
||||
nLength: dword;
|
||||
dwWriteCoord: TCoord;
|
||||
lpWritten: dword;
|
||||
begin
|
||||
hConsoleOutput := GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
cCharacter := ' ';
|
||||
New(pCsbi);
|
||||
GetConsoleScreenBufferInfo(hConsoleOutput, pCsbi^);
|
||||
wAttribute := pCsbi^.wAttributes;
|
||||
nLength := pCsbi^.dwSize.X * pCsbi^.dwSize.Y;
|
||||
Dispose(pCsbi);
|
||||
dwWriteCoord.X := 0;
|
||||
dwWriteCoord.Y := 0;
|
||||
FillConsoleOutputCharacter(hConsoleOutput, cCharacter, nLength,
|
||||
dwWriteCoord, lpWritten);
|
||||
FillConsoleOutputAttribute(hConsoleOutput, wAttribute, nLength,
|
||||
dwWriteCoord, lpWritten);
|
||||
SetConsoleCursorPosition(hConsoleOutput, dwWriteCoord);
|
||||
end;
|
||||
|
||||
procedure FlushInputBuffer;
|
||||
begin
|
||||
FlushConsoleInputBuffer(GetStdHandle(STD_INPUT_HANDLE));
|
||||
end;
|
||||
|
||||
function GetTextBackground: byte;
|
||||
begin
|
||||
Result := GetScreenInfo.wAttributes AND bWhite;
|
||||
end;
|
||||
|
||||
function GetTextColor: byte;
|
||||
begin
|
||||
Result := GetScreenInfo.wAttributes AND fWhite;
|
||||
end;
|
||||
|
||||
function GetScreenInfo: TConsoleScreenBufferInfo;
|
||||
begin
|
||||
GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), Result);
|
||||
end;
|
||||
|
||||
Procedure GotoXY(X, Y: integer);
|
||||
var
|
||||
CoordCursor: TCoord;
|
||||
begin
|
||||
CoordCursor.X := X - 1;
|
||||
CoordCursor.Y := Y - 1;
|
||||
SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), CoordCursor);
|
||||
end;
|
||||
|
||||
Procedure HighVideo;
|
||||
var
|
||||
Attribute: word;
|
||||
begin
|
||||
Attribute := GetScreenInfo.wAttributes;
|
||||
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
|
||||
Attribute OR FOREGROUND_INTENSITY);
|
||||
end;
|
||||
|
||||
Procedure HighVideoBackground;
|
||||
var
|
||||
Attribute: word;
|
||||
begin
|
||||
Attribute := GetScreenInfo.wAttributes;
|
||||
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
|
||||
Attribute OR BACKGROUND_INTENSITY);
|
||||
end;
|
||||
|
||||
Function InputEvent: word;
|
||||
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 := 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
|
||||
FreeMem(pInput);
|
||||
end;
|
||||
end;
|
||||
|
||||
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
|
||||
FreeMem(pInput);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure LowVideo;
|
||||
var
|
||||
Attribute: word;
|
||||
begin
|
||||
Attribute := GetScreenInfo.wAttributes;
|
||||
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
|
||||
Attribute AND NOT FOREGROUND_INTENSITY);
|
||||
end;
|
||||
|
||||
Procedure LowVideoBackground;
|
||||
var
|
||||
Attribute: word;
|
||||
begin
|
||||
Attribute := GetScreenInfo.wAttributes;
|
||||
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
|
||||
Attribute AND NOT BACKGROUND_INTENSITY);
|
||||
end;
|
||||
Procedure NormVideo;
|
||||
var
|
||||
Attribute: word;
|
||||
begin
|
||||
Attribute := GetScreenInfo.wAttributes;
|
||||
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
|
||||
Attribute AND (fLightGray OR bWhite) OR StartTextIntensity);
|
||||
end;
|
||||
|
||||
Procedure NormVideoBackground;
|
||||
var
|
||||
Attribute: word;
|
||||
begin
|
||||
Attribute := GetScreenInfo.wAttributes;
|
||||
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
|
||||
Attribute AND (fWhite OR bLightGray) OR StartBackgroundIntensity);
|
||||
end;
|
||||
|
||||
Function ReadKey: char;
|
||||
var
|
||||
hConsoleInput: THandle;
|
||||
pInput: pInputRecord;
|
||||
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
|
||||
if not ExtendedChar then begin
|
||||
hConsoleInput := GetStdHandle(STD_INPUT_HANDLE);
|
||||
try
|
||||
New(pInput);
|
||||
with pInput^.KeyEvent do begin
|
||||
Repeat
|
||||
ReadConsoleInput(hConsoleInput, pInput^, 1, lpcRead);
|
||||
until (pInput^.EventType = KEY_EVENT)
|
||||
and (bKeyDown = false)
|
||||
and not (wVirtualScanCode in ScanCodesToSkip);
|
||||
|
||||
{ Get state of control keys }
|
||||
|
||||
AltKey := ((dwControlKeyState AND
|
||||
(RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
|
||||
CtrlKey := ((dwControlKeyState AND
|
||||
(RIGHT_CTRL_PRESSED OR LEFT_CTRL_PRESSED)) > 0);
|
||||
ShiftKey := ((dwControlKeyState AND SHIFT_PRESSED) > 0);
|
||||
|
||||
{ Get key value, making some corrections to comply with MSDOS}
|
||||
|
||||
if AltKey then
|
||||
Result := #0
|
||||
else begin
|
||||
Result := AsciiChar;
|
||||
if CtrlKey then
|
||||
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;
|
||||
finally
|
||||
Dispose(pInput);
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
Result := char(ScanCode);
|
||||
ExtendedChar := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function RemapScanCode (ScanCode: byte; CtrlKeyState: byte): byte;
|
||||
|
||||
{ Several remappings of scancodes are necessary to comply with what
|
||||
we get with MSDOS. Special Windows keys, as Alt-Tab, Ctrl-Esc etc.
|
||||
are excluded }
|
||||
|
||||
var
|
||||
AltKey, CtrlKey, ShiftKey: boolean;
|
||||
const
|
||||
{
|
||||
Keypad key scancodes:
|
||||
|
||||
Ctrl Norm
|
||||
|
||||
$77 $47 - Home
|
||||
$8D $48 - Up arrow
|
||||
$84 $49 - PgUp
|
||||
$8E $4A - -
|
||||
$73 $4B - Left Arrow
|
||||
$8F $4C - 5
|
||||
$74 $4D - Right arrow
|
||||
$4E $4E - +
|
||||
$75 $4F - End
|
||||
$91 $50 - Down arrow
|
||||
$76 $51 - PgDn
|
||||
$92 $52 - Ins
|
||||
$93 $53 - Del
|
||||
}
|
||||
CtrlKeypadKeys: array[$47..$53] of byte =
|
||||
($77, $8D, $84, $8E, $73, $8F, $74, $4E, $75, $91, $76, $92, $93);
|
||||
|
||||
begin
|
||||
AltKey := ((CtrlKeyState AND
|
||||
(RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
|
||||
CtrlKey := ((CtrlKeyState AND
|
||||
(RIGHT_CTRL_PRESSED OR LEFT_CTRL_PRESSED)) > 0);
|
||||
ShiftKey := ((CtrlKeyState AND SHIFT_PRESSED) > 0);
|
||||
if AltKey then
|
||||
case ScanCode of
|
||||
// Digits, -, =
|
||||
$02..$0D: inc(ScanCode, $76);
|
||||
// Function keys
|
||||
$3B..$44: inc(Scancode, $2D);
|
||||
$57..$58: inc(Scancode, $34);
|
||||
// Extended cursor block keys
|
||||
$47..$49, $4B, $4D, $4F..$53:
|
||||
inc(Scancode, $50);
|
||||
// Other keys
|
||||
$1C: Scancode := $A6; // Enter
|
||||
$35: Scancode := $A4; // / (keypad and normal!)
|
||||
end
|
||||
else if CtrlKey then
|
||||
case Scancode of
|
||||
// Tab key
|
||||
$0F: Scancode := $94;
|
||||
// Function keys
|
||||
$3B..$44: inc(Scancode, $23);
|
||||
$57..$58: inc(Scancode, $32);
|
||||
// Keypad keys
|
||||
$35: Scancode := $95; // \
|
||||
$37: Scancode := $96; // *
|
||||
$47..$53: Scancode := CtrlKeypadKeys[Scancode];
|
||||
end
|
||||
else if ShiftKey then
|
||||
case Scancode of
|
||||
// Function keys
|
||||
$3B..$44: inc(Scancode, $19);
|
||||
$57..$58: inc(Scancode, $30);
|
||||
end
|
||||
else
|
||||
case Scancode of
|
||||
// Function keys
|
||||
$57..$58: inc(Scancode, $2E); // F11 and F12
|
||||
end;
|
||||
Result := ScanCode;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TextBackground (Color: Byte);
|
||||
var
|
||||
Background, Foreground: byte;
|
||||
begin
|
||||
Background := Color AND bWhite;
|
||||
Foreground := GetScreenInfo.wAttributes AND fWhite;
|
||||
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
|
||||
Background OR Foreground);
|
||||
end;
|
||||
|
||||
Procedure TextColor (Color: Byte);
|
||||
var
|
||||
Background, Foreground: byte;
|
||||
begin
|
||||
Background := GetScreenInfo.wAttributes AND bWhite;
|
||||
Foreground := Color AND fWhite;
|
||||
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
|
||||
Background OR Foreground);
|
||||
end;
|
||||
|
||||
Function WhereX: integer;
|
||||
begin
|
||||
Result := GetScreenInfo.dwCursorPosition.X + 1;
|
||||
end;
|
||||
|
||||
Function WhereY: integer;
|
||||
begin
|
||||
Result := GetScreenInfo.dwCursorPosition.Y + 1;
|
||||
end;
|
||||
|
||||
Function WinReadKey: WinReadKeyRecord;
|
||||
var
|
||||
hConsoleInput: THandle;
|
||||
pInput: pInputRecord;
|
||||
lpcRead: integer;
|
||||
|
||||
const
|
||||
KeysToSkip: set of byte =
|
||||
[VK_SHIFT, VK_CONTROL, VK_MENU, VK_CAPITAL, VK_NUMLOCK, VK_SCROLL];
|
||||
|
||||
begin
|
||||
hConsoleInput := GetStdHandle(STD_INPUT_HANDLE);
|
||||
try
|
||||
New(pInput);
|
||||
with pInput^.KeyEvent do begin
|
||||
Repeat
|
||||
ReadConsoleInput(hConsoleInput, pInput^, 1, lpcRead);
|
||||
until (pInput^.EventType = KEY_EVENT)
|
||||
and (bKeyDown = TRUE)
|
||||
and not (wVirtualKeyCode in KeysToSkip);
|
||||
|
||||
{ Get key value }
|
||||
|
||||
with Result do begin
|
||||
|
||||
KeyStatus := 0;
|
||||
AsciiChar := pInput^.KeyEvent.AsciiChar;
|
||||
KeyCode := wVirtualKeyCode;
|
||||
|
||||
{ Set bits 0..2 of KeyStatus to indicate control key state}
|
||||
|
||||
if ((dwControlKeyState AND SHIFT_PRESSED) > 0) then
|
||||
KeyStatus := (KeyStatus OR $01);
|
||||
if ((dwControlKeyState AND
|
||||
(RIGHT_CTRL_PRESSED OR LEFT_CTRL_PRESSED)) > 0) then
|
||||
KeyStatus := (KeyStatus OR $02);
|
||||
if ((dwControlKeyState AND
|
||||
(RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0) then
|
||||
KeyStatus := (KeyStatus OR $04);
|
||||
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Dispose(pInput);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
New(pCsbi);
|
||||
pCsbi^ := GetScreenInfo;
|
||||
StartTextIntensity := pCsbi^.wAttributes AND FOREGROUND_INTENSITY;
|
||||
StartBackgroundIntensity := pCsbi^.wAttributes AND BACKGROUND_INTENSITY;
|
||||
Dispose(pCsbi);
|
||||
end.
|
Loading…
Reference in New Issue
Block a user