Юмор, :) Опции

[oleg309]

Летит компьютер с девятого этажа и думает: "Эх, сейчас бы зависнуть..."

[Altair]

Прога пришла по почте от одной девушки.
вот цитата из аськи: (ник ее изменен)

22:19:08 ****: я написала кое-как лабу... скажи мне, как она должна работать!!
  22:21:29 Oleg_Z: не совсем понял чтоты от меняхочешь..... тебе лабу сдалать?
  22:21:59 ****: когда её запускаешь, что должно происходить?
  22:23:52 Oleg_Z: а я откуда знаю? что за глупые вопросы?
  22:24:49 ****: глупые? ну спасибо... ты кажется хвастался что всё знаешь...мо жно я те её на мыло скину, ты посмотришь?
  22:25:02 Oleg_Z: кидай.
  22:28:48 ****: я отправила
  22:31:58 ****: Посмотри пожалста!!!!
  22:32:10 Oleg_Z: щас

Обратите внимание на ФОРМАТИРПОВАНИЕ ТЕКСТА!!!!!!!
ЭТО ОРИГИНАЛ!!!!!!!!!

Исходный код

program laba1;
uses crt;
type um=^tm;
tm=array[1..10,1..10] of integer;
matrix=object
m,n:integer;
a:um;
constructor init;
procedure del; virtual;
destructor done; virtual;
end;
matr=object(matrix)
constructor init1;
procedure del; virtual;
procedure stb;
destructor done; virtual;
end;
constructor matrix.init;
var i,j:integer;
begin
writeln('vvedite m,n');
readln(m,n);
getmem(a,2*m*n);
writeln('vvedite elementi');
for i:=1 to m do
for j:=1 to n do
readln(a^[i,j])
end;
destructor matrix.done;
begin
freemem(a,2*m*n)
end;
procedure matrix.del;
var i,j,max,k:integer;
f:boolean;
begin
max:=a^[1,1];
for i:=1 to m do
for j:=1 to n do
if a^[i,j]>max then
max:=a^[i,j];
k:=0;
for i:=1 to m do
begin
f:=true;
for j:=1 to n do
if a^[i,j]=max then
f:=false;
if f then
begin
k:=k+1;
for j:=1 to n do
a^[k,j]:=a^[i,j];
end;
end;
for i:=1 to k do
begin
for j:=1 to n do
write (a^[i,j]:5);
writeln
end;
end;
constructor matr.init1;
var i,j:integer;
begin
writeln('vvedite m,n');
readln(m,n);
getmem(a,2*m*n);
writeln('vvedite elementi');
for i:=1 to m do
for j:=1 to n do
read (a^[i,j])
end;
procedure matr.del;
var i,j,d,k:integer;
f:boolean;
begin
k:=0;
for i:=1 to m do
for d:=1 to n do
begin
f:=true;
for j:=1 to n do
if a^[i,j]=d then
f:=false
end;
if f then
begin
k:=k+1;
for j:=1 to n do
a^[k,j]:=a^[i,j];
end;
for i:=1 to k do
begin
for j:=1 to n do
write(a^[i,j]:5);
writeln
end;
end;
procedure matr.stb;
var i,j,f0,f1,f2,k:integer;
f:boolean;
begin
k:=0;
for j:=1 to n do
f:=true;
for i:=1 to m do
begin
f0:=0;
f1:=1;
while f1<a^[i,j] do
begin
f2:=f0+f1;
f0:=f1;
f1:=f2
end;
if f1=a^[i,j] then f:=false
end;
if f then
begin
k:=k+1;
for i:=1 to m do
a^[i,k]:=a^[i,j]
end;
for i:=1 to m do
begin
for j:=1 to n do
write (a^[i,j]:5);
writeln
end;
end;
destructor matr.done;
begin
freemem(a,2*m*n)
end;
var r1:matrix;
   r2:matr;
begin
r1.init;
r1.del;
r2.init1;
r2.del;
r2.stb;
r2.done;
r1.done;
readkey
end.

Сообщение отредактировано: APAL - 18.03.2005 18:11