Как писать консольные приложения в Delphi?

Code:

{

[]-----------------------------------------------------------[]

CON001 - Show various Console API functions. Checked with Win95

 version 1.01

 by Alex G. Fedorov, May-July, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

 some minor corrections (shown in comments)

[]-----------------------------------------------------------[]

}

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: LongInt; // Для хранения результатов некоторых функций

//-----------------------------------------

// Получение дескриптора для консольного ввода

//-----------------------------------------

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;

// Расположение окна на экране

{!! 1.01 !!}

with R do

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.KeyEvent.bKeyDown = True) and

         (IBuff.KeyEvent.wVirtualKeyCode = VK_ESCAPE)) then

           Continue := False;

       end;

     _MOUSE_EVENT :

       begin

         with IBuff.MouseEvent.dwMousePosition do

           StatusLine(Format('%d, %d', [X, Y]));

       end;

   end;

end {While}

end.