Автор: Jokerjar79
Дата сообщения: 16.03.2008 16:32
Вот нашел исходник, присутствует реализация базовых функций для проектирования консольных приложений. Протестил на Turbo Delphi 2006
[more]program Con001;
{$APPTYPE CONSOLE}
uses Windows, SysUtils;
const
// Некоторые стандартные цвета
YellowOnBlue = FOREGROUND_GREEN OR FOREGROUND_RED OR
FOREGROUND_INTENSITY OR BACKGROUND_BLUE;
WhiteOnBlue = FOREGROUND_BLUE OR FOREGROUND_GREEN OR
FOREGROUND_RED OR FOREGROUND_INTENSITY OR
BACKGROUND_BLUE;
RedOnWhite = FOREGROUND_RED OR FOREGROUND_INTENSITY OR
BACKGROUND_RED OR BACKGROUND_GREEN OR BACKGROUND_BLUE
OR BACKGROUND_INTENSITY;
WhiteOnRed = BACKGROUND_RED OR BACKGROUND_INTENSITY OR
FOREGROUND_RED OR FOREGROUND_GREEN OR FOREGROUND_BLUE
OR FOREGROUND_INTENSITY;
var
ConHandle : THandle; // Дескриптор консольного окна
Coord : TCoord; // Для хранения/установки позиции экрана
MaxX, MaxY : Word; // Для хранения максимальных размеров окна
CCI : TConsoleCursorInfo;
NOAW : Cardinal; // Для хранения результатов некоторых функций
//-----------------------------------------
// Получение дескриптора для консольного ввода
//-----------------------------------------
function GetConInputHandle : THandle;
begin
Result := GetStdHandle(STD_INPUT_HANDLE)
end;
//-----------------------------------------
// Получение дескриптора для консольного вывода
//-----------------------------------------
function GetConOutputHandle : THandle;
begin
Result := GetStdHandle(STD_OUTPUT_HANDLE)
end;
//-----------------------------------------
// Установка курсора в координаты X, Y
//-----------------------------------------
procedure GotoXY(X, Y : Word);
begin
Coord.X := X; Coord.Y := Y;
SetConsoleCursorPosition(ConHandle, Coord);
end;
//-----------------------------------------
// Очистка экрана - заполнение его пробелами
//-----------------------------------------
procedure Cls;
begin
Coord.X := 0; Coord.Y := 0;
FillConsoleOutputCharacter(ConHandle, ' ', MaxX*MaxY, Coord, NOAW);
GotoXY(0, 0);
end;
//--------------------------------------
// Показываем/Скрываем курсор
//--------------------------------------
procedure ShowCursor(Show : Bool);
begin
CCI.bVisible := Show;
SetConsoleCursorInfo(ConHandle, CCI);
end;
//--------------------------------------
// Инициализация глобальных переменных
//--------------------------------------
procedure Init;
begin
// Получаем дескриптор вывода (output)
ConHandle := GetConOutputHandle;
// Получаем максимальные размеры окна
Coord := GetLargestConsoleWindowSize(ConHandle);
MaxX := Coord.X;
MaxY := Coord.Y;
end;
//---------------------------------------
// рисуем строку статуса ("status line")
//---------------------------------------
procedure StatusLine(S : String);
begin
Coord.X := 0; Coord.Y := 0;
WriteConsoleOutputCharacter(ConHandle, PChar(S), Length(S)+1, Coord, NOAW);
FillConsoleOutputAttribute (ConHandle, WhiteOnRed, Length(S), Coord, NOAW);
end;
//-----------------------------------------------------
// Консольный обработчик событий
//-----------------------------------------------------
function ConProc(CtrlType : DWord) : Bool; stdcall; far;
var
S : String;
begin
case CtrlType of
CTRL_C_EVENT : S := 'CTRL_C_EVENT';
CTRL_BREAK_EVENT : S := 'CTRL_BREAK_EVENT';
CTRL_CLOSE_EVENT : S := 'CTRL_CLOSE_EVENT';
CTRL_LOGOFF_EVENT : S := 'CTRL_LOGOFF_EVENT';
CTRL_SHUTDOWN_EVENT : S := 'CTRL_SHUTDOWN_EVENT';
else
S := 'UNKNOWN_EVENT';
end;
MessageBox(0, PChar(S + ' detected'), 'Win32 Console', MB_OK);
Result := True;
end;
{
[]---------------------------------------------------------------[]
Основная программа - показывает использование некоторых подпрограмм
а так же некоторых функций консольного API
[]---------------------------------------------------------------[]
}
var
R : TSmallRect;
Color : Word;
OSVer : TOSVersionInfo;
IBuff : TInputRecord;
IEvent : DWord;
Continue : Bool;
begin
// Инициализация глобальных переменных
Init;
// Расположение окна на экране
With R do
{!! 1.01 !!}
begin
Left := 10; Top := 10; Right := 40; Bottom := 40;
end;
{!! 1.01 !!}
SetConsoleWindowInfo(ConHandle, False, R);
// Устанавливаем обработчик событий
SetConsoleCtrlHandler(@ConProc, True);
// Проверяем обработчик событий
GenerateConsoleCtrlEvent(CTRL_C_EVENT, 0);
// Изменяем заголовок окна
SetConsoleTitle('Console Demo');
// Прячем курсор
ShowCursor(False);
Coord.X := 0; Coord.Y := 0;
// Устанавливаем белый текст на синем фоне
Color := WhiteOnBlue;
FillConsoleOutputAttribute(ConHandle, Color, MaxX*MaxY, Coord, NOAW);
// Console Code Page API is not supported under Win95 - only GetConsoleCP
Writeln('Console Code Page = ', GetConsoleCP);
Writeln('Max X=', MaxX,' Max Y=', MaxY);
Readln; // ожидаем ввода пользователя
Cls; // очищаем экран
ShowCursor(True); // показываем курсор
//
// Use some Win32API stuff
//
OSVer.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(OSVer);
With OSVer do
Begin
Writeln('dwMajorVersion = ', dwMajorVersion);
Writeln('dwMinorVersion = ', dwMinorVersion);
Writeln('dwBuildNumber = ', dwBuildNumber);
Writeln('dwPlatformID = ', dwPlatformID);
End;
//
Readln; // ожидаем ввода пользователя
// Удаляем обработчик событий
SetConsoleCtrlHandler(@ConProc, False);
Cls;
//
// "Цикл обработки сообщений"
//
Continue := True;
While Continue do
Begin
ReadConsoleInput(GetConInputHandle, IBuff, 1, IEvent);
Case IBuff.EventType of
KEY_EVENT : Begin
// Проверяем клавишу ESC и завершаем программу
If ((IBuff.Event.KeyEvent.bKeyDown = True) AND
(IBuff.Event.KeyEvent.wVirtualKeyCode = VK_ESCAPE)) Then
Continue := False;
End;
_MOUSE_EVENT : Begin
With IBuff.Event.MouseEvent.dwMousePosition do
StatusLine(Format('%d, %d', [X, Y]));
End;
end;
End {While}
end.[/more]
