Курсовая работа: Работа с текстовыми строками, двумерными массивами, файловыми структурами данных
if
(isletter(Sl[I])) then
Inc(Count);
if
(Sl[I]>='A') and (Sl[I]<='Z') then
Sl[I]:=char(byte(Sl[I])+32);
end;
{esli
v slove net bukv}
if
Count=0 then
alforder:=False
else
if
Count=1 then
alforder:=True
else
begin
F:=True;
While
F do
begin
F:=False;
for
I:=1 to L-1 do
if
(Not isletter(Sl[I])) And (isletter(Sl[I+1])) then
begin
F:=True;
Buf:=Sl[I];
Sl[I]:=Sl[I+1];
Sl[I+1]:=Buf;
end;
end;
F:=true;
for
I:=1 to Count-1 do
if
Sl[I]>Sl[I+1] then
begin
F:=False;
break;
end;
alforder:=F;
end;
end;
procedure
alfslovo(S: Stroka250);
var
F:
boolean;
Len:
Byte;
I:
Byte;
Counter:
Byte;
FSlovo,
Buf: Slovo;
Index,
L: Byte;
MaxCol:
Byte;
begin
Len:=Length(S);
if
S[Len]<>' ' then
begin
S:=S+'
';
Inc(Len);
end;
F:=False;
MaxCol:=0;
for
I:=1 to Len do
if
S[I]<>' ' then
begin
if
F=False then
begin
F:=True;
Index:=I;
L:=1;
end
else
Inc(L);
end
else
if
F=True then
begin
F:=False;
Buf:=Copy1(S,
Index, L);
Buf[0]:=char(L);
if
alforder(Buf, Counter) then
begin
if
Counter>MaxCol then
begin
FSlovo:=Copy1(S,
Index, L);
FSlovo[0]:=char(L);
MaxCol:=Counter;
end;
end;
end;
if
MaxCol=0 then
writeln('Net
podhodyaschi slov v texte')
else
writeln(FSlovo,
' kol-vo bukv: ', MaxCol);
end;
function
simmetr(S: Slovo):boolean;
var
L,
I, R: Byte;
F:
Boolean;
begin
L:=Length(S);
R:=L
div 2;
F:=True;
for
I:=1 to R do
if
S[I]<>S[L-I+1] then
begin
F:=False;
break;
end;
simmetr:=F;
end;
procedure
colsimmslovo(S: Stroka250);
var
F:
boolean;
Len:
Byte;
I:
Byte;
Counter:
Byte;
Buf:
Slovo;
Index,
L: Byte;
MaxCol:
Byte;
begin
Len:=Length(S);
if
S[Len]<>' ' then
begin
S:=S+'
';
Inc(Len);
end;
F:=False;
Counter:=0;
writeln('Spisok
simmetrichnyh slov iz bolshe chem 2 znaka:');
for
I:=1 to Len do
if
S[I]<>' ' then
begin
if
F=False then
begin
F:=True;
Index:=I;
L:=1;
end
else
Inc(L);
end
else
if
F=True then
begin
F:=False;
if
L>2 then
begin
Buf:=Copy(S,
Index, L);
Buf[0]:=char(L);
if
simmetr(Buf) then
begin
Inc(Counter);
writeln(Buf);
end;
end;
end;
writeln('Kol-vo
naidennyh slov: ', Counter);
end;
procedure
menu;
begin
writeln;
writeln('++++++++++++++++++++++++++++++++++++++++++++++++');
writeln('+
Vvod texta --> 1 +');
writeln('+
Slovo s max. kol.bukv v alf. poryadke --> 2 +');
writeln('+
Simmetrichnye slova --> 3 +');
writeln('+
Vyvod texta --> 4 +');
writeln('+
+');
writeln('+
Konec --> 0 +');
writeln('++++++++++++++++++++++++++++++++++++++++++++++++');
writeln;
end;
var
Txt:
Stroka250;
Vvod,
Cont: Boolean;
Rem:
Char;
begin
Vvod:=False;
Cont:=True;
while
Cont do
begin
clrscr;
menu;
write('Vvedite
komandu: ');
readln(Rem);
case
Rem of
'0':
Cont:=False;
'1':
begin
writeln('Text:');
readln(Txt);
Vvod:=True;
end;
'2':
begin
if
Not Vvod then
writeln('Ne
vveden text')
else
alfslovo(Txt);
end;
'3':
begin
if
Not Vvod then
writeln('Ne
vveden text')
else
colsimmslovo(Txt);
end;
'4':
begin
if
Not Vvod then
writeln('Ne
vveden text')
else
writeln(Txt);
end
else
writeln('Neizvestnaya
komanda');
end;
if
Cont then
begin
write('Nagmite
ENTER dlya vvoda sleduyuschei komandy... ');
readln;
end
else
clrscr;
end;
end.
8
Приложение Б
Код программы 2
program
massiv1;
uses
crt;
type
Matrix=array[1..20,1..20] of Integer;
type
Vector=array[1..80] of Integer;
procedure
TurnArray(var V: Vector; NN: Integer; Rev: Integer);
var
Buf: Integer;
I,
J: Integer;
begin
for
J:=1 to Rev do
begin
Buf:=V[NN];
for
I:=NN downto 2 do
V[I]:=V[I-1];
V[1]:=Buf;
end;
end;
procedure
TurnMatrix(var A: Matrix; N: Integer);
var
Arr: Vector;
I,
J, K, Ot, L: Integer;
R:
Integer;
Revers:
Integer;
Buf1,
Buf2: Integer;
begin
R:=N div 2;
Ot:=0;
for
K:=1 to R do
begin
L:=0;
for
J:=1+Ot to N-Ot do
begin
Inc(L);
Arr[L]:=A[1+Ot,
J];
end;
for
I:=2+Ot to N-1-Ot do
begin
Inc(L);
Arr[L]:=A[I,
N-Ot];
end;
for
J:=N-Ot downto 1+Ot do
begin
Inc(L);
Arr[L]:=A[N-Ot,
J];
end;
for
I:=N-1-Ot downto 2+Ot do
begin
Inc(L);
Arr[L]:=A[I,
1+Ot];
end;
Revers:=N-2*Ot-1;
TurnArray(Arr,
L, Revers);
L:=0;
for
J:=1+Ot to N-Ot do
begin
Inc(L);
A[1+Ot,
J]:=Arr[L];
end;
for
I:=2+Ot to N-1-Ot do
begin
Inc(L);
A[I,
N-Ot]:=Arr[L];
end;
for
J:=N-Ot downto 1+Ot do
begin
Inc(L);
A[N-Ot,
J]:=Arr[L];
end;
for
I:=N-1-Ot downto 2+Ot do
begin
Inc(L);
A[I,
1+Ot]:=Arr[L];
end;
Inc(Ot);
end;
end;
procedure
FormMatrix(var A: Matrix; N, M: Integer);
var
I, J: Integer;
D:
Integer;
R:
Integer;
begin
randomize;
for
I:=1 to N do
for
J:=1 to M do
begin
A[I,J]:=random(100);
if
(random(1000) mod 2)=0 then
A[I,J]:=0-A[I,J];
end;
end;
procedure
PrintMatrix(var A: Matrix; N, M: Integer);
var
I, J: Integer;
begin
for
I:=1 to N do
begin
for
J:=1 to M do
write(A[I,J]:4);
writeln;
end;
end;
var
Matr: Matrix;
N:
Integer;
begin
clrscr;
repeat
write('Razmer matricy (12..20): ');
readln(N);
until
(N>=12) and (N<=20);
FormMatrix(Matr,
N, N);
writeln('Sformirovana
matrica:');
PrintMatrix(Matr,
N, N);
TurnMatrix(Matr,
N);
writeln('Matrica
posle povorota');
PrintMatrix(Matr,
N, N); readln;
end.
9
Приложение В
Код программы 3
program
textfile;
uses
crt;
type
arr = array [1..83] of string;
var
slova1, slova2, slova: arr;
m,
m1, m2, k1, k2, k, l, g: integer;
first,
second, third: text;
command:
char;
p,
v, t, S1, S2: string;
pf,
vf, tf, cont, flag1, flag2: boolean;
function
check2: boolean;
begin
if
eof(first) = true then flag1 := true else flag1 :=
false;
if
eof(second) = true then flag2 := true else flag2 := false;
if
(flag1 = false) and (flag2 = false) then check2 := false else check2 := true;
end;
procedure
closing;
begin
close(first);
close(second);
close(third);
end;
procedure
obrslov(a, b: arr; na, nb: integer; var c: arr; var nc:
integer);
var
i, j, k: integer;
begin
nc := 0;
for
i := 1 to na do
begin
k := 0;
for
j := 1 to nb do
if
a[i] = b[j] then k := 1;
if
k = 0 then
begin
nc := nc + 1;
c[nc]
:= a[i];
end;
end;
for
i := 1 to nb do
begin
k := 0;
for
j := 1 to na do
if
b[i] = a[j] then k := 1;
if
k = 0 then
begin
nc := nc + 1;
c[nc]
:= b[i];
end;
end;
end;
procedure
slv;
var
i, j: integer;
begin
Readln(first, S1);
readln(second,
S2);
S1
:= ' ' + S1 + ' ';
S2
:= ' ' + S2 + ' ';
k1
:= 0;
k2
:= 0;
for
i := 1 to length(S1) do
begin
if
s1[i] = ' ' then
begin
for
j := i + 1 to length(s1) do
if
s1[i + 1] <> ' ' then
if
s1[j] = ' ' then begin
k1 := k1 + 1;
slova1[k1]
:= copy(s1, i + 1, j - i - 1);
break;
end;
end;
end;
for
i := 1 to length(S2) do
begin
if
s2[i] = ' ' then
begin
for
j := i + 1 to length(s2) do
if
s2[i + 1] <> ' ' then
if
s2[j] = ' ' then begin
k2 := k2 + 1;
Страницы: 1, 2, 3, 4, 5, 6, 7 |
