10 procedure AssignCrt(var F: Text);
16 procedure Delay(MS: WORD);
18 procedure GotoXY(X: tcrtcoord; Y: tcrtcoord);
21 function KeyPressed: Boolean;
25 function ReadKey: Char;
26 procedure Sound(Hz: Word);
27 procedure TextBackground(Color: Byte);
28 procedure TextColor(Color: Byte);
29 procedure TextMode(Mode: WORD);
30 function WhereX: tcrtcoord;
31 function WhereY: tcrtcoord;
32 procedure Window(X1: Byte; Y1: Byte; X2: Byte; Y2: Byte);
55 procedure AssignCrt(var F: Text);
61 info: TConsoleScreenBufferinfo;
64 GetConsoleScreenBufferInfo(output, info);
65 WriteConsoleOutputCharacter(output, SPACE, WIDTH - info.dwCursorPosition.X, info.dwCursorPosition, n);
66 SetConsoleCursorPosition(output, info.dwCursorPosition);
71 info: TConsoleScreenBufferinfo;
78 GetConsoleScreenBufferInfo(output, info);
79 FillConsoleOutputCharacter(output, Char(' '), info.dwSize.X * info.dwSize.Y, xy, written);
80 FillConsoleOutputAttribute(output, info.wAttributes, info.dwSize.X * info.dwSize.Y, xy, written);
90 info: CONSOLE_CURSOR_INFO;
92 GetConsoleCursorInfo(output, info);
93 info.bVisible := false;
94 SetConsoleCursorInfo(output, info);
99 info: CONSOLE_CURSOR_INFO;
101 GetConsoleCursorInfo(output, info);
102 info.bVisible := true;
103 SetConsoleCursorInfo(output, info);
106 procedure Delay(MS: Word);
115 info: TConsoleScreenBufferinfo;
121 GetConsoleScreenBufferInfo(output, info);
123 rect.Top := info.dwCursorPosition.Y + 1;
124 rect.Right := WIDTH - 1;
125 rect.Bottom := HEIGHT - 1;
128 clip.Right := WIDTH - 1;
129 clip.Bottom := HEIGHT - 1;
131 xy.y := info.dwCursorPosition.Y;
134 ScrollConsoleScreenBuffer(output, rect, clip, xy, c);
137 procedure GotoXY(X: tcrtcoord; Y: tcrtcoord);
144 SetConsoleCursorPosition(output, xy);
153 info: TConsoleScreenBufferinfo;
159 GetConsoleScreenBufferInfo(output, info);
161 rect.Top := info.dwCursorPosition.Y;
162 rect.Right := WIDTH - 1;
163 rect.Bottom := HEIGHT - 1;
166 clip.Right := WIDTH - 1;
167 clip.Bottom := HEIGHT - 1;
169 xy.y := info.dwCursorPosition.Y + 1;
172 ScrollConsoleScreenBuffer(output, rect, clip, xy, c);
175 function KeyPressed: Boolean;
181 if((GetAsyncKeyState(VK_BACK) and $8000) <> 0) then last_key := #$08;
182 if((GetAsyncKeyState(VK_TAB) and $8000) <> 0) then last_key := #$09;
183 if((GetAsyncKeyState(VK_RETURN) and $8000) <> 0) then last_key := #$13;
184 if((GetAsyncKeyState(VK_SPACE) and $8000) <> 0) then last_key := ' ';
185 if((GetAsyncKeyState(VK_0) and $8000) <> 0) then last_key := '0';
186 if((GetAsyncKeyState(VK_1) and $8000) <> 0) then last_key := '1';
187 if((GetAsyncKeyState(VK_2) and $8000) <> 0) then last_key := '2';
188 if((GetAsyncKeyState(VK_3) and $8000) <> 0) then last_key := '3';
189 if((GetAsyncKeyState(VK_4) and $8000) <> 0) then last_key := '4';
190 if((GetAsyncKeyState(VK_5) and $8000) <> 0) then last_key := '5';
191 if((GetAsyncKeyState(VK_6) and $8000) <> 0) then last_key := '6';
192 if((GetAsyncKeyState(VK_7) and $8000) <> 0) then last_key := '7';
193 if((GetAsyncKeyState(VK_8) and $8000) <> 0) then last_key := '8';
194 if((GetAsyncKeyState(VK_9) and $8000) <> 0) then last_key := '9';
195 if((GetAsyncKeyState(VK_A) and $8000) <> 0) then last_key := 'A';
196 if((GetAsyncKeyState(VK_B) and $8000) <> 0) then last_key := 'B';
197 if((GetAsyncKeyState(VK_C) and $8000) <> 0) then last_key := 'C';
198 if((GetAsyncKeyState(VK_D) and $8000) <> 0) then last_key := 'D';
199 if((GetAsyncKeyState(VK_E) and $8000) <> 0) then last_key := 'E';
200 if((GetAsyncKeyState(VK_F) and $8000) <> 0) then last_key := 'F';
201 if((GetAsyncKeyState(VK_G) and $8000) <> 0) then last_key := 'G';
202 if((GetAsyncKeyState(VK_H) and $8000) <> 0) then last_key := 'H';
203 if((GetAsyncKeyState(VK_I) and $8000) <> 0) then last_key := 'I';
204 if((GetAsyncKeyState(VK_J) and $8000) <> 0) then last_key := 'J';
205 if((GetAsyncKeyState(VK_K) and $8000) <> 0) then last_key := 'K';
206 if((GetAsyncKeyState(VK_L) and $8000) <> 0) then last_key := 'L';
207 if((GetAsyncKeyState(VK_M) and $8000) <> 0) then last_key := 'M';
208 if((GetAsyncKeyState(VK_N) and $8000) <> 0) then last_key := 'N';
209 if((GetAsyncKeyState(VK_O) and $8000) <> 0) then last_key := 'O';
210 if((GetAsyncKeyState(VK_P) and $8000) <> 0) then last_key := 'P';
211 if((GetAsyncKeyState(VK_Q) and $8000) <> 0) then last_key := 'Q';
212 if((GetAsyncKeyState(VK_R) and $8000) <> 0) then last_key := 'R';
213 if((GetAsyncKeyState(VK_S) and $8000) <> 0) then last_key := 'S';
214 if((GetAsyncKeyState(VK_T) and $8000) <> 0) then last_key := 'T';
215 if((GetAsyncKeyState(VK_U) and $8000) <> 0) then last_key := 'U';
216 if((GetAsyncKeyState(VK_V) and $8000) <> 0) then last_key := 'V';
217 if((GetAsyncKeyState(VK_W) and $8000) <> 0) then last_key := 'W';
218 if((GetAsyncKeyState(VK_X) and $8000) <> 0) then last_key := 'X';
219 if((GetAsyncKeyState(VK_Y) and $8000) <> 0) then last_key := 'Y';
220 if((GetAsyncKeyState(VK_Z) and $8000) <> 0) then last_key := 'Z';
221 if((GetAsyncKeyState(VK_NUMPAD0) and $8000) <> 0) then last_key := '0';
222 if((GetAsyncKeyState(VK_NUMPAD1) and $8000) <> 0) then last_key := '1';
223 if((GetAsyncKeyState(VK_NUMPAD2) and $8000) <> 0) then last_key := '2';
224 if((GetAsyncKeyState(VK_NUMPAD3) and $8000) <> 0) then last_key := '3';
225 if((GetAsyncKeyState(VK_NUMPAD4) and $8000) <> 0) then last_key := '4';
226 if((GetAsyncKeyState(VK_NUMPAD5) and $8000) <> 0) then last_key := '5';
227 if((GetAsyncKeyState(VK_NUMPAD6) and $8000) <> 0) then last_key := '6';
228 if((GetAsyncKeyState(VK_NUMPAD7) and $8000) <> 0) then last_key := '7';
229 if((GetAsyncKeyState(VK_NUMPAD8) and $8000) <> 0) then last_key := '8';
230 if((GetAsyncKeyState(VK_NUMPAD9) and $8000) <> 0) then last_key := '9';
231 if((GetAsyncKeyState(VK_MULTIPLY) and $8000) <> 0) then last_key := '*';
232 if((GetAsyncKeyState(VK_ADD) and $8000) <> 0) then last_key := '+';
233 if((GetAsyncKeyState(VK_SUBTRACT) and $8000) <> 0) then last_key := '-';
234 if((GetAsyncKeyState(VK_DECIMAL) and $8000) <> 0) then last_key := '/';
235 if((GetAsyncKeyState(VK_DIVIDE) and $8000) <> 0) then last_key := '.';
237 keyPressed := (last_key <> #0);
252 function ReadKey: Char;
257 if (last_key <> #0) then
261 FlushConsoleInputBuffer(input);
265 SetConsoleMode(input, ENABLE_PROCESSED_INPUT);
267 ReadConsole(input, buf, 1, n, nil);
268 ReadKey := String(buf)[1];
270 SetConsoleMode(input, ENABLE_PROCESSED_INPUT or ENABLE_LINE_INPUT or ENABLE_ECHO_INPUT);
273 procedure Sound(Hz: Word);
277 procedure TextBackground(Color: Byte);
281 1: fore_color := BACKGROUND_BLUE;
282 2: fore_color := BACKGROUND_GREEN;
283 3: fore_color := BACKGROUND_BLUE or BACKGROUND_GREEN;
284 4: fore_color := BACKGROUND_RED;
285 5: fore_color := BACKGROUND_RED or BACKGROUND_BLUE;
286 6: fore_color := BACKGROUND_RED or BACKGROUND_GREEN;
287 7: fore_color := BACKGROUND_RED or BACKGROUND_BLUE or BACKGROUND_GREEN;
288 8: fore_color := BACKGROUND_INTENSITY;
289 9: fore_color := BACKGROUND_INTENSITY or BACKGROUND_BLUE;
290 10: fore_color := BACKGROUND_INTENSITY or BACKGROUND_GREEN;
291 11: fore_color := BACKGROUND_INTENSITY or BACKGROUND_BLUE or BACKGROUND_GREEN;
292 12: fore_color := BACKGROUND_INTENSITY or BACKGROUND_RED;
293 13: fore_color := BACKGROUND_INTENSITY or BACKGROUND_RED or BACKGROUND_BLUE;
294 14: fore_color := BACKGROUND_INTENSITY or BACKGROUND_RED or BACKGROUND_GREEN;
295 15: fore_color := BACKGROUND_INTENSITY or BACKGROUND_RED or BACKGROUND_BLUE or BACKGROUND_GREEN;
299 SetConsoleTextAttribute(output, fore_color or back_color);
302 procedure TextColor(Color: Byte);
306 1: back_color := FOREGROUND_BLUE;
307 2: back_color := FOREGROUND_GREEN;
308 3: back_color := FOREGROUND_BLUE or FOREGROUND_GREEN;
309 4: back_color := FOREGROUND_RED;
310 5: back_color := FOREGROUND_RED or FOREGROUND_BLUE;
311 6: back_color := FOREGROUND_RED or FOREGROUND_GREEN;
312 7: back_color := FOREGROUND_RED or FOREGROUND_BLUE or FOREGROUND_GREEN;
313 8: back_color := FOREGROUND_INTENSITY;
314 9: back_color := FOREGROUND_INTENSITY or FOREGROUND_BLUE;
315 10: back_color := FOREGROUND_INTENSITY or FOREGROUND_GREEN;
316 11: back_color := FOREGROUND_INTENSITY or FOREGROUND_BLUE or FOREGROUND_GREEN;
317 12: back_color := FOREGROUND_INTENSITY or FOREGROUND_RED;
318 13: back_color := FOREGROUND_INTENSITY or FOREGROUND_RED or FOREGROUND_BLUE;
319 14: back_color := FOREGROUND_INTENSITY or FOREGROUND_RED or FOREGROUND_GREEN;
320 15: back_color := FOREGROUND_INTENSITY or FOREGROUND_RED or FOREGROUND_BLUE or FOREGROUND_GREEN;
324 SetConsoleTextAttribute(output, fore_color or back_color);
327 procedure TextMode(Mode: WORD);
331 function WhereX: tcrtcoord;
333 info: TConsoleScreenBufferinfo;
335 GetConsoleScreenBufferInfo(output, info);
336 WhereX := info.dwCursorPosition.X - wx + 1;
339 function WhereY: tcrtcoord;
341 info: TConsoleScreenBufferinfo;
343 GetConsoleScreenBufferInfo(output, info);
344 WhereY := info.dwCursorPosition.Y - wy + 1;
347 procedure Window(X1: Byte; Y1: Byte; X2: Byte; Y2: Byte);
359 output := GetStdHandle(STD_OUTPUT_HANDLE);
360 input := GetStdHandle(STD_INPUT_HANDLE);
361 SetConsoleMode(output, ENABLE_PROCESSED_OUTPUT or ENABLE_WRAP_AT_EOL_OUTPUT);
362 SetConsoleMode(input, ENABLE_PROCESSED_INPUT or ENABLE_LINE_INPUT or ENABLE_ECHO_INPUT);
366 SetConsoleScreenBufferSize(output, xy);
370 r.Right := WIDTH - 1;
371 r.Bottom := HEIGHT - 1;
372 SetConsoleWindowInfo(output, true, r);
393 Copyright 2019 maruhiro
396 Redistribution and use in source and binary forms,
397 with or without modification, are permitted provided that
398 the following conditions are met:
400 1. Redistributions of source code must retain the above copyright notice,
401 this list of conditions and the following disclaimer.
403 2. Redistributions in binary form must reproduce the above copyright notice,
404 this list of conditions and the following disclaimer in the documentation
405 and/or other materials provided with the distribution.
407 THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
408 INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
409 FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
410 THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
411 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
412 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
413 OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
414 WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
415 OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
416 ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.