Localize file www.TrSek.com/pas/ascii.pas

{ ASCII.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Program zobrazi ascii tabulku OS                                  }
{ Pred svojim spustenim si zapameta podklad a potom ho vrati spat   }
{                                                                   }
{ Datum:28.05.96, 07.04.05                     http://www.trsek.com }

program ascii;
uses crt,dos;

const cground=blue;ctext=yellow;cnadpis=red;cpodnad=green;
      ccisla=yellow;cpodklad=black;
      pos=8;

      popis_txt:array[0..32] of string = (
      'NUL-Null',                        { 0}
      'SOH-Start of Heading',            { 1}
      'STX-Start of Text',               { 2}
      'ETX-End of Text',                 { 3}
      'EOT-End of Transmission',         { 4}
      'ENQ-Enquiry',                     { 5}
      'ACK-Acknowledge',                 { 6}
      'BEL-Bell',                        { 7}
      'BS -Backspace',                   { 8}
      'HT -Horizontal Tabulator',        { 9}
      'LF -Line Feed',                   {10}
      'VT -Vertical Tabulator',          {11}
      'FF -Form Feed',                   {12}
      'CR -Carriage Return',             {13}
      'SO -Shift Out',                   {14}
      'SI -Shift In',                    {15}
      'DLE-Data Link Escape',            {16}
      'DC1-Device Control 1',            {17}
      'DC2-Device Control 2',            {18}
      'DC3-Device Control 3',            {19}
      'DC4-Device Control 4',            {20}
      'NAK-Negative Acknowledge',        {21}
      'SYN-Synchronus Idle',             {22}
      'ETB-End of Transmision Block',    {23}
      'CAN-Cancel',                      {24}
      'EM -End of Medium',               {25}
      'SUB-Substitute',                  {26}
      'ESC-Escape',                      {27}
      'FS -File Separator',              {28}
      'GS -Group Separator',             {29}
      'RS -Record Separator',            {30}
      'US -Unit Separator',              {31}
      'SPC-Space');                      {32}

var x,y:integer;
    a:array[1..80,1..25] of char;
    h:char;

procedure KurzorZap(ZapVyp:boolean);
var
    Regs : Registers;
  begin
     with Regs do
     begin
        AH := $03;
        BH := $00;
        Intr($10,Regs);
        If not (Zapvyp) then
        CH := CH or $20
        else
        CH := CH and $DF;
        AH := $01;
        Intr($10,Regs);
     end;
  end;

procedure nacitajob;
var x,y:integer;
    regs:registers;
begin
for x:=1 to 80 do for y:=1 to 25 do begin
   gotoxy(x,y);
   regs.bh:=0;regs.ah:=8;
   intr($10,regs);
   a[x,y]:=chr(regs.al);
   end;
end;

procedure vypisob;
var x,y:integer;
begin
for x:=80 downto 1 do for y:=1 to 25 do begin
  if not ((x=80) and (y=25)) then begin
   gotoxy(x,y);write(a[x,y]);
   end;
  end;
end;

procedure farba(cground,ctext:integer);
begin
textbackground(cground);
textcolor(ctext);
end;

procedure writexy(x,y:integer;text:string);
begin
gotoxy(x,y);writeln(text);
end;

procedure znak(x,y,ch,col:integer);
begin
farba(col,ccisla);
if (ch>255)or(ch=7)or(ch=10)or(ch=8)or(ch=13) then ch:=32;
gotoxy(x*3+3,y+pos);
writeln(' ',char(ch),' ');
end;

BEGIN
  nacitajob;
  farba(cpodklad,cnadpis);
  farba(cground,cnadpis);
  for y:=1 to 16 do
    writexy(1,y+pos-4,'                                                                                ');
  farba(cpodnad,cnadpis);
  writexy(14,pos-5,'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  writexy(14,pos-4,'º  American Standard Code for Information Interchange. º');
  writexy(14,pos-3,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼');
  farba(cground,ctext);
  writexy(1,pos-2,' º 0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25');
  writexy(1,pos-1,'ÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
  for y:=0 to 9 do begin
    gotoxy(1,y+pos);writeln(y,'º');
  end;
  writexy(1,pos+10,'ÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
  writexy(63,pos+11,'Software by Trsek');
  gotoxy(3,pos+11);writeln('Ovl danie:',chr(24),' ',chr(25),' ',chr(26),' ',chr(27),' Esc-koniec.');
  writexy(3,pos+12,'Znak m  v ASCII k¢de hodnotu : 109  ');

  for x:=0 to 9 do
    for y:=0 to 25 do znak(y,x,y*10+x,cground);

  x:=10;y:=9;
  znak(x,y,x*10+y,cpodklad);
  kurzorzap(false);

  repeat
    h:=readkey;
    znak(x,y,x*10+y,cground);
    if h=#0 then case readkey of
                  #72:y:=y-1;
                  #80:y:=y+1;
                  #75:x:=x-1;
                  #77:x:=x+1;
                  #72:x:=x-1;
                 end;
    if x>25 then begin x:=0;y:=y+1;end;
    if x<0 then if y<6 then begin
       x:=25;y:=y-1;
       if y<0 then y:=10;
     end
    else begin
       x:=24;y:=y-1;
       if y<0 then y:=9;
     end;

    if(y=9) and (x>24) then begin x:=0;y:=1;end;
    if y>9 then begin
       y:=0;x:=x+1;
       if x>25 then x:=0;
     end;

    if y<0 then begin
       y:=9;x:=x-1;
       if x<0 then x:=24;
     end;

    if(x*10+y)>255 then begin
       x:=0;if y<9 then y:=y+1;
     end;

    znak(x,y,x*10+y,cpodklad);
    farba(cground,ctext);
    gotoxy(3,pos+12);

    if (x*10+y)<=32 then
       write('Znak m  v ASCII k¢de hodnotu : ',popis_txt[x*10+y],'                        ')
    else
       write('Znak m  v ASCII k¢de hodnotu : ',x*10+y,'                        ');
    kurzorzap(false);
  until (h=#13) or (h=#27);

  farba(0,15);
  vypisob;
  farba(1,14);gotoxy(1,1);
  write(' ASCII  Copyright  (c).    Softwre  by  TRSEK.    All  right  reserved   TRSEK.');
END.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com