286 Приложение

ParPrefix : Char; (Символ "+"}

CharsCount: Word; (Количество символов в шрифте}

Reservl : Byte; (He используется}

FirstChar : Byte; (Код первого символа}

DataOffset: Word; (Смещение до векторных команд первого символа}

FillFlag : Byte; (Флаг заливки}

UpperMargin: Byte; (Высота символов}

Reserv2 : Byte; (He используется}

LowerMargin: Shortint; (Нижняя кромка}

Reserv3 : array [1..5] of Byte end;

THead = array [1..4] of Char;

const

FontList: PFontDesc Bs NIL; (Список шрифтов} FontNumb: Integer = 0; (Количество шрифтов} var

FDesc: TFontDesc;

F: File;

Buf: array [1..128] of Byte; (Заголовок) Head: THead absolute Buf;

FPar: TFontPara; (Параметры шрифта} coast

HeadO: THead = ('P','K',#8,#8);

Function RegisterCHRFile(S: String): Integer;

{Регистрирует векторный шрифт, содержащийся в файле с именем S, и возвращает порядковый номер шрифта} var

k: Integer;

Err: Boolean;

P,PD: PFontDesc;

ParOffs: Word;

Function ReadFile(var Dest; Size: Word): Boolean;

(Читает Size байт из файла F в переменную Dest} begin

BlockRead(F,Dest,Size,k) ;

ReadFile := k=Size end;

{——————}

begin

{Проверяем и корректируем имя} if pos (' . ',S)=0 then S := S+'.chr' ;

(Проверяем по списку, чтобы исключить повторную регистрацию} if FontNurnboO then begin

FDesc := FontList^-with FDesc do

while (NextFontOMIL) and (SOName.FName) do FDesc := MextFont^;

if S=FDesc.Name.PName then

begin (Найден в списке - вернуть номер} RegisterChrFile := FDesc.NFont;

Exit end end;