bai tap nang cao phan1

{$V-}
Var
w,St:String;
Procedure TachTu(Var Td:String; Dong:String);
Var
i:Integer;
Begin
i:=1;
Td:=' ';
While ((UpCase(Dong[i]) < 'A') Or (UpCase(Dong[i]) > 'Z'))
And (I <=Length(Dong)) Do
i:=i+1;
While ((UpCase(Dong[i]) >= 'A') And (UpCase(Dong[i]) <= 'Z'))
And (I <=Length(Dong)) Do
Begin
Td:=Td+Dong[i];
i:=i+1;
End;
End;
{---------------------------}
BEGIN
Write('-Nhap mot dong: ');
Readln(St);
TachTu(W,St);
Write(W);
Readln
END.

Program Dem_Tu;
{$V-}
Var
St:String;
Function Sochu(Dong:String):Integer;
Var
dem,i:Integer;
Begin
Dem:=0;
i:=1;
Repeat
While ((UpCase(Dong[i]) < 'A') Or (UpCase(Dong[i]) > 'Z'))
And (I <=Length(Dong)) Do
i:=i+1;
If i <= Length(Dong) Then
Dem:=Dem + 1;
While ((UpCase(Dong[i]) >= 'A') And (UpCase(Dong[i]) <= 'Z'))
And (I <=Length(Dong)) Do
i:=i+1;
Until i > Length(Dong);
Sochu:=Dem;
End;
{---------------------------}
BEGIN
Write('-Nhap mot cau ca dao tuc ngu: ');
Readln(St);
Writeln('-Cau nay co: ',Sochu(St),' tu');
Readln
END.

Program Doi_So_Ra_Chu;
Var
Tiep:Char;
Chuoitk,Chuoikq:String;
So:0..999;
Tram,Chuc,Donvi:0..9;
Begin
Tiep:='C';
While UpCase(Tiep)='C' Do
Begin
{$R+}
Chuoitk:='MOT HAI BA BON NAM SAU BAY TAM CHIN';
Write('-Nhap so can doi: ');
Readln(so);
If So = 0 Then
Writeln('So khong')
Else
Begin
Tram:=So Div 100;
Chuc:=(So-Tram * 100) Div 10;
Donvi:= So Mod 10;
Chuoikq:=' ';
If (Donvi > 0) And (Donvi <> 5) Then
Chuoikq :=Chuoikq + Copy(Chuoitk,4* Donvi -3,4);
If (Donvi = 5) And (Chuc = 0) Then
Chuoikq :=Chuoikq + ' NAM';
If (Donvi = 5) And (Chuc > 0) Then
Chuoikq := Copy(Chuoitk,4 * Chuc-3,4)+' LAM';
If (Donvi = 5) And (Chuc = 1) Then
Chuoikq := ' LAM';
If Chuc = 1 Then
Chuoikq:='MUOI'+chuoikq;
If (Chuc > 1) And (Donvi = 0) Then
Chuoikq:=Copy(Chuoitk,4 * Chuc-3,4)+' MUOI ';
If (Chuc > 1) And (Donvi = 1) Then
Chuoikq:=Copy(Chuoitk,4 * Chuc-3,4)+' MUOI '+Chuoikq;
If (Chuc > 1) And (Donvi > 1) And (Donvi <>5) Then
Chuoikq:=Copy(Chuoitk,4 * Chuc-3,4)+' MUOI '+Chuoikq;
If (Tram > 0) And (Chuc=0) And (Donvi=0) Then
Chuoikq:=Copy(Chuoitk,4*Tram-3,4)+' TRAM ';
If (Tram > 0) And (Chuc = 0) And (Donvi > 0) Then
Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM LINH '+ Copy(Chuoitk,4*Donvi-3,4);
If (Tram > 0) And (Chuc = 1) And (Donvi = 0) Then
Chuoikq := Copy(Chuoitk,4*Tram-3,4)+ 'TRAM MUOI';
If (Tram > 0) And (Chuc >= 2) And (Donvi = 0) Then
Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM '+ Copy(Chuoitk,4*Chuc -3,4) +' MUOI';
If (Tram > 0) And (Chuc <> 0) And (Donvi > 0) Then
Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM '+ Copy(Chuoitk,4*Chuc -3,4) +' MUOI '+
Copy(Chuoitk,4*Donvi-3,4);
If (Tram > 0) And (Chuc <> 0) And (Donvi = 5) Then
Chuoikq := Copy(Chuoitk,4*Tram-3,4)+' TRAM '+ Copy(Chuoitk,4*Chuc -3,4) +' MUOI LAM';
Write('-Viet bang chu la: ',Chuoikq);
End;
Writeln;
Write('+Tiep tuc nua khong (C/K) ');
Readln(Tiep);
End;
End.

Program Chu_Chay;
Uses Crt;
Const
a='Nha sach Minh Khai, 249 Nguyen Thi Minh Khai, Quan 1, Tp Ho Chi Minh ';
b='Tel: 8 331 124, 9 250 590 ';
c='Chuyen phat hanh cac giao trinh tin hoc phuc vu hoc sinh, sinh vien';
d='Chan thanh cam on quy doc gia';
Function Lap(Kt:Char; N:Integer): String;
Var
Tam:String;
K:Integer;
Begin
Tam:=' ';
For K:=1 To N Do
Tam:=Tam+Kt;
Lap:=Tam;
End;
{--------------}
Procedure WriteXY(X,Y:Integer; St:String);
Begin
GotoXY(X,Y);
Write(St);
End;
{--------------}
Function Min(a,b:Integer):Integer;
Begin
If a < b Then
Min:=a
Else
Min:=b;
End;
{--------------}
Procedure Chuchay(St:String);
Var
k:Integer;
Tin:String;
Begin
Tin:=Lap(' ',68)+'<<' +St+' ';
For k:=1 To Length(Tin) Do
Begin
TextColor(k MOD 16);
WriteXY(6,8,Copy(Tin,k,Min(68,Length(Tin)-k+1)));
Delay(100);
End;
End;
{--------------}
Procedure Khung(x1,y1,x2,y2:Integer);
Var
k:Integer;
Begin
TextColor(14);
WriteXY(x1,y1,#201);
For k:=x1+1 To x2-1 Do
Write(#205);
Write(#187);
WriteXY(x1,y2,#200);
For k:=x1+1 To x2-1 Do
Write(#205);
Write(#188);
For k:=y1+1 To y2-1 Do
Begin
WriteXY(x1,k,#186);
WriteXY(x2,k,#186);
End;
End;
{--------------}
BEGIN
TextBackGround(1);
ClrScr;
TextColor(3+Blink);
GotoXY(30,4);
Writeln('NAM HOC 1999 -2000');
Khung(5,7,75,9);
Repeat
Chuchay(a);
Chuchay(b);
Chuchay(c);
Chuchay(d);
Until KeyPressed;
END.

Program Loang_mau;
Uses Crt;
Const
St=' Chao mung ban da den voi Turbo Pascal ';
Var
k:Integer;
Procedure Mau(nen,chu:Integer);
Begin
TextBackGround(nen);
TextColor(chu);
End;
BEGIN
TextMode(C80);
TextBackGround(Black);
ClrScr;
For k:=2 To 23 Do
Begin
Mau(k Mod 8,(k+4) Mod 8 + ;
GotoXY(1,k);
Write(St)
End;
Readln
END.

Program Tim_Xoa;
Var
St,St1:String;
Ch:Char;
i,l,l1:Byte;
Begin
Writeln('TIM VA XOA CAC KY TU TRUNG NHAU TRONG CHUOI');
Writeln(' -----------------');
Writeln;
Write('-Nhap mot chuoi: ');
Readln(St);
St1:=St;
i:=1;
l:=Length(St);
While i <= l Do
Begin
i:=i+1;
If St[i]=St[i - 1] Then
Begin
Writeln('+Ky tu thu: ',i:2,' la: ',St[i],' bi trung lap');
Write('Ban co muon xoa ky tu nay khong (c/k)');
Readln(Ch);
If UpCase(Ch)='C' Then
Begin
Delete(St,i,1);
i:= i - 1;
End;
End;
End;
l1:=Length(St);
Writeln;
Writeln('+Chuoi ban dau : ',St1,' co: ',l:2,' ky tu');
Writeln(' Sau khi xoa ky tu trung nhau');
Writeln(' Chuoi con lai: ',St,' gom: ',l1:2,' ky tu');
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

Program Tim_chuoi;
Var
St1,St2:String;
i,sl:Integer;
Begin
Writeln('TIM CHUOI HAI XUAT HIEN TRONG CHUOI MOT');
Writeln(' --------------');
Writeln;
Write('-Chuoi thu nhat: ');
Readln(St1);
Write('-Chuoi thu hai : ');
Readln(St2);
sl:=0;
For i:=1 To Length(St1) Do
If St2 = Copy(St1,i,Length(St2)) Then
sl:=sl+1;
Writeln;
Writeln('+Chuoi thu 2 xuat hien: ',sl:2,' lan trong chuoi 1');
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

Program So_La_Ma;
Label l1;
Var
St:String;
tiep:Char;
i,So:Integer;
Begin
Writeln('DOI SO LA MA RA SO THAP PHAN');
Writeln(' ------------');
Writeln;
L1:Write('-Nhap so La ma: ');
Readln(St);
So:=0;
i:=Length(St);
While i > 0 Do
Case St[i] Of
'I':Begin
So:=So+1;
i:=i-1;
End;
'V':If (i > 1) And (St[i-1] = 'I') Then
Begin
So:=So+4;
i:=i-2;
End
Else
Begin
So:=So+5;
i:=i-1;
End;
'X':If (i > 1) And (St[i-1] = 'I') Then
Begin
So:=So+9;
i:=i-2;
End
Else
Begin
So:=So+10;
i:=i-1;
End;
'L':If (i > 1) And (St[i-1] = 'X') Then
Begin
So:=So+40;
i:=i-2;
End
Else
Begin
So:=So+50;
i:=i-1;
End;
'C':If (i > 1) And (St[i-1] = 'X') Then
Begin
So:=So+90;
i:=i-2;
End
Else
Begin
So:=So+100;
i:=i-1;
End;
'D':If (i > 1) And (St[i-1] = 'C') Then
Begin
So:=So+400;
i:=i-2;
End
Else
Begin
So:=So+500;
i:=i-1;
End;
'M':If (i > 1) And (St[i-1] = 'C') Then
Begin
So:=So+900;
i:=i-2;
End
Else
Begin
So:=So+1000;
i:=i-1;
End;
End;
Writeln('+So La ma : ',St);
Writeln('+Doi ra thap phan: ',So);
Writeln;
Write('-Tiep tuc nua khong (c/k) ');
Readln(tiep);
If UpCase(tiep)='C' Then
Goto l1;
End.

Program Kiem_tra_so;
Label tt;
Var
St:String;
So:Real;
Dung:Integer;
tiep:Char;
Begin
Repeat
Writeln('KIEM TRA SO NHAP VAO');
Writeln(' -----------');
tt:Write('-Nhap mot so: ');
Readln(St);
Val(St,So,Dung);
If Dung = 0 Then
Writeln(' +Ban da nhap mot so: ',So:8:2)
Else
Writeln(' +Khong phai so, xin nhap lai:');
Until Dung = 0;
Writeln;
Write('-Co tiep tuc khong (C/K) ');
Readln(Tiep);
If UpCase(Tiep)='C' Then
Goto tt;
End.

Program Ma_hoa;
Var
St:String;
k:Integer;
i,n:Integer;
Begin
Writeln('CHUONG TRINH MA HOA');
Writeln(' -----------');
Write('-Nhap chuoi: ');
Readln(St);
Write('-Nhap ma so k: ');
Readln(k);
k:=k Mod 26;
For i:= 1 To Length(St) Do
Begin
n:=Ord(St[i]);
If (n >=97) And (n<=122) then
Begin
n:=n+k;
If n > 122 Then
n:=(n Mod 122) + 96;
End;
St[i]:=Chr(n);
End;
Writeln;
Writeln('+Sau khi ma hoa: ',St);
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

Program Ngat_tu;
Var
St:String;
Begin
Writeln('NGAT TUNG TU TRONG CAU');
Writeln(' --------------');
Writeln;
Write('-Nhap mot cau: ');
Readln(St);
Repeat
While (St[1] =' ') And (Length(St) <> 0) Do
Delete(St,1,1);
While (St[1] <> ' ') And (Length(St) <>0) Do
Begin
Write(St[1]);
Delete(St,1,1);
End;
Writeln;
Until Length(St)=0;
Readln
End.

Program Cung_Ky_Tu;
Var
St1,St2:String;
Dung:Boolean;
i:Integer;
Begin
Writeln('KIEM TRA KY TU TRUNG CUA 2 CHUOI');
Writeln(' --------------');
Writeln;
Write('-Nhap chuoi 1: ');
Readln(St1);
Write('-Nhap chuoi 2: ');
Readln(St2);
Dung:=False;
If Length(St1)=Length(St2) Then
Begin
Dung:=True;
For i:= 1 To Length(St1) Do
If Pos(St1[i],St2) = 0 Then
Dung:=False
Else
Delete(St2,Pos(St1[i],St2),1);
End;
If Dung Then
Writeln('+Hai chuoi co cung cac ky tu')
Else
Writeln('+Hai chuoi co cac ky tu khac nhau');
Readln
End.

Program Chuoi_Doi_Xung;
Var
St:String;
l,i:Integer;
Dung:Boolean;
Begin
Writeln('KIEM TRA CHUOI DOI XUNG');
Writeln(' -------------');
Writeln;
Write('-Nhap chuoi: ');
Readln(St);
l:=Length(St);
Dung:=True;
For i:=1 To (l Div 2) Do
If St[i] <> St[l-i+1] Then
Dung:=False;
If Dung Then
Writeln('+Chuoi nay doi xung')
Else
Writeln('+Chuoi nay khong doi xung');
Readln
End.

Program So_La_Ma;
Var
So,So1,i:Integer;
St:String;
Begin
Writeln('DOI SO THAP PHAN SANG SO LA MA');
Writeln(' ------------');
Writeln;
Write('-Nhap so nguyen: ');
Readln(So);
So1:=So;
St:=' ';
For i:=1 To (so Div 1000) Do
St:=St+'M';
So:=So Mod 1000;
If So >= 900 Then
Begin
St:=St+'CM';
So:=So-900;
End
Else
If So >=500 Then
Begin
St:=St+'I';
So:=So-500;
End
Else
If So >=400 Then
Begin
St:=St+'CD';
So:=So-400;
End;
For i:=1 To (so Div 100) Do
St:=St+'C';
So:=So Mod 100;
If So >= 90 Then
Begin
St:=St+'XC';
So:=So-90;
End
Else
If So >=50 Then
Begin
St:=St+'L';
So:=So-50;
End
Else
If So >=40 Then
Begin
St:=St+'XL';
So:=So-40;
End;
For i:=1 To (so Div 10) Do
St:=St+'X';
So:=So Mod 10;
If So >= 9 Then
Begin
St:=St+'IX';
So:=So-9;
End
Else
If So >=5 Then
Begin
St:=St+'V';
So:=So-5;
End
Else
If So >=4 Then
Begin
St:=St+'IV';
So:=So-4;
End;
For i:=1 To So Do
St:=St+'I';
Writeln;
Writeln('+So thap phan: ',So1);
Writeln('+So La ma : ',St);
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

xem xong cong diem cho em nha!!!!!!!!!!!!!!!! thankKKKKKKKK