Это старье, конечно... Вроде все уже такое умеют.
Hу все-равно...
<<Vic>>
[ Team Daemon's Hedgehog ]
--- Дедуля/386 2.50.Beta4+
{> Cut here. FileName= BIGCHAR.PAS }
uses crt;
{ Здоpовые символы }
procedure writes(x,y:byte;s:string);
type fnt=array[1..16] of byte;
const bites:array[1..8] of byte = ( 128,64,32,16,8,4,2,1 );
var font:array[0..255] of fnt;
f1,f2,f3,f4,f5:byte;
Procedure LoadChar(CharNum: Byte; var Pic:array of byte);
Begin
Inline($FA);PortW[$3C4]:=$0402;PortW[$3C4]:=$0704;PortW[$3CE]:=$0204;
PortW[$3CE]:=$0005;PortW[$3CE]:=$0006;
Move(Mem[$A000:CharNum*32],Pic, 16);
PortW[$3C4]:=$0302;PortW[$3C4]:=$0304;PortW[$3CE]:=$0004;PortW[$3CE]:=$1005;
PortW[$3CE]:=$0E06;Inline($FB);
end;
procedure loadfont; var ff:byte;
begin for ff:=0 to 255 do loadchar(ff,font[ff]); end;
begin
loadfont;
for f1:=1 to length(s) do begin
f2:=f1*8+x;
for f3:=1 to 16 do begin
f4:=y+f3;
for f5:=1 to 8 do begin
gotoxy(f2+f5,f4);
if (font[ord(s[f1]),f3] and bites[f5]) = bites[f5] then write('');
end;
end;
end;
end;
begin
writes(5,5,'Привет');readln;
end.
|