Код: Выделить всё
(========================================================================================================================================================)
Program TEXT;
uses crt,graph;
const col:array[0..15] of string[12] = ('black','blue','green','cyan','red','magenta','brown','lightgray','darkgray','lightblue','lightgreen','lightcyan','lightred','lightmagenta','yellow','white');
Type
typeText=record
text:string;
color: string;
size:word;
font:integer;
end;
var
driver,mode,error, k, hh:integer;
a:typeText;
f:file of typeText;
ndir,fn,str:string;
i:integer;
begin
clrscr;
ndir:='typetext';
fn:='text';
{$I-}
chdir(ndir);
{$I+};
If IoResult <>0 then
begin
mkdir(ndir);
chdir(ndir);
end;
assign(f,fn);
{$I-}
reset(f);
{$I+};
if IoResult <>0 then
rewrite(f);
writeln('Введите текст');
readln(a.text);
writeln('Какого цвета должен быть ваш текст?');
writeln('Выберите один из шестнадцати');
writeln(' black, blue, green, cyan, red, magenta, brown');
writeln(' lightgray, darkgray, lightblue, lightgreen, lightcyan');
writeln(' lightred, lightmagenta, yellow, white');
read(str);
for i:=0 to 15 do
if str=col[i] then a.color:=col[i];
writeln('Укажите размер шрифта');
read(a.size);
writeln('Укажите вид шрифта, выберите число от 0 до 10');
read(a.font);
write(f,a);
driver:=detect;
InitGraph(driver,mode,'');
error:=GraphResult;
if error <>0 then writeln(GraphErrorMsg(error))
else
begin
SetColor(a.color);
SetTextStyle(a.font,0,a.size);
OutText(a.text);
readkey;
closegraph;
end;
(===================================================================================================================================)
Но только здесь ошибка, хотя я видел подобный алгоритм в книге Фаронова
Компилятор и подставляет тот который у него под рукой.