B1 xóa các kí t tr ng đ u và cu i chu iự ắ ở ầ ố ỗ
while s[1]=' ' do delete(s,1,' ');
while s[length(s)]=' ' do delete(s,length(s),' ');
{t o sâu ch có 1 d u cách gi a các t }ạ ỉ ấ ữ ừ
i:=1;
while i<>length(s) do if (s[i]=' ' and s[i+1]=' ') then delete(s,i+1,' ') else i:=i+1;
B2 đ m s t trong xauế ố ừ
program demsotu;
Var S:string;
i,d:byte;
Begin
write('Nhap vao xau:');
Readln(S);
S:=S+' ';
d:=0;
For i:=1 to length(S) do
if (S[i]<>' ') and (S[i+1]=' ') then inc(d);
write('Xau co so tu la:',d);
Readln
End.
B3 L p trình nh p vào m t xâu t bàn phím. Hãy bi n đ i xâu đã cho b ng cáchậ ậ ộ ừ ế ổ ằ
thay đ i t c các d u ch m li n nhau b ng đ c thay b ng m t d u ch mổ ấ ả ấ ấ ề ằ ượ ằ ộ ấ ấ
procedure Chuanhoa(var s:string);
var i:integer;
begin
while s[1]=' ' do delete(s,1,1);
while s[length(s)]=' ' do delete(s,length(s),1);
i:=1;
while i<=length(s) do
if (s[i]=' ') and (s[i+1]=' ') then delete(s,i+1,1)
else inc(i);
end;
procedure Deldot(var s:string);
var i:integer;
begin
i:=1;
while i<=length(s) do
if (s[i]='.') and (s[i+1]='.') then delete(s,i+1,1)
else inc(i);
end;
procedure Inhoa(var s:string);
var i:integer;
begin
for i:=1 to length(s) do
if (s[i]<>' ')and(s[i-1]=' ')or(i=1) then
begin
s[i]:=upcase(s[i]);
end;
end;
function FilterEn(s:string):string;
var s2:string;
i:integer;
begin
s2:='';
for i:=1 to length(s) do
if (s[i] in ['A'..'Z','a'..'z',' ','.',',']) then s2:=s2+s[i];
FilterEn:=s2;
end;
var s:string;
BEGIN
write('NHAP VAO 1 XAU : ');
read(s); writeln('|',s,'| <- Vua nhap');
Chuanhoa(s); writeln('|',s,'| <- Chuan hoa');
Inhoa(s); writeln('|',s,'| <- In hoa');
writeln('|',FilterEn(s),'| <- Loc tieng anh');
Deldot(s); writeln('|',s,'| <- Xoa cham');
readln;
readln;
END.
B4 Nh p dãy s g m N s nguyên d ng (N<50), sau đó; đ m các s l c a dãyậ ố ồ ố ươ ế ố ẻ ủ
vad xu t ra màn hình k t qu đ m và các s l c a dãy s .ấ ế ả ế ố ẻ ủ ố
var i,j,n,dem:integer;
a:array [1..50] of integer;
begin
write('Nhap n='); read(n);
for i:=1 to n do
begin
write('a[',i,']=');
readln(a[i]);
end;
dem:=0;
writeln('Cac so le trong day:');
for i:=1 to n do
if a[i] mod 2 <> 0 then
begin
inc(dem);
write(a[i],' ');
end;
writeln;
writeln('Co tat ca ',dem,' so.');
readln;
end.
B5 Vi t ch ng trình nh p vào xâu, đ a ra xâu đ o. ví d : đi xe đ p ---> đ p xeế ươ ậ ư ả ụ ạ ạ
đi
type xaukep=array[1..100,1..100] of char;
procedure tachtu(st:string; var s1:xaukep; var p:integer);
var i,j,k:integer;
begin
st:=' '+st;
p:=0;
for i:=1 to length(st) do
if (st[i]=' ') and (st[i+1]<>' ') then
begin
j:=i+1; k:=1; inc(p);
while j<=length(st) do
begin
if (st[j]<>' ') then begin s1[p,k]:=st[j]; inc(j); inc(k); end
else begin i:=i+k-1;
{s1[p,k]:='\0';} {Khong nho ky tu ket thuc xau
trong pascal la gì :( }
dec(p); break; end;
end;
inc(p);
end;
end;
var n,i:integer;
s2:xaukep;
BEGIN
tachtu('Chuong trinh viet nguoc xau',s2,n);
for i:=n-1 downto 1 do
writeln('|',s2[i],'|');
readln;
END.