-







































: , ,

: , ,

1 1.

1.1 - .

1.2

2 2.

2.1 -

2.2 .

3 3.

3.1 -

3.2

4 4.

4.1

5 5.

5.1 -

5.2

6 .

7 .

8

9

10

11

12


 

1  1

, . , .

1.1   : begin-



.

Begin

, .

Vvod:=False;

Cont:=True;

while Cont do

Begin

.

clrscr;

, 1.

1 .

menu;

write('Vvedite komandu: ');

Rem.

readln(Rem);

.

case Rem of

'0': Cont:=False;

'1': begin

Txt Vvod True, , .

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

Rem , .

writeln('Neizvestnaya komanda');

end;

, ENTER .

if Cont then

begin

write('Nagmite ENTER dlya vvoda sleduyuschei komandy... ');

readln;

end

else

clrscr;

end;

end.

, .

S , , .

procedure alfslovo(S: Stroka250);

var

F True, .

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

, , Index L.

if F=False then

begin

F:=True;

Index:=I;

L:=1;

end

else

, .

Inc(L);

end

else

i- , , Buf .

if F=True then

begin

F:=False;

Buf:=Copy1(S, Index, L);

Buf[0]:=char(L);

. , True False.

if alforder(Buf, Counter) then

begin

, , Fslovo MaxCol.

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;

alforder S1, , True False. Count .

function alforder(Sl: Slovo; var Count: Byte): Boolean;

var

I, L: Byte;

F: Boolean;

Buf: Char;

begin

L:=Length(Sl);

.

Count:=0;

.

for I:=1 to L do

begin

if (isletter(Sl[I])) then

Inc(Count);

if (Sl[I]>='A') and (Sl[I]<='Z') then

Sl[I]:=char(byte(Sl[I])+32);

end;

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

i- , , .

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;

colsimmsolvo S, , .

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 , F=true . .

F:=False;

Counter:=0;

writeln('Spisok simmetrichnyh slov iz bolshe chem 2 znaka:');

.

for I:=1 to Len do

, i- , , , .

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); {kopiruem slovo v Buf}

Buf[0]:=char(L);

, , , .

if simmetr(Buf) then

begin

Inc(Counter);

writeln(Buf);

end;

end;

end;

writeln('Kol-vo naidennyh slov: ', Counter);

end;

.

function simmetr(S: Slovo):boolean;

var

L, I, R: Byte;

F: Boolean;

Begin

. , True. , False.

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;


2  2

. , / .

2.1  -



2.2 

2 : .

type

Matrix=array[1..20,1..20] of Integer;

type

Vector=array[1..80] of Integer;

Begin

, .

clrscr;

, 12 22.

repeat

write('Razmer matricy (12..20): ');

readln(N);

until (N>=12) and (N<=20);

Matr N N . .

FormMatrix(Matr, N, N);

writeln('Sformirovana matrica:');

PrintMatrix(Matr, N, N);

.

TurnMatrix(Matr, N);

writeln('Matrica posle povorota');

PrintMatrix(Matr, N, N);

readln;

end.

FormMatrix

-99 99 .

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

0 99.

A[I,J]:=random(100);

0 999 , , .

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;

90 .

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 .

Ot:=0;

for K:=1 to R do

begin

L Arr. , Arr .

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;

Arr.

Revers:=N-2*Ot-1;

, , Arr L Revers . .

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;

.

procedure TurnArray(var V: Vector; NN: Integer; Rev: Integer);

var

Buf: Integer;

I, J: Integer;

Begin

for J:=1 to Rev do

begin

V[NN] Buf, 1 .

Buf:=V[NN];

for I:=NN downto 2 do

V[I]:=V[I-1];

V[1]:=Buf;

end;

end;


3  3

 

, , -.

3.1  -



3.2 

Begin

, 2.

2 .

menu;

, . , .

pf:=false;

vf:=false;

tf:=false;

cont:=true;

2 , flag1 flag1, .

flag1:=false;

flag2:=false;

while cont do

begin

writeln;

write('Vvedite komandu: ');

.

readln(command);

case command of

'0': cont:=false;

'1': begin

write('Vvedite imja pervogo faila: ');

readln(p);

, , True. .

if check1(p)=true then

begin

pf:=true;

clrscr;

menu;

end

else

begin

clrscr;

menu;

writeln('Error input');

end;

end;

'2': begin

write('Vvedite imja vtorogo faila: ');

readln(v);

, , True. .

if check1(v)=true then

begin;

vf:=true;

clrscr;

menu;

end

else

begin

clrscr;

menu;

writeln('Error input');

end;

end;

'3': begin

write('Vvedite imja tretego faila: ');

readln(t);

, , True. .

if check1(t)=true then

begin

tf:=true;

clrscr;

menu;

end

else

begin

clrscr;

menu;

writeln('Error input');

end;

end;

'4': begin

, .

if (pf=true)and(vf=true)and(tf=true) then

begin

filepr;

.

chmax;

, .

if check2=false then

begin

.

for l:=1 to m do

begin

slv;

obrslov(slova1,slova2,k1,k2,slova,k);

for g:=1 to k do

begin

write(third,slova[g]);

if g<k then write(third,' ');

end;

.

writeln(third,'');

end;

.

if m1<>m2 then

begin

if m1>m2 then for L:=m to m1 do

begin

readln(first,S1);

writeln(third,S1);

end

else

for L:=m to m2 do

begin

readln(second,S2);

Writeln(third,S2);

end;

end;

closing;

writeln('Operacia zavershena');

end

else

, , .

begin

if flag1=true then writeln('Pervii fail pustoi');

if flag2=true then writeln('Vtoroi fail pustoi');

end;

end

else

begin

, , .

if pf=false then writeln('Ne vvedeno imja pervogo faila');

if vf=false then writeln('Ne vvedeno imja vtorogo faila');

if tf=false then writeln('Ne vvedeno imja tretego faila');

end;

end;

else

writeln('Neizvestnaya komanda');

end;

end;

end.

.

function check1(x:string):boolean;

begin

, , .

if length(x)>0 then begin

if x[1]<>' ' then

check1:=true;

end;

end;

.

procedure filepr;

begin

assign(first,p);

assign(second,v);

assign(third,t);

reset(first);

reset(second);

rewrite(third);

end;

.

procedure chmax;

begin

.

m1:=0;

m2:=0;

.

while not eof(first) do

begin

readln(first,S1);

m1:=m1+1;

end;

.

while not eof(second) do

Begin

readln(second,S2);

m2:=m2+1;

end;

m.

if m1<m2 then m:=m1 else m:=m2;

.

close(first);

reset(first);

close(second);

reset(second);

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;

slova2[k2]:=copy(s2,i+1,j-i-1);

break;

end;

end;

end;

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;

.

function check2:boolean;

begin

, , , False.

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;

4  4.

(), :

X=A∙cos(t)+D∙cos(A∙t); [0<=t<=2∙pi]

X=A∙sin(t)+D∙sin(A∙t);

A,D .

4.1 

Begin

t, .

t:=0;

menu;

cont:=true;

while cont do

begin

, 3.

3 4.

Writeln('Vvedite komady: ');

Readln(command);

case command of

'0':cont:=false;

'1':

begin

writeln;

. , , ( D) .

writeln('Vvedite imja faila: ');

Readln(name);

if check1 = true then begin

namef:=true;

read(fileg,a);

read(fileg,d);

close(fileg);

end else namef:=false;

end;

'2':

Begin

, , :

- .

- .

- .

- .

if namef=false then

writeln('Ne Vvedeno imja faila')

else

begin

clearwindow;

SetWindowSize(800,600);

mnoj;

graf;

cont:=false;

end;

end;

end;

end;

ReDraw.

lockdrawing;

OnResize .

OnResize:=resize;

end.

function Yfunc(i: real): real;

begin

result:=A*sin(i)-D*sin(A*t);

end;

function Xfunc(i:real):real;

begin

Xfunc:=A*cos(i)+D*cos(A*i);

end;

, .

procedure mnoj;

begin

t:=0;

.

while t <= 2*pi do

begin

xx:=trunc(Xfunc(t));

ifabs(xx)> maxx then maxx:=abs(xx);

yy:=trunc(Yfunc(t));

if abs(yy)> maxy then maxy:=abs(yy);

.

t:=t+0.001;

end;

. : , , .

if WindowWidth<WindowHeight then

if maxy>maxx then k:=(WindowHeight/2)/maxy else k:=(windowWidth/2)/maxx else

If maxx>maxy then k:=(windowheight/2)/maxx else k:=(windowWidth/2)/maxy;

end;

.

function check1:boolean;

begin

.

if length(name)>0 then

begin

assign(fileg, name);

reset(fileg);

if eof(fileg)=false then check1:= true else check1:=false;

end;

end;

.

procedure graf;

begin

, .

k:=k-k*0.1;

. , . , , .

moveto(1, windowHeight div 2);

lineto(WindowWidth, WindowHeight div 2);

moveto(WindowWidth div 2, 1);

lineto(WindowWidth div 2, WindowHeight);

moveto(trunc((WindowWidth div 2)*0.98),trunc(0.04*WindowHeight));

Lineto((Windowwidth div 2),1);

lineto(trunc((windowWidth div 2)*1.02),trunc(0.04*windowHeight));

moveto(trunc(windowwidth*0.96),trunc(0.98*(windowheight div 2)));

lineto(windowwidth,windowheight div 2);

lineto(trunc(windowwidth*0.96),trunc(1.02*(windowheight div 2)));

T:=0;

, .

xx:=(WindowWidth div 2)+trunc(k*Xfunc(t));

yy:=(WindowHeight div 2)+trunc(k*Yfunc(t));

moveto(xx,yy);

, , .

while t<=2*pi do

begin

xx:=(WindowWidth div 2)+trunc(k*Xfunc(t));

yy:=(WindowHeight div 2)+trunc(k*Yfunc(t));

lineto(xx,yy);

. , .

t:=t+0.001;

end;

, .

If WindowWidth>400 then

If Windowheight>200 then

begin

textout(trunc(1.05*(windowWidth div 2)),trunc(0.01*(WindowHeight )),'Y');

Textout(trunc(0.95*WindowWidth),trunc((WindowHeight div 2)*1.05),'X');

end;

end;

.

procedure resize;

begin

mnoj;

ClearWindow;

graf;

redraw;

lockdrawing;

end;


 

5  5

, :

Type Vladelez=Record

Familia: String;

Adress:String;

Avto:lnteger;

Nomer:Integer;

End;

: - ;

- ;

- .

5.1   : Begin-




5.2 

Begin

, ch, .

for i:=1 to 200 do

ch[i]:=false;

, , 4.

5 .

clrscr;

menu;

, .

cont:=true;

fzap:=false;

while cont do

begin

write('Vvedite komandu: ');

readln(command);

case command of

'0': cont := false;

'1':

Begin

, , fzap true.

Write('Vvedite kol-vo zapisei(1..200): ');

readln(n);

if (n>0) and (n<=200) then

fzap:=true else fzap:=false;

end;

'2':

Begin

, , . , .

if fzap=true then

begin

for i:=1 to n do

hange(i, avtovl, ch);

clrscr;

menu;

end

else writeln('Ne vvedeno kol-vo zapisei');

end;

'3':

Begin

, . , .

if fzap=true then

begin

write('Vvedite nomer redaktiryemoi zapisi: ');

readln(i);

if i>n then writeln('Wrong input')

else

begin

change(i, avtovl, ch);

clrscr;

menu;

end;

end

else Writeln('Ne vvedeno obshee chislo zapisei');

end;

'4':

Begin

, . . , .

if fzap=true then

begin

for i:=1 to n do

if ch[i]=false then

begin

dzap:=false;

writeln('Vvedeni ne vse zapisi');

end

else dzap:=true;

if dzap=true then

mark(avtovl);

end

else

Writeln('Ne vvedeno obshee chislo zapisei');

end;

'5':

Begin

, .

if fzap=true then

begin

for i:=1 to n do

if ch[i]=false then

begin

dzap:=false;

writeln('Vvedeni ne vse zapisi');

end

else dzap:=true;

if dzap=true then

mostold(avtovl);

end

else

Writeln('Ne vvedeno obshee chislo zapisei');

end;

'6':

Begin

, .

if fzap=true then

begin

for i:=1 to n do

if ch[i]=false then

begin

dzap:=false;

writeln('Vvedeni ne vse zapisi');

end

else dzap := true;

if dzap=true then

oprmarki(avtovl);

end

else

Writeln('Ne vvedeno obshee chislo zapisei');

end;

end;

end;

end.

oprmarki;

procedure oprmarki(x: mas);

var

h:integer;

m:string;

begin

, .

Write('Vvedite marku avto: ');

readln(m);

for h:=1 to n do

if x[h].Avto=m then

writeln(x[h].Familia, ' nomer-', x[h].Nomer);

end;

procedure mostold(x: mas);

var

min,nmin,h:integer;

begin

min:=x[1].Vypusk;

nmin:=0;

min, nmin. .

for h:=1 to n do

if x[h].Vypusk<min then

begin

min:=x[h].Vypusk;

nmin:=h;

end;

Writeln(x[nmin].Familia, ' - ', min,' god vypuska');

end;

.

procedure mark(x: mas);

var

h, l, k: integer;

begin

for h := 1 to n do

begin

. . , . , , h- . h- l- , . .

if not (x[h].avto in marki) = true then

begin

k := 0;

include(marki, x[h].avto);

for l:=h to n do

if x[h]=x[l] then

if x[l].avto in marki then

k:=k + 1;

writeln(x[h].avto, '-', k);

end;

end;

end;

.

procedure change(x: integer; var z: mas; var v: mas2);

begin

clrscr;

, .

v[x]:=true;

write('Vvedite familiu: ');

readln(z[x].familia);

write('Vvedite adress: ');

readln(z[x].adress);

write('Vvedite marku avto: ');

readln(z[x].avto);

write('Vvedite nomer avto: ');

readln(z[x].nomer);

z[x].Vypusk:= 0;

while (z[x].Vypusk < 1900) or (z[x].Vypusk > 2000) do

begin

write('Vvedite god vipuska(1900..2000): ');

readln(z[x].vypusk);

end;

end;


 

6  .

Pascal. , , , .


 

1

program slova1;

uses crt;

type

Stroka250=string[250];

Slovo=string[20];

function Copy1(S: Stroka250; Start, Len: Integer):Stroka250;

var

Rez: Stroka250;

L: Integer;

I, J: Integer;

begin

L:=byte(S[0]);

if (L<Start) then

Rez[0]:=char(0)

else

begin

if (Start+Len-1)>L then

Len:=L-Start+1;

J:=Start;

for I:=1 to Len do

begin

Rez[I]:=S[J];

Inc(J);

end;

Rez[0]:=char(Len);

end;

Copy1:=Rez;

end;

function isletter(C: Char): Boolean;

begin

if ((C>='A') and (C<='Z')) or ((C>='a') and (C<='z')) then

isletter:=True

else

isletter:=False;

end;

function alforder(Sl: Slovo; var Count: Byte): Boolean;

var

I, L: Byte;

F: Boolean;

Buf: Char;

begin

L:=Length(Sl);

Count:=0;

for I:=1 to L do

begin

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.

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.


 

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;

slova2[k2] := copy(s2, i + 1, j - i - 1);

break;

end;

end;

end;

end;

procedure chmax;

begin

m1 := 0;

m2 := 0;

while not eof(first) do

begin

readln(first, S1);

m1 := m1 + 1;

end;

while not eof(second) do

begin

readln(second, S2);

m2 := m2 + 1;

end;

if m1 < m2 then m := m1 else m := m2;

close(first);

reset(first);

close(second);

reset(second);

end;

procedure filepr;

begin

assign(first, p);

assign(second, v);

assign(third, t);

reset(first);

reset(second);

rewrite(third);

end;

function check1(x: string): boolean;

begin

if length(x) > 0 then begin

if x[1] <> ' ' then

check1 := true;

end;

end;

procedure menu;

begin

writeln;

writeln('++++++++++++++++++++++++++++++++++++++++++++++++');

writeln('+ Vvod imeni pervogo faila --> 1 +');

writeln('+ Vvod imeni vtorogo faila --> 2 +');

writeln('+ Vvod imeni tretiego faila --> 3 +');

writeln('+ Preobrazovat tretii fail --> 4 +');

writeln('+ +');

writeln('+ Konec --> 0 +');

writeln('++++++++++++++++++++++++++++++++++++++++++++++++');

writeln;

end;

begin

menu;

pf := false;

vf := false;

tf := false;

cont := true;

flag1 := false;

flag2 := false;

while cont do

begin

writeln;

write('Vvedite komandu: ');

readln(command);

case command of

'0': cont := false;

'1':

begin

write('Vvedite imja pervogo faila: ');

readln(p);

if check1(p) = true then

begin

pf := true;

clrscr;

menu;

end

else

begin

clrscr;

menu;

writeln('Error input');

end;

end;

'2':

begin

write('Vvedite imja vtorogo faila: ');

readln(v);

if check1(v) = true then

begin;

vf := true;

clrscr;

menu;

end

else

begin

clrscr;

menu;

writeln('Error input');

end;

end;

'3':

begin

write('Vvedite imja tretego faila: ');

readln(t);

if check1(t) = true then

begin

tf := true;

clrscr;

menu;

end

else

begin

clrscr;

menu;

writeln('Error input');

end;

end;

'4':

begin

if (pf = true) and (vf = true) and (tf = true) then

begin

filepr;

chmax;

if check2 = false then

begin

for l := 1 to m do

begin

slv;

obrslov(slova1, slova2, k1, k2, slova, k);

for g := 1 to k do

begin

write(third, slova[g]);

if g < k then write(third, ' ');

end;

writeln(third, '');

end;

if m1 <> m2 then

begin

if m1 > m2 then for L := m to m1 do

begin

readln(first, S1);

writeln(third, S1);

end

else

for L := m to m2 do

begin

readln(second, S2);

Writeln(third, S2);

end;

end;

closing;

writeln('Operacia zavershena');

end

else

begin

if flag1 = true then writeln('Pervii fail pustoi');

if flag2 = true then writeln('Vtoroi fail pustoi');

end;

end

else

begin

if pf = false then writeln('Ne vvedeno imja pervogo faila');

if vf = false then writeln('Ne vvedeno imja vtorogo faila');

if tf = false then writeln('Ne vvedeno imja tretego faila');

end;

end;

else

writeln( 'Neizvestnaya komanda');

end;

end;

end.


 

10 

4

program grafik;

uses

graphabc;

var

xx, yy, a, d, maxy, maxx: integer;

t, k: real;

fileg: text;

cont, namef: boolean;

command: char;

name: string;

function Yfunc(i: real): real;

begin

result := A * sin(i) - D * sin(A * t);

end;

function Xfunc(i: real): real;

begin

result := A * cos(i) + D * cos(A * i);

end;

procedure mnoj;

begin

t := 0;

while t <= 2 * pi do

begin

xx := trunc(Xfunc(t));

if abs(xx) > maxx then maxx := abs(xx);

yy := trunc(Yfunc(t));

if abs(yy) > maxy then maxy := abs(yy);

t := t + 0.001;

end;

if WindowWidth < WindowHeight then

if maxy > maxx then k := (WindowHeight / 2) / maxy else k := (windowWidth / 2) / maxx else

if maxx > maxy then k := (windowheight / 2) / maxx else k := (windowWidth / 2) / maxy;

end;

procedure graf;

begin

k := k - k * 0.1;

moveto(1, windowHeight div 2);

lineto(WindowWidth, WindowHeight div 2);

moveto(WindowWidth div 2, 1);

lineto(WindowWidth div 2, WindowHeight);

moveto(trunc((WindowWidth div 2) * 0.98), trunc(0.04 * WindowHeight));

Lineto((Windowwidth div 2), 1);

lineto(trunc((windowWidth div 2) * 1.02), trunc(0.04 * windowHeight));

moveto(trunc(windowwidth * 0.96), trunc(0.98 * (windowheight div 2)));

lineto(windowwidth, windowheight div 2);

lineto(trunc(windowwidth * 0.96), trunc(1.02 * (windowheight div 2)));

T := 0;

xx := (WindowWidth div 2) + trunc(k * Xfunc(t));

yy := (WindowHeight div 2) + trunc(k * Yfunc(t));

moveto(xx, yy);

while t <= 2 * pi do

begin

xx := (WindowWidth div 2) + trunc(k * Xfunc(t));

yy := (WindowHeight div 2) + trunc(k * Yfunc(t));

lineto(xx, yy);

t := t + 0.0001;

end;

if WindowWidth > 400 then

if Windowheight > 200 then

begin

textout(trunc(1.05 * (windowWidth div 2)), trunc(0.01 * (WindowHeight )), 'Y');

Textout(trunc(0.95 * WindowWidth), trunc((WindowHeight div 2) * 1.05), 'X');

end;

end;

function check1: boolean;

begin

if length(name) > 0 then

begin

assign(fileg, name);

reset(fileg);

if eof(fileg) = false then check1 := true else check1 := false;

end;

end;

procedure menu;

begin

writeln;

writeln('++++++++++++++++++++++++++++++++++++++++++++++++');

writeln('+ Vvod imeni faila s parametrami --> 1 +');

writeln('+ Porstroenie grafika --> 2 +');

writeln('+ Vihod --> 0 +');

writeln('++++++++++++++++++++++++++++++++++++++++++++++++');

writeln;

end;

procedure resize;

begin

mnoj;

ClearWindow;

graf;

redraw;

lockdrawing;

end;

begin;

t := 0;

menu;

cont := true;

while cont do

begin

Writeln('Vvedite komady: ');

Readln(command);

case command of

'0': cont := false;

'1':

begin

writeln;

writeln('Vvedite imja faila: ');

Readln(name);

if check1 = true then begin

namef := true;

read(fileg, a);

read(fileg, d);

close(fileg);

end else namef := false;

end;

'2':

begin

if namef = false then

writeln('Ne Vvedeno imja faila')

else

begin

clearwindow;

SetWindowSize(800, 600);

mnoj;

graf;

cont := false;

end;

end;

end;

end;

lockdrawing;

OnResize := resize;

end.


 

11 

5

program zapisi;

uses

crt;

type

vladelez = record

Familia: string;

Adress: string;

Avto: string;

Nomer: string;

Vypusk: integer;

end;

mas2 = array [1..200] of boolean;

mas = array [1..200] of vladelez;

var

command: char;

cont, fzap, dzap: boolean;

avtovl: mas;

n: integer;

i: integer;

ch: mas2;

marki: set of string;

procedure oprmarki(x: mas);

var

h: integer;

m: string;

begin

Write('Vvedite marku avto: ');

readln(m);

for h := 1 to n do

if x[h].Avto = m then

writeln(x[h].Familia, ' nomer-', x[h].Nomer);

end;

procedure mostold(x: mas);

var

min, nmin, h: integer;

begin

min := x[1].Vypusk;

nmin := 1;

for h := 1 to n do

if x[h].Vypusk < min then

begin

min := x[h].Vypusk;

nmin := h;

end;

Writeln(x[nmin].Familia, ' - ', min, ' god vypuska');

end;

procedure mark(x: mas);

var

h, l, k: integer;

begin

for h := 1 to n do

begin

if not (x[h].avto in marki) = true then

begin

k := 0;

include(marki, x[h].avto);

for l := h to n do

if x[h] = x[l] then

if x[l].avto in marki then

k := k + 1;

writeln(x[h].avto, '-', k);

end;

end;

end;

procedure change(x: integer; var z: mas; var v: mas2);

begin

clrscr;

v[x] := true;

write('Vvedite familiu: ');

readln(z[x].familia);

write('Vvedite adress: ');

readln(z[x].adress);

write('Vvedite marku avto: ');

readln(z[x].avto);

write('Vvedite nomer avto: ');

readln(z[x].nomer);

z[x].Vypusk := 0;

while (z[x].Vypusk < 1900) or (z[x].Vypusk > 2000) do

begin

write('Vvedite god vipuska(1900..2000): ');

readln(z[x].vypusk);

end;

end;

procedure menu;

begin

writeln;

Writeln('+++++++++++++++++++++++++++++++++++++++++++++++++++++');

writeln('+ Ykazat kolichestvo zapisei ->1 +');

writeln('+ Izmenit vse zapisi ->2 +');

writeln('+ Izmenit odny zapis ->3 +');

writeln('+ Kolichestvo avtomobilei kazdoi marki ->4 +');

writeln('+ Vladelec samogo starogo avtomobila ->5 +');

writeln('+ Familii vladelcev i nomera avto dannoi marki ->6 +');

Writeln('+ +');

writeln('+ Konec ->0 +');

Writeln('+++++++++++++++++++++++++++++++++++++++++++++++++++++');

writeln;

end;

begin

for i := 1 to 200 do

ch[i] := false;

clrscr;

menu;

cont := true;

fzap := false;

while cont do

begin

write('Vvedite komandu: ');

readln(command);

case command of

'0': cont := false;

'1':

begin

Write('Vvedite kol-vo zapisei(1..200): ');

readln(n);

if (n > 0) and (n <= 200) then

fzap := true else fzap := false;

end;

'2':

begin

if fzap = true then

begin

for i := 1 to n do

change(i, avtovl, ch);

clrscr; menu;

end

else writeln('Ne vvedeno kol-vo zapisei');

end;

'3':

begin

if fzap = true then

begin

write('Vvedite nomer redaktiryemoi zapisi: ');

readln(i);

if i > n then writeln('Wrong input')

else

begin

change(i, avtovl, ch);

clrscr;

menu;

end;

end

else Writeln('Ne vvedeno obshee chislo zapisei');

end;

'4':

begin

if fzap = true then

begin

for i := 1 to n do

if ch[i] = false then

begin

dzap := false;

writeln('Vvedeni ne vse zapisi');

end

else dzap := true;

if dzap = true then

mark(avtovl);

end

else

Writeln('Ne vvedeno obshee chislo zapisei');

end;

'5':

begin

if fzap = true then

begin

for i := 1 to n do

if ch[i] = false then

begin

dzap := false;

writeln('Vvedeni ne vse zapisi');

end

else dzap := true;

if dzap = true then

mostold(avtovl);

end

else

Writeln('Ne vvedeno obshee chislo zapisei');

end;

'6':

begin

if fzap = true then

begin

for i := 1 to n do

if ch[i] = false then

begin

dzap := false;

writeln('Vvedeni ne vse zapisi');

end

else dzap := true;

if dzap = true then

oprmarki(avtovl);

end

else

Writeln('Ne vvedeno obshee chislo zapisei');

end;

end;

end;

end.


2011 , .