14.Описание: Выравнивание текста

uses crt;

const

l = 79; {kolvo liter, umeshayushihsya na ekrane v DOSe}

var t: text; i, j: integer; s: string; c, ost: byte;

begin clrscr;

assign(t, 'input.txt'); reset(t);

while not EoF(t) do begin readln(t, s);

for i := 1 to length(s) do if s[i] = ' ' then incc;

ost := l - length(s); {ost - kolichestvo probelov, kotorie nado}

j := 1;

while ost > 0 do begin for i := 1 to length(s) + c - 1 do if (s[i] = ' ') then begin if ost <= 0 then break;

insert(' ', s, i); dec(ost); inc(i, j); end;

inc(j); {t.k. pri prohozhdenii cikla FOR mi vstrechaem pervii probel} end;

c := 0; {obyazatel'no obnulayem kol-vo strok v stroke}

writeln(s); end;

close(t); readkey;

end.

15.Описание:Программа контроля студентов по литературе.Формируется файл вопросов и ответов

program zavd1;

uses crt;

const qfile='quest.txt'; afile='ansver.txt'; var f1,f2:text;i,k:integer; name,ansv:string;

begin clrscr;

assign(f1,qfile);

assign(f2,afile);

rewrite(f2);

reset(f1);

write('vvedi imya ?¬`п, gruppu :');

readln(name);

writeln(f2,name);

while not eof(f1) do begin readln(f1,name);

writeln(name);

write('‚ и ў?¤Ї®ў?¤м :');

readln(name);

writeln(f2,name);

readln(f1,ansv);

if ansv=name then k:=k+1;

i:=i+1;end;

writeln(f2,'‚бм®Ј® ЇЁв ­м :');

writeln(f2,i);

writeln(f2,'Џа ўЁ«м­Ёе ЇЁв ­м :');

writeln(f2,k);

close(f1); close(f2);

end.

Раздел: Строки

1. Описание: Из строки повторяющихся слов, отделяемых запятыми и заканчивающиеся точкой, выписать все гласные буквы в алфавитном порядке, которые входят не более чем в одно слово.

program one;

Uses CRT;

Type MyType = Set Of Char; Var S,W : String; I,K,L : Integer; J : Char; M,N : MyType; B,C : Array [1..32] of MyType;

Begin ClrScr;

M :=[' ','Ґ','с','Ё','®','г','л','н','о','п']; S := 'е«ҐЎ,¬®«®Є®, аЎг§,алЎ ,ᥫҐ¤Є .'; K := 1;

writeln(s);

While pos(',',S) > 0 Do Begin W := copy(S,1,pos(',',S));

B[K] := [];

For I := 1 To Length(W) Do B[K] := B[K] + [W[I]];

Inc(K);

delete(S,1,pos(',',S)); End;

W := S; B[K] := [];

For I := 1 To Length(W) Do B[K] := B[K] + [W[I]];

For I := 1 To K Do Begin C[I] := B[I]; For L := 1 To K Do If I <> L Then C[I] := C[I] - B[L]; End;

N := [];

For I := 1 To K Do N := N + C[I];

M := M * N;

For J := ' ' To 'п' Do If J in M Then Write(J,' ');

WriteLn; ReadKey;

End.

2.Описание: Основа алгоритма игры, согласно которой из слова образца, которое является первым в строке (в данном случае Pascal), составляются другие слова из тех же букв. Количество вхождений одной и той же буквы должно быть не больше, чем в образце.

program one;

Uses CRT;

Var S,T : String; N,I,J : Integer; A : Array [1..100] of String; F : Boolean;

Begin ClrScr;

S := 'pascal cal lasca nosok pasca sapca lapca caplan capla';

N := 1;

While pos(' ', S) > 0 Do Begin A[N] := copy(S, 1, pos(' ', S)-1);

delete(S, 1, pos(' ', S));

inc(N); End;

A[N] := S;

For I := 2 To N Do Begin F := True;

T := A[I];

For J := 1 To Length(T) Do Begin If (pos(T[J], A[1])) >0 Then T[J] := '*' Else F := False; End;

If F Then WriteLn(A[I]); End;

readln;

End.

3.Описание: Вывести каждое слово предложения задом наперед.

Program Stroki;

const chars=['.',',','!','?',' '];var S,S_out,slovo: string; i,j: integer;

begin Writeln('Vv stroku');

Readln(S);

S:= S+' ';

for i:= 1 to Length(S) do if not (S[i] in chars) then Slovo:=slovo+S[i] else if slovo <> '' then begin for j:= Length(slovo) downto 1 do S_out:=s_out+slovo[j];

s_out:=s_out+' ';

slovo:=''; end;

Writeln(S_out);

Readln;

end.

4.Описание: Расположить слова в порядке возрастания их длины в тексте.

program one;

uses crt;

var a,d,sl1,sl2 : string; i,l,k,j : longint; b : array [1..50] of string;

begin clrscr;

write('input s: ');readln(a);l:=length(a);

if a=''then halt;

if a[l]<>' ' then begin inc(l);a[l]:=' '; end;

for i:=1 to l do if a[i]=' 'then begin inc(j);b[j]:=d;d:=''; end else d:=d+a[i];

for i:=1 to j-1 do for k:=i+1 to j do begin sl1:=b[i]; sl2:=b[k];

if length(sl1)>length(sl2) then begin b[i]:=sl2; b[k]:=sl1; end; end;

for i:=1 to j do write(' ',b[i]); readln;

end.

5.Описание: Найти и заменить определенные символы в тексте (заменяемые) введенным символом с клавиатуры (заменяющий). Каждую замену сопровождать подтверждением.

program one;

uses crt;

var i,l:longint;a,a1,a2,p:string;

begin clrscr;textcolor(11);

write('vvedite text: '); readln(a);

write('zamenyaemyi simvol: '); readln(a1);

write('zamenyauschiy simvol: '); readln(a2);

if (length(a1)>1)or(length(a2)>1) then halt;l:=length(a);

for i:=1 to l do if a[i]=a1 then begin clrscr; a[i]:='_';

writeln(a);

writeln('Vy podtverzhdaete zamenu ',i,'-ogo simvola? (y/n)'); readln(p);

if p='y' then a[i]:=a2[1] else a[i]:=a1[1]; end;

clrscr;

write(a); readln;

end.

6.Описание: Найти похожее слово в предложении, которое отличается не более, чем на два символа. Пример: Pascal=Paskal=Pacsal.

program one;

var s,sl:string; m:array[1..100] of string; i,j,k,p,n,kol:integer;

beginwrite('Vvedite TEXT (slova cerez PROBEL): '); readln(s);

write('ISCEM - ? : '); readln(sl);

i:=0;

repeat inc(i);

p:=pos(' ',s);

m[i]:=copy(s,1,p-1);

delete(s,1,p);

until p=0; n:=i; m[n]:=s;

writeln('Naideno:');writeln;

for i:=1 to n do begin kol:=0;

for j:=1 to length(sl) do if pos(sl[j],m[i])<>0 then inc(kol);

if (length(m[i])-kol)<3 then writeln('*',m[i]); end; readln;

end.

7.Описание: Подсчет числа слов в тексте.

program one;

uses crt;

var tec : string; l,i,n : longint;

begin clrscr;

write('input s:');readln(tec);

l:=length(tec)+1;tec[l]:=' ';

for i:=1 to l do if tec[i]=' 'then n:=n+1;

write('in s ',n,' words');

readln;

end.

8.Описание: Максимальное слово в прдложении

program one;

Uses CRT;

Var MaxL,C : String; Pb : Byte;

Begin ClrScr;

WriteLn(vvedite predlojenie:'); ReadLn(C);

MaxL := '';

While Pos(' ',C) <> 0 Do Begin Pb := Pos(' ',C);

If Length(MaxL) < Length(Copy(C,1,Pb-1)) Then MaxL := Copy(C,1,Pb-1);

Delete(C,1,Pb); End;

If Length(MaxL) < Length(C) Then MaxL := C;

WriteLn;

WriteLn('Samaya bolshayaposledovatelnost'simvolov v predlojenii:');

WriteLn(MaxL);

ReadLn;

End.

9.Описание: Выписать слова из строки, которые начинаются с заданной буквы.

program one;

uses crt;

var a,aa,b : string; i,l,o,oo : longint;

begin clrscr;

write('string: ');readln(a);

write('bukva: ');readln(aa);l:=length(a);

if length(aa)>1 then halt;

if a[l]<>' 'then begin inc(l);a[l]:=' '; end;

for i:=1 to l do if a[i]=' 'then begin if b[1]=aa then writeln(b) else inc(o);inc(oo);b:='';

end else b:=b+a[i];

if o=oo then write('takix slov net!'); readln;

end.

10.Вводится 10 букв, а затем слово. Проверяется возможность составить введенное слово из этих символов.

program one;

uses crt;

var as:Array[1..10]of Char; s,s2:String; i,b:Byte;

beginclrscr;

Writeln('vvedite 10 simvolov:');

for i:=1 to 10 do begin rite('ь',i,': ');

readln(mas[i]); end;

write('vvedite stroku: '); readln(s);

for i:=1 to Length(s) do for b:=1 to 10 do if s[i]=mas[b] then begin s2:=s2+mas[b];

mas[b]:=' '; b:=10; end;

if s2=s then write('Iz etih simvolov mozhno sostavit' slovo ',s)else writeln('Iz etih simvolov nelzya sostavit slovo',s);

readln;

end.

11.Описание:Найти в строке минимальное и максимальное слова

program gdy;

label 1;

var s:string; m:array[1..100] of string; i,p,n:integer; ax,min:string; c:char;

begin 1:write('Vvedite stroky: '); readln(s);

if s[length(s)]<>'.' then begin writeln('ERROR: konec stroki okancivaetsia na "."'); goto 1; end;

if length(s)>79 then begin writeln('ERROR: stroka doljna biti <=79 simvolov'); goto 1; end;

write('Vvedite ZADANII SIMVOL:'); readln(c);

i:=0;

repeat p:=pos(' ',s);

if pos(c,copy(s,1,p-1))<>0 then begin inc(i); m[i]:=copy(s,1,p-1); end; delete(s,1,p); until p=0; n:=i; f pos(c,copy(s,1,length(s)-1))<>0 then begin n:=i+1; m[n]:=copy(s,1,length(s)-1); end;

max:=m[1]; min:=m[1];

for i:=2 to n do begin if length(m[i])>length(max) then max:=m[i];

if length(m[i])<length(min) then min:=m[i]; end;writeln;

writeln('MakS: ',max);

writeln('MIN: ',min);

readln; readln;

end.

12.Описание: Счет количества вхождений каждого символа в строку.

program one;

Var I : Word; M : Array [0..255] Of Byte; S : String;

Begin For I := 0 To 255 Do M[I] := 0;

writeln('input string');

Readln(S);

For I := 1 To Length(S) Do Begin Inc(M[ORD(S[I])]); End;

For I := 0 To 255 Do Begin If M[I] > 0 Then WriteLn(CHR(I):3, M[I]:3); End; readln;

End.

13.Описание: Удаление пробелов из заданной строки и вывод результата.

program one;

Var S,T : String; I : Integer;

Begin writeln('input string');

readln(s);

T := '';

For I := 1 To Length(S) Do Begin If (S[I] <> ' ') Then T := T + S[I];

End;

WriteLn(T);

ReadLn;

End.

14.Описание: Вывести заданный символ заданное количество раз

program one;

uses crt;

var n:byte; l:string;n function zvezda(n:byte;l:string):real; var i:integer; s:string;

begin i:=1;

s:='';

while i<=n do begin s:=s+l;

inc(i); end;

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10