Zobrazí ASCII tabulku znakú 0-255
Delphi & Pascal (èeská wiki)
Kategórie: Programy v Pascalu
Program: Ascii.pas
Soubor exe: Ascii.exe
Soubor ubuntu: Ascii
Program: Ascii.pas
Soubor exe: Ascii.exe
Soubor ubuntu: Ascii
Zobrazí ASCII tabulku znakú 0-255. V èasech programování pro DOS to byl velice úspì¹ný program.
Prìd svím spu¹tìním si zapamatuje podklad a pak ho vrátí zpìt.
Prìd svím spu¹tìním si zapamatuje podklad a pak ho vrátí zpìt.
{ 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; 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.