288____________ ____ __ _________________________Приложение

Leng[LastChar] := FileSize(F)-

Offs[LastChar-1]-ParOffs end;

{Формируем список описателей} if FontNumb=0 then

FontList := PD {Список был пустым} else

begin {Ищем конец списка} Р := FontList; {Начало списка} while P^NextFontONIL do

Р := P^.NextFont; {Next^NIL - конец} P^NextFont :» PD end;

inc(FontNumb)i RegisterChrFile := FontHumb end; {RegisterChrFile} ^_————.———————_

Function RegisterCHRFont(Font: Pointer): Integer;

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

type

TByte = array [0..65534] of Byte;

var

PH: "THead;

PP: "TFontPara;

PB: "TByte absolute PH;

P,PD: PFontDesc;

k: Integer;

ParOffset: Word;

FileSize: Word;

begin

{Проверяем начало заголовка} PH :° Font;

RegisterChrFont := -Si-if PH^oHeadO then

Exit; {Нет поля 'РК'#8#8} k := 4 у {Ищем CopynghtEnd} while (PB''[k]o$lA) and (k<256) do

inc(k);

if PB^[k]o$lA then

Exit; /Яе нашли терминатор в 256 байтах} {Проверяем блок параметров} ParOffset := РВ^+И+РВ"^-!^] shi 8;

FileSize := PB'^ [k+7]^-PBЛ [k+8] shi 8;

PP :» AddrtPB^[ParOffset]);

if PPA.ParPrefix<>'+^ then

Exit; {Нет префикса параметров} {Резервируем память для описателя} RegisterChrFont :» -3;

if MaxAvail<SizeOf(TFontDesc) then

Exit; /йег памяти для регистрации} New(PD) ;

{Формируем новый дескриптор} with PD^PP^ do

begin

NextFont := 11IL;

NFont := FontNumb+1;

Name.Flag := 0; {Шрифт - в памяти)