Матрица Опции

[ghost]

:help: Помогите пожалуйста сделать задачу :help:
Дана матрица А(6,6). Создать новую матрицу В(6,6), где
а) В(I,J)=A(I,J), если A(I,J)>0
б) B(I,J) не равно 0, если A(I,J)<=0
Вывести исходную матрицу А, а под ней полученную матрицу В.
В программе должна быть "защита от дурака"

Сообщение отредактировано: ghost - 5.12.2004 0:23

[ghost]

Как будет выглядет б/с к этой немного переделанной проге

Код

uses crt;
const
  max_n = 9;
var
a,b:array[1..max_n,1..max_n] of integer;
i,j,n1,n2,error:integer;
s: string; x: longint; er: integer;
bn: boolean;
label e1;
begin
clrscr;
gotoxy  (3,10);
  writeln ('Данная программа задаёт матрицу А. После чего создаёт');
   gotoxy  (57,10);
  writeln ('новую матрицу B, где ');
   gotoxy  (12,11);
  writeln ('а) B(i,j) = A(i,j), если A(i,j) > 0');
   gotoxy  (12,12);
  writeln ('б) B(i,j) не равно 0, если A(i,j) <= 0');
   gotoxy  (7,14);
  writeln ('Элементами матрицы могут быть только целые числа от -32768 до 32767,');
   gotoxy  (18,15);
  writeln ('максимальный размер матрицы 9х9!');
   gotoxy  (12,17);
  writeln ('текст');
   gotoxy  (27,18);
  writeln ('текст');
   gotoxy  (18,20);
  writeln ('Нажмите любую клавишу для продолжения');
   readkey;
e1:
clrscr;
  repeat
    write('Введите кол-во строк = ');
{$I-} readln(n1);
error:=ioresult;{$I+}
IF (n1<2) or (n1>max_n) or (error<>0)
then  writeln ('Кол-во строк от 2 до 9!');
  until (n1 >= 2) and (n1<=max_n) and (error=0);

  repeat
    write('Введите кол-во столбцов = ');
    {$I-} readln(n2);
    error:=ioresult;{$I+}
    IF (n2<2) or (n2>max_n) or (error<>0)
    then writeln ('Кол-во столбцов от 2 до 9!');
  until (n2 >= 2) and (n2<=max_n) and (error=0);


  for i := 1 to n1 do
  for j := 1 to n2 do
    begin
      repeat
        write('a[', i, ',', j, '] = '); Readln(s);
        val(s, x, er);
        bn := (er<>0) or (x < -Pred(maxint)) or (x > maxint);
        if bn then writeln('Введённый вами символ вне диапозона от -32768 до 32767');
      until not bn;
      a[i,j] := x;
    end;

  for i := 1 to n1 do
  for j := 1 to n2 do
  begin
       if a[i,j] > 0 then b[i,j] := a[i,j]
       else
       b[i,j] := 0;
  end;
  clrscr;
  write('matrix A');
  for i := 1 to n1 do
  begin
       writeln;
       for j := 1 to n2 do
       Write(a[i,j]:7);
  end;

  writeln;
  write('matrix B');
  for i := 1 to n1 do
  begin
       writeln;
       for j := 1 to n2 do
       Write(b[i,j]:7);
       end;
       writeln ('');
       write('Вы хотите сделать ещё одну матрицу? y/n');
       case readkey of
   #89: goto  e1;
   #121: goto e1;
   #78: exit;
   #110: exit;
  end;
end.