Скачать Вывод на экран большими буквами

12.07.1994
Скачать файл (882,00 Б)

{> 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.{> 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.