program STTNgay;
var sn:array[1..12] of integer;
d,m,y,i:byte;
stt:integer;
uses crt;
begin
  clrscr;
  sn[1]:=31;sn[3]:=31;sn[5]:=31;sn[7]:=31;sn[8]:=31;sn[10]:=31;sn[12]:=31;
  sn[4]:=30;sn[6]:=30;sn[9]:=30;sn[11]:=30;
  if y mod 4=0 then sn[2]:=29 else sn[2]:=28;
  while (y=0) do write('nhap nam:');readln(y);
  while (m=0)or(m>12) do write('nhap thang:');readln(m);
  while d>sn[m] do write('nhap ngay:');readln(d);
  stt:=0;
  if m=1 then writeln('stt cua ngay ',d,'/',m,'/',y,'trong nam la:',d)
  else
  begin
      for i:=1 to m do stt:=stt+sn[m];
      writeln('stt cua ngay ',d,'/',m,'/',y,'trong nam la:',stt+d);
  end;
readln;
end.

program DocSo;
var ten:array[1..9] of string;
n:integer;
a,b,c:byte;
uses crt;
procedure docten(b,c:integer);
var t:array[1..9] of string;
  begin
      t[1]:='mot';t[2]:='hai';t[3]:='ba';t[4]:='bon':t[5]:='nam';
      t[6]:='sau';t[7]:='bay';t[8]:='tam';t[9]:='chin';
      if b=0 then if c=0 then writeln() else writeln(t[c]) else
        if b=1 then if c=0 then writeln('muoi') else writeln('muoi ',t[c]) else
            if c=0 then writeln(t[b],' muoi') else writeln(t[b],' muoi ',t[c]);
  end;
begin
  clrscr;
  ten[1]:='mot';ten[2]:='hai';ten[3]:='ba';ten[4]:='bon':ten[5]:='nam';
  ten[6]:='sau';ten[7]:='bay';ten[8]:='tam';ten[9]:='chin';
  while(n<0)or(n>1000) do write('nhap so can doc :');readln(n);
  a:=n div 100;
  b:=(n div 10)-a*10;
  c:=n-a*100-b*10;
  write('cach doc la :');
  if n=0 then writeln('khong')
  else
      if a=0 then docten(b,c) else
        if(b=0)and(c=0) then writeln(ten[a],' tram') else
            if b=0 then writeln(ten[a],' tram le ',ten[c]) else
              writeln(ten[a],' tram ',ten[b],' muoi ',ten[c]);
readln;
end.

program STTNgay;
uses crt;
type mang=array[1..12] of integer;
var
sn:mang;
d,m,y,i:byte;
stt:integer;

begin
  clrscr;
  sn[1]:=31;sn[3]:=31;sn[5]:=31;sn[7]:=31;sn[8]:=31;sn[10]:=31;sn[12]:=31;
  sn[4]:=30;sn[6]:=30;sn[9]:=30;sn[11]:=30;
  if y mod 4=0 then sn[2]:=29 else sn[2]:=28;
 repeat
  write('Nhap ngay ' );readln(d);
  write('Nhap thang ' );readln(m);
  write('Nhap nam ');readln(y);
 until (d<=sn[m]) and (d>0) and (m>0) and (m<=12);
 stt:=0;
 for i:=1 to m-1 do
    stt:=stt+sn[i];
 stt:=stt + d;
 write('So thu tu cua ngay tren la ',stt);
 readln;
end.

uses crt;
type vitri=array[1..3] of integer;
    so=array[1..9] of string;
var  s,dem,i:integer;
    Vt:vitri;
    doc:so;
procedure docso(n:integer);
begin
doc[1]:='mot';  doc[2]:='hai'; doc[3]:='ba'; doc[4]:='bon';
doc[5]:='nam';  doc[6]:='sau'; doc[7]:='bay'; doc[8]:='tam';  doc[9]:='chin';
write(doc[n]);
end;
begin
    clrscr;
    repeat
    write('Nhap so can doc ');readln(s);
    until (s>=100) and (s<=999);
    for i:=1 to 3 do
        begin
        vt[4-i]:=s mod 10;
        s:=s div 10;
        end;
docso(VT[1]);
write(' tram ');
if VT[2]=1 then write('') else docso(VT[2]);
if VT[2]=0 then write('le ') else write(' muoi ');

docso(VT[3]);

    readln;
end.

progam SapXep;
uses crt;
type day=array[1..200] of real;
var a:day;
n,i,j:byte;
procedure doicho(a,b:real);
var c:real;
  begin
      c:=a;
      a:=b;
      b:=c;
  end;
begin
  clrscr;
  write('nhap so luong cac so cua day:');readln(n);
  for i:=1 to n do
      begin
        write('nhap so thu ',i,':');readln(a[i]);
      end;
  for i:=1 to n do
      for j:=1 to n-1 do if a[j]>a[j+1] then doicho(a[j],a[j+1]);
  writeln('Ket qua la sau khi sap xep la:');
  for i:=1 to n-1 do write(a[i]:0:2,' < ');
  writeln(a[n]:0:2);
  readln;
end.

uses crt;
type mang=array[1..100] of integer;
var  day:mang;
    n,i,j,tam:integer;
procedure Nhaplieu;
begin
write('Nhap so phan tu cua mang ');readln(n);
for i:=1 to n do
    begin
    write('Nhap gia tri phan tu thu ',i, ' = ');
    readln(day[i]);
    end;
end;
procedure Xuly;
begin
 for i:=1 to n do
        for j:=i to n do
        if day[i]>day[j] then
            begin
            tam:=day[i];
            day[i]:=day[j];
            day[j]:=tam;
            end;
    for i:=1 to n do write(day[i],'  ');
end;

begin
    clrscr;
    Nhaplieu;
    Xuly;
    readln;
end.

program STTNgay;
var sn:array[1..12] of integer;
d,m,y,i:byte;
stt:integer;
uses crt;
begin
  clrscr;
  sn[1]:=31;sn[3]:=31;sn[5]:=31;sn[7]:=31;sn[8]:=31;sn[10]:=31;sn[12]:=31;
  sn[4]:=30;sn[6]:=30;sn[9]:=30;sn[11]:=30;
  if y mod 4=0 then sn[2]:=29 else sn[2]:=28;
  while (y=0) do write('nhap nam:');readln(y);
  while (m=0)or(m>12) do write('nhap thang:');readln(m);
  while d>sn[m] do write('nhap ngay:');readln(d);
  stt:=0;
  if m=1 then writeln('stt cua ngay ',d,'/',m,'/',y,'trong nam la:',d)
  else
  begin
      for i:=1 to m do stt:=stt+sn[m];
      writeln('stt cua ngay ',d,'/',m,'/',y,'trong nam la:',stt+d);
  end;
readln;
end.

program DocSo;
uses crt;
var ten:array[1..9] of string;
n:integer;
a,b,c:byte;
procedure docten(b,c:integer);
var t:array[1..9] of string;
  begin
      t[1]:='mot';t[2]:='hai';t[3]:='ba';t[4]:='bon';t[5]:='nam';
      t[6]:='sau';t[7]:='bay';t[8]:='tam';t[9]:='chin';
      if b=0 then if c=0 then writeln else writeln(t[c]) else
        if b=1 then if c=0 then writeln('muoi') else if c=5 then writeln('muoi lam') else
          writeln('muoi ',t[c]) else
            if c=0 then writeln(t[b],' muoi') else if c=5 then writeln(t[b],' muoi lam') else
              writeln(t[b],' muoi ',t[c]);
  end;
begin
  repeat
  clrscr;
  ten[1]:='mot';ten[2]:='hai';ten[3]:='ba';ten[4]:='bon';ten[5]:='nam';
  ten[6]:='sau';ten[7]:='bay';ten[8]:='tam';ten[9]:='chin';
  n:=9999;
  while(n<0)or(n>1000) do begin
  write('nhap so can doc :');readln(n);end;
  a:=n div 100;
  b:=(n div 10)-a*10;
  c:=n-a*100-b*10;
  write('cach doc la :');
  if n=0 then writeln('khong')
  else
      if a=0 then docten(b,c) else
        if(b=0)and(c=0) then writeln(ten[a],' tram') else
            if b=0 then writeln(ten[a],' tram le ',ten[c]) else
              if (b=1)and(c=0)then writeln(ten[a],' tram muoi') else
                  if (b=1)and(c=5) then writeln(ten[a],' tram muoi lam') else
                    if c=5 then writeln(ten[a],' tram ',ten[b],' muoi lam') else
                        writeln(ten[a],' tram ',ten[b],' muoi ',ten[c]);
  writeln('ban esc de thoat-phim bat ky de thu lai');
  until ord(readkey)=27;
end.

program SapXep;
uses crt;
type day=array[1..200] of real;
var a:day;
n,i,j:byte;
c:real;
procedure xuat(a:day;n:byte);
var i:byte;
  begin
  for i:=1 to n-1 do write(a[i]:0:2,' < ');
  writeln(a[n]:0:2);
  end;
begin
  repeat
  i:=0;j:=0;n:=0;
  clrscr;
  write('nhap so luong phan tu cua day:');readln(n);
  for i:=1 to n do
    begin
        write('nhap so thu ',i,':');readln(a[i]);
    end;
  for i:=1 to n do
      for j:=1 to n-1 do if a[j]>a[j+1] then
      begin
        c:=a[j];
        a[j]:=a[j+1];
        a[j+1]:=c;
      end;
  writeln('Ket qua la sau khi sap xep la:');
  xuat(a,n);
  writeln('nhan esc de thoat-phim bat ky de thu lai');
  until ord(readkey)=27;
end.