Как в консольном приложении можно задать цвет текста?

Code:

unit UffCRT;

// written by Michael Uskoff, Apr 2001, St.Petersburg, RUSSIA

interface

procedure ClrScr;

procedure SetAttr(attr: word);

function GetAttr: word;

procedure GotoXY(aX, aY: integer); // zero-based coords

function WhereX: integer;

function WhereY: integer;

implementation

uses Windows;

var

UpperLeft: TCoord = (X: 0; Y: 0);

hCon: integer;

procedure GotoXY(aX, aY: integer);

var aCoord: TCoord;

begin

aCoord.x := aX;

aCoord.y := aY;

SetConsoleCursorPosition(hCon, aCoord);

end;

procedure SetAttr(attr: word);

begin

SetConsoleTextAttribute(hCon, attr);

end;

function WhereX: integer;

var ScrBufInfo: TConsoleScreenBufferInfo;

begin

GetConsoleScreenBufferInfo(hCon, ScrBufInfo);

Result := ScrBufInfo.dwCursorPosition.x;

end;

function WhereY: integer;

var ScrBufInfo: TConsoleScreenBufferInfo;

begin

GetConsoleScreenBufferInfo(hCon, ScrBufInfo);

Result := ScrBufInfo.dwCursorPosition.y;

end;

function GetAttr: word;

var ScrBufInfo: TConsoleScreenBufferInfo;

begin

GetConsoleScreenBufferInfo(hCon, ScrBufInfo);

Result := ScrBufInfo.wAttributes;

end;

procedure ClrScr;

var fill: integer;

ScrBufInfo: TConsoleScreenBufferInfo;

begin

GetConsoleScreenBufferInfo(hCon, ScrBufInfo);

fill := ScrBufInfo.dwSize.x * ScrBufInfo.dwSize.y;

FillConsoleOutputCharacter(hCon, ' ', fill, UpperLeft, fill);

FillConsoleOutputAttribute(hCon, ScrBufInfo.wAttributes, fill, UpperLeft, fill);

GotoXY(0, 0);

end;

initialization

hCon := GetStdHandle(STD_OUTPUT_HANDLE);

end.

Теперь можно творить такое:

uses UffCRT;

....

ClrScr;

SetAttr($1E);

GotoXY(32, 12);

Write('Hello, master !');

ReadLn;

...