1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
| program Project1;
{$APPTYPE CONSOLE}
uses
Messages,
Windows,
Classes,
SysUtils;
var finished:boolean;
ch:char;
dummy: HWND;
msg: TMsg;
function KeyPressed: Boolean;
var
NumEvents: DWORD;
begin
If GetNumberOfConsoleInputEvents(GetStdhandle(STD_INPUT_HANDLE), NumEvents) then
KeyPressed := NumEvents > 0
else
begin
WriteLn(Format('GetNumberOfConsoleInputEvents failed, reason: %s',
[SysErrorMessage(GetLastError)]));
KeyPressed := true;
end;
end;
function ReadKey: Char;
var
InputBuf: Char;
NumRead: DWord;
begin
InputBuf := #0;
If ReadConsole(GetStdhandle(STD_INPUT_HANDLE), @InputBuf, 1, NumRead, nil) then
Result := InputBuf
else
begin
WriteLn(Format('ReadConsole failed, reason: %s',
[SysErrorMessage(GetLastError)]));
Result := #0;
end;
end;
function GetInputmode: DWord;
begin
Result := 0;
GetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), Result);
end;
procedure timer;
begin;
writeln('Test');
end;
begin
SetConsoleMode(GetStdhandle(STD_INPUT_HANDLE), GetInputmode and
not (ENABLE_WINDOW_INPUT or ENABLE_MOUSE_INPUT or
ENABLE_LINE_INPUT or ENABLE_ECHO_INPUT));
finished := false;
dummy := classes.AllocateHWnd(nil);
SetTimer(dummy, 1, 5000, nil);
while not finished do begin
if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then begin;
case Msg.message of
WM_TIMER: Timer;
else begin
translateMessage(msg);
dispatchMessage(msg);
end;
end;
end;
if KeyPressed then begin
ch := ReadKey;
if ch = #27 then begin;
finished := true;
end;
end;
end;
classes.DeallocateHWnd(dummy);
end. |
