{========================================================}
{ Следует дать команду "binobj cga.bgi cga.obj CGADriv" }
{ перед трансляцией этой программы. }
{========================================================}
program Font_Generator; {$I-,L cga.obj}
uses Graph, Dos, Crt;
label 1,2,3;
type
ReadKType = (LeftK, RightK, UpK, DownK,
F1K, F2K, F10K, EnterK, EscK, Err);
FType = array [1..64, 1..8] of Word;
FontType = array [0..127, 0..7] of Byte;
const
{ Таблица шрифта для работы самой программы : }
Font : FType = (
($7830,$cccc,$ccfc,$00cc, $62fe,$7c60,$6666,$00fc),
($66fc,$7c66,$6666,$00fc, $62fe,$6060,$6060,$00f0),
($361e,$6666,$6666,$c3ff, $62fe,$7868,$6268,$00fe),
($d6d6,$387c,$d67c,$00d6, $cc78,$300c,$cc0c,$0078),
($6763,$7b6f,$6373,$0063, $d6d6,$dece,$e6f6,$00c6),
($66e6,$786c,$666c,$00e6, $331f,$6363,$6363,$00c3),
($eec6,$fefe,$c6d6,$00c6, $cccc,$fccc,$cccc,$00cc),
($6c38,$c6c6,$6cc6,$0038, $c6fe,$c6c6,$c6c6,$00c6),
($66fc,$7c66,$6060,$00f0, $663c,$c0c0,$66c0,$003c),
($b4fc,$3030,$3030,$0078, $c6c6,$c6c6,$06fe,$007c),
($d67c,$d6d6,$7cd6,$0010, $c6c6,$386c,$6c38,$00c6),
($cccc,$cccc,$cccc,$06fe, $ccce,$cccc,$0c7c,$001e),
($d6d6,$d6d6,$d6d6,$00fe, $d6d6,$d6d6,$d6d6,$03ff),
($30f0,$3c30,$3636,$003c, $c6c6,$f6c6,$cece,$00f6),
($c0c0,$f8c0,$cccc,$00f8, $cc78,$3e06,$cc06,$0078),
($d6cc,$f6f6,$d6d6,$00cc, $c67e,$7ec6,$6636,$00c6),
($0000,$0c78,$cc7c,$0076, $0000,$c0f8,$ccf8,$00f8),
($0000,$ccf8,$ccf8,$00f8, $0000,$64fc,$6060,$00f0),
($0000,$6c3c,$6c6c,$6cfe, $0000,$cc78,$c0fc,$0078),
($0000,$d6d6,$d67c,$00d6, $0000,$0cf8,$0c78,$00f8),
($0000,$Dece,$e6f6,$00c6, $3800,$Dece,$e6f6,$00c6),
($0000,$d8cc,$d8f0,$00cc, $0000,$6c3c,$6c6c,$00cc),
($0000,$eec6,$d6fe,$00c6, $0000,$cccc,$ccfc,$00cc),
($0000,$cc78,$cccc,$0078, $0000,$ccfc,$cccc,$00cc),
($cc33,$cc33,$cc33,$cc33, $aa55,$aa55,$aa55,$aa55),
($77ee,$77ee,$77ee,$77ee, $1818,$1818,$1818,$1818),
($1818,$1818,$18f8,$1818, $1818,$f818,$f818,$1818),
($2424,$2424,$24e4,$2424, $0000,$0000,$24fc,$2424),
($0000,$f800,$f818,$1818, $2424,$e424,$e404,$2424),
($2424,$2424,$2424,$2424, $0000,$fc00,$e404,$2424),
($2424,$e424,$fc04,$0000, $2424,$2424,$00fc,$0000),
($1818,$f818,$f818,$0000, $0000,$0000,$18f8,$1818),
($1818,$1818,$181f,$0000, $1818,$1818,$00ff,$0000),
($0000,$0000,$18ff,$1818, $1818,$1818,$181f,$1818),
($0000,$0000,$00ff,$0000, $1818,$1818,$18ff,$1818),
($1818,$1f18,$1f18,$1818, $2424,$2424,$2427,$2424),
($2424,$2724,$3f20,$0000, $0000,$3f00,$2720,$2424),
($2424,$e724,$ff00,$0000, $0000,$ff00,$e700,$2424),
($2424,$2724,$2720,$2424, $0000,$ff00,$ff00,$0000),
($2424,$e724,$e700,$2424, $1818,$ff18,$ff00,$0000),
($2424,$2424,$00ff,$0000, $0000,$ff00,$ff00,$1818),
($0000,$0000,$24ff,$2424, $2424,$2424,$003f,$0000),
($1818,$1f18,$1f10,$0000, $0000,$1f00,$1f10,$1818),
($0000,$0000,$243f,$2424, $2424,$2424,$24ff,$2424),
($1818,$ff18,$ff18,$1818, $1818,$1818,$00f8,$0000),
($0000,$0000,$181f,$1818, $ffff,$ffff,$ffff,$ffff),
($0000,$0000,$ffff,$ffff, $f0f0,$f0f0,$f0f0,$f0f0),
($0f0f,$0f0f,$0f0f,$0f0f, $ffff,$ffff,$0000,$0000),
($0000,$ccf8,$c0f8,$00c0, $0000,$cc78,$ccc0,$0078),
($0000,$b4fc,$3030,$0078, $0000,$cccc,$7ccc,$780c),
($1000,$d67c,$d6d6,$107c, $0000,$6cc6,$6c38,$00c6),
($0000,$cccc,$cccc,$06fe, $0000,$ccce,$0c7c,$001e),
($0000,$d6d6,$d6d6,$00fe, $0000,$d6d6,$d6d6,$03ff),
($0000,$30f0,$363c,$003c, $0000,$f6c6,$cece,$00f6),
($0000,$f8c0,$cccc,$00f8, $0000,$cc78,$cc1c,$0078),
($0000,$f6dc,$f6f6,$00dc, $0000,$cc7c,$6c7c,$00cc),
($fecc,$7860,$6260,$00fe, $00cc,$cc78,$c0fc,$0078),
($0000,$0000,$0603,$180c, $0000,$0000,$60c0,$1830),
($3018,$c060,$0000,$0000, $0c18,$0306,$0000,$0000),
($0c00,$ff06,$0c06,$0000, $3000,$ff60,$3060,$0000),
($1818,$1818,$7e18,$183c, $3c18,$187e,$1818,$1818),
($1818,$7e00,$1800,$0018, $1818,$187e,$0018,$007e),
($c7c7,$f6e4,$cede,$00c6, $c300,$663c,$3c66,$00c3),
($0000,$3c3c,$3c3c,$0000, $0000,$0000,$0000,$0000));
li = ' ';
wdw = 10; { ширина клетки рабочего поля }
htw = 8; { высота клетки рабочего поля }
wdt = 15; { ширина клетки таблицы }
htt = 11; { высота клетки таблицы }
xw = wdw; { левая граница рабочего поля }
f1f : Boolean = False; { флаг режима F1 }
f2f : Boolean = False; { флаг режима F2 }
iw : Byte = 0; { горизонтальная координата пикселя в
рабочем поле }
jw : Byte = 0; { вертикальная координата пикселя }
if1 : Byte = 4; { горизонтальная координата режима F1 }
jf1 : Byte = 1; { вертикальная координата режима F1 }
if2 : Byte = 8; { горизонтальная координата режима F2 }
jf2 : Byte = 0; { вертикальная координата режима F2 }
Cng : Boolean = False; { флаг изменения шрифта }
FlagFont : Boolean = False; { флаг считанного шрифта }
var
{ рабочие переменные: }
b : Char;
st : String;
IOres, es : Boolean;
f : file of FontType; { файл со шрифтом }
Nfont : FontType; { таблица знакогенератора }
d, r, e : Integer; { переменные для установки графики }
FntC : array [-4..10] of Byte;
{ образ очередного символа, первые 4 байта - служебные }
yw, { верхняя граница рабочего поля }
xt, { левая граница таблицы }
yt, { верхняя граница таблицы }
i, j, x, y : Integer; { рабочие переменные }
pw, { указатель на клетку для рабочего поля }
pw0 : Pointer;
pc, { указатель на символ }
pt : Pointer; { указатель на клетку таблицы }
fontB : array [0..7, 0..7] of Boolean;
{ массив признаков светящихся пикселей }
procedure CGADriv; external;
{ ====================================================== }
procedure GraphRead(var st : String; var esc : Boolean);
{ Вводит символьную строку с имитацией курсора:
st - введенная строка; esc - признак выхода по ESC }
const
Ins : Boolean = True;
var
x, y, x0, y0, i : Byte;
c1, c2 : Char;
procedure Cursor;
{ Имитация мигающего курсора для процедуры GraphRead }
const
Time = 20;
ImCursor1 : array [1..14] of Byte =
(7,0,7,0,0,0,0,0,0,255,255,0,32,32);
var
i, x, y : Byte;
d, r : Integer;
begin
x:=WhereX; y:=WhereY;
repeat
PutImage((x+Lo(WindMin)-1)*8,(y+Hi(WindMin)-1)*8+2,
ImCursor1,XorPut);
i:=0;
while (not KeyPressed) and (i<Time) do
begin
Delay(10); Inc(i)
end;
PutImage((x+Lo(WindMin)-1)*8,(y+Hi(WindMin)-1)*8+2,
ImCursor1,XorPut);
i:=0;
while (not KeyPressed) and (i<Time) do
begin
Delay(10); Inc(i)
end
until KeyPressed
end { Cursor };
begin
x:=WhereX; x0:=x; y:=WhereY; y0:=y; st:=''; esc:=False;
repeat
Cursor; c1:=ReadKey;
if c1=#0 then c2:=ReadKey;
case Ord(c1) of
13: begin Writeln; Exit end;
27: begin esc:=True; Exit end;
127,8: if x>x0 then
begin
GoToXY(x0,y0); for i:=1 to Length(st) do Write(' ');
Delete(st,x-x0,1); Dec(x); GoToXY(x0,y0); Write(st)
end;
0: case Ord(c2) of
82: Ins:=not Ins;
71: x:=x0;
75: if x>x0 then Dec(x);
77: if x-x0<Length(st) then Inc(x);
79: x:=x0+Length(st);
83: if (Length(st)<>0) and (x-x0<Length(st)) then
begin
GoToXY(x0,y0); for i:=1 to Length(st) do Write(' ');
Delete(st,x-x0+1,1); GoToXY(x0,y0); Write(st)
end
end { case Ord(c2) }
else { case Ord(c1) } begin
if x-x0=Length(st) then
begin
st:=st+c1; Write(c1); Inc(x)
end
else if Ins then
begin
Insert(c1,st,x-x0+1); GoToXY(x0,y0);
Write(st); Inc(x)
end
else begin
st[x-x0+1]:=c1; GoToXY(x,y); Write(c1); Inc(x)
end
end { else case }
end { case Ord(c1) };
GoToXY(x,y)
until False
end { GraphRead };
{ ====================================================== }
function ErrName(nm : String) : Boolean;
{ Проверяет корректность введенного имени файла }
var Srec : SearchRec;
begin
FindFirst(nm,Archive+ReadOnly,Srec);
if (DosError<>0) and (DosError<>18) then ErrName:=True
else ErrName:=False
end;
{ ====================================================== }
procedure Zast;
{ Выводит заставку в начале и в конце работы программы }
begin
SetIntVec(31,@font); GoToXY(1,2);
Writeln(' FFFFFFFFF OOOOO NN NN TTTTTTTTTT');
Writeln(' FFFFFFFFF OO OO NN NN TTTTTTTTTT');
Writeln(' FF OO OO NNN NN TT');
Writeln(' FF OO OO NNNN NN TT');
Writeln(' FFFFFFF OO OO NN NN NN TT');
Writeln(' FFFFFFF OO OO NN NN NN TT');
Writeln(' FF OO OO NN NNNN TT');
Writeln(' FF OO OO NN NNN TT');
Writeln(' FF OO OO NN NN TT');
Writeln(' FF OOOOO NN NN TT'#10#13);
Writeln(li+' ▒▒▒ ▒▒▒ ▒ ▒ ▒▒▒ ▒ ▒▒ ▒▒ ▒▒▒▒▒ ▒▒ ▒ ▒▒');
Writeln(li+'▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒');
Writeln(li+'▒ ▒ ▒ ▒▒ ▒ ▒ ▒▒ ▒ ▒ ▒ ▒ ▒ ▒▒');
Writeln(li+' ▒▒▒▒ ▒▒▒ ▒ ▒ ▒ ▒▒▒▒ ▒ ▒▒▒▒ ▒ ▒ ▒ ▒');
Writeln(li+' ▒ ▒ ▒ ▒▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒');
Writeln(li+'▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒');
Writeln(li+' ▒▒▒ ▒▒▒ ▒ ▒ ▒▒▒ ▒ ▒ ▒ ▒ ▒▒ ▒');
GoToXY(22,22); Write('==== ПРОГРАММА ГЕНЕРАЦИИ ШРИФТОВ ====');
GoToXY(26,24); Write('>>> Нажмите любую клавишу <<<');
RectAngle(0,0,GetMaxX,160); RectAngle(0,160,GetMaxX,GetMaxY)
end;
{ ====================================================== }
procedure Build;
{ Подготавливает рабочее поле; подготовка и формирование
таблицы; выводит верхнюю строку-подсказку }
procedure BuildWork;
{ Подготавливает рабочее поле в левой части экрана.
Расчерчивает поле 8x8 и готовит образ пустой клетки
(указатель pw0^) и память для мигания (pw^) }
begin
yw:=(GetMaxY-htw*8-9) div 2;
for i:=0 to 8 do
begin
Line(xw,yw+i*htw,xw+wdw*8,yw+i*htw);
Line(xw+i*wdw,yw,xw+i*wdw,yw+htw*8)
end;
GetMem(pw,ImageSize(xw+1,yw+1,xw+wdw,yw+htw));
GetMem(pw0,ImageSize(xw+1,yw+1,xw+wdw,yw+htw));
GetImage(xw+1,yw+1,xw+wdw,yw+htw,pw0^)
end { BuildWork };
procedure BuildTable;
{ Расчерчивает поле 16x16 для таблицы знакогенератора.
Читает стандартный шрифт из первой половины ASCII-кодов
и помещает его в первую часть таблицы. Если был считан
входной файл (признак в переменной FlagFont), то форми-
руется и правая часть таблицы. В указателе pc^ сохраняет-
ся память для переноса символов из таблицы в рабочее поле
и обратно. В указателе pt^ резервируется память для
выделения клетки таблицы }
var
is, k : Integer;
begin
xt:=GetMaxX-16*wdt-xw-1;
yt:=(GetMaxY-16*htt-8) div 2 + 8;
for i:=0 to 16 do
begin
Line(xt,yt+i*htt,xt+16*wdt,yt+i*htt);
Line(xt+i*wdt,yt,xt+i*wdt,yt+16*htt)
end;
RectAngle(xt-1,yt-1,xt+8*wdt-1,yt+16*htt+1);
RectAngle(xt+8*wdt+1,yt-1,xt+16*wdt+1,yt+16*htt+1);
is:=ImageSize(0,0,7,7);
GetImage(0,0,7,7,FntC); GetMem(pc,is);
{ Цикл подготовки символов: сначала каждый символ выводит-
ся в левый верхний угол экрана, затем переносится в
нужное место таблицы.
Символы 7, 8, 10, 13 выводятся через процедуру OutText }
for i:=0 to 8*Succ(Ord(FlagFont))-1 do for j:=0 to 15 do
begin
GoToXY(1,1); k:=i*16+j;
if (k=7) or (k=8) or (k=10) or (k=13)
then OutTextXY(0,0,chr(k)) else Write(chr(k));
GetImage(0,0,7,7,pc^); PutImage(0,0,pc^,XorPut);
PutImage(xt+i*wdt+(wdt-8) div 2 + 1,
yt+j*htt+(htt-8) div 2 + 1,pc^,NormalPut)
end;
GetMem(pt,ImageSize(0,0,wdt,htt))
end { BuildTable };
const
tx = 'F1-Выбрать символ; F2-Поместить символ; F10-Выход.';
begin
GoToXY((80-textwidth(tx) div 8) div 2 - 3,1); Write(tx);
SetIntVec(31,@Nfont); BuildWork; BuildTable;
RectAngle(0,10,GetMaxX,GetMaxY)
end { Build };
{ ====================================================== }
procedure Work;
{ Готовит вспомогательный массив - признак пикселей fontB,
затем в бесконечном цикле читает клавиатуру и передает
управление соответствующей процедуре }
{ ------------------------------------------------------ }
function RedK : ReadKType;
{ Обеспечивает мигание клетки рабочего поля или выделенного
символа до тех пор, пока не будет нажата очередная кла-
виша. Преобразует код клавиши в тип ReadKType }
const
Temp = 5; { Частота мигания }
ReadKTable : array [0..6] of Byte =
(75,77,72,80,59,60,68);
var
p : Pointer; { Образ мигания }
c1, c2 : Char;
rk : ReadKType;
begin
{ Подготовить в x, y - координаты,
а в p^ - образ для мигания }
if not (f1f or f2f) then
begin
x:=xw+iw*wdw+3; y:=yw+jw*htw+2; p:=pw;
GetImage(x,y,x+wdw-7,y+htw-4,p^)
end
else begin
if f1f then
begin
x:=xt+if1*wdt; y:=yt+jf1*htt
end
else begin
x:=xt+if2*wdt; y:=yt+jf2*htt
end;
p:=pt; GetImage(x,y,x+wdt,y+htt,p^)
end;
{ Цикл сканирования клавиатуры }
repeat
while not KeyPressed do
begin
PutImage(x,y,p^,NotPut);
for i:=1 to 50 do
if not KeyPressed then Delay(Temp);
PutImage(x,y,p^,NormalPut);
if not KeyPressed then for i:=1 to 50 do
if not KeyPressed then Delay(Temp)
end;
{ Опознать клавишу в соответствии с типом ReadKType }
rk:=Err; c1:=ReadKey;
if Ord(c1)=0 then c2:=ReadKey else c2:=#0;
if Ord(c1)=13 then rk:=EnterK
else if Ord(c1)=27 then rk:=EscK
else if Ord(c1)=0 then for i:=0 to 6 do
if Ord(c2)=ReadKTable[i] then rk:=ReadKType(i)
{ Продолжить сканирование, если клавиша не
соответствует типу ReadKType }
until rk<>Err;
RedK:=rk
end { RedK };
{ ------------------------------------------------------ }
procedure MoveXY(x : Integer);
{ Переводит указатель в рабочем поле или таблице:
1 - налево; 2 - направо; 3 - вверх; 4 - вниз }
procedure Left(var i : Byte; a, b : Byte);
begin
if i=a then i:=b else Dec(i)
end;
procedure Right(var i : Byte; a, b : Byte);
begin
if i=b then i:=a else Inc(i)
end;
procedure Up(var i : Byte; a : Byte);
begin
if i=0 then i:=a else Dec(i)
end;
procedure Down(var i : Byte; a : Byte);
begin
if i=a then i:=0 else Inc(i)
end;
begin
if f1f then
begin
case x of
1: Left(if1,0,15); 2: Right(if1,0,15);
3: Up(jf1,15); 4: Down(jf1,15)
end;
GoToXY(76,1); Write(if1*16+jf1:3)
end
else if f2f then
begin
case x of
1: Left(if2,8,15); 2: Right(if2,8,15);
3: Up(jf2,15); 4: Down(jf2,15)
end;
GoToXY(76,1); Write(if2*16+jf2:3)
end
else case x of
1: Left(iw,0,7); 2: Right(iw,0,7);
3: Up(jw,7); 4: Down(jw,7)
end
end { MoveXY };
{ ------------------------------------------------------ }
procedure CopyChar;
{ Копирует символ в виде матрицы 3x3 знака в центре экрана }
begin
x:=xw+8*wdw+1; x:=x+(xt-x-24) div 2;
y:=(GetMaxY-32) div 2;
for i:=0 to 2 do for j:=0 to 2 do
PutImage(x+8*j,y+8*i,FntC,NormalPut);
RectAngle(x-1,y-1,x+25,y+25)
end { CopyChar };
{ ------------------------------------------------------ }
procedure Enter;
{ В режиме редактирования инвертирует пиксель,
в режиме F1 переносит выбранный символ в рабочее поле,
в режиме F2 переносит символ в таблицу }
procedure GetChar;
{ Переносит выбранный в таблице символ в рабочее поле }
begin
x:=xt+if1*wdt+(wdt-8) div 2 + 1;
y:=yt+jf1*htt+(htt-8) div 2 + 1;
GetImage(x,y,x+7,y+7,FntC);
{ Проверить образ побитно и сформировать изображение
в рабочем поле }
for i:=0 to 7 do for j:=0 to 7 do
if (FntC[i] and (128 shr j))<>0 then
begin
PutImage(xw+j*wdw+1,yw+i*htw+1,pw0^,NotPut);
fontB[i,j]:=True
end
else begin
PutImage(xw+j*wdw+1,yw+i*htw+1,pw0^,NormalPut);
fontB[i,j]:=False
end;
CopyChar; GoToXY(76,1); Write(' '); f1f:=False
end { GetChar };
procedure PutChar;
{ Помещает отредактированный символ в таблицу }
begin
x:=xt+if2*wdt+(wdt-8) div 2 + 1;
y:=yt+jf2*htt+(htt-8) div 2 + 1;
PutImage(x,y,FntC,NormalPut);
{ Скопировать символ в основную таблицу Font }
i:=if2*16+jf2-128;
for j:=0 to 7 do Nfont[i,j]:=FntC[j];
{ Очистить рабочее поле }
for i:=0 to 7 do
begin
FntC[i]:=0; for j:=0 to 7 do
begin
PutImage(xw+j*wdw+1,yw+i*htw+1,pw0^,NormalPut);
fontB[i,j]:=False
end
end;
Cng:=True; CopyChar; GoToXY(76,1);
Write(' '); f2f:=False
end { PutChar };
begin
if f1f then GetChar else if f2f then PutChar else
begin
if fontB[jw,iw] then
begin
PutImage(xw+iw*wdw+1,yw+jw*htw+1,pw0^,NormalPut);
fontB[jw,iw]:=False
end
else begin
PutImage(xw+iw*wdw+1,yw+jw*htw+1,pw0^,NotPut);
fontB[jw,iw]:=True
end;
FntC[jw]:=FntC[jw] xor (128 shr iw); CopyChar
end
end { Enter };
{ ------------------------------------------------------ }
procedure Quit;
{ Запись шрифта в новый файл. Конец работы }
label 1,2,3,4;
begin
ClearDevice; Zast;
if not Cng then goto 2 else
begin
1: SetViewPort(8,168,631,191,ClipOn); ClearViewPort;
SetViewPort(0,0,639,199,ClipOn);
GoToXY(7,22); Write('==== Введите имя выходного файла,');
Write(' ESC - Для выхода без записи ====');
GoToXY(26,24); Write('>>> '); GraphRead(st,es);
if es then goto 4;
if ErrName(st) then
begin
GoToXY(26,24); Write('Неверное имя файла !'#7);
b:=ReadKey; if b=#0 then ReadKey;
goto 1
end;
Assign(f,st); Rewrite(f);
Write(f,Nfont); if IOresult<>0 then goto 3;
Close(f); goto 2
end;
3: GoToXY(18,24); Write('Шрифт не записан');
Write(' - Нажмите любую клавишу'#7);
b:=ReadKey; if b=#0 then ReadKey;
goto 4;
2: GoToXY(23,24);
Write('Нормальное завершение программы ...');
b:=ReadKey; if b=#0 then ReadKey;
4: CloseGraph; Halt(0)
end { Quit };
{ ------------------------------------------------------ }
begin
for i:=0 to 7 do for j:=0 to 7 do fontB[i,j]:=False;
while True do case RedK of
LeftK: MoveXY(1); RightK: MoveXY(2);
UpK: MoveXY(3); DownK: MoveXY(4);
F1K: begin f1f:=True; f2f:=False end;
F2K: begin f1f:=False; f2f:=True end;
EscK: begin f1f:=False; f2f:=False end;
F10K: Quit; EnterK: Enter
end
end { Work };
{ ====================================================== }
begin
if RegisterBGIDriver(@CGADriv)<0 then
begin
Writeln('Ошибка при регистрации драйвера'); Halt(1)
end;
DirectVideo:=False; d:=CGA; r:=CGAHi;
InitGraph(d,r,''); e:=GraphResult; r:=GetGraphMode;
if e<>grOk then
begin
Writeln('Невозможно установить графический режим'); Halt(1)
end;
if r<>CGAHi then
begin
CloseGraph;
Writeln('Невозможно установить требуемый режим'); Halt(1)
end;
Zast;
1: b:=ReadKey; if b=#0 then ReadKey;
SetViewPort(8,168,631,191,ClipOn); ClearViewPort;
SetViewPort(0,0,639,199,ClipOn);
GoToXY(9,22); Write('==== Введите имя входного файла,');
Write(' ESC - Для создания нового ====');
GoToXY(26,24); Write('>>> '); GraphRead(st,es);
if es then
begin
FlagFont:=False; goto 2
end;
if ErrName(st) then
begin
GoToXY(26,24); Write('Неверное имя файла !'#7); goto 1
end;
for i:=0 to 127 do for j:=0 to 7 do Nfont[i,j]:=0;
Assign(f,st); Reset(f);
if FileSize(f)<>1 then IOres:=False else IOres:=True;
if (IOresult=0) or IOres then
begin
Read(f,Nfont); if IOresult<>0 then goto 3;
Close(f); FlagFont:=True
end
else begin
3: GoToXY(17,24); Write('Шрифт не прочитан');
Write(' - Нажмите любую клавишу'#7);
b:=ReadKey; if b=#0 then ReadKey;
FlagFont:=False
end;
2: ClearDevice; Build; Work
end { Font_Generator }.