Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.07.2011, 13:36   #1
Metanoia
Новичок
Джуниор
 
Регистрация: 13.07.2011
Сообщений: 2
По умолчанию Нужно исправить ошибки!Pascal ABC Очень надо!

Текст вызывающей программы
Код:
Program xzsdv;
uses crt,modul1;
var A,c:matr;
 f1,f2:boolean;

procedure menu;
var choise,cinp:char;
 inp,e:integer;
begin
 clrscr;
 Writeln(' Menu');
 Writeln(' 1. Vvod matrici A');
 Writeln(' 2. Obraborat''matricu');
 Writeln(' 3. Vivesti rezultat');
 Writeln(' 4. Vihod');
 choise:=readkey;
 if choise=#27 then halt;
 if ((choise<>'1') and (choise<>'4') and (f1=false)) then
 begin
 Writeln('Snachala neobhodimo sozdat'' matricu A');
 cinp:=readkey;
 if cinp=#27 then halt;
 menu;
 end;
 if ((choise='3') and (f2=false)) then
 begin
 Writeln('Snachala neobhodimo obrabotat'' matricu A');
 cinp:=readkey;
 if cinp=#27 then halt;
 menu;
 end;
 Case choise of
 '1': begin
 f1:=true;
 clrscr;
 Writeln;
 Writeln('1. Sozdat sluchainuyu matricu');
 Writeln('2. Vvesti s klaviaturi');
 Writeln('3. Iz faila');
 cinp:=readkey;
 val(cinp,inp,e);
 if ((e=0) And ((inp=1) Or (inp=2) Or (inp=3))) then
 begin
 create(A,inp);
 menu;
 end
 else begin
 writeln('Neverniy vibor');
 readkey;
 menu;
 end;
 end;{1}
 '2': begin
 f2:=true;

 obrab(a,c);
 Writeln('Matrica uspeshno obrabotana:');
 Writeln('Ishodnaya matrica:');
 vivod(A,1,0);
 Writeln('Naiden minor minimalnogo elementa [',nomi('i',A),',',nomi('j',A),']');
 readkey;
 menu;
 end;
 '3': begin
 clrscr;
 Writeln;
 Writeln('1. Vivesti na ekran');
 Writeln('2. Sohranit v fail');
 Writeln('3. Raspechatat''');
 cinp:=readkey;
 val(cinp,inp,e);
 if ((e=0) And ((inp=1) Or (inp=2) Or (inp=3))) then
 begin
 vivod(C,inp,1);
 readkey;
 menu;
 end
 else begin
 writeln('Neverniy vibor');
 readkey;
 menu;
 end;
 end;
 '4': halt;
 else begin
 writeln('Neverniy vibor');
 readkey;
 menu;
 end;

 end;{Case}
end;

BEGIN
clrscr;
f1:=false;
f2:=false;
menu;

readkey;
END.

___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

Последний раз редактировалось Serge_Bliznykov; 13.07.2011 в 14:55.
Metanoia вне форума Ответить с цитированием
Старый 13.07.2011, 13:36   #2
Metanoia
Новичок
Джуниор
 
Регистрация: 13.07.2011
Сообщений: 2
По умолчанию Модуль

Текст модуля
Код:
unit modul1;
interface
{uses wincrt,winprn;}
const n=40;
type
matr = array [1..n,1..n] of integer;
var k1,k2: integer;

procedure create (var b:matr;t:integer);
procedure vivod (b:matr;t:integer;x:integer);
function nomi(x:char;b:matr):integer;
function null(c:matr):integer;
procedure obrab (b:matr;var c:matr);
 function FileExists(FileName: String): Boolean;

implementation
var F:file of integer;
function FileExists:string;
begin
 {$I-}
 Assign(F, FileExists);
 Reset(F);
 Close(F);
 {$I+}

 end;

function null:integer;
var k,i,j:integer;
c:Array[1..n,1..n] of integer;
 begin
 k:=0;
 for i:=1 to k1-1 do
 for j:=1 to k2-1 do
 if c[i,j]=0 then k:=k+1;
end;

procedure obrab;
var x,y,i,j:integer;
b:matr;
c:Array[1..n,1..n] of integer;
 begin
 x:=0; y:=0;
 for i:=1 to k1 do
 begin
 if i<>nomi('i',b) then x:=x+1;
 y:=0;
 for j:=1 to k2 do
 if (j<>nomi('j',b)) And (i<>nomi('i',b)) then
 begin
 y:=y+1;
 c[x,y]:=b[i,j];
 end;
 end;
 end;
function nomi:integer;
 var min,a,i,j:integer;
 b:matr;
 x:char;
 begin
 min:=maxint;
 for i:=1 to k1 do
 for j:=1 to k2 do
 begin
 if b[i,j]<min then begin
 min:=b[i,j];
 if x='i' then a:=i;
 if x='j' then a:=j;
 end;
 end;
 end;


procedure create;
 var i,j,x,e:integer;
 f:text;
 ch: char;
 path,s: string;
 t:integer;
 b:matr;
begin
 case t of
 1: begin {random}
 randomize;
 writeln('Vvedite razmer matrici');
 write('n='); readln(k1);
 write('m='); readln(k2);
 for i:=1 to k1 do
 for j:=1 to k2 do
 b[i,j]:=random(21)-10;
 end;{random}
 2: begin{keyboard}
 writeln('Vvedite razmer matrici');
 write('n='); readln(k1);
 write('m='); readln(k2);
 writeln('Vvedite ',k1*k2,' elementov');
 for i:=1 to k1 do
 for j:=1 to k2 do
 begin
 write('Vvedite [',i,',',j,'] element: ');
 readln(s);
 val(s,x,e);
 if e=0 then b[i,j]:=x
 else begin
 Writeln('Matrica dolzhna sostoyat'' iz celih chisel');
 readln;
 i:=k1;
 j:=k2;
 end;
 end;
 end;{keyboard}
 3: begin{FromFile}
 i:=1; j:=1; s:=''; k1:=1; k2:=1;
 Writeln('Vvedite imya faila (ili polniy put)');
 readln(path);
 if FileExists(path):=true then
 begin
 Assign(f,path);
 Reset(f);
 repeat
 Read(F, ch);
 if ch=#10 then begin
 i:=i+1;
 k1:=k1+1;
 k2:=j-1;
 j:=1;
 end;
 if ((ch<>' ')and(ch<>#13)and(ch<>#10)) then s:=s+ch
 else  begin
 if (s<>'') then
 begin
 val(s,x,e);
 s:='';
 if e=0 then begin
 b[i,j]:=x;
 j:=j+1;
 end
 else begin
 writeln('Oshibka v dannih');
 end;
 end;
 end;
 until Eof(F);

 if s<>'' then begin
 val(s,x,e);
 s:='';
 if e=0 then begin
 b[i,j]:=x;
 j:=j+1;
 end
 else begin
 writeln('Oshibka v dannih');
 end;
 end;
 Close(f);
 end{FileExist}
 else begin
 writeln('Fail ne sushestvuet');
 readln;
 end;
 end;{FromFile}
 end;{case}
end;{procedure}

 procedure vivod;
 var i,j:integer;
 ff,fp:text;
 path:string;
 line:string;
begin
 case t of
 1: begin
 for i:=1 to k1-x do
 begin
 for j:=1 to k2-x do
 write (b[i,j]:6);
 writeln;
 end;
 if x=1 then Writeln('Kolichestvo nuley: ',null(b));
 end;
 2: begin
 Writeln('Vvedite imya faila (ili polniy put)');
 readln(path);

 assign(ff,path);
 rewrite(ff);
 for i:=1 to k1-x do
 begin
 for j:=1 to k2-x do
 write(ff,b[i,j],' ');
 writeln(ff);
 end;
 Writeln(ff,'Kolichestvo nuley: ',null(b));
 Close(ff);
 Writeln('Matrica uspeshno sohranena v faile ',path);
 end;
(* 3: begin{Printer}
 AssignDefPrn(fp);
 for i:=1 to k1 do
 for j:=1 to k2 do
 Writeln(fp, b[i,j], ' ');

 if KeyPressed and (ReadKey = #27) then
 begin
 AbortPrn(Prn);
 Break;
 end;
Close(fp);
 end;*){Printer}

end;{case}
end;{Procedure}
end.

___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

Последний раз редактировалось Serge_Bliznykov; 13.07.2011 в 14:55.
Metanoia вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужно исправить ошибки ДмитрийРэй Помощь студентам 0 22.05.2011 16:37
Нужно исправить ошибки в С+ Ximik28 Общие вопросы C/C++ 12 11.01.2011 04:14
надо до зафтра сделать,из С++ в Pascal ABC Aidar9119 Помощь студентам 0 04.01.2011 18:58
нужно исправить ошибки( basav1k Помощь студентам 3 17.05.2010 22:46