Untitled

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

const m = 3; //Здесь размер матрицы, поменяй на что-нибудь свое
type TMatrix = array[1..m,1..m] of integer;
var
    a:TMatrix;
    i,j,p,q:integer;
procedure InputData(var x:TMatrix);
var i,j:integer;
begin
    for i:=1 to m do
        for j:=1 to m do
        begin
            writeln('Введите элемент матрицы ',i,' ',j);
            readln(x[i,j]);
        end;
end;
function NullRow(const x:TMatrix; y:integer):boolean; //Состоит ли строка из нулей?
var i:integer;
    r:boolean;
begin
    r:=true;
    for i:=1 to m do
        if x[y,i]<>0 then r:=false;
    NullRow:=r;
end;
function NullColumn(const x:TMatrix; y:integer):boolean; //Состоит ли столбец из нулей?
var i:integer;
    r:boolean;
begin
    r:=true;
    for i:=1 to m do
        if x[i,y]<>0 then r:=false;
    NullColumn:=r;
end;
procedure RemoveRow(var x:TMatrix; y:integer); //Удаляем строку
var i:integer;
begin
    if y<>m then
        for i:=1 to m do
            x[y,i]:=x[y+1,i];
end;
procedure RemoveColumn(var x:TMatrix; y:integer); //Удаляем столбец
var i:integer;
begin
    if y<>m then
        for i:=1 to m do
            x[i,y]:=x[i,y+1];
end;
procedure PrintMatrix(const x:TMatrix; p:integer; q:integer);
var i,j:integer;
begin
    for i:=1 to p do
    begin
        for j:=1 to q do write(x[i,j], ' ');
        writeln;
    end;
end;
begin
    SetConsoleCp(1251); SetConsoleOutputCp(1251);
    InputData(a);
    p:=m; //Строк в конечной матрице
    q:=m; //Столбцов
    for i:=m downto 1 do
    begin
        if NullRow(a,i) then
        begin
            RemoveRow(a,i);
            p:=p-1;
        end;
        if NullColumn(a,i) then
        begin
            RemoveColumn(a,i);
            q:=q-1;
        end;
    end;
    PrintMatrix(a, p, q);
    readln;
end.