k: Integer;

b: Byte;

j: Byte;

begin

for k := 0 to predd'F) do begin

b := Font" [Ch*YF+lc] ;

case Adapter of

О: {Вывод без аппаратной поддержки}

begin

for j := 0 to 7 do

if b and (128 shr j)<>0 then

PutPixel(X*XF+j,Y+k,TCol) else if BColoO then

PutPixel(X*XF+j,Y+k,BCol) end;

1: {Аппаратная поддержка EGA/VGA}

asm

{Вычисляем адрес байта а видеопамяти}

mov ax,$AOOO

mov es,ax {es = $АООО}

mov bx, у (Ьх = у)

add bx,k (Ьх » (y-l-k) }

mov cl,4

shi bx,cl

mov dx,bx {dx » (y+k>*16}

mov ci,2

shi bx,cl {bx = <y+k)*64f

add bx,dx {bx = (y+k) *80)

add bx,x {bx = (y+k)*80+x} {Устанавливаем режим записи 2]

mov dx,$3CE

mov al,5

out dx,al

inc dx

mov al,2

out dx,al {Разрешаем изменять только биты символа}

mov dx,$3CE

mov al,8

out dx,al

inc dx

mov al,b {Разрешены биты символа}

out dx,al

{Выводим символ}

mov al,es: [bx]

mov al,TCol

mov es:[bx],al {Проверяем фоновый цвет}

mov dl,BCol

cmp dl, 0

je @0 {Изменяем биты фона для создания фонового цвета}

mov dx,$3CE

mov al,8 {Регистр маски битов}

out dx,al

inc dx

mov al,b {Разрешить изменение}

not al {разрядов фона}

out dx,al